Sub CATMain()
Dim oDoc As Document
Set oDoc = CATIA.ActiveDocument
Dim oSel As Selection
Set oSel = oDoc.Selection
Dim oPart As Product
Set oPart = oDoc.Part
Dim oHybridBodies As HybridBodies
Set oHybridBodies = oPart.HybridBodies
Dim oHybridBody As HybridBody
Set oHybridBody = oHybridBodies.Add()
oHybridBody.Name = "User Selected point"
oPart.InWorkObject = oHybridBody
oPart.Update
Dim oHSF As HybridShapeFactory
Set oHSF = oPart.HybridShapeFactory
Dim oInputObjectType()
Dim iStatus As Integer
ReDim oInputObjectType(1)
oInputObjectType(0)="TriDimFeatEdge"
oInputObjectType(1)="BiDimFeatEdge"
iStatus = oSel.SelectElement2(oInputObjectType,"Select an edge ",FALSE)
If (iStatus = "Cancel" Or iStatus = "Undo" Or iStatus = "Redo") then Exit Sub
Dim oEdgeOrCurveSelected
Set oEdgeOrCurveSelected = oSel.Item(1).Value
'Dim s
's = TypeName(oEdgeOrCurveSelected) & vblf & vblf
's = s & TypeName(oEdgeOrCurveSelected.Parent) & vblf & vblf
's = s & oEdgeOrCurveSelected.Parent.Name & vblf & vblf
's = s & TypeName(oEdgeOrCurveSelected.Parent.Parent) & vblf & vblf
's = s & TypeName(oEdgeOrCurveSelected.Parent.Parent.Parent) & vblf & vblf
's = s & TypeName(oEdgeOrCurveSelected.Parent.Parent.Parent.Parent) & vblf & vblf
's = s & TypeName(oEdgeOrCurveSelected.Parent.Parent.Parent.Parent.Parent) & vblf & vblf
's = s & TypeName(oEdgeOrCurveSelected.Parent.Parent.Parent.Parent.Parent.Parent) & vblf
'MsgBox s
iStatus = MsgBox("Please Select Point 1",VbOkOnly,"Point 1")
If iStatus = vbCancel Then Exit Sub
' Following has been taken from documentation
' ****************************
' See also: Selection.IndicateOrSelectElement3D which can, in particular,
'enable indication and not selection (positionning the iFilterType parameter
'to an empty string), whichs enables to subscribe to mouse move events,
'positionning the iTriggeringOnPreSelection to true.
' ****************************
Dim HybridShapeFactory
Dim InputObjectType(0)
Dim WindowLocation2D(1)
Dim WindowLocation3D(2)
Dim TempPointHasBeenCreatedAtLeastOnce
Dim ObjectSelected
Dim ExistingPoint
Dim PlaneReference
ReDim WindowLocation2D(1),WindowLocation3D(2)
InputObjectType(0) = ""
Set HybridShapeFactory = Part.HybridShapeFactory :
Set Body = Part.Bodies.Item("PartBody")
'Set HybridShapePlane = Body.HybridShapes.Item("Plane.1")
Set HybridShapePlane = Part.OriginElements.PlaneXY
Set PlaneReference = Part.CreateReferenceFromObject(HybridShapePlane)
' Empty string - through filter array
iStatus = oSel.IndicateOrSelectElement3D(HybridShapePlane,"select a point or click to locate the point", _
InputObjectType,false,false,true, _
ObjectSelected,WindowLocation2D,WindowLocation3D)
' Not working
' Empty string - Direct
iStatus = oSel.IndicateOrSelectElement3D(HybridShapePlane,"select a point or click to locate the point", _
"",false,false,true, _
ObjectSelected,WindowLocation2D,WindowLocation3D)
' Not working
' This selects the existing point.
InputObjectType(0) = "Point"
iStatus = oSel.SelectElement3(InputObjectType,"Select points", _
true,CATMultiSelTriggWhenSelPerf,false)
End Sub