Get and Set Beams and Joints Example (VBA)
This example shows how to get and set beams and joints.
'---------------------------------------------------------------------------
' Preconditions:
' 1. Add the SOLIDWORKS Simulation as an add-in
' (in
SOLIDWORKS, click Tools > Add-ins
> SOLIDWORKS Simulation).
' 2. Add the SOLIDWORKS Simulation type library as a reference
' (in
the IDE, click Tools > References
> SOLIDWORKS
' Simulation
version type
library).
' 3. Open the Immediate window.
' 4. Run the macro.
'
' Postconditions:
' 1. A static study, frame,
is created.
' 2. Beam information is printed to the Immediate window.
' 3. Plain Carbon Steel
material is applied to all beams.
' 4. Joints are calculated for all beams, and
' a
neutral axis is shown for each beam. Pinball tolerance
' value
and unit are printed to the Immediate window.
' 5. Mixed mesh is created, and type and state printed
to Immediate window.
'
' NOTES:
' * Beam
elements are created by default for parts with
' structural
members.
' * Because
the part document is used with
' a
SOLIDWORKS Simulation online tutorial, do not save any
' changes
when closing the document.
'-------------------------------
Option Explicit
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
Joints As CosmosWorksLib.CWJoints
Dim
Mesh As CosmosWorksLib.CWMesh
Dim
nbrBeamBodies As Long
Dim
beamBodyType As Long
Dim
ElementSize As Double
Dim
Tolerance As Double
Dim
errors As Long, warnings As Long
Dim
errCode As Long
Dim
j As Integer
Dim
bApp As Boolean
Dim keepJointUpdates As Boolean
'
Connect to SOLIDWORKS
If
SwApp Is Nothing Then Set SwApp = Application.SldWorks
'
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\samples\tutorial\weldments\weldment_box2.sldprt",
swDocPART, swOpenDocOptions_Silent, "", errors, warnings
Set
ActDoc = COSMOSWORKS.ActiveDoc()
If
ActDoc Is Nothing Then ErrorMsg SwApp, "No active document.",
True
'Create
new static study named frame
Set
StudyMngr = ActDoc.StudyManager()
If
StudyMngr Is Nothing Then ErrorMsg SwApp, "StudyMngr object not there.",
True
Set
Study = StudyMngr.CreateNewStudy("frame",
swsAnalysisStudyTypeStatic, swsMeshTypeMixed, errCode)
If
Study Is Nothing Then ErrorMsg SwApp, "Study not created.",
True
'
Get and set beam info
Set
BeamMgr = Study.BeamManager
nbrBeamBodies
= BeamMgr.BeamCount
Debug.Print
"Beams..."
Debug.Print
" Number
of beams: " & nbrBeamBodies
Set
BeamBody = Nothing
For
j = 0 To (nbrBeamBodies - 1)
Set
BeamBody = BeamMgr.GetBeamBodyAt(j,
errCode)
If
errCode <> 0 Then ErrorMsg SwApp, "No beam body.", True
Debug.Print
" Name
of beam body: " & BeamBody.BeamBodyName
beamBodyType
= BeamBody.BeamType
If
beamBodyType = 0 Then
Debug.Print
" Type
of beam body: beam"
Else
Debug.Print
" Type
of beam body: truss"
End
If
bApp
= BeamBody.SetLibraryMaterial("C:\Program
Files\SOLIDWORKS Corp\SOLIDWORKS\lang\english\sldmaterials\solidworks
materials.sldmat", "Plain Carbon Steel")
If
bApp = False Then ErrorMsg SwApp, "No material applied.", True
Set
BeamBody = Nothing
Next
j
'
Calculate joints
Set
Joints = BeamMgr.GetJointGroup(errCode)
Debug.Print
" "
Debug.Print
"Joints..."
If
errCode <> 0 Then ErrorMsg SwApp, "No joint group.", True
Joints.JointsBeginEdit
Joints.IncludeAllSelectedBeam = True
Joints.IncludeDisplayNeutralAxis = True
Joints.CalculateJoints
Joints.JointsEndEdit
keepJointUpdates = Joints.IncludeKeepModifiedJointOnUpdate
If (keepJointUpdates = True) Then
Debug.Print (" Keep joint updates? yes")
Else
Debug.Print (" Keep joint updates? no")
End If
Debug.Print " Overwrite the pinball value: " & Joints.IncludeTreatAsJointForClearanceLessThan
Debug.Print
" Pinball
radius: " & Joints.PinBallRadius
* 0.001
Select
Case Joints.PinBallRadiusUnit
Case
0
Debug.Print
" Pinball
radius unit: mm"
Case
1
Debug.Print
" Pinball
radius unit: cm"
Case
2
Debug.Print
" Pinball
radius unit: m"
Case
3
Debug.Print
" Pinball
radius unit: in"
Case
4
Debug.Print
" Pinball
radius unit: ft"
Case
5
Debug.Print
" Pinball
radius unit: ft-in"
Case
6
Debug.Print
" Pinball
radius unit: am"
Case
7
Debug.Print
" Pinball
radius unit: nm"
Case
8
Debug.Print
" Pinball
radius unit: micron"
Case
9
Debug.Print
" Pinball
radius unit: mil"
Case
10
Debug.Print
" Pinball
radius unit: MicroIn"
End
Select
'
Mesh the part
Set
Mesh = Study.Mesh
If
Mesh Is Nothing Then ErrorMsg SwApp, "No mesh object.", False
Mesh.Quality = swsMeshQualityHigh
Mesh.GetDefaultElementSizeAndTolerance swsLinearUnitMillimeters,
ElementSize, Tolerance
errCode
= Study.CreateMesh(swsLinearUnitMillimeters,
ElementSize, Tolerance)
If
errCode <> 0 Then ErrorMsg SwApp, "Mesh failed.", True
Debug.Print
" "
Debug.Print
"Mesh..."
Debug.Print
" Time
to create mesh: " & Mesh.TimeToCompleteMesh
Select
Case Mesh.MeshType
Case
0
Debug.Print
" Mesh
type: solid"
Case
1
Debug.Print
" Mesh
type: midsurface"
Case
2
Debug.Print
" Mesh
type: surface"
Case
3
Debug.Print
" Mesh
type: mixed"
Case
4
Debug.Print
" Mesh
type: beam"
End
Select
Debug.Print
" Number
of mesh controls: " & Mesh.MeshControlCount
Select
Case Mesh.MeshState
Case
0
Debug.Print
" Mesh
state: no mesh"
Case
1
Debug.Print
" Mesh
state: exists and is current"
Case
2
Debug.Print
" Mesh
state: exists and is not current"
Case
3
Debug.Print
" Mesh
state: failed"
Case
4
Debug.Print
" Mesh
state: interrupted"
End
Select
End Sub
'Error function
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