Code:
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim selBody As String
Dim selRefAXS As String
Dim ZielAXS As String
Dim shapeFactory1 As ShapeFactory 'solids
Set shapeFactory1 = part1.ShapeFactory
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridBody1 As HybridBody
Dim UserSelection As Object
Set UserSelection = partDocument1.Selection
UserSelection.clear
'--- Körper auswählen
Dim BodyFilter()
ReDim BodyFilter(0)
BodyFilter(0) = "Body"
selBody = UserSelection.SelectElement3(BodyFilter, "Referenzkörper auswählen", False, CATMultiSelTriggWhenUserValidatesSelection, True)
If selBody = "Normal" Then
Dim BodyArray()
ReDim BodyArray(UserSelection.Count)
For a = 1 to UserSelection.Count
Set BodyArray(a) = UserSelection.Item(a).Value
Next
Else
MsgBox ("Fehler falsche Auswahl - Bitte Körper wählen")
End If
UserSelection.clear
'--- RefAxs auswählen
Dim AXSFilter()
ReDim AXSFilter(0)
AXSFilter(0) = "AxisSystem"
selRefAXS = UserSelection.SelectElement2 (AXSFilter, "Referenz Achse auswählen", False)
If selRefAXS = "Normal" Then
Dim RefAXSArray()
ReDim RefAXSArray(UserSelection.Count)
For b = 1 to UserSelection.Count
Set RefAXSArray(b) = UserSelection.Item(b).Value
Next
Else
MsgBox ("Fehler falsche Auswahl - Bitte Achse wählen")
End If
UserSelection.clear
'--- ZielAxs auswählen
ZielAXS = UserSelection.SelectElement3(AXSFilter, "Ziel Achse(n) auswählen", False, CATMultiSelTriggWhenUserValidatesSelection, True)
If ZielAXS = "Normal" Then
Dim ZielAXSArray()
ReDim ZielAXSArray(UserSelection.Count)
For c = 1 to UserSelection.Count
Set ZielAXSArray(c) = UserSelection.Item(c).Value
Next
Else
MsgBox ("Fehler falsche Auswahl - Bitte Achse wählen")
End If
UserSelection.clear
'--- Methode
For d = 1 to UBound(ZielAXSArray)
For e = 1 to Ubound(BodyArray)
UserSelection.add BodyArray(e)
UserSelection.copy
UserSelection.PasteSpecial "CATPrtResult"
UserSelection.Clear
Next
Next
end sub