Copy Items to Another Study Example (VBA)

This example shows how to copy contact sets and fixtures from one study to another.

'----------------------------------------------------------------------------
' Preconditions:
' 1. Add the SOLIDWORKS Simulation as an add-in
'    (in SOLIDWORKS, select Tools > Add-ins > SOLIDWORKS Simulation,
'    and click OK).
' 2. Add the SOLIDWORKS Simulation type library as a reference
'    (in the IDE, select Tools > References > SOLIDWORKS Simulation version
'    type library, and click OK).
' 3. Ensure the specified model exists.
' 4. Open the Immediate window.
'
' Postconditions:
' 1. Opens the assembly document.
' 2. Copies fixtures and contact sets from Ready to Partial.
' 3. Activates Partial.
' 4. Meshes Partial.
' 5. Analyzes Partial.
' 6. Inspect the Immediate window, the Simulation study tree, and the
'    graphics area.
'
' NOTE: Because the model is used elsewhere, do not save changes.
' ---------------------------------------------------------------------------
Option Explicit
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim COSMOSWORKS As Object
    Dim COSMOSObject As CosmosWorksLib.CwAddincallback
    Dim ActDoc As CosmosWorksLib.CWModelDoc
    Dim StudyMngr As CosmosWorksLib.CWStudyManager
    Dim Study As CosmosWorksLib.CWStudy
    Dim CwMesh As CosmosWorksLib.CwMesh
    Dim lrMngr As CosmosWorksLib.CWLoadsAndRestraintsManager
    Dim Fixture As CosmosWorksLib.CWLoadsAndRestraints
    Dim ContactMgr As CosmosWorksLib.CWContactManager
    Dim ContactSet As CosmosWorksLib.CWContactSet
    Dim errCode As Long
    Dim errors As Long
    Dim warnings As Long
    Dim contactSets(0) As Variant
    Dim fixtures(2) As Variant
    Dim i As Long
   

    Const fileName As String = "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\Simulation\Examples\Contact\slider_locker_mechanism.sldasm"
   

    Set swApp = Application.SldWorks

    Set COSMOSObject = swApp.GetAddInObject("SldWorks.Simulation")
    If COSMOSObject Is Nothing Then ErrorMsg swApp, "No Simulation add-in", True
    Set COSMOSWORKS = COSMOSObject.COSMOSWORKS
    If COSMOSWORKS Is Nothing Then ErrorMsg swApp, "No COSMOSWORKS object", True

    swApp.OpenDoc6 fileName, swDocumentTypes_e.swDocASSEMBLY, swOpenDocOptions_Silent, "", errors, warnings
    Set ActDoc = COSMOSWORKS.ActiveDoc()
    If ActDoc Is Nothing Then ErrorMsg swApp, "No active document", True

    Set StudyMngr = ActDoc.StudyManager()
    If StudyMngr Is Nothing Then ErrorMsg swApp, "No CWStudyManager object", True
    Set Study = StudyMngr.GetStudy(0)
    StudyMngr.ActiveStudy = 0
    If Study Is Nothing Then ErrorMsg swApp, "No study", True
    If (Study.Name <> "Ready") Then ErrorMsg swApp, "Wrong study", True
    Debug.Print ("Name of study: " & Study.Name)
   

    ' Create array of names of contact sets to copy
    Set ContactMgr = Study.ContactManager
    For i = 0 To (ContactMgr.ContactSetCount - 1)
        Set ContactSet = ContactMgr.GetContactSetAt(i)
        contactSets(i) = ContactSet.ContactName
    Next
   

    ' Create array of names of fixtures to copy
    Set lrMngr = Study.LoadsAndRestraintsManager
    For i = 0 To (lrMngr.Count - 1)
        Set Fixture = lrMngr.GetLoadsAndRestraints(i, errCode)
        fixtures(i) = Fixture.Name
    Next
   

    ' Copy fixtures and contact sets from Ready study to Partial study
    errCode = ContactMgr.CopyContactsToStudy("Partial", contactSets)
    errCode = lrMngr.CopyLoadsAndRestraintsToStudy("Partial", fixtures)
   

    ' Activate Partial study
    Set Study = StudyMngr.GetStudy(1)
    StudyMngr.ActiveStudy = 1
   

    Set CwMesh = Study.Mesh
    If CwMesh Is Nothing Then ErrorMsg swApp, "No mesh", False

    ' Set type of mesh to curvature-based
    CwMesh.MesherType = swsMesherTypeAlternate

    ' Set mesh parameters
    CwMesh.GrowthRatio = 1.6
    CwMesh.MinElementsInCircle = 8
 

    ' Create mesh
    errCode = Study.CreateMesh(swsLinearUnitMillimeters, 20, 1)
    Debug.Print "Mesh error code: " & errCode
    If errCode <> 0 Then ErrorMsg swApp, "Mesh failed", True

    errCode = Study.RunAnalysis
    Debug.Print "Analysis error code: " & errCode
    If errCode <> 0 Then ErrorMsg swApp, "Analysis failed", True
   

End Sub
Sub ErrorMsg(swApp As SldWorks.SldWorks, Message As String, EndTest As Boolean)
    swApp.SendMsgToUser2 Message, 0, 0
    swApp.RecordLine "'*** WARNING - General"
    swApp.RecordLine "'*** " & Message
    swApp.RecordLine ""
End Sub