Witam wszystkich, napisałem makro do eksportu rozwiniętych części arkusza blachy, wszystko działa dobrze, gdy jest włączone z części.
Chcę, aby działał nawet wtedy, gdy aktywny dokument jest planem (zbliżam się do etapu eksportu).
W przypadku, gdy punktem wyjścia jest plan, celem jest, aby otworzyć/aktywować część o tej samej nazwie, a następnie wyeksportować ją za pomocą ExportToDWG2.
Ale otrzymuję błąd "właściwość lub metoda nie jest obsługiwana przez ten obiekt" w tym kontekście, pomysły?
(jednak po otwarciu części, MsgBox ("Aktywny dokument to: " & swApp.ActiveDoc.GetTitle) informuje mnie, że część jest aktywna)
---------------------------------SPRAWDZENIE KONTEKSTU I URUCHOMIENIE-------------------------
Sub dxfexport()
Jeśli nie swDOC to nic to nic
Jeśli swDOC.GetType = swDocDRAWING Następnie
Jeśli fso. FileExists(PART_PATH) Następnie
Zadzwoń do openpart
Zadzwoń do dxf
Zadzwoń closepart
Else: MsgBox ("Pièce Introuvable")
End If
ElseIf swDOC.GetType = swDocPART Then
'openpart
dxf
End If
Inaczej
MsgBox "Proszę otworzyć dokument", vbExquiation + vbOKOnly
Zakończ jeżeli:
Koniec subwoofera
--------------------------------- OTWARCIU POKOJU----------------------------
Sub openpart()
Dim swApp As Object
Przyciemnij część jako obiekt
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Ustaw swApp = Application.SldWorks
Ustaw część = swApp.ActiveDoc
Robić
Jeśli fso. FileExists(PART_PATH) Następnie
Ustaw część = swApp.OpenDoc6(PART_PATH, 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc3 PART_PATH, False, swRebuildOnActivation_e.swDontRebuildActiveDoc, longstatus
'swApp.ActivateDoc2 PART_PATH, Fałsz, długi status
Ustaw część = swApp.ActiveDoc
W przeciwnym razie: MsgBox ("nie znaleziono części")
Zakończ jeżeli:
Pętla do Part.GetType = swDocPART
Part.EditRebuild3 (Edycja części)
Part.ViewZoomtofit2
MsgBox ("Aktywny dokument to: " & swApp.ActiveDoc.GetTitle)
Koniec subwoofera
-------------------------------------------EKSPORT------------------------------------
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"
Inaczej
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
Zakończ jeżeli:
Koniec subwoofera
