Hello everyone,
I'm looking to develop a macro that allows you to open the plans of each part of a given assembly (the file in progress) and then make PDFs (the objective is to make a manufacturing file for my subcontractors without forgetting anything). The conversion to PDF no problem, but I don't know how to search for each part of the assembly tree and then open the associated plan (if existing).
Any idea?
I'm on SW 2021, without PDM or myCAD.
Thank you in advance for your answers. 
0
Hello
Welcome to the forum 
Attached is an existing macro
CitationSub ShowAllOpenFiles()
Dim swDoc As SldWorks.ModelDoc2
Dim swAllDocs As EnumDocuments2
Dim FirstDoc As SldWorks.ModelDoc2
Dim dummy As Boolean
Dim NumDocsReturned As Long
Dim DocCount As Long
Sun i As Long
Dim sMsg As String
Dim swApp As SldWorks.SldWorks
Dim bDocWasVisible As Boolean
Dim OpenWarnings As Long
Dim OpenErrors As Long
Dim DwgPath As String
Dim myDwgDoc As SldWorks.ModelDoc2
Dim drwPathName As String
Dim pdfPathName As String
Dim pdfFolderName As String
Dim swExportPDFData As SldWorks.ExportPdfData
Dim lErrors As Long
Dim lWarnings As Long
Dim boolstatus As Boolean
Set swApp = Application.SldWorks
Set swAllDocs = swApp.EnumDocuments2
Set FirstDoc = swApp.ActiveDoc
DocCount = 0
swAllDocs.Reset
swAllDocs.Next 1, swDoc, NumDocsReturned
While NumDocsReturned <> 0
bDocWasVisible = swDoc.Visible
‹ swApp.ActivateDoc swDoc.GetPathName ›
DwgPath = swDoc.GetPathName
If (LCase(Right(DwgPath, 3)) <> " drw ") And (DwgPath <> " ") Then
DwgPath = Left(DwgPath, Len(DwgPath) - 3) & " drw "
Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, " ", OpenErrors, OpenWarnings)
If Not myDwgDoc Is Nothing Then
swApp.ActivateDoc myDwgDoc.GetPathName
pdfFolderName = "C:\pdf files"
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject(" Scripting.FileSystemObject ")
If (Not fso. FolderExists(pdfFolderName)) Then
MkDir pdfFolderName
'MsgBox (pdfFolderName + " does not exist")
'Exit Sub
End If
Dim Part As ModelDoc2
Set Part = swApp.ActiveDoc()
'You have a drawing active
drwPathName = Part.GetPathName()
If (" " = drwPathName) Then
' GetPathName() was empty
MsgBox (" This drawing has not been saved yet ")
Exit Sub
End If
pdfPathName = fso. BuildPath(pdfFolderName, fso. GetBaseName(drwPathName) + " .pdf ")
Debug.Print pdfPathName
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False
Part.Extension.SaveAs pdfPathName, 0, 0, swExportPDFData, lErrors, lWarnings
'MsgBox (" PDF file was created ")
swApp.QuitDoc (Part.GetTitle)
Set myDwgDoc = Nothing
End If
End If
swAllDocs.Next 1, swDoc, NumDocsReturned
DocCount = DocCount + 1
Wend
swApp.ActivateDoc FirstDoc.GetPathName
End Sub
Hello
Great, that's exactly what I needed.
Thank you for your help.
You're welcome 