AnsweredAssumed Answered

Dissolving all the sub-assemblies in an Assembly - including sub-assemblies inside a sub-assembly

Question asked by Arvind Purushotaman on Sep 26, 2015

Hello,

 

I wrote a code around a logic by which we can dissolve sub-assemblies inside another sub-assembly. I was not able to achieve the objective of dissolving. I went through one of the author's code (Keith Rice) but still I am a bit confused.

 

Here is my code, can some kindly help me out?

 

 

 

Dim swApp                       As SldWorks.SldWorks

Dim swModel                     As SldWorks.ModelDoc2

Dim swAssem                     As SldWorks.AssemblyDoc

Dim swFeat                      As SldWorks.Feature

Dim swComp                      As SldWorks.Component2

Dim swRootComp                  As SldWorks.Component2

Dim swConfMgr                   As SldWorks.ConfigurationManager

Dim swConf                      As SldWorks.Configuration

Sub main()

   

   

    Set Part = New Collection

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swAssem = swModel

    Set swFeat = swModel.FirstFeature

    Set swConfMgr = swModel.ConfigurationManager

    Set swConf = swConfMgr.ActiveConfiguration

    Set swRootComp = swConf.GetRootComponent3(True)

    While Not swFeat Is Nothing

        If swFeat.GetTypeName2 = "Reference" Then

            Set swComp = swFeat.GetSpecificFeature2

                If UCase(Right(swComp.GetPathName, 3)) = "ASM" Then

                    MsgBox "Name : " & swComp.Name2

                    Call Dissolve(swComp)

                End If

        End If

        Set swFeat = swFeat.GetNextFeature

    Wend

End Sub

 

 

Sub Dissolve(prt As SldWorks.Component2)

Dim Children                    As Variant

Dim ChildComp                   As Component2

Dim Aparts                      As Integer

Dim Pparts                      As Integer

Aparts = 0

Pparts = 0

Dim swcompModel                 As SldWorks.ModelDoc2

Dim swcompAssy                  As SldWorks.AssemblyDoc

Dim test                        As Boolean

 

 

               Children = prt.GetChildren

               For i = 0 To UBound(Children)

                   Set ChildComp = Children(i)

                   If UCase(Right(ChildComp.GetPathName, 3)) = "ASM" Then

                      MsgBox "Name 2 :" & ChildComp.Name2

                      Aparts = Aparts + 1

                      Call Dissolve(ChildComp)

                   Else

                      Pparts = Pparts + 1

                   End If

               Next i

               If Aparts = 0 Then

                Set swcompModel = prt.GetModelDoc2

                Set swcompAssy = swcompModel

                prt.Select4 False, Nothing, False

                test = swcompAssy.DissolveSubAssembly

               

              End If

               

End Sub

 

 

Thank you,

Arvind

Outcomes