座標系に依存した点の作成

CATIAです。

マクロで普通に点を作成した場合は、絶対座標の位置に点が作成されますが、
特定の座標系に依存する位置での点の作成を行うサンプルです。

Option Explicit

Sub CATMain()

    ' 座標系の選択
    Dim msg As String
    msg = "使用する座標系を選択 : ESCｷｰ 終了"
    
    Dim filter As Variant
    filter = Array("AxisSystem")
    
    Dim selElementy As SelectedElement
    Set selElementy = selectElement(msg, filter)

    If selElementy Is Nothing Then
        Exit Sub
    End If
    
    Dim axis As AxisSystem
    Set axis = selElementy.Value
    
    ' 座標値を入力
    msg = "座標値を入力してください(例:10,20,30)"
    
    Dim pos As Variant
    pos = getCoordinate(msg)
    
    If IsEmpty(pos) Then
        Exit Sub
    End If
    
    ' 点の作成
    Call initPoint(pos, axis)
    
End Sub

' 点の作成
Private Function initPoint( _
    ByVal ary As Variant, _
    ByVal axis As AxisSystem) _
    As HybridShapePointCoord

    Dim part As part
    Set part = CATIA.ActiveDocument.part

    Dim fact As HybridShapeFactory
    Set fact = part.HybridShapeFactory
    
    ' 裏側で点作成
    Dim pntCoord As HybridShapePointCoord
    Set pntCoord = fact.AddNewPointCoord( _
        ary(0), _
        ary(1), _
        ary(2) _
    )

    Dim axisRef As Reference
    Set axisRef = part.CreateReferenceFromObject(axis)
    pntCoord.RefAxisSystem = axisRef '<-ここで点が参照する座標系を設定

    ' 形状セット新作
    Dim hBody As HybridBody
    Set hBody = part.HybridBodies.Add()
    hBody.Name = "Macro Point"

    ' 形状セットに点代入
    hBody.AppendHybridShape pntCoord
    part.UpdateObject pntCoord

    Set initPoint = pntCoord

End Function

' 座標値入力
Private Function getCoordinate( _
    ByVal msg As String) _
    As Variant
    
    Dim res
    res = InputBox(msg, "座標値", "10,20,30")
    
    Dim ary As Variant
    ary = Split(res, ",")
    
    If UBound(ary) < 2 Then
        Exit Function
    End If
    
    On Error Resume Next
    
    getCoordinate = Array( _
        CDbl(ary(0)), _
        CDbl(ary(1)), _
        CDbl(ary(2)) _
    )
    
End Function

' 要素選択
Private Function selectElement( _
    ByVal msg As String, _
    ByVal filter As Variant) _
    As SelectedElement

    Dim sel As Variant
    Set sel = CATIA.ActiveDocument.Selection

    sel.Clear
    Select Case sel.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Set selectElement = Nothing
            Exit Function
    End Select
    Set selectElement = sel.Item(1)

End Function