Hide Table of Contents

Create Drop Test Study Example (VBA)

This example shows how to create a drop test study.

NOTE: To get persistent reference identifiers (PIDs) for model selections, you can use pidcollector.exe or IModelDocExtension::GetPersistReference3.

'----------------------------------------------------------------------------
' Preconditions:
' 1. Open:
'    install_dir\samples\tutorial\api\KeyPad_1.sldasm.
' 2. Add the SOLIDWORKS Simulation as an add-in
'    (in SOLIDWORKS, click Tools > Add-ins > SOLIDWORKS Simulation).
' 3. Add the SOLIDWORKS Simulation type library as a reference
'    (in the IDE, click Tools > References > SOLIDWORKS
'    Simulation
version type library).
'
' Postconditions:
' 1.  Default drop test study results plot is created.
' 2.  Drop test study, "Study 2", is created.
' 3.  Nylon 101 SOLIDWORKS material is applied to all components.
' 4.  The mesh is created.
' 5.  Drop height is set to 1000 mm.
' 6.  Analysis is run.
' 7.  The von Mises stress results in the last step are validated.
' 8.  When the macro stops, inspect the Immediate window for the
'     1000 mm drop test study's setup and result options.
'     Inspect the default drop test study results plot.
'     Click F5 to continue.
' 9.  Drop height is changed to 2000 mm.
' 10. Analysis is run again.
' 11. Inspect the results folder.
'
' NOTE: Because the model is used elsewhere,
' do not save changes when closing it.
' ---------------------------------------------------------------------------

 

Dim SwApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim COSMOSWORKS As CosmosWorksLib.COSMOSWORKS
Dim CWAddinCallBack As CosmosWorksLib.CWAddinCallBack
Dim ActDoc As CosmosWorksLib.CWModelDoc
Dim StudyMngr As CosmosWorksLib.CWStudyManager
Dim Study As CosmosWorksLib.CWStudy
Dim CWMesh As CosmosWorksLib.CWMesh
   

Dim CWFeatObj As CosmosWorksLib.CWResults
Dim SolidMgr As CosmosWorksLib.CWSolidManager
Dim SolidComponent As CosmosWorksLib.CWSolidComponent
Dim Solidbody As CosmosWorksLib.CWSolidBody
Dim Setup As CosmosWorksLib.CWDropTestSetup
Dim ResultOptions As CosmosWorksLib.CWDropTestResultOptions
Dim StudyOptions As CosmosWorksLib.CWDropTestStudyOptions
Dim Selection As Object
   

Dim CosmosFolder As String
Dim sLibWithPathname As String, sMaterialName As String, sName As String
          

Dim errCode As Long
Dim VMS1000 As Double, VMS2000 As Double, Stress As Variant
Dim nStep As Long, CompCount As Long, j As Long, Height As Double
   

Dim bApp As Long
Dim PIDCollection As New Collection
Dim Tol As Double, A As Double, B As Double

