EXPORT DE FICHIER AUTOCAD VERS WMF ET DXF (EN LOT)

Public Sub ExportWmfDxf()
    '---------------------------------------------------------------------------------------
    '------------                   Macro crée               le 16/01/08              ------
    '---------------------------------------------------------------------------------------
    '---------------------------------------------------------------------------------------
    '-----                 faire un bouton avec la commande suivante dans autocad          -
    '-----   $path of DVB module$ fait référence à l'emplacement du fichier "dvb"          -
    '-----                           à remplacer par le bon chemin !                       -
    '---------------------------------------------------------------------------------------
    '----   ^C^C-vbarun "C:/ $path of DVB module$ /export_WmfDxf.dvb!Module1.ExportWmfDxf" -
    '---------------------------------------------------------------------------------------
    
    Dim DOC As AcadDocument
    Dim msg As String
    
    msg = vbCrLf & " - Dessin concerné :" & vbCrLf
    For Each DOC In Documents
        msg = msg & DOC.Name & vbCrLf
    Next
        msg = msg & vbCrLf & "Note : les fichiers seront exportés au même endroit que le fichier source." & vbCrLf
        
    If Documents.Count > 0 Then
        myans = MsgBox("ATTENTION le dessin sera fermé à la fin de la manipulation, le contenu ne sera PAS SAUVEGARDER, Doit-je donc Continuer ?: " & msg, vbOKCancel, "ATTENTION")
    Else
        Exit Sub
    End If
    
    If myans <> vbOK Then Exit Sub
    
    For Each DOC In Documents
        DOC.Activate
        Call ExportBoucle
    Next
End Sub

Public Sub ExportBoucle()

    ' init
    
    Dim sset As AcadSelectionSet
    Dim newPViewport As AcadPViewport
    Dim centerPoint(0 To 2) As Double
    Dim height As Double
    Dim width As Double
    Dim exportFile As String
    
    height = 300#
    width = 400#
    
    ' sauvegarde au format DXF (version compatible Autocad 2000)
    
    ThisDrawing.Activate
    ThisDrawing.ActiveSpace = acModelSpace
    ZoomExtents
    exportFile = ThisDrawing.Path & "\" & Left(ThisDrawing.Name, Len(ThisDrawing.Name) - 4)
    ThisDrawing.SaveAs exportFile & ".dxf", ac2000_dxf
    
    ' sauvegarde au format wmf en N&B
    
    'création de la fenetre
    centerPoint(0) = 0#: centerPoint(1) = 0#: centerPoint(2) = 0#
    ThisDrawing.ActiveSpace = acPaperSpace
    Set newPViewport = ThisDrawing.PaperSpace.AddPViewport(centerPoint, width, height)
    ZoomExtents
    ' activation de la nouvelle fenetre
    newPViewport.Display True
    ThisDrawing.MSpace = True
    ThisDrawing.ActivePViewport = newPViewport
    ZoomExtents
    ' tout les calques en N&B
    t = ThisDrawing.Layers.Count
    For n = 1 To t - 1
        ThisDrawing.Layers.Item(n).color = acWhite
    Next n
    ' regeneration de la fenetre pour le N&B
    ThisDrawing.Regen acActiveViewport
    ' selection du contenu de la fenetre
    Set sset = ThisDrawing.SelectionSets.Add(ThisDrawing.Name)
    sset.Select acSelectionSetAll
    ' sauvegarde wmf du contenu de la selection
    ThisDrawing.Export exportFile, "wmf", sset
    ' libération de la selection
    Set sset = Nothing
    ' fermeture du dessin (sans sauvegarde)
    ThisDrawing.Close False
    
End Sub

Télécharger le zip

18 janvier 2008 16:28:45 :

vide