0 Replies Latest reply on Sep 26, 2015 5:31 PM by Arvind Purushotaman

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

    Arvind Purushotaman



      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


      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)


                            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,