Hide Table of Contents

Create Fatigue Study for Dynamic Random Vibration Study Example (VBA)

This example shows how to create a fatigue study for a linear dynamic random vibration study.

'---------------------------------------------------------------------------
' Preconditions:
' 1. Add the SOLIDWORKS Simulation as an add-in (in SOLIDWORKS, click
'    Tools > Add-ins > SOLIDWORKS Simulation > OK).
' 2. Add the SOLIDWORKS Simulation type library as a reference (in the IDE,
'    click Tools > References > SOLIDWORKS Simulation version type library).
' 3. Ensure that the specified part and material library exist.
' 4. Open an Immediate window.
'
' Postconditions:
'  1. Opens the specified file.
'  2. Creates and analyzes study, Dynamic_Random_Vibration.
'  3. Creates a default fatigue study damage plot.
'  4. Creates study, RandomVibrationFatigue.
'  5. Adds a fatigue event of duration 60 seconds to RandomVibrationFatigue.
'  6. Modifies the fatigue S-N curve equation for the model's material.
'  7. Analyzes RandomVibrationFatigue and displays message boxes with damage
'     percentage errors for each of the following computational methods:
'     * Narrow Band
'     * Steinberg
'     * Wirsching
'  8. Click OK to close each message box.
'  9. Inspect the Immediate window for the Narrow Band method
'     minimum and maximum fatigue.
' 10. Inspect the damage plot.
'
' NOTE: Because the model is used elsewhere, do not save any changes.
'---------------------------------------------------------------------------

Option Explicit

