Utworzyłem makro do automatycznego wstawiania sił ze zbioru wyboru powierzchni do elementu.
W niektórych przypadkach muszę zrobić to samo, ale w kontekście zgromadzenia. Zbiory wskazań znajdują się zawsze w jednej z części zespołu. Polecenie działa, ale nie jest wybrana żadna powierzchnia...
Wstawię kod używany do informacji:
Public Sub CreateForce200(swSelSet As SldWorks.SelectionSet)
Dim swApp As Object
Set swApp = Application.SldWorks
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.CosmosWorks
Dim ActiveDocObj As Object
Dim StudyManagerObj As Object
Dim LoadsAndRestraintsManagerObj As Object
Dim ErrorCodeObj As Long
Dim ContactManagerObj As Object
Set ActiveDocObj = COSMOSWORKSObj.ActiveDoc()
Set StudyManagerObj = ActiveDocObj.StudyManager()
Dim StudyObj As Object
Set StudyObj = StudyManagerObj.GetStudy(0)
Set LoadsAndRestraintsManagerObj = StudyObj.LoadsAndRestraintsManager()
Dim vSelItems As Variant
Dim vSelItemTypes As Variant
Dim swSelItem As SldWorks.SelectionSetItem
Dim swFace As SldWorks.Face2
Dim j As Integer
Dim errors As Long
vSelItems = swSelSet.GetSelectionSetItems
vSelItemTypes = swSelSet.GetSelectionSetItemTypes
Debug.Print "Nom du jeu de Selection: " & swSelSet.GetName
'Contrôle pièce activée
'Dim swPart As SldWorks.PartDoc
'Set swPart = swApp.ActivateDoc3(nameCarte2, True, swRebuildOnActivation_e.swUserDecision, errors)
Dim DispArray As Variant
Dim cnt As Long
cnt = UBound(vSelItems)
Dim myArray()
ReDim Preserve myArray(cnt)
For j = 0 To cnt
Set swSelItem = vSelItems(j)
If vSelItemTypes(j) = swSelectType_e.swSelFACES Then
Set myArray(j) = swSelItem.GetCorrespondingItem
End If
Next
DispArray = myArray
Dim CWForceObj As Object
Dim DistanceValues As Variant
Dim ForceValues As Variant
Dim ComponentValues As Variant
Dim data(6) As Double
data(0) = 1: data(1) = 1: data(2) = 1: data(3) = 1: data(4) = 1: data(5) = 1
ComponentValues = data
Set CWForceObj = LoadsAndRestraintsManagerObj.AddForce3(1, 0, -1, 0, 0, 0, (DistanceValues), (ForceValues), 0, False, 0, 0, 0, 1, (ComponentValues), False, False, (DispArray), Nothing, False, ErrorCodeObj)
StudyObj.ShowOrHideForce = False
Set StudyManagerObj = Nothing
Set ActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
End Sub