Option Explicit
Sub main()
   

    Set PIDCollection = PIDInitializer()
       

    Tol = 0.25                                '25% tolerance
    VMS1000 = 7314431                         'maximum von Mises stress at step 25 for drop height = 1000 mm
    VMS2000 = 10389063                        'maximum von Mises stress at step 25 for drop height = 2000 mm

    Set SwApp = Application.SldWorks
    If SwApp Is Nothing Then Exit Sub
       

    CosmosFolder = SwApp.GetExecutablePath
       

    Set Part = SwApp.ActiveDoc
       

    Set CWAddinCallBack = SwApp.GetAddInObject("SldWorks.Simulation")
    Set COSMOSWORKS = CWAddinCallBack.COSMOSWORKS
       

    Set ActDoc = COSMOSWORKS.ActiveDoc()
 

    ' Add a default drop test study results plot
    bApp = ActDoc.AddDefaultDropTestStudyPlot(swsDropTestResultElementalStress, swsStressComponentVON)


    Set StudyMngr = ActDoc.StudyManager()
   

    'Create a drop test study
    Set Study = StudyMngr.CreateNewStudy3("Study 2", 6, 0, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to create a drop test study"
   

    Set StudyOptions = Study.DropTestStudyOptions
    Debug.Print "Study results folder: " & StudyOptions.ResultFolder
    Debug.Print "Study displacement formulation (1 = large): " & StudyOptions.LargeDisplacement
    Set ResultOptions = Study.DropTestResultOptions
    Debug.Print "Number of graph steps: " & ResultOptions.NoOfGraphSteps
    Debug.Print "Number of plots: " & ResultOptions.NoOfPlots
    Debug.Print "Save results from starting time (sec): " & ResultOptions.SaveResultsStartingTime
    Debug.Print "Time to solve after impact (sec): " & ResultOptions.SolutionTimeAfterImpact
   

    'Create mesh
    Set CWMesh = Study.Mesh
    CWMesh.MesherType = 0                                       'standard mesh = 0, CB mesh = 1
    CWMesh.Quality = 0                                          'draft = 0, high quality = 1
    errCode = Study.CreateMesh(0, 2, 0.05)                      'create mesh, 0-1-2-3-4 : mm-cm-m-in-ft
   

    'Apply material
    sLibWithPathname = CosmosFolder & "\lang\english\sldmaterials\solidworks materials.sldmat"
    sMaterialName = "Nylon 101"                                'Nylon 101 SOLIDWORKS material
    Set SolidMgr = Study.SolidManager
    CompCount = SolidMgr.ComponentCount
    For j = 0 To (CompCount - 1)                               'Apply material to all solid components
        Set SolidComponent = SolidMgr.GetComponentAt(j, errCode)
        sName = SolidComponent.ComponentName
        Set Solidbody = SolidComponent.GetSolidBodyAt(0, errCode)
        bApp = Solidbody.SetLibraryMaterial(sLibWithPathname, sMaterialName)
        Set Solidbody = Nothing
    Next j
   

    'Assign drop test setup
    Set Selection = SelectByPID(Part, "selection1", PIDCollection)
    Set Setup = Study.AddDropTestSetup(Selection, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to create DropTestSetup object"
    If Setup Is Nothing Then ErrorMsg SwApp, "Failed to get DropTestSetup object"
    Height = Setup.DropHeight
    If Height <> 1000 Then ErrorMsg SwApp, "Failed to validate drop height = 1000 mm from original Study 1"
   

    Debug.Print "Drop height (mm): " & Setup.DropHeight
    Debug.Print "Drop height type (swsDropHeightType_e): " & Setup.DropHeightType
    Debug.Print "Drop height units (swsLinearUnit_e): " & Setup.DropHeightUnit
    Debug.Print "Drop type (swsDropType_e): " & Setup.DropType
    Debug.Print "Reverse gravity direction? (1 = yes) " & Setup.FlipGravityDirection

    Debug.Print "Reverse velocity direction? (1 = yes) " & Setup.FlipVelocityDirection
    Debug.Print "Coefficient of friction: " & Setup.FrictionCoefficient
    Debug.Print "Gravity magnitude: " & Setup.Gravity
    Debug.Print "Gravity units (swsAccelerationUnit_e): " & Setup.GravityUnit
    Debug.Print "Mass density of impact layer: " & Setup.MassDensity
    Debug.Print "Stiffness per unit area normal to impact plane: " & Setup.NormalStiffness
    Debug.Print "Units of stiffness (swsUnitSystem_e): " & Setup.StiffnessUnit
    Debug.Print "Stiffness per unit area parallel to the impact plane: " & Setup.TangentialStiffness
    Debug.Print "Orientation of impact plane (swsDropTargetOrientationType_e): " & Setup.TargetOrientationType
    Debug.Print "Stiffness type (swsDropTargetStiffnessType_e): " & Setup.TargetStiffnessType
    Debug.Print "Thickness of the impact layer: " & Setup.TargetThickness
    Debug.Print "Units of thickness (swsLinearUnit_e): " & Setup.ThicknessUnit
    Debug.Print "Velocity at impact: " & Setup.Velocity
    Debug.Print "Units of velocity (swsVelocityUnit_e): " & Setup.VelocityUnit
   

    'Run study for drop height = 1000 mm
    errCode = Study.RunAnalysis
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to run study (drop height = 1000 mm)"
    Set CWFeatObj = Study.Results
    If CWFeatObj Is Nothing Then ErrorMsg SwApp, "Failed to get Result Object (drop height = 1000 mm)"
    nStep = CWFeatObj.GetMaximumAvailableSteps         'nStep = last step of study
    If nStep <> 25 Then ErrorMsg SwApp, "Total number of steps in result is incorrect (drop height = 1000 mm)"
    Stress = CWFeatObj.GetMinMaxStress(9, 0, nStep, Nothing, 0, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to get von Mises stress result for drop height = 1000 mm"
        A = Stress(3)
        B = VMS1000
        If ResultsVer(A, B, Tol) = True Then
        ErrorMsg SwApp, "The von Mises stress result for drop height = 1000 mm has % error = " & ResultsError(A, B, Tol)
    End If
   

    'Change drop height from 1000 mm to 2000 mm
    Setup.DropTestSetupBeginEdit
    Setup.DropType = 0
    Setup.DropHeightType = 0
    Setup.DropHeight = 2000
    Setup.DropHeightUnit = 0
    errCode = Setup.DropTestSetupEndEdit
   

    If errCode <> 0 Then ErrorMsg SwApp, "Failed to make change to drop height"
    Height = Setup.DropHeight
    If Height <> 2000 Then ErrorMsg SwApp, "Failed to correctly change drop height to 2000 mm"
   

    Stop ' Inspect results for drop height = 1000 mm
   

    'Run study for drop height = 2000 mm
    errCode = Study.RunAnalysis
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to run study (drop height = 2000 mm)"
    Set CWFeatObj = Study.Results
    If CWFeatObj Is Nothing Then ErrorMsg SwApp, "Failed to get Result Object (drop height = 2000 mm) "
    nStep = CWFeatObj.GetMaximumAvailableSteps         'nStep = last step of study
    If nStep <> 25 Then ErrorMsg SwApp, "Total number of steps in result is incorrect (drop height = 2000 mm)"
    Stress = CWFeatObj.GetMinMaxStress(9, 0, nStep, Nothing, 0, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to get von Mises stress result for drop height = 2000 mm"
        A = Stress(3)
        B = VMS2000
        If A < VMS1000 Or A = VMS1000 Then ErrorMsg SwApp, "The von Mises stress for drop height = 2000 mm is less than or equal to drop height = 1000 mm."
        If ResultsVer(A, B, Tol) = True Then
        ErrorMsg SwApp, "The von Mises stress result for drop height = 2000 mm has % error = " & ResultsError(A, B, Tol)
    End If
   

End Sub

Function ResultsVer(ActualResult As Variant, ReferenceResult As Variant, Tolerance As Double) As Boolean
    ResultsVer = (ActualResult < (1 - Tolerance) * ReferenceResult) Or (ActualResult > (1 + Tolerance) * ReferenceResult)
End Function

Function ResultsError(ActualResult As Variant, ReferenceResult As Variant, Tolerence As Double) As Double
    ResultsError = (ActualResult - ReferenceResult) / ReferenceResult * 100
End Function

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

Function SelectByPID(nPart As SldWorks.ModelDoc2, PIDName As String, PIDCollection As Collection) As Object
    Dim PID() As Byte
    Dim PIDVariant As Variant
    Dim PIDString As String
    Dim EntityType As Long
    Dim i As Long
    Dim SelObj As Object

    'Get the string from the collection
    PIDString = ""
    PIDString = PIDCollection.Item(PIDName)
    'Parse the string into an array
    PIDVariant = Split(PIDString, ",")
    ReDim PID(UBound(PIDVariant))
    'Change to a byte array
    For i = 0 To (UBound(PIDVariant) - 1)
        PID(i) = PIDVariant(i)
    Next i
    'Select the entity
    Set SelObj = nPart.Extension.GetObjectByPersistReference3((PID), errCode)
    Set SelectByPID = SelObj
    Set SelObj = Nothing
End Function

Function PIDInitializer() As Collection
Dim PIDCollection As New Collection

    Dim selection1 As String

    'Constants
    selection1 = "35,29,213,113,218,129,72,162,168,88,152,178,27,137,239,153,20,0,0,0,25,0,0,0,120,1,147,22,102,96,96,100,96,96,248,255,239,63,144,100,96,96,1,98,0,36,141,3,48,0,0,0,0,0,0,0,0"
    selection1 = selection1 & ",Type=1"

    'Store constants in a collection
    PIDCollection.Add selection1, "selection1"

    Set PIDInitializer = PIDCollection
End Function

 



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Create Drop Test Study Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2015 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.