Hi everyone,

I have modified the macro posted in Code Stack Traversing the components tree using SOLIDWORKS API in order to print the drawings of all the components inside the active assembly. 

There will be instances that I have an sub-assembly as a reference only/ excluded from BOM. So I need a way to for the macro to skip all components tagged with "exclude from BOM".

Im not proficient at all on VBA. I just grab examples on the Internet and kinda merge them together. If anyone could modify the macro for me, I would greatly appreciate it.

Also, the traverse portion doesn't follow the order of the design tree; if that could be changed, it would be perfectly splendid.

Thanks!

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDwg As SldWorks.ModelDoc2
Dim swExt As SldWorks.ModelDocExtension
Dim PrintSpec As SldWorks.PrintSpecification
Dim DrawingFile As String
Dim Errors As Long
Dim Warnings As Long
Dim longstatus As Long, longwarnings As Long

Const INDENT_SYMBOL As String = " "

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then

DrawingFile = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1) & ".slddrw"
Debug.Print DrawingFile

If Dir(DrawingFile) <> "" Then
swApp.OpenDoc6 DrawingFile, swDocDRAWING, swOpenDocOptions_Silent, "", Errors, Warnings
swApp.ActivateDoc2 DrawingFile, True, longstatus

Call Print_current
swApp.CloseDoc DrawingFile

End If

Dim swRootComp As SldWorks.Component2

Set swRootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent

TraverseComponent swRootComp, ""

Else

MsgBox "Please open assembly"

End If

End Sub

Sub TraverseComponent(comp As SldWorks.Component2, indent As String)

Dim vChildComps As Variant

vChildComps = comp.GetChildren

Dim i As Integer

For i = 0 To UBound(vChildComps)

Dim swChildComp As SldWorks.Component2
Set swChildComp = vChildComps(i)

DrawingFile = Left(swChildComp.GetPathName, InStrRev(swModel.GetPathName, ".") - 1) & ".slddrw"
Debug.Print DrawingFile

If Dir(DrawingFile) <> "" Then
swApp.OpenDoc6 DrawingFile, swDocDRAWING, swOpenDocOptions_Silent, "", Errors, Warnings
swApp.ActivateDoc2 DrawingFile, True, longstatus

Call Print_current
swApp.CloseDoc DrawingFile

End If

TraverseComponent swChildComp, indent & INDENT_SYMBOL

Next

End Sub

Sub Print_current()

Set swDwg = swApp.ActiveDoc
Set swExt = swDwg.Extension
Dim myPageSetup As Object

Set myPageSetup = swDwg.PageSetup
myPageSetup.DrawingColor = swPageSetupDrawingColor_e.swPageSetup_BlackAndWhite
myPageSetup.ScaleToFit = True
myPageSetup.Orientation = swPageSetupOrientation_e.swPageSetupOrient_Landscape
myPageSetup.PrinterPaperSize = 17

Set PrintSpec = swExt.GetPrintSpecification
PrintSpec.ScaleMethod = swPrintAll

'swExt.PrintOut4 "", "", PrintSpec
Debug.Print "----------" & swDwg.GetPathName
Set swExt = Nothing
Set swPrintSpec = Nothing
Set swDwg = Nothing

End Sub