Sub main()

    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 SolidMat As CosmosWorksLib.CWMaterial
    Dim LBCMgr As CosmosWorksLib.CWLoadsAndRestraintsManager
    Dim DynStudyOptions As CosmosWorksLib.CWDynamicStudyOptions
    Dim CWDirectionEntity As Object
    Dim CWBaseExcitationEntity as Object
    Dim longstatus As Long
    Dim longwarnings As Long
    Dim errCode As Long
    Dim boolstatus As Boolean
    Dim pDisp5 As Object
    Dim DispArray1 As Variant, DispArray3 As Variant
    Dim sStudyName As String
    Dim ResultOptions As CosmosWorksLib.CWStudyResultOptions
    Dim DampingOptions As CosmosWorksLib.CWDampingOptions
    Dim DampingRatios As Variant
    Dim freqOption As Long
    Dim freqValue As Double
    Dim bChecked As Boolean
    Dim CWFeatObj As Object
    Dim CWFeatObj2 As CosmosWorksLib.CWPressure
    Dim CWFeatObj3 As CosmosWorksLib.CWRestraint
    Dim CWFeatObj4 As CosmosWorksLib.CWMesh
    Dim CWFeatObj5 As CosmosWorksLib.CWResults
    Dim param As Long
    Dim dParam As Double
    Dim inRadius As Double
    Dim outRadius As Double
    Dim FatigueOptions As CosmosWorksLib.CWFatigueStudyOptions
    Dim FatigueEvent As CosmosWorksLib.CWFatigueEvent
    Dim Damage As Variant
  

    Const Tol As Double = 0.05 '5% - damage tolerance
    Const DamageMax_NarrowBand As Double = 1305.36  'baseline percentage
    Const DamageMax_Steinberg As Double = 741.951  'baseline percentage
    Const DamageMax_Wirsching As Double = 907.23  'baseline percentage
    Const MeshEleSize As Double = 26.5868077635828 'mm
    Const MeshTol As Double = 1.32934038817914 'mm

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

    Set Part = SwApp.OpenDoc6("C:\Users\Public\Documents\SOLIDWORKS\SOLIDWORKS 2017\tutorial\api\block.SLDPRT", swDocPART, swOpenDocOptions_Silent, "", longstatus, longwarnings)
    If Part Is Nothing Then ErrorMsg SwApp, "Failed to open block.SLDPRT"

    Set CWAddinCallBack = SwApp.GetAddInObject("CosmosWorks.CosmosWorks")
    If CWAddinCallBack Is Nothing Then ErrorMsg SwApp, "Failed to get CwAddincallback object"
    Set COSMOSWORKS = CWAddinCallBack.COSMOSWORKS
    If COSMOSWORKS Is Nothing Then ErrorMsg SwApp, "Failed to get CosmosWorks object"

    Set ActDoc = COSMOSWORKS.ActiveDoc()
    If ActDoc Is Nothing Then ErrorMsg SwApp, "Failed to get active document"

    ' Create a dynamic random vibration study
    Set StudyMngr = ActDoc.StudyManager()
    If StudyMngr Is Nothing Then ErrorMsg SwApp, "Failed to get CWStudyManager object"

    sStudyName = "Dynamic_Random_Vibration"
    Set Study = StudyMngr.CreateNewStudy3(sStudyName, swsAnalysisStudyTypeDynamic, swsDynamicAnalysisSubTypeRandom, errCode)

    Debug.Print "Linear dynamic study with random vibration analysis"
    Debug.Print ""
    Debug.Print "Study configuration name is " & Study.ConfigurationName
    Debug.Print "Dynamic analysis subtype as defined in swsAnalysisStudyType_e is " & Study.DynamicAnalysisSubType
    Debug.Print "Dynamic study options..."

    Set DynStudyOptions = Study.DynamicStudyOptions

    errCode = DynStudyOptions.GetFrequencyOption2(freqOption, freqValue)
    Debug.Print "  Frequency option (0=number of frequencies, 1=upper bound): " & freqOption
    Debug.Print "  No. of frequencies or upper-bound frequency: " & freqValue
    errCode = DynStudyOptions.GetFrequencyShiftOption2(bChecked, freqValue)
    Debug.Print "  Is frequency shift enabled (0=no, 1=yes)? " & bChecked
    Debug.Print "  Frequency shift: " & freqValue

    errCode = DynStudyOptions.SetIncompatibleBondingOption2(swsIncompatibleBondingOption_Automatic)
    errCode = DynStudyOptions.SetUseSoftSpring2(0) ' Not using soft spring to stabilize model
    errCode = DynStudyOptions.SetResultFolderPath2("c:\temp")

    DynStudyOptions.SolverType = swsSolverTypeFFEPlus

    errCode = DynStudyOptions.GetRandomVibrationAnalysisMethod2(param)
    Debug.Print "  Analysis method as defined in swsRandomVibrationAnalysisMethod_e: " & param
    errCode = DynStudyOptions.GetRandomVibrationBiasingParameter2(dParam)
    Debug.Print "  Biasing parameter: " & param
    errCode = DynStudyOptions.GetRandomVibrationCorrelationOption2(param)
    Debug.Print "  Correlation option as defined in swsRandomVibrationCorrelationOption_e: " & param
    errCode = DynStudyOptions.GetRandomVibrationCrossModeCutOffRatio2(dParam)
    Debug.Print "  Cross-mode cut-off ratio: " & param
    errCode = DynStudyOptions.GetRandomVibrationFrequencyLowerLimit2(dParam)
    Debug.Print "  Operating frequency lower limit: " & param
    errCode = DynStudyOptions.GetRandomVibrationFrequencyUnits2(param)
    Debug.Print "  Units of operating frequency as defined in swsFrequencyUnit_e: " & param
    errCode = DynStudyOptions.GetRandomVibrationFrequencyUpperLimit2(dParam)
    Debug.Print "  Operating frequency upper limit: " & param
    errCode = DynStudyOptions.GetRandomVibrationGaussIntegrationOrder2(param)
    Debug.Print "  Gauss integration order as defined in swsGaussIntegrationOrder_e: " & param
    errCode = DynStudyOptions.GetRandomVibrationNoOfFrequencyPoints2(param)
    Debug.Print "  Number of frequency points: " & param
    errCode = DynStudyOptions.GetRandomVibrationPartialCorrelationDetails2(param, inRadius, outRadius)
    Debug.Print "  Partially correlated units as defined in swsLinearUnit_e: " & param
    Debug.Print "  Inside radius: " & inRadius
    Debug.Print "  Outside radius: " & outRadius

    Debug.Print ""

    ' Set study result options
    Debug.Print "Study result options..."
    Set ResultOptions = Study.StudyResultOptions
    ResultOptions.SaveResultsForSolutionStepsOption = swsSaveResultsOption_ForAllSolutionSteps
    ResultOptions.SaveDisplacementsAndVelocitiesOption = swsResultsDisplacementAndVelocityOption_Absolute
    ResultOptions.SaveStresses = 1 ' Save stress results
  

    ' Set damping options
    Set DampingOptions = Study.DampingOptions
    DampingOptions.DampingType = swsDampingType_Modal
    DampingRatios = Array(1, 5, 3.45, 6, 15, 15, 16, 25, 34.5)
    errCode = DampingOptions.SetDampingRatios(3, (DampingRatios))
    DampingOptions.ComputeFromMaterialDamping = 0 ' Not using the material damping ratio to calculate modal damping ratios

    Dim PID       As Variant
    Dim SelObj    As Object
    Dim obj       As Object
    Dim fixtureEntity As Object

    ' Get a face to which to apply a pressure
    boolstatus = Part.Extension.SelectByID2("", "FACE", -7.95509158535879E-03, 0, -1.13043904061669E-02, False, 0, Nothing, 0)
    Set obj = Part.SelectionManager.GetSelectedObject6(1, -1)
    PID = Part.Extension.GetPersistReference3(obj)
    Set SelObj = Part.Extension.GetObjectByPersistReference3((PID), errCode)
    DispArray1 = Array(SelObj)

    ' Get a face to use as a fixture
    boolstatus = Part.Extension.SelectByID2("", "FACE", -2.07435908961884E-02, -1.34200983288792E-02, -9.99045700837087E-03, False, 0, Nothing, 0)
    Set obj = Part.SelectionManager.GetSelectedObject6(1, -1)
    PID = Part.Extension.GetPersistReference3(obj)
    Set fixtureEntity = Part.Extension.GetObjectByPersistReference3((PID), errCode)
    DispArray3 = Array(fixtureEntity)

    ' Get a face to use as a reference entity
    boolstatus = Part.Extension.SelectByID2("", "FACE", 1.80913769526114E-02, -1.29337958455835E-02, -1.01226987114842E-02, False, 0, Nothing, 0)
    Set obj = Part.SelectionManager.GetSelectedObject6(1, -1)
    PID = Part.Extension.GetPersistReference3(obj)
    Set CWDirectionEntity = Part.Extension.GetObjectByPersistReference3((PID), errCode)
    Set pDisp5 = CWDirectionEntity

    ' Add a material
    Dim SolidMgr As CosmosWorksLib.CWSolidManager
    Dim SolidComponent As CosmosWorksLib.CWSolidComponent
    Dim SName As String
    Dim SolidBody As CosmosWorksLib.CWSolidBody
   

    Set SolidMgr = Study.SolidManager
    Set SolidComponent = SolidMgr.GetComponentAt(0, errCode)
    SName = SolidComponent.ComponentName

    Set SolidBody = SolidComponent.GetSolidBodyAt(0, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "No solid body"

    boolstatus = SolidBody.SetLibraryMaterial("C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\english\sldmaterials\solidworks materials.sldmat", "Ductile Iron (SN)")
    If boolstatus = False Then ErrorMsg SwApp, "No material applied"

    ' Get loads and restraints manager
    Set LBCMgr = Study.LoadsAndRestraintsManager
    If LBCMgr Is Nothing Then ErrorMsg SwApp, "Failed to get loads and restraints manager"

    ' Apply pressure normal to the selected face
    Set CWFeatObj2 = LBCMgr.AddPressure(swsPressureTypeNormal, (DispArray1), Nothing, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to create normal pressure"
    Call CWFeatObj2.PressureBeginEdit
    Debug.Print "Normal pressure values..."
    Debug.Print ("  Pressure unit in swsStrengthUnit_e units: " & CWFeatObj2.Unit)
    Debug.Print ("  Pressure value: " & CWFeatObj2.Value)
    Debug.Print ("  Pressure phase angle (-1 if not set): " & CWFeatObj2.PhaseAngle)
    Debug.Print ("  Pressure phase angle unit in swsPhaseAngleUnit_e units: " & CWFeatObj2.PhaseAngleUnit)
    errCode = CWFeatObj2.PressureEndEdit
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to apply normal pressure value"

    Debug.Print " "

    ' Add a fixture
    Set CWFeatObj3 = LBCMgr.AddRestraint(swsRestraintTypeFixed, (DispArray3), pDisp5, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to create restraint"
    Call CWFeatObj3.RestraintBeginEdit
    Call CWFeatObj3.SetTranslationComponentsValues(0, 0, 1, 0#, 0#, 0#)
    Call CWFeatObj3.SetRotationComponentsValues(0, 0, 0, 0#, 0#, 0#)
    CWFeatObj3.Unit = swsLinearUnitMeters
    errCode = CWFeatObj3.RestraintEndEdit
    If errCode <> 0 Then ErrorMsg SwApp, "Restraint end-edit failed"

    ' Create mesh
    Set CWFeatObj4 = Study.Mesh
    If CWFeatObj4 Is Nothing Then ErrorMsg SwApp, "Failed to create mesh object"
    CWFeatObj4.MesherType = swsMesherTypeStandard
    CWFeatObj4.Quality = swsMeshQualityHigh

    errCode = Study.CreateMesh(swsLinearUnitMillimeters, MeshEleSize, MeshTol)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to create mesh"
    Debug.Print "Worst Jacobian ratio for the mesh: " & CWFeatObj4.GetWorstJacobianRatio
    Debug.Print ""

    ' Run analysis
    Debug.Print "Running the analysis"
    Debug.Print ""
    errCode = Study.RunAnalysis
    If errCode <> 0 Then ErrorMsg SwApp, "Analysis failed with error code as defined in swsRunAnalysisError_e:" & errCode
    Set CWFeatObj5 = Study.Results
    If CWFeatObj5 Is Nothing Then ErrorMsg SwApp, "Failed to get results object"
  

    ' Add default fatigue study results plot
    errCode = ActDoc.AddDefaultFatigueStudyPlot(swsFatigueStudy_DamagePlot)
 

    Set StudyMngr = ActDoc.StudyManager()
    If StudyMngr Is Nothing Then ErrorMsg SwApp, "Failed to get CWStudyManager object"
  

    ' Create random vibration fatigue study
    Debug.Print "Creating RandomVibrationFatigue study..."
    Set Study = StudyMngr.CreateNewStudy3("RandomVibrationFatigue", swsAnalysisStudyTypeFatigue, 3, errCode)
    If Study Is Nothing Then ErrorMsg SwApp, "Failed to create new study"
   

    errCode = Study.SetFatigueResultOptions(swsFatigueCalculationsOption_SurfaceOnly, Nothing)
 

    Set FatigueOptions = Study.FatigueStudyOptions
    If FatigueOptions Is Nothing Then ErrorMsg SwApp, "Failed to get CWFatigueStudyOptions object"

    Set FatigueEvent = FatigueOptions.AddFatigueEventForRandomVibration("Dynamic_Random_Vibration", 60, 0, errCode)
   

    Set SolidMgr = Study.SolidManager
    Set SolidComponent = SolidMgr.GetComponentAt(0, errCode)
    SName = SolidComponent.ComponentName

    Set SolidBody = SolidComponent.GetSolidBodyAt(0, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "No solid body"

    boolstatus = SolidBody.SetLibraryMaterial("C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\english\sldmaterials\solidworks materials.sldmat", "Ductile Iron (SN)")
    If boolstatus = False Then ErrorMsg SwApp, "No material applied"

    Set SolidMat = SolidBody.GetSolidBodyMaterial

    SolidMat.SNCurveSource = swsMaterialSNCurveSourceEquation
    SolidMat.SNCurveEstimateConstants = 0 ' Specify Basquin Equation constants, B and m
    SolidMat.SNCurveSpecificConstantBUnit = 3 ' N/mm^2
    SolidMat.SNCurveSpecificConstantB = 2E+20 ' B constant
    SolidMat.SNCurveSlopeM = 0.5 ' Slope m
   

    errCode = SolidBody.SetSolidBodyMaterial(SolidMat)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to apply material"
   
    FatigueOptions.RandomVibrationComputationalMethod = 0 ' Narrow Band computational method

    errCode = Study.RunAnalysis
    If errCode <> 0 Then ErrorMsg SwApp, "Narrow Band analysis failed with error code as defined in swsRunAnalysisError_e: " & errCode
  

    Set CWFeatObj = Study.Results
    If CWFeatObj Is Nothing Then ErrorMsg SwApp, "Failed to get CWResults object"
   

    ' Get minimum and maximum damage
    Damage = CWFeatObj.GetMinMaxFatigue(swsFatigueComponent_Damage, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to get Narrow Band minimum and maximum damage. Error code as defined in swsResultsError_e: " & errCode
   

    ' Compare maximum damage percentage with baseline and report errors
    If (Damage(3) < (1 - Tol) * DamageMax_NarrowBand) Or (Damage(3) > (1 + Tol) * DamageMax_NarrowBand) Then
        ErrorMsg SwApp, "Narrow Band damage % error = " & (((Damage(3) - DamageMax_NarrowBand) / DamageMax_NarrowBand) * 100)
    End If

    Debug.Print "Narrow Band computational method..."
    Debug.Print "  Minimum fatigue is " & Damage(1) & " at node " & Damage(0)
    Debug.Print "  Maximum fatigue is " & Damage(3) & " at node " & Damage(2)
   
    FatigueOptions.RandomVibrationComputationalMethod = 1 ' Steinberg computational method
    errCode = Study.RunAnalysis
    If errCode <> 0 Then ErrorMsg SwApp, "Steinberg analysis failed with error code as defined in swsRunAnalysisError_e: " & errCode
  

    Set CWFeatObj = Study.Results
    If CWFeatObj Is Nothing Then ErrorMsg SwApp, "Failed to get CWResults object"
   

    ' Get minimum and maximum damage
    Damage = CWFeatObj.GetMinMaxFatigue(swsFatigueComponent_Damage, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to get Steinberg minimum and maximum damage. Error code as defined in swsResultsError_e: " & errCode
   

    ' Compare maximum damage percentage with baseline and report errors
    If (Damage(3) < (1 - Tol) * DamageMax_Steinberg) Or (Damage(3) > (1 + Tol) * DamageMax_Steinberg) Then
        ErrorMsg SwApp, "Steinberg damage % error = " & (((Damage(3) - DamageMax_Steinberg) / DamageMax_Steinberg) * 100)
    End If
   
    FatigueOptions.RandomVibrationComputationalMethod = 2 ' Wirsching computational method
    errCode = Study.RunAnalysis
    If errCode <> 0 Then ErrorMsg SwApp, "Wirsching analysis failed with error code as defined in swsRunAnalysisError_e: " & errCode
  

    Set CWFeatObj = Study.Results
    If CWFeatObj Is Nothing Then ErrorMsg SwApp, "Failed to get CWResults object"
   

    ' Get minimum and maximum damage
    Damage = CWFeatObj.GetMinMaxFatigue(swsFatigueComponent_Damage, errCode)
    If errCode <> 0 Then ErrorMsg SwApp, "Failed to get Wirsching minimum and maximum damage. Error code as defined in swsResultsError_e: " & errCode
   

    ' Compare maximum damage percentage with baseline and report errors
    If (Damage(3) < (1 - Tol) * DamageMax_Wirsching) Or (Damage(3) > (1 + Tol) * DamageMax_Wirsching) Then
        ErrorMsg SwApp, "Wirsching damage % error = " & (((Damage(3) - DamageMax_Wirsching) / DamageMax_Wirsching) * 100)
    End If
   

End Sub

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

 



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 Fatigue Study for Dynamic Random Vibration 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) 2017 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.