Hi Folks,
I am trying to generate a spring curve for a nonlinear spring Running SW Premium 2013 SP3.0. using a VBA macro.
The intent ultimately is to change the value of the force and run the simulation in a loop incrementing the force and collecting a single sensor reading.
Currently it attempts to simply change the value from the original value to a different one and run.
I have set up a simple static study (attached.) The macro is also attached.
The macro runs and acts like it is doing the correct thing, but the actual simulation does not use new force values nor does the force dialog update in the application window.
Sub main()
Dim SwApp As SldWorks.SldWorks
Dim COSMOSWORKS As CosmosWorksLib.COSMOSWORKS
Dim COSMOSObject As CosmosWorksLib.CWAddinCallBack
Dim ActDoc As CosmosWorksLib.CWModelDoc
Dim StudyMngr As CosmosWorksLib.CWStudyManager
Dim Study As CosmosWorksLib.CWStudy
Dim BeamMgr As CosmosWorksLib.CWBeamManager
Dim BeamBody As CosmosWorksLib.CWBeamBody
Dim SolidMgr As CosmosWorksLib.CWSolidManager
Dim SolidComponent As CosmosWorksLib.CWSolidComponent
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim SolidBody As CosmosWorksLib.CWSolidBody
Dim nbrBeamBodies As Long
Dim beamBodyType As Long
Dim errors As Long, warnings As Long
Dim errCode As Long
Dim j As Long
Dim nbrSolidComponents As Long
Dim nbrSolidBodies As Long
Dim k As Long
' Connect to SolidWorks
If SwApp Is Nothing Then Set SwApp = Application.SldWorks
Set swModel = SwApp.ActiveDoc()
Set swModelDocExt = swModel.Extension
' Get the SolidWorks Simulation object
Set COSMOSObject = SwApp.GetAddInObject("SldWorks.Simulation")
If COSMOSObject Is Nothing Then ErrorMsg SwApp, "COSMOSObject object not found.", True
Set COSMOSWORKS = COSMOSObject.COSMOSWORKS
If COSMOSWORKS Is Nothing Then ErrorMsg SwApp, "COSMOSWORKS object not found.", True
'Open and get the active document
'SwApp.OpenDoc6 "C:\Program Files\SolidWorks Corp\SolidWorks\Simulation\Examples\Beams\Beam_Truss.sldprt", swDocPART, swOpenDocOptions_Silent, "", errors, warnings
Set ActDoc = COSMOSWORKS.ActiveDoc()
If ActDoc Is Nothing Then ErrorMsg SwApp, "No active document.", True
'Get study Manager
Set StudyMngr = ActDoc.StudyManager()
If StudyMngr Is Nothing Then ErrorMsg SwApp, "StudyMngr object not there.", True
StudyMngr.ActiveStudy = 0
'Get study
Set Study = StudyMngr.GetStudy(0)
If Study Is Nothing Then ErrorMsg SwApp, "No study.", True
Dim LBCMgr As CosmosWorksLib.CWLoadsAndRestraintsManager
'get LoadAndRestraintsManager
Set LBCMgr = Study.LoadsAndRestraintsManager
Dim LandRValue As CWLoadsAndRestraints
Dim LRErrors As Long
Dim MyCWForce As CosmosWorksLib.ICWForce
Set MyCWForce = LBCMgr.GetLoadsAndRestraints(1, LRErrors)
'MsgBox MyCWForce.Name
Dim B1 As Long
Dim B2 As Long
Dim B3 As Long
Dim D1 As Double
Dim D2 As Double
Dim D3 As Double
Dim value As Integer
Dim PIDCollection As New Collection
Dim var1 As Variant
Dim var2 As Variant
Dim pDisp1 As Object
Dim pDisp2 As Object
Dim DispArray1 As Variant
Dim DispArray2 As Variant
Dim selection1 As String
Dim oSelect1 As Object
Dim varArray1 As Variant
Dim status As Long
'Constants
selection1 = "112,23,0,0,3,0,0,0,255,254,255,0,0,0,0,0,255,255,1,0,11,0,109,111,70,97,99,101,82,101,102,95,99,1,0,0,0,0,0,0,0,6,0,0,0,0,3,0,0,0,0,0,0,125,195,148,37,173,73,178,84,125,195,148,37,173,73,178,84,0,0,255,255,1,0,23,0,109,111,70,114,111,109,83,107,116,69,110,116,83,117,114,102,73,100,82,101,112,95,99,0,0,255,255,1,0,6,0,109,111,70,82,95,99,255,255,1,0,13,0,109,111,69,120,116,79,98,106,101,99,116,95,99,255,255,1,0,17,0,109,111,67,83,116,114,105,110,103,72,97,110,100,108,101,95,99,255,254,255,63,92,0,92,0,72,0,84,0,92,0,72,0,84,0,101,0,99,0,104,0,92,0,80,0,114,0,111,0,106,0,101,0,99,0,116,0,115,0,92,0,80,0,114,0,105,0,110,0,116,0,32,0,84,0,101,0,99,0,104,0,92,0,84,0,101,0,110,0,110,0,105,0,115,0,92,0,83,0,112,0,114,0,105,0,110,0,103,0,45,0,78,0,111,0,110,0,76,0,105,0,110,0,101,0,97,0,114,0,32,0,49,0,46,0,83,0,76,0,68,0,80,0,82,0,84,0,9,128,255,254,255,18,83,0,112,0,114,0,105,0,110,0,103,0,45,0,78,0,111,0,110,0,76,0,105,0,110,0,101,0,97,0,114,0,32,0,49,0,2,0,0,184,104,237,81,0"
selection1 = selection1 & ",211,110,168,48,0,0,0,0,0,0,0,0,0,0,0,0,255,254,255,7,68,0,101,0,102,0,97,0,117,0,108,0,116,0,0,0,0,0,0,0,0,0,72,17,95,99,42,0,0,0,68,105,237,81,3,0,0,0,255,255,1,0,20,0,109,111,69,110,100,70,97,99,101,83,117,114,102,73,100,82,101,112,95,99,0,0,5,128,8,0,42,0,0,0,68,105,237,81,0,0,0,0,0,0,0,0,255,255,1,0,19,0,109,111,70,105,108,108,101,116,83,117,114,102,73,100,82,101,112,95,99,0,0,5,128,8,0,45,0,0,0,73,221,237,81,2,0,0,0,12,128,0,0,5,128,8,0,42,0,0,0,68,105,237,81,1,0,0,0,0,0,0,0,3,128,0,0,5,128,8,0,42,0,0,0,68,105,237,81,6,0,0,0,0,0,0,0,0,0,0,0,0,0"
selection1 = selection1 & ",Type=1"
StringtoArray selection1, var1
Set oSelect1 = swModelDocExt.GetObjectByPersistReference3((var1), status)
varArray1 = Array(oSelect1)
'when not commented out this sucessfully adds a force, but its value does not change either.
'Set MyCWForce = LBCMgr.AddForce2(swsForceTypeNormal, 0, (varArray1), Nothing, errCode)
'If errCode <> 0 Then ErrorMsg SwApp, "No force applied.", True
MyCWForce.GetForceComponentValues B1, B2, B3, D1, D2, D3
MsgBox B1 & " " & B2 & " " & B3 & " " & D1 & " " & D2 & " " & D3
'correct force reported
MyCWForce.ForceBeginEdit
MyCWForce.SetForceComponentValues 0, 0, 1, 0, 0, 7
value = MyCWForce.ForceEndEdit()
MsgBox value
'No error reported
MyCWForce.GetForceComponentValues B1, B2, B3, D1, D2, D3
MsgBox B1 & " " & B2 & " " & B3 & " " & D1 & " " & D2 & " " & D3
'force values show to be changed Values in dialog box in study do not change.
errCode = Study.RunAnalysis
If errCode <> 0 Then ErrorMsg SwApp, "Analysis failed with error code " & errCode & " - " & ProcErrCode(errCode), False
'Simulation does not use new values but otherwise runs correctly.
End Sub
Function ErrorMsg(SwApp As Object, Message As String, EndTest As Boolean)
SwApp.SendMsgToUser2 Message, 0, 0
SwApp.RecordLine "'*** WARNING - General"
SwApp.RecordLine "'*** " & Message
SwApp.RecordLine ""
If EndTest Then
End If
End Function
Function StringtoArray(inputSTR As String, varEntity As Variant)
Dim PID() As Byte
Dim i As Integer
varEntity = Split(inputSTR, ",")
ReDim PID(UBound(varEntity))
For i = 0 To (UBound(varEntity) - 1)
PID(i) = varEntity(i)
Next i
varEntity = PID
End Function