Export de fichier autocad vers wmf et dxf (en lot)

Télécharger le projet
Commenter

Description

Ayant besoin d'exporter une bonne quantité de dessins dans différents formats, j'ai fait ce petit bout de code qui satisfait à mon besoin...

requis:
Autocad 2006
fonctionnement:
- charger les fichiers(2D) dans Autocad
- lancer la macro
- les fichiers wmf & dxf sont automatiquement créer au même niveau dans l'arborescence du fichier d'origine
- fermeture du fichier
- rebouclage ou arret si plus fichier n'est charger

Note aux administrateurs CS:
Je n'ai pas vu de categorie 2D mais ce bout de code marche avec des fichiers 2D ^^

Source / Exemple : 


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

Conclusion :


mon code est loin d'etre optimal mais il marche sur Autocad 2006 je l'ai tester sur 50 fichiers charger avec un poids variable de 500ko à 8Mo avec succes...
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.