Save Solid Body to File Example (VB.NET)

'----------------------------------------------------------------------------
' Preconditions: Open a weldment part with a cut list.
'
' Postconditions:
' 1. The cut list in the weldment part is updated.
' 2. The first weldment member in the FeatureManager design tree is saved to
'    RefWeldment1.sldprt, and the cut list properties in the parent part
'    are saved to the cut list of the new part.
' 3. RefWeldment1.sldprt is opened, and its cut list is updated.
'    This may take a few minutes.
' 4. When the macro stops, press F5 to close the saved part.
' ---------------------------------------------------------------------------
Imports SolidWorks.Interop.sldworks
Imports SolidWorks.Interop.swconst
Imports System.Runtime.InteropServices
Imports System

Partial Class SolidWorksMacro

    Dim swFeat As Feature
    Dim swBodyFolder As BodyFolder
    Dim updateBoolstatus As Boolean
    Dim boolstatus As Boolean
    Dim longstatus As Integer
    Dim longWarnings As Integer
    Dim currentModel As ModelDoc2
    Dim swModel As ModelDoc2
    Dim modelType As Integer
    Dim modelTitle As String

    Sub main()

        currentModel = swApp.ActiveDoc

        modelTitle = currentModel.GetTitle
        modelType = currentModel.GetType

        swFeat = currentModel.FirstFeature
        If swFeat Is Nothing Then ErrorMsg(swApp, "Failed to get first feature")

        Do While Not swFeat Is Nothing
            If swFeat.GetTypeName2 = "SolidBodyFolder" Then
                swBodyFolder = swFeat.GetSpecificFeature2
                If swBodyFolder Is Nothing Then ErrorMsg(swApp, "Failed to get body folder")

                boolstatus = swBodyFolder.SetAutomaticCutList(True)

                boolstatus = swBodyFolder.UpdateCutList()

                Exit Do
            End If
            swFeat = swFeat.GetNextFeature
        Loop

        updateBoolstatus = False

        swFeat = currentModel.FirstFeature
        If swFeat Is Nothing Then ErrorMsg(swApp, "Failed to get first feature")

        Do While Not swFeat Is Nothing
            If swFeat.GetTypeName2 = "WeldMemberFeat" Then
                boolstatus = swFeat.Select2(False, 0)
                If boolstatus = False Then ErrorMsg(swApp, "Failed to select feature")

                ' Save the selected solid body weldment member to another part,
                ' transferring the solid body's cut list properties to the new part's cut list;
                ' automatically creates a weldment and cut list folder
                boolstatus = currentModel.SaveToFile3(swApp.GetCurrentMacroPathFolder + "\RefWeldment1" + ".sldprt", 1, swCutListTransferOptions_e.swCutListTransferOptions_CutListProperties, False, "", longstatus, longWarnings)
                Stop
                If boolstatus = False Then ErrorMsg(swApp, "Failed to insert weldment member into new part")

                swModel = swApp.ActiveDoc
                If swModel Is Nothing Then ErrorMsg(swApp, "Failed to set open model as active document")

                updateBoolstatus = True
                Exit Do
            End If
            swFeat = swFeat.GetNextFeature
        Loop

        If updateBoolstatus = True Then
            swFeat = currentModel.FirstFeature
            If swFeat Is Nothing Then ErrorMsg(swApp, "Failed to get first feature")

            Do While Not swFeat Is Nothing
                If swFeat.GetTypeName2 = "SolidBodyFolder" Then
                    swBodyFolder = swFeat.GetSpecificFeature2
                    If swBodyFolder Is Nothing Then ErrorMsg(swApp, "Failed to get body folder")

                    boolstatus = swBodyFolder.SetAutomaticCutList(True)
                    If boolstatus = False Then ErrorMsg(swApp, "Failed to set cut list to automatic")

                    boolstatus = swBodyFolder.UpdateCutList()
                    If boolstatus = False Then ErrorMsg(swApp, "Failed to update cut list")

                    swApp.CloseDoc(swModel.GetTitle)
                    Exit Do
                End If
                swFeat = swFeat.GetNextFeature
            Loop
        End If

    End Sub

    Sub ErrorMsg(ByVal Swapp As Object, ByVal Message As String)
        Swapp.SendMsgToUser2(Message, 0, 0)
        Swapp.RecordLine("'*** WARNING - General")
        Swapp.RecordLine("'*** " & Message)
        Swapp.RecordLine("")
    End Sub


    Public swApp As SldWorks


End Class