Create 3DContact Feature (VBA)
This example shows how to create a 3D contact feature for use in Basic
Motion and Motion Analysis studies.
'------------------------------------
' Preconditions: Assembly document is open and Motion
Study 3 exists.
' SolidWorks
MotionStudy type library is referenced.
'
' Postconditions: a 3DContact feature is created.
'--------------------------------------
Option Explicit
Sub main()
Dim
swApp As SldWorks.SldWorks
Dim
swModel As SldWorks.ModelDoc2
Dim
swModelDocExt As SldWorks.ModelDocExtension
Dim
swMotionMgr As SwMotionStudy.MotionStudyManager
Dim
swMotionStudy3 As SwMotionStudy.MotionStudy
Dim
swContFeat As SldWorks.Simulation3DContactFeatureData
Dim
boolstatus As Boolean
Dim
swFeat As SldWorks.Feature
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swModelDocExt = swModel.Extension
'
Get the MotionManager
Set
swMotionMgr = swModelDocExt.GetMotionStudyManager()
If
(swMotionMgr Is Nothing) Then
End
End
If
'
Motion Study 3 must exist for this macro to work
Set
swMotionStudy3 = swMotionMgr.GetMotionStudy("Motion
Study 3")
If
(swMotionStudy3 Is Nothing) Then
MsgBox
"Motion Study 3 is not available."
End
End
If
'
Ativate Motion Study 3
swMotionStudy3.Activate
Dim
swSelMgr As SldWorks.SelectionMgr
Set
swSelMgr = swModel.SelectionManager
Set
swModelDocExt = swModel.Extension
'
Select the faces on the components for which you want to check for contact
between
boolstatus
= swModelDocExt.SelectByID2("",
"FACE", -0.07792618280496, 0.06212618843159, 0.02214691016243,
True, 0, Nothing, 0)
boolstatus
= swModelDocExt.SelectByID2("",
"FACE", -0.07924982844941, 0.06212618843165, 0.03225592518596,
True, 0, Nothing, 0)
'
Create the definition for the 3DContact feature
Set
swContFeat = swMotionStudy3.CreateDefinition(swFmAEM3DContact)
If
swContFeat Is Nothing Then
Debug.Print
"ERROR: Creation of 3DContact feature data object failed."
Exit
Sub
End
If
'
Define the 3DContact feature
'swMotionContactFrictionOff
= 0,
'swMotionContactFrictionFull
= 1,
'swMotionContactFrictionDynamic
= 2
swContFeat.FrictionOption = swMotionContactFrictionFull
'Static Friction is on for full friction model
'swContFeat.FrictionOption = swMotionContactFrictionDynamic
'Only dynamic friction so Static Friction is off
'
Get the components for the 3DContact feature
Dim
ContactObj(1) As Object
Set
ContactObj(0) = swSelMgr.GetSelectedObject6(1,
-1)
Set
ContactObj(1) = swSelMgr.GetSelectedObject6(2,
-1)
'
Cast ContactObj to a Variant
Dim
vContact As Variant
vContact
= ContactObj
swContFeat.ContactComponents = vContact
'
Create a 3DContact feature
Set
swFeat = swMotionStudy3.CreateFeature(swContFeat)
If
swFeat Is Nothing Then
Debug.Print
" ERROR: Creation of the 3DContact feature failed."
Else
Debug.Print
"Name of the feature added : " & swFeat.Name
End
If
End Sub