2 Replies Latest reply on Jun 7, 2017 7:31 AM by Sachin Murigesh

    Make all the parts, sub assemblies and parts in sub-assemblies in the main assembly as virtual components through API

    Sachin Murigesh

      Hi API gurus,

      I was creating this tiny VBA code that transverse through all the parts in assembly (Current active, opened assembly) and make them as virtual components.

      If there is sub assembly inside the main assembly, it'll make it as virtual component and the loop through it to make its parts virtual.

       

      I was able to make the pars and sub-assemblies in first layer as virtual components.

      I'm having having trouble to set the components in layer 2,3++ that belong to sub-assemblies as virtual components.

      But my function can loop through it.

       

       

      Any help will be highly appreciated

       

      Option Explicit
      
      
      Dim swApp As SldWorks.SldWorks
      Dim swAssembly As SldWorks.AssemblyDoc
      Dim swModel As SldWorks.ModelDoc2
      Dim swConfig As SldWorks.Configuration
      Dim swRootComp As SldWorks.Component2
      
      
      Dim n As Long
      
      
      
      
      Sub TraverseComponent(swComp As SldWorks.Component2)
          Dim vChildComp As Variant
          Dim swChildComp As SldWorks.Component2
          Dim swCompModel  As ModelDoc2
          Dim swCompConfig As SldWorks.Configuration
          Dim sPadStr As String
          Dim i As Long
          Dim stat As Boolean
          
          vChildComp = swComp.GetChildren
          For i = 0 To UBound(vChildComp)
          Set swChildComp = vChildComp(i)
          
             Set swCompModel = swChildComp.GetModelDoc2
             'Debug.Print swChildComp.Name
             If swCompModel.Extension.ToolboxPartType = 0 Then
                  stat = swChildComp.MakeVirtual
                  Debug.Print swChildComp.Name
             End If
             
             TraverseComponent swChildComp
             
             
         
          Next i
      End Sub
      
      
      Sub main()
          
          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 i As Long
          
          Set swApp = CreateObject("SldWorks.Application")
          Set swModel = swApp.ActiveDoc
          Set swConf = swModel.GetActiveConfiguration
          Set swRootComp = swConf.GetRootComponent3(True)
          
          TraverseComponent swRootComp
          
      End Sub
      

      Thanks,