Hi All,

I'm trying to write a macro to solve an issue that surely others have: print out all of the drawings related to an assembly in order.  I have spent quite some time looking around for a macro that can do this, but haven't had any success, so I decided to write one.  I am new to VBA, but I'm familiar with some other programming languages.

I have two macros right now that each do half of what I ultimately want in the final macro:

1. The first macro opens up all of the unique drawings related to the assembly (all parts/drawings are in the same directory), but doesn't print them in order shown in the tree.
2. The second macro is able to identify the top level components in the tree in order and print the names to the immediate window, but prints all instances of each component.

What I'm thinking is that I can use the logic from the second macro (opening components in order) and apply that to the first macro, which is opening and printing unique drawings related to the assembly.  Can anybody else provide some insight to solving this?  It would be greatly appreciated and I will certainly post the final working macro here, as I have had enormous help from others' posts.

Macro One:

Sub 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

Dim 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 swPageSetup As SldWorks.PageSetup

Dim swDocName As String

Dim swDwgName As String

Dim CurrentDoc As SldWorks.ModelDoc2

Dim CurrentDocQuit As SldWorks.ModelDoc2

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"

        Debug.Print "Drawing =  " & DwgPath

        Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)

        If Not myDwgDoc Is Nothing Then 'If a drawing exists for this part, then:

            swApp.ActivateDoc myDwgDoc.GetPathName

            Set myDwgDoc = Nothing

            '--PRINT SECTION--

            Set CurrentDoc = swApp.ActiveDoc

            Set swPageSetup = CurrentDoc.PageSetup

            swPageSetup.ScaleToFit = True 'Scale sheet to size

            swPageSetup.PrinterPaperSize = 1 'Print on Ledger (3) size or Letter (1) size

            CurrentDoc.PrintDirect 'Print to default printer

        End If

        '--CLOSE DOCUMENT--

        Set CurrentDocQuit = swApp.ActiveDoc

        swDwgName = CurrentDocQuit.GetTitle

        swApp.QuitDoc swDwgName 'Close drawing sheet

        swDocName = swDoc.GetTitle

        swApp.QuitDoc swDocName 'Close model

    End If

    swAllDocs.Next 1, swDoc, NumDocsReturned

    DocCount = DocCount + 1

Wend

End Sub

Macro 2:

'Written Feb 1, 09

'This Traverse the Manager tree and prints the components

'Out put is print to Immediate window of Folder names, Component names.

Dim swApp As SldWorks.SldWorks

Dim Part As SldWorks.ModelDoc2

Dim SelMgr As SldWorks.SelectionMgr

Sub main()

Dim RootNode As SldWorks.TreeControlItem

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

Set SelMgr = Part.SelectionManager

Set FeatureMgr = Part.FeatureManager

Set RootNode = FeatureMgr.GetFeatureTreeRootItem()

Traverse_Nodes RootNode, 1

End Sub

Sub Traverse_Nodes(node As SldWorks.TreeControlItem, Level As Integer)

Dim Childnode As SldWorks.TreeControlItem

Dim Cnode As SldWorks.TreeControlItem

Dim Feat As SldWorks.Feature

Dim FeatTypeName As String

Dim comp As SldWorks.Component2

Dim CompDoc As SldWorks.ModelDoc2

Dim Indent As String

Indent = Space(Level * 4)

Set Childnode = node.GetFirstChild

If Childnode Is Nothing Then

    'An empty folder causes an empty node

    Debug.Print "      Empty Folder"

End If

While Not Childnode Is Nothing

    'If the node is a feature type is 1

    If Childnode.ObjectType = 1 Then

        Set Feat = Childnode.Object

        FeatTypeName = Feat.GetTypeName

        'If the feature is a folder with part in it or a pattern with parts in it

        If FeatTypeName = "FtrFolder" Or InStr(FeatTypeName, "Pattern") > 0 Then

        'Prints the name of the folder and goes through the components

        Debug.Print Childnode.Text

            Traverse_Nodes Childnode, Level + 1

        End If

    'If the node is a component

    ElseIf Childnode.ObjectType = 2 Then

        Set comp = Childnode.Object

        Debug.Print Indent & comp.Name2

        Set Cnode = Childnode.GetFirstChild

     Set CompDoc = comp.GetModelDoc

        'This get parts and mates in subassemblies

        If Not CompDoc Is Nothing Then

            If CompDoc.GetType = 2 Then

                'This loops through subassemblies

                'To get Sub Comps unremark next line.

                'Traverse_Nodes Childnode, Level + 1  'XXXXXXXXXXXXXXXXXXXXXXXXX

            End If

        End If

    Else

        Debug.Print Indent & "Not Sure of node type"

   End If

NoSubs:

    Set Childnode = Childnode.GetNext

Wend

End Sub