AnsweredAssumed Answered

Traverse Assembly at Component

Question asked by Yong Ning on Feb 18, 2016

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

Attachments

Outcomes