2 Replies Latest reply: Apr 2, 2013 9:58 PM by Yong Ning

    Traverse Assembly at Component→Merge duplicate Component

    Yong Ning

      00.jpg

       

      Sub Main1()

          Dim swApp                       As SldWorks.SldWorks
          Dim swModel                     As SldWorks.ModelDoc2
          Dim swAssy                      As SldWorks.AssemblyDoc
          Dim swConf                      As SldWorks.Configuration
          Dim swRootComp                  As SldWorks.Component2
          Dim bRet                        As Boolean
          Dim ii, nn
         
          Set swApp = CreateObject("SldWorks.Application")
          Set swModel = swApp.ActiveDoc
          Set swConf = swModel.GetActiveConfiguration
          Set swRootComp = swConf.GetRootComponent
          Dim vChildComp
          ''
          Dim SwArr()
          ''
          vChildComp = swRootComp.GetChildren
          nn = UBound(vChildComp)
          ReDim SwArr(nn)
          For ii = 0 To nn
              Set SwArr(ii) = vChildComp(ii).GetModelDoc
              Debug.Print "Set SwArr(" & ii & ") → Object →" & SwArr(ii).GetTitle
          Next ii

      End Sub

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

      Run code result is

      Set SwArr(0) → Object →Rib.SLDPRT

      Set SwArr(1) → Object →Rib.SLDPRT

      Set SwArr(2) → Object →Web.sldprt

      Set SwArr(3) → Object →Pad.sldprt

      Set SwArr(4) → Object →BasePlate-S.SLDPRT

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

       

      My demand is Merge duplicate Component

      Tow Compoent (Rib.SldPrt) --- one Component(Rib.SldPrt)

       

      Set SwArr(0) → Object →Rib.SLDPRT

      Set SwArr(1) → Object →Web.sldprt

      Set SwArr(2) → Object →Pad.sldprt

      Set SwArr(3) → Object →BasePlate-S.SLDPRT

          • Re: Traverse Assembly at Component→Merge duplicate Component
            Yong Ning

            Thank you tip

             

            Sorry, I'm Chinese with English, not fully express meaning.

             

                      d.Add filename, counter

            FileName → String

            I need FileName → String →  Object () →Set SwArr(ii) = vChildComp(ii).GetModelDoc

             

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

             

            Option Explicit
            Sub Main1()
                Dim swApp                       As SldWorks.SldWorks
                Dim swModel                     As SldWorks.ModelDoc2
                Dim swAssy                      As SldWorks.AssemblyDoc
                Dim swComp                  As SldWorks.Component2
                Dim compCount As Integer
                Dim vComponents As Variant
                Dim SwArr() As String
                Dim d As Object
                Set d = CreateObject("Scripting.Dictionary")

                Dim i As Integer
                Dim key As Variant
                'd.CompareMode = TextCompare
                Dim counter As Integer
                Dim filename As String
                Set swApp = CreateObject("SldWorks.Application")
                Set swModel = swApp.ActiveDoc
                Set swAssy = swModel
                compCount = swAssy.GetComponentCount(False)
                vComponents = swAssy.GetComponents(False)
                counter = 0
                For i = 0 To compCount - 1
                    Set swComp = vComponents(i)
                    filename = GetFileName(swComp.GetPathName)
                    If Not d.Exists(filename) Then
                        d.Add filename, counter
                        counter = counter + 1
                    Else
                    End If
                Next i
               
                ReDim SwArr(d.Count - 1)
               
               
                For Each key In d.Keys
                    SwArr(d(key)) = key
                Next
                   
            End Sub
            Private Function GetFileName(FilePath As String) As String
               Dim l() As String
               l = Split(FilePath, "\")
               GetFileName = l(UBound(l))
            End Function