Bonjour à tous, j’ai écris une macro permettant d’effectuer un export du déplié de pièces de tolerie, tout marche bien lorsque celle ci est enclenchée depuis une piece.
Je souhaite la faire fonctionner meme lorsque le document actif est un plan (j’y arrive pour export step).
L’objet est donc, dans le cas ou le point de depart est un plan, d’ouvrir/activer la piece du meme nom puis de faire l’export via ExportToDWG2.
Or j’obtiens une erreur « propriété ou méthode non gérée par cet objet » dans ce contexte, des idées?
(pourtant apres l’ouverture de la piece, MsgBox ("Le document actif est: " & swApp.ActiveDoc.GetTitle) m’indique bien que la pièce est active)
---------------------------------VERIFICATION DU CONTEXTE ET LANCEMENT-------------------------
Sub dxfexport()
If Not swDOC Is Nothing Then
If swDOC.GetType = swDocDRAWING Then
If fso.FileExists(PART_PATH) Then
Call openpart
Call dxf
Call closepart
Else: MsgBox ("Pièce Introuvable")
End If
ElseIf swDOC.GetType = swDocPART Then
'openpart
dxf
End If
Else
MsgBox « Veuillez ouvrir un document », vbExclamation + vbOKOnly
End If
End Sub
---------------------------------OUVERTURE DE LA PIECE----------------------------
Sub openpart()
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Do
If fso.FileExists(PART_PATH) Then
Set Part = swApp.OpenDoc6(PART_PATH, 1, 0, « », longstatus, longwarnings)
swApp.ActivateDoc3 PART_PATH, False, swRebuildOnActivation_e.swDontRebuildActiveDoc, longstatus
'swApp.ActivateDoc2 PART_PATH, False, longstatus
Set Part = swApp.ActiveDoc
Else: MsgBox (« Pièce Introuvable »)
End If
Loop Until Part.GetType = swDocPART
Part.EditRebuild3
Part.ViewZoomtofit2
MsgBox ("Le document actif est: " & swApp.ActiveDoc.GetTitle)
End Sub
-------------------------------------------EXPORT------------------------------------
Sub dxf()
Dim modelPath As String
Dim longstatus As Long
modelPath = swDOC.GetPathName
Dim OUT_PATH As String
OUT_PATH = EXPORT_PATH & FILE_NAME & Indice + ".DXF"
Dim options As Long
options = 1 Or 2 Or 4 Or 8 Or 16 Or 32
'Codes d'options d'export:
'ExportFlatPatternGeometry = 1
'IncludeHiddenEdges = 2
'ExportBendLines = 4
'IncludeSketches = 8
'MergeCoplanarFaces = 16
'ExportLibraryFeatures = 32
'ExportFormingTools = 64
'ExportBoundingBox = 2048
If modelPath = "" Then
Err.Raise vbError, "", "Enregistrez votre pièce avant export"
Else
If False = swDOC.ExportToDWG2(OUT_PATH, PART_PATH, swExportToDWG_e.swExportToDWG_ExportSheetMetal, True, Empty, False, False, options, Empty) Then
Err.Raise vbError, "", "Erreur d'export DXF"
End If
End If
End Sub
