AnsweredAssumed Answered

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

Question asked by Sachin Murigesh on Jun 6, 2017
Latest reply on Jun 7, 2017 by 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,

Outcomes