Witam wszystkich,
Chcę opracować makro, które pozwoli otworzyć plany każdej części danego zespołu (pliku w toku), a następnie zrobić PDF-y (celem jest zrobienie pliku produkcyjnego dla moich podwykonawców, nie zapominając o niczym). Konwersja do formatu PDF nie stanowi problemu, ale nie wiem, jak wyszukać każdą część drzewa złożenia, a następnie otworzyć powiązany plan (jeśli istnieje).
Jakiś pomysł?
Korzystam z oprogramowania SW 2021, bez PDM i myCAD.
Z góry dziękuję za odpowiedzi. 
0
Witam
Witam na forum 
W załączeniu znajduje się istniejące makro
CytatSub Pokaż wszystkie otwarte pliki()
Dim swDoc jako SldWorks.ModelDoc2
Dim swAllDocs As EnumDocuments2
Przyciemnij FirstDoc jako SldWorks.ModelDoc2
Dim dummy As Boolean
Dim NumDocsZwrócono tak długo, jak długo
Dim DocCount tak długo
Słońce i tak długo
Dim sMsg As Ciąg
Dim swApp jako SldWorks.SldWorks
Dim bDocWasVisible As Boolean
Przyciemnij OpenWarnings tak długo
Przyciemnij OpenErrors tak długo
Dim DwgPath As Ciąg
Przyciemnij myDwgDoc jako SldWorks.ModelDoc2
Dim drwPathName As String
Przyciemnij pdfPathName jako ciąg
Przyciemnij pdfFolderName Jako ciąg
Dim swExportPDFData As SldWorks.ExportPdfData
Dim lErrors tak długo
Dim lOstrzeżenia tak długo
Dim boolstatus As Boolean
Ustaw swApp = Application.SldWorks
Ustaw swAllDocs = swApp.EnumDocuments2
Ustaw FirstDoc = swApp.ActiveDoc
Liczba dokumentów = 0
swAllDocs.Reset
swAllDocs.Next 1, swDoc, NumDocsReturned
Podczas gdy NumDocsReturned <> 0
bDocWasVisible = swDoc.Visible
‹ swApp.ActivateDoc swDoc.GetPathName ›
DwgPath = swDoc.Nazwa_ścieżki_pobierania
Jeśli (LCase(Right(DwgPath, 3)) <> " drw ") And (DwgPath <> " ") Wtedy
DwgPath = Lewo(DwgPath, Len(DwgPath) - 3) & " drw "
Ustaw myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, " ", OpenErrors, OpenWarnings)
Jeśli nie myDwgDoc to nic to
swApp.ActivateDoc myDwgDoc.GetPathName
pdfFolderName = "C:\pdf pliki"
Dim fso As Scripting.FileSystemObject
Ustaw fso = CreateObject(" Scripting.FileSystemObject ")
Jeśli (Nie fso. FolderExists(pdfFolderName)) Następnie
MkDir nazwa_folderu pdf
"MsgBox" (pdfFolderName + " nie istnieje")
"Wyjdź z sub
Zakończ jeżeli:
Przyciemnij część jako ModelDoc2
Ustaw część = swApp.ActiveDoc()
"Masz aktywny rysunek
drwPathName = Część.GetPathName()
Jeśli (" " = drwNazwaŚcieżki) Wtedy
' GetPathName() było puste
MsgBox (" Ten rysunek nie został jeszcze zapisany ")
Wyjdź z subwoofera
Zakończ jeżeli:
pdfPathName = fso. BuildPath(pdfFolderName, fso. GetBaseName(drwPathName) + " .pdf ")
Debug.Print nazwa_ścieżki pdf
Ustaw swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = Fałsz
Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
'MsgBox (" Plik PDF został utworzony ")
swApp.QuitDoc (Część.GetTitle)
Ustaw myDwgDoc = Nic
Zakończ jeżeli:
Zakończ jeżeli:
swAllDocs.Next 1, swDoc, NumDocsReturned
DocCount = Liczba dokumentów + 1
Wend
swApp.ActivateDoc FirstDoc.GetPathName
Koniec subwoofera
Witam
Świetnie, to jest dokładnie to, czego potrzebowałem.
Dziękuję za pomoc.
Proszę 