選択したボディのエッジの両端点座標の取得

CATIA V5です。

選択したボディのエッジの両端点座標をメッセージボックスで
表示させるサンプルです。

'vba
Option Explicit

Sub CATMain()

    '選択
    Dim selElm As SelectedElement
    Set selElm = select_element("select edge", Array("Edge"))
    
    '両端点相当の点の取得
    '形状セットには点を入れていません
    Dim endPoints As Variant
    endPoints = get_end_points(selElm)

    '座標値を文字列として取得
    Dim msg As String
    msg = "-- 端点の座標値 --" & vbCrLf
    
    Dim coords As Variant
    Dim i As Long
    For i = 0 To UBound(endPoints)
        coords = get_coordinates(endPoints(i))
        msg = msg & Join(coords, ",") & vbCrLf
    Next
    
    '両端点相当の点を削除する
    'これを行わないとCATDUAで削除する事になります
    'と思っていたのですが、何か1個残ります・・・
    Call remove_elements(selElm, endPoints)
    
    MsgBox msg
    
End Sub


'両端相当の点の削除
Private Sub remove_elements( _
    ByVal selElm As SelectedElement, _
    ByVal elements As Variant)

    Dim pt As Part
    Set pt = selElm.Document.Part

    Dim hSFact As HybridShapeFactory
    Set hSFact = pt.HybridShapeFactory
    
    Dim i As Long
    For i = UBound(elements) To 0 Step -1
        hSFact.DeleteObjectForDatum elements(i)
    Next
    
End Sub
    
    
'点の座標値取得
Private Function get_coordinates( _
    ByVal point As AnyObject) _
    As Variant
    
    Dim coords(2) As Variant
    point.GetCoordinates coords
    
    get_coordinates = coords
    
End Function


'両端相当の点の取得
Private Function get_end_points( _
    ByVal selElm As SelectedElement) _
    As Variant

    'HybridShapeFactory取得
    Dim pt As Part
    Set pt = selElm.Document.Part

    Dim hSFact As HybridShapeFactory
    Set hSFact = pt.HybridShapeFactory

    '曲線上の点の比率
    Dim ratios As Variant
    ratios = Array(0#, 1#)

    '曲線上の点作成-形状セットには入れない
    Dim endPoints(1) As Variant
    Dim i As Long
    Dim pointOnCurve As HybridShapePointOnCurve
    
    For i = 0 To 1
        Set pointOnCurve = hSFact.AddNewPointOnCurveFromPercent( _
            selElm.Reference, _
            ratios(i), _
            False _
        )
        pt.UpdateObject pointOnCurve 'これ重要
        Set endPoints(i) = pointOnCurve

    Next

    get_end_points = endPoints
    

End Function


'エッジの選択
Private Function select_element( _
    ByVal msg As String, _
    Optional ByVal filter As Variant = Empty) _
    As SelectedElement

    Set select_element = Nothing

    If IsEmpty(filter) Then filter = Array("AnyObject")

    Dim Sel As Variant 'Selection
    Set Sel = CATIA.ActiveDocument.Selection

    Sel.Clear
    Select Case Sel.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Function
    End Select

    Set select_element = Sel.Item(1)
    Sel.Clear

End Function