SolidWorks VBA Macro : Combining step doesn't work

83 Views Asked by At

Here is my macro code which aims to calculate an inner volume of a vessel. So, the steps are in a loop (because there are several part files) and it start with opening the file, inserting a file "Bounding Box", combining (subtracting operation) both parts (Bounding Box + part's bodies) by selecting all bodies automatically and keeping the Bounding Box body, finally save the file and close it.

My problem is the combining step doesn't work according to SolidWorks, and I am a beginner in programming so I don't know how to solve it.

Sub OpenSldprtFiles()
    Dim strPath As String
    Dim strFile As String
    Dim objSW As SldWorks.SldWorks
    Dim objModel As SldWorks.ModelDoc2
    Dim boolstatus As Boolean
    Dim longstatus As Long, longwarnings As Long
    
    Set objSW = Application.SldWorks
    
    'Specify the folder path
    strPath = "C:\Users\emilien.petit\Desktop\VolumeCalculation\Components\"
    
    'Loop through all the files in the folder
    strFile = Dir(strPath & "*.sldprt")
    Do While strFile <> ""
        
        'Open the file
        Set objModel = objSW.OpenDoc6(strPath & strFile, swDocPART, swOpenDocOptions_Silent, "", 0, 0)
        
        'Insert Bounding Box
        Dim myFeature As Object
        Set myFeature = objModel.InsertPart3("C:\Users\emilien.petit\Desktop\VolumeCalculation\BoundingBox.SLDPRT", 1, "Default")
        objModel.ClearSelection2 True
        
        ' Combine the Bounding Box with other parts as a subtract operation
        Dim vBodies As Variant
        Dim i As Integer
        
        ' Get the collection of all solid bodies in the active document
        vBodies = objModel.GetBodies2(swAllBodies, True)
        
        ' Loop through all the solid bodies and select them
        For i = 0 To UBound(vBodies)
            boolstatus = objModel.Extension.SelectByID2(vBodies(i).Name, "SOLIDBODY", 0, 0, 0, True, 0, Nothing, 0)
        Next i
        
        ' Create a Combine feature with the selected bodies
        Set myFeature = objModel.FeatureManager.InsertCombineFeature(0, Nothing, Nothing)
        
        ' Check if the Combine feature was created successfully
        If Not myFeature Is Nothing Then
            ' Set the operation as Subtract
            myFeature.Operation = swSubtract
            myFeature.Name = "Combine1"
        
            ' Set the target body for subtraction (in this case, "Body1")
            myFeature.Bodies2(0).Name = "Body1"
        Else
            ' Handle the case where the Combine feature could not be created
            MsgBox "Combine feature could not be created."
        End If

        
        ' Save the body as a .sldprt file
        Dim savePath As String
        savePath = "C:\Users\emilien.petit\Desktop\VolumeCalculation\ComponentVolumeTest\" & Replace(strFile, ".sldprt", "_VOLUME.sldprt") ' Replace the folder path as needed
        
        boolstatus = objModel.Extension.SaveAs(savePath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, longstatus, longwarnings)
                
        ' Clear the selection
        objModel.ClearSelection2 True

        'Close the file
        objSW.CloseDoc (strPath & strFile)
        
        'Get the next file name
        strFile = Dir()
    Loop
    
End Sub

I want to fix the problem

Error displayed:

enter image description here

1

There are 1 best solutions below

0
JeromeP On

You have to specify a 'Mark' for the target body (1) and the rest (2)

See the Remarks in InsertCombineFeature

Option Explicit
Sub OpenSldprtFiles()
    Dim strPath As String
    Dim strFile As String
    Dim objSW As SldWorks.SldWorks
    Dim objModel As SldWorks.ModelDoc2
    Dim boolstatus As Boolean
    Dim swSelData As SldWorks.SelectData
    Dim vBodies As Variant
    Dim i As Integer
    Dim swBody As SldWorks.Body2
    Dim myFeature As SldWorks.Feature
    Dim BoundBoxPath As String
    BoundBoxPath = "C:\Users\emilien.petit\Desktop\VolumeCalculation\BoundingBox.SLDPRT"

    Set objSW = Application.SldWorks
    
    'Specify the folder path
    strPath = "C:\Users\emilien.petit\Desktop\VolumeCalculation\Components\"
    
    'Loop through all the files in the folder
    strFile = Dir(strPath & "*.sldprt")
    Do While strFile <> ""
        
        'Open the file
        Set objModel = objSW.OpenDoc6(strPath & strFile, swDocPART, swOpenDocOptions_Silent, "", 0, 0)
        Set swSelData = objModel.SelectionManager.CreateSelectData

        'Insert Bounding Box
        Set myFeature = objModel.InsertPart3(BoundBoxPath, swInsertPartOptions_e.swInsertPartImportSolids, "Default")
        objModel.ClearSelection2 True
        
        ' Get the collection of all solid bodies in the active document
        vBodies = objModel.GetBodies2(swAllBodies, True)
        
        ' Loop through all the solid bodies and select them
        For i = 0 To UBound(vBodies)
            Set swBody = vBodies(i)
            swSelData.Mark = 2
            If i = UBound(vBodies) Then swSelData.Mark = 1
            swBody.Select2 True, swSelData
        Next i
          
        ' Create a Combine feature with the selected bodies
        Set myFeature = objModel.FeatureManager.InsertCombineFeature(swBodyOperationType_e.SWBODYCUT, Nothing, Nothing)
        
        ' Check if the Combine feature was created successfully
        If Not myFeature Is Nothing Then
            myFeature.Name = "Combine1"
        Else
            ' Handle the case where the Combine feature could not be created
            MsgBox "Combine feature could not be created."
        End If
        
        ' Save the body as a .sldprt file
        Dim savePath As String
        savePath = "C:\Users\emilien.petit\Desktop\VolumeCalculation\ComponentVolumeTest\" & Replace(strFile, ".sldprt", "_VOLUME.sldprt") ' Replace the folder path as needed
        
        boolstatus = objModel.Extension.SaveAs(savePath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, Empty, Empty)
                
        ' Clear the selection
        objModel.ClearSelection2 True

        'Close the file
        objSW.CloseDoc (strPath & strFile)
        
        'Get the next file name
        strFile = Dir()
    Loop
End Sub