Insert New Virtual Component Example (VBA)

This example shows how to insert a new part as a virtual component in an assembly and save it to an external file.

'---------------------------------------------------------------------
' Preconditions:

' 1. Open: <SolidWorks_install_dir>\samples\tutorial\smartcomponents\stepped_shaft.sldasm
' 2. A planar face on the assembly is selected.
' 3. Step through this macro (F8).
'
' Postconditions:

' 1. The new part is inserted as a virtual component in the assembly.
' 2. The virtual component is saved to an external file,
'       and its name changes in the FeatureManager design tree.
'
' NOTE: Because this assembly is used in a SolidWorks online tutorial, do not
'       save the assembly when you close it.
'---------------------------------------------------------------------

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swComponent As SldWorks.Component2
Dim swSelMgr As SldWorks.SelectionMgr
Dim status As Long

Sub Main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc
    Set swAssy = swModel

    ' Get the pre-selected planar face
    Dim swFeature  As SldWorks.Face2
    Set swSelMgr = swModel.SelectionManager
    Set swFeature = swSelMgr.GetSelectedObject6(1, 0)

    ' Create the part and insert it as a virtual component
    ' in the assembly
    status = swAssy.InsertNewVirtualPart(swFeature, swComponent)

    If status = 1 Then

        Debug.Print "Name of virtual component: " & swComponent.Name2

        ' Check to see if the part is a virtual component
        Debug.Print "Is component virtual? " & swComponent.IsVirtual
       

        Dim objFSO As Object
        Dim objFile As Object
        Dim compName As String
        Dim splits As Variant
       

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objFile = objFSO.GetFile(swModel.GetPathName)

        splits = Split(swComponent.Name, "^")
        compName = objFSO.GetParentFolderName(objFile) & "\" & splits(0)

        If swComponent.GetModelDoc2.GetType = swDocPART Then
            compName = compName & ".sldprt"
        Else
            compName = compName & ".sldasm"
        End If

        Debug.Print "Name of saved virtual component: " & compName
        swComponent.SaveVirtualComponent compName

    Else
        Debug.Print "Error code returned when attempting to insert new part as virtual component: " & status
    End If

    swModel.ClearSelection2 (True)
   

End Sub