AnsweredAssumed Answered

How to combine muliple bodies into one single body?

Question asked by Thijs Vernooij on Feb 6, 2016
Latest reply on Dec 19, 2018 by Alexander Klammer

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

Outcomes