1 Reply Latest reply on Feb 6, 2016 8:09 PM by Artem Taturevych

    How to combine muliple bodies into one single body?

    Thijs Vernooij

      I have created a single macro to:

      1-     Save an assembly as a part.

      2-     Opens that part

      3-     Selecting all solids inside that part

      4-     Combine all bodies                                                  (at this point is get wrong)

      5-     SaveOut as an *.STL                                                 (is not yet in this macro)

       

      The weird thing is, he just doesn't do the combine feature. If I let run the delete bodies feature, it worked, but the combine just doesn't work

       

      ----

       

       

            Option Explicit

       

      Sub SaveAndOpen(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)

       

       

      Dim SwDoc As ModelDoc2

      'Dim swApp As Object

       

      Dim sldwrks As SldWorks.SldWorks

      Dim Part As ModelDoc2

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      Dim swRootComp As SldWorks.Component2

      Dim sPadStr As String

      Dim vBody As Variant

       

      Set sldwrks = _

      Application.SldWorks

       

      Set Part = sldwrks.ActiveDoc

       

      Dim newfileName As String

      newfileName = Part.GetPathName

       

      newfileName = Replace(newfileName, ".sldasm", ".sldprt")

      newfileName = Replace(newfileName, ".SLDASM", ".SLDPRT")

       

      Debug.Print newfileName;

       

      longstatus = Part.SaveAs3(newfileName, 0, 0)

       

      Set swApp = _

      Application.SldWorks

      Set Part = swApp.ActiveDoc

      Set Part = swApp.OpenDoc6(newfileName, 1, 0, "", longstatus, longwarnings)

      'Set Part = swApp.OpenDoc6("L:\Moogue\DriveWorks\DW-Orders\WebShopBestelling\1187-2455-BHSHUVZVL__-Marjolein Smids_TextSleutelhanger-SLT001_ ID109\1187-2455_2325_-TextSleutelhanger-SLT001----L_Johnny_-R_UwspaceText_-Oranje-_ ID109.SLDPRT", 1, 0, "", longstatus, longwarnings)

       

       

      'Set Part = Nothing

      'Set sldwrks = Nothing

       

      SelectBodies swApp, swModel, vBody, sPadStr

       

      End Sub

       

      Sub SelectBodies(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, vBody As Variant, sPadStr As String)

       

          Dim swModExt As SldWorks.ModelDocExtension

          Dim swBody As SldWorks.Body2

          Dim sBodySelStr As String

          Dim sBodyTypeSelStr As String

          Dim i As Long

          Dim bRet As Boolean

          Dim swCombineBodiesFeatureData As SldWorks.CombineBodiesFeatureData

          Dim swFeature As SldWorks.Feature

          Dim status As Boolean

          Dim errors As Long

          Dim warnings As Long

         

      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      'Dim myFeature As Object

      'Su main()

      Dim myFeature As Object

      Set swApp = _

      Application.SldWorks

       

      Set Part = swApp.ActiveDoc

       

         

       

       

          If IsEmpty(vBody) Then Set myFeature = Part.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYADD, Nothing)          'if you swap those rules, Combino off      ' and deletebody on, you will see that this worked. Why does it not Combine?

          'If IsEmpty(vBody) Then Set myFeature = Part.FeatureManager.InsertDeleteBody2(True)

          

         

          If IsEmpty(vBody) Then Exit Sub

        

          Set swModExt = swModel.Extension

       

          For i = 0 To UBound(vBody)

              Set swBody = vBody(i)

              sBodySelStr = swBody.GetSelectionId

              Debug.Print "  " & sPadStr & sBodySelStr

       

              Select Case swBody.GetType

                  Case swSolidBody

                      sBodyTypeSelStr = "SOLIDBODY"

                  Case swSheetBody

                      sBodyTypeSelStr = "SURFACEBODY"

                  Case Else

                      Debug.Assert False

              End Select

             

            

              boolstatus = Part.Extension.SelectByID2(sBodySelStr, sBodyTypeSelStr, 0, 0, 0, True, 0, Nothing, 0)

            

              Set myFeature = Part.FeatureManager.InsertCombineFeature(15903, Nothing, 2)

         

          Next i

       

      End Sub

       

      Sub ProcessComponent(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swComp As SldWorks.Component2, nLevel As Long)

       

          Dim vChildComp As Variant

          Dim swChildComp As SldWorks.Component2

          Dim sPadStr As String

          Dim vBody As Variant

          Dim i As Long

       

          For i = 0 To nLevel - 1

              sPadStr = sPadStr + "  "

          Next i

       

          Debug.Print sPadStr & swComp.Name2 & " <" & swComp.ReferencedConfiguration & ">"

       

          ' Solid bodies

          vBody = swComp.GetBodies2(swSolidBody)

          SelectBodies swApp, swModel, vBody, sPadStr

       

          ' Surface bodies

          vBody = swComp.GetBodies2(swSheetBody)

          SelectBodies swApp, swModel, vBody, sPadStr

       

          vChildComp = swComp.GetChildren

          For i = 0 To UBound(vChildComp)

              Set swChildComp = vChildComp(i)

              ProcessComponent swApp, swModel, swChildComp, nLevel + 1

          Next i

       

      End Sub

       

      Sub ProcessAssembly(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)

       

          Dim swConfigMgr As SldWorks.ConfigurationManager

          Dim swConf As SldWorks.Configuration

          Dim swRootComp As SldWorks.Component2

       

          Set swConfigMgr = swModel.ConfigurationManager

          Set swConf = swConfigMgr.ActiveConfiguration

          Set swRootComp = swConf.GetRootComponent3(True)

          ProcessComponent swApp, swModel, swRootComp, 1

       

      End Sub

       

      Sub Combiner(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2)

       

      Dim Part As Object

      Dim boolstatus As Boolean

      Dim longstatus As Long, longwarnings As Long

      Dim myFeature As Object

      Dim sldwrks As SldWorks.SldWorks

       

      'Dim Part As ModelDoc2

      'Dim boolstatus As Boolean

      'Dim longstatus As Long, longwarnings As Long

      'Dim swApp As SldWorks.SldWorks

      'Dim swModel As SldWorks.ModelDoc2

       

      Dim swModelDocExt As SldWorks.ModelDocExtension

      Dim swFeatureMgr As SldWorks.FeatureManager

      Dim swFeature As SldWorks.Feature

      Dim swCombineBodiesFeatureData As SldWorks.CombineBodiesFeatureData

      Dim fileName As String

      Dim status As Boolean

      Dim errors As Long

      Dim warnings As Long

       

      'Dim swApp As Object

      'Dim Part As Object

      'Dim boolstatus As Boolean

      'Dim longstatus As Long, longwarnings As Long

         

      'Dim myFeature As Object

       

          'Set swApp = Application.SldWorks

      '    Set Part = sldwrks.ActiveDoc

       

          'fileName = "C:\Program Files\SolidWorks Corp\SolidWorks\samples\tutorial\multibody\multi_inter.sldprt"

          'Set swModel = swApp.OpenDoc6(fileName, swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)

          'Set swModel = SldWorks.ActiveDoc

       

          'Set swModelDocExt = swModel.Extension

          'status = swModelDocExt.SelectByID2("Extrude-Thin1", "SOLIDBODY", 0, 0, 0, True, 0, Nothing, 0)

          'status = swModelDocExt.SelectByID2("Boss-Extrude1", "SOLIDBODY", 0, 0, 0, True, 0, Nothing, 0)

          'swModel.ClearSelection2 False

          'status = swModelDocExt.SelectByID2("Extrude-Thin1", "SOLIDBODY", 0, 0, 0, False, 2, Nothing, 0)

          'status = swModelDocExt.SelectByID2("Boss-Extrude1", "SOLIDBODY", 0, 0, 0, True, 2, Nothing, 0)

          'Set swFeatureMgr = swModel.FeatureManager

          'Set swFeature = swFeatureMgr.InsertCombineFeature(swBodyOperationType_e.SWBODYADD, Nothing, Nothing)

       

          'Set swCombineBodiesFeatureData = swFeature.GetDefinition

          'status = swCombineBodiesFeatureData.AccessSelections(swModel, Nothing)

          'swCombineBodiesOperationType_e:

          ' swCombineBodiesOperationAdd = 0

          ' swCombineBodiesOperationCommon = 2

          ' swCombineBodiesOperationSubract = 1

          'Debug.Print "Type of combine feature: " & swCombineBodiesFeatureData.OperationType

          'swCombineBodiesFeatureData.ReleaseSelectionAccess

       

      'Set myFeature = Part.FeatureManager.InsertCombineFeature(15903, Nothing, Nothing)

         

      'Set myFeature = Part.FeatureManager.InsertDeleteBody2(True)

       

      End Sub

       

      Sub main()

       

          Dim swApp As SldWorks.SldWorks

          Dim swModel As SldWorks.ModelDoc2

          Dim swPart As SldWorks.PartDoc

          Dim vBody As Variant

          Dim i As Long

          Dim bRet As Boolean

       

          Set swApp = Application.SldWorks

          Set swModel = swApp.ActiveDoc

       

          swModel.ClearSelection2 True

       

          Debug.Print "File = " & swModel.GetPathName

       

          Select Case swModel.GetType

              Case swDocPART

                  Set swPart = swModel

                  ' Solid bodies

                  vBody = swPart.GetBodies2(swSolidBody, True)

                  SelectBodies swApp, swModel, vBody, ""

                  Combiner swApp, swModel

                  ' Surface bodies

                  vBody = swPart.GetBodies2(swSheetBody, True)

                  SelectBodies swApp, swModel, vBody, ""

              Case swDocASSEMBLY

                  'ProcessAssembly swApp, swModel

                  SaveAndOpen swApp, swModel

              Case Else

                  Exit Sub

       

          End Select

       

      End Sub

       

       

      The biggest issue is: How do i get different unknown bodies combined in a part. After that, I kan just save it as an STL.

       

      Thanks for your help.

       

      Thijs

        • Re: How to combine muliple bodies into one single body?
          Artem Taturevych

          Hi Thijs,

           

          The InsertCombineFeature may be used in 2 ways:

           

          • By capturing the selection objects. In this case last two parameters should be Nothing
          • By passing the bodies directly. In this case you do not need to preselect the objects

           

          In your case you should either preselect the bodies and mark the selection with 2 or pass the bodies array directly as the third parameter. Like the following:

          Set myFeature = Part.FeatureManager.InsertCombineFeature(15903, Nothing, vBody)

           

          Thanks,

          Artem