Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Option Explicit
Sub CATMain()
Dim USel As Selection
Dim USelLB
Dim InputObject(0)
Dim oStatus
Dim i As Integer
Dim sName As String
InputObject(0) = "AnyObject" 'selection filter forces user to select specific objects, AnyObject allows selection of any object
Set USel = CATIA.ActiveDocument.Selection
Set USelLB = USel
MsgBox "Please select fix points." & vbCrLf & "Select a curve only !" & vbCrLf & "Presse escape to cancel the process."
USel.Clear 'clear the selection before making a selection
oStatus = USelLB.SelectElement3(InputObject, "Select objects to list names", True, CATMultiSelTriggWhenUserValidatesSelection, False)
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.Name = "Here the result"
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory
If (oStatus = "Cancel") Then 'User hit esc on keyboard
MsgBox "Macro canceled by user"
Exit Sub
Else 'Loop through selected objects and list names
For i = 1 To USel.Count
sName = USel.Item(i).Value.Name
sName = Replace(sName, "Selection_", "")
MsgBox (sName)
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromBRepName(sName, part1)
'Set reference1 = part1.CreateReferenceFromGeometry()
'Set reference1 = part1.CreateReferenceFromName()
'Set reference1 = part1.CreateReferenceFromObject()
Dim hybridShapePointCenter1 As HybridShapePointCenter
Set hybridShapePointCenter1 = hybridShapeFactory1.AddNewPointCenter(reference1)
hybridBody1.AppendHybridShape hybridShapePointCenter1
hybridShapePointCenter1.Name = "Point " & i
'MsgBox hybridShapePointCenter1.Name
part1.InWorkObject = hybridShapePointCenter1
part1.Update
Next
End If
USel.Clear
End Sub
Dim refObject as Reference
set refObject = USel.Item(i).Value
Dim refObject as Reference
on error resume next
set refObject = USel.Item(i).Value
on error goto 0
if refObject is Nothing then
set refObject = USel.Item(i).LeafProduct.ReferenceProduct.Parent.Part.CreateReferenceFromObject(USel.Item(i).Value)
end if
Dim doc: set doc = USel.Item(i).LeafProduct.ReferenceProduct.Parent
Dim meas: set meas = doc.GetWorkbench("SPAWorkbench").GetMeasurable(refObject)
ReDim cog(2)
meas.GetCOG cog
ReDim cog(2)
USel.Item(i).LeafProduct.GetTechnologicalObject("Inertia").GetCOG cog