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...
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.