0 Replies Latest reply on Feb 20, 2016 3:33 AM by Yong Ning

    Traverse Assembly at Component

    Yong Ning

      This example shows how to traverse an assembly at the component level. It is assumed that you have an active assembly.

      2010 SOLIDWORKS API Help - Traverse Assembly at Component Level Example (VBA)

      http://help.solidworks.com/2010/english/api/sldworksapi/traverse_assembly_at_component_level_example_vb.htm

       

       

       

      I use other method,  see follow code.

      1.jpg

       

       

       

      Function TraverseComponentArr(SwAssy As AssemblyDoc)

         Dim oDict As New Dictionary

         Dim vComp, swComp As Component2, oSwModel As ModelDoc2

            vComp = SwAssy.GetComponents(True)

            For ii = 0 To UBound(vComp)

                Set swComp = vComp(ii)

                Set oDict(swComp.GetPathName) = swComp

            Next ii

            TraverseComponentArr = oDict.Items

      End Function

       

       

      Private Sub ll()

         Dim swApp As SldWorks.SldWorks, swModel As ModelDoc2

             Set swApp = Application.SldWorks

             Set swModel = swApp.ActiveDoc

         Dim SwAssy As AssemblyDoc, CompArr, CompArr1

             CompArr = TraverseComponentArr(swModel)

         Dim swComp As Component2, oSwModel As ModelDoc2

             For ii = 0 To UBound(CompArr)

                Set swComp = CompArr(ii)

                Debug.Print swComp.GetPathName, swComp.ReferencedConfiguration

                If UCase(swComp.GetPathName) Like "*SLDASM" Then

                

                    swComp.SetSuppression2 swComponentResolved

                    Set oSwModel = swComp.GetModelDoc

                    'Stop

                    CompArr1 = TraverseComponentArr(oSwModel)

                    For jj = 0 To UBound(CompArr1)

                        Set swComp = CompArr1(jj)

                        Set oSwModel = swComp.GetModelDoc

                        'Stop

                        Debug.Print swComp.Name2, swComp.ReferencedConfiguration

                        'SwComp.GetPathName '.GetModelDoc.GetTitle

                    Next jj

                End If

             Next ii

      End Sub

       

       

      *********************************

       

       

       

      Function TraverseComponentArr(SwAssy As AssemblyDoc)

         Dim oDict As New Dictionary

         Dim vComp, SwComp As Component2, oSwModel As ModelDoc2

            vComp = SwAssy.GetComponents(True)

            For ii = 0 To UBound(vComp)

                Set SwComp = vComp(ii)

                Set oDict(SwComp.GetPathName) = SwComp

            Next ii

            TraverseComponentArr = oDict.Items

      End Function

       

       

      Function retuSheetArr(SwAssy As AssemblyDoc, SheetArr)

         Dim CompArr, CompArr1, Str

             CompArr = TraverseComponentArr(SwAssy)

         Dim rSheetArr()

             ReDim rSheetArr(UBound(SheetArr) - 1, 1)

           

         Dim SwComp As Component2, oSwModel As ModelDoc2

             For ii = 0 To UBound(CompArr)

                Set SwComp = CompArr(ii)

                Debug.Print SwComp.Name, , , SwComp.ReferencedConfiguration

                Str = SwComp.Name

                Str = Split(Str, "-")(0)

                For jj = 0 To UBound(SheetArr)

                    If SheetArr(jj) = Str Then

                        rSheetArr(jj - 1, 0) = Str

                        rSheetArr(jj - 1, 1) = SwComp.ReferencedConfiguration

                        Exit For

                    End If

                Next jj

                ''

                If UCase(SwComp.GetPathName) Like "*SLDASM" Then

                    ''

                    SwComp.SetSuppression2 swComponentResolved

                    Set oSwModel = SwComp.GetModelDoc

                    oSwModel.ShowConfiguration2 SwComp.ReferencedConfiguration

                    oSwModel.ForceRebuild3 False

                    'Debug.Print oSwModel.GetPathName

                    'Stop

                    '

                    CompArr1 = TraverseComponentArr(oSwModel)

                    For jj = 0 To UBound(CompArr1)

                        Set SwComp = CompArr1(jj)

                        Set oSwModel = SwComp.GetModelDoc

                        Debug.Print SwComp.Name, , , SwComp.ReferencedConfiguration

                        Str = SwComp.Name

                        Str = Split(Str, "-")(0)

                        ''

                        For jj1 = 0 To UBound(SheetArr)

                           If SheetArr(jj1) = Str Then

                              rSheetArr(jj1 - 1, 0) = Str

                              rSheetArr(jj1 - 1, 1) = SwComp.ReferencedConfiguration

                              Exit For

                           End If

                        Next jj1

                        ''

                    Next jj

                End If

             Next ii

             ''

             retuSheetArr = rSheetArr

      End Function

       

       

      Private Sub ChangViewConfiguration()

        

          Dim Xls As Excel.Application, Rng As Range

              Set Xls = GetObject(, "Excel.Application")

              Set Rng = Xls.Selection

          Dim Sht As Worksheet

              Set Sht = Rng.Parent

          Dim PdfDwgPath, SldDrwPath, xlsPath, openSldDrw, saveSldDrw

              xlsPath = Xls.ActiveWorkbook.Path '& "\"

              Debug.Print Sht.Name

              PdfDwgPath = xlsPath & Sht.Cells(3, 1)

              SldDrwPath = xlsPath & Sht.Cells(3, 2)

              openSldDrw = SldDrwPath & Sht.Cells(4, 2)

              'Stop

          Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

              Set SwApp = Application.SldWorks

              Set SwModel = SwApp.ActiveDoc

          Dim SwSelMgr As SelectionMgr

              Set SwSelMgr = SwModel.SelectionManager

          Dim SwDraw As DrawingDoc

              Set SwDraw = SwModel

          Dim vSheet, SwSheet As Sheet

              vSheet = SwDraw.GetSheetNames

              SwDraw.ActivateSheet (vSheet(0))

          Dim SwView As View

          Dim SwAssy As AssemblyDoc

          Dim SwSheetArr, SheetArr

              SheetArr = SwDraw.GetSheetNames

          Dim CompArr, SwComp As Component2

              For ii = 1 To Rng.Rows.Count

                 Set SwView = SwDraw.GetFirstView

                 Set SwView = SwView.GetNextView

                 SwView.ReferencedConfiguration = Rng(ii, 1)

                 ''

                 Set SwModel = SwView.ReferencedDocument

                 ''

                 SwModel.ForceRebuild3 True

                 SwModel.ShowConfiguration Rng(ii, 1)

                 ''

                 SwModel.ForceRebuild3 False

                 Set SwAssy = SwModel

                 SwSheetArr = retuSheetArr(SwAssy, SheetArr)

                 Str = SwAssy.GetTitle

                 SwSheetArr(0, 0) = Left(Str, Len(Str) - 7)

                 SwSheetArr(0, 1) = Rng(ii, 1)

                 ''

                 For jj = 0 To UBound(SwSheetArr)

                     Debug.Print jj, SwSheetArr(jj, 0),

                     Debug.Print SwSheetArr(jj, 1)

                 Next jj

                 ''

                 ''

               

              Next ii

      End Sub