選択したエッジをスケッチに投影・分離・固定

CATIAです。

表題の "選択したエッジをスケッチに投影・分離・固定" を行うマクロです。
ツールバーからの呼び出しでも機能しました。

"分離"については機能を探しましたが見つからない為、CATIA.StartCommand
を使用しています。(その為、日本語環境でのみです)

'vba 選択したエッジをスケッチに投影・分離・固定

Option Explicit

Sub CATMain()

    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim pt As Part
    Set pt = doc.Part
    
    Dim bdy As Body
    Set bdy = pt.Bodies.Item(1)
    
    Dim sel As Selection
    Set sel = doc.Selection
    
    Dim edge As AnyObject
    Set edge = selectItem("エッジを選択", Array("Edge"))
    If edge Is Nothing Then
        Exit Sub
    End If

    Dim skt As Sketch
    Set skt = initSketch(pt, pt.OriginElements.PlaneZX)
    
    add_Isolate_Projection skt, edge, pt

End Sub

' スケッチに投影・分離・固定
Private Function add_Isolate_Projection( _
    ByVal skt As Sketch, _
    ByVal edge As AnyObject, _
    ByVal pt As Part) _
    As AnyObject

    'スケッチ編集
    Dim fact As Factory2D
    Set fact = skt.OpenEdition()
    
    '投影
    Dim proj As Geometry2D
    Set proj = fact.CreateProjection(edge)
    
    '分離
    DoEvents
    
    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    sel.Clear
    sel.Add proj
    
    CATIA.StartCommand "分離"
    
    Dim isolate As AnyObject
    Set isolate = skt.GeometricElements.Item( _
        skt.GeometricElements.Count _
    )
    
    '固定
    Dim ref As Reference
    Set ref = pt.CreateReferenceFromObject(isolate)
    
    Dim con_raint As Constraint
    Set con_raint = skt.Constraints.AddMonoEltCst( _
        catCstTypeReference, _
        ref _
    )
    con_raint.Mode = catCstModeDrivingDimension
    
    skt.CloseEdition

    '更新
    pt.UpdateObject skt

    Set add_Isolate_Projection = isolate
    
End Function
    
Private Function initSketch( _
    ByVal pt As Part, _
    ByVal pln As Plane) _
    As Sketch

    Dim ref As Reference
    Set ref = pln

    Dim hBody As HybridBody
    Set hBody = pt.HybridBodies.Add()

    Set initSketch = hBody.HybridSketches.Add(ref)

End Function

Private Function selectItem( _
    ByVal msg As String, _
    ByVal filter As Variant) _
    As AnyObject
    
    Set selectItem = Nothing
    
    Dim sel As Variant
    Set sel = CATIA.ActiveDocument.Selection
    sel.Clear

    Select Case sel.SelectElement2(filter, msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Function
    End Select
    
    Dim entity As AnyObject
    Set entity = sel.Item(1).Value
    
    sel.Clear
    
    Set selectItem = entity
    
End Function