指定した要素の同一形状ｾｯﾄ内に、対称形状を作成する

ご質問頂いたもののｻﾝﾌﾟﾙです。

ﾕｰｻﾞｰが指定した要素(点・線・面等)をZX平面を基準とした対称要素を、
指定した要素と同一の形状ｾｯﾄ内に作成します。
仮に、以下の様な状態のﾌｧｲﾙがあるとします。

ここでﾏｸﾛを実行し、"曲線.1" "ｻｰﾌｪｽ.1" "点.1" をShiftやCtrlｷｰを利用して
複数選択します。
その際、"Selection.SelectElement2" では現れなかった "ﾂｰﾙﾊﾟﾚｯﾄ" と言う
ﾀﾞｲｱﾛｸﾞが表示されますので、一番右の "完了" を押す事で選択完了となります。

ZX平面を基準とした対称要素が、ﾃﾞｰﾀﾑ化された状態で追加されます。

ｿｰｽｺｰﾄﾞです。

'vba
'CreateSymmetryDatum
Dim Part As Part '作業中Part
Dim HSFact As HybridShapeFactory '作業中HybridShapeFactory

Sub CATMain()
    Call CreateSymmetryDatumMain
End Sub

Sub CreateSymmetryDatumMain()
    '準備
    Dim Doc As Document
    Set Doc = CATIA.ActiveDocument
    
    Dim Selection1 'As Selection
    Set Selection1 = Doc.Selection
    
    'ﾕｰｻﾞｰ選択
    Dim InputObjectType(0) As Variant
    Dim SelectHybridShapes As New Collection
    InputObjectType(0) = "HybridShape"
    With Selection1
        .Clear
        Result = .SelectElement3(InputObjectType, "形状ｾｯﾄを選択して下さい // [Esc]=ｷｬﾝｾﾙ", True, CATMultiSelTriggWhenUserValidatesSelection, False)
        If Result = "Cancel" Then Exit Sub
        For i = 1 To .Count
            Call SelectHybridShapes.Add(.Item(i).Value)
        Next
        .Clear
    End With
    
    '対称作成
    Dim HShape As HybridShape
    For Each HShape In SelectHybridShapes
        Call CreateSymmetryDatum(HShape)
    Next
End Sub

Private Sub CreateSymmetryDatum(HS As HybridShape)
    '選択要素のPartを取得
    Set Part = GetPart(HS)

    '選択要素のPartと形状ｾｯﾄ取得
    Dim HBody As HybridBody
    Select Case TypeName(HS.Parent)
        Case "Parameters"
            'ﾃﾞｰﾀﾑ
            Set HBody = GetHybridBodyDatum(HS, Part.HybridBodies)
        Case Else
            '非ﾃﾞｰﾀﾑ
            Set HBody = HS.Parent '無理やり取得できる
    End Select
    
    'HybridShapeFactory更新
    Set HSFact = Part.HybridShapeFactory
    
    '対称基準面取得
    Dim BasePlaneRef As Reference
    Set BasePlaneRef = Part.CreateReferenceFromObject(Part.OriginElements.PlaneZX)
    
    '対称ﾃﾞｰﾀﾑ作成
    Dim Datum As AnyObject
    Set Datum = CreateDatum(CreateSymmetry(HS, BasePlaneRef))
    
    '形状ｾｯﾄに登録
    Call HBody.AppendHybridShape(Datum)
End Sub

'HybridShapeからPartの取得
Private Function GetPart(OJ As AnyObject) As Part
    If TypeName(OJ.Parent) = "Part" Then
        Set GetPart = OJ.Parent
    Else
        Set GetPart = GetPart(OJ.Parent)
    End If
End Function

'ﾃﾞｰﾀﾑ要素から所属する形状ｾｯﾄの取得
Private Function GetHybridBodyDatum(HS As HybridShape, HBs As HybridBodies) As HybridBody
    Dim HB As HybridBody
    Dim HSha As HybridShape
    
    For Each HB In HBs
        For Each HSha In HB.HybridShapes
            'If HSha Is HS Then 'これではNG
            If HSha.Name = HS.Name Then
                Set GetHybridBodyDatum = HB
                Exit Function
            End If
        Next
        If GetHybridBodyDatum Is Nothing Then
            Set GetHybridBodyDatum = GetHybridBodyDatum(HS, HB.HybridBodies)
        Else
            Exit For
        End If
    Next
End Function

'Symmetry
Private Function CreateSymmetry(ItemRef As Reference, PlaneRef As Reference) As Reference
    Dim Symmetry As HybridShapeSymmetry
    Set Symmetry = HSFact.AddNewSymmetry(ItemRef, PlaneRef)
    Symmetry.VolumeResult = False
    Call Part.UpdateObject(Symmetry)
    Set CreateSymmetry = Part.CreateReferenceFromObject(Symmetry)
End Function

'Datum
Private Function CreateDatum(Ref As Reference) As AnyObject
    Dim Datum As AnyObject
    Select Case HSFact.GetGeometricalFeatureType(Ref)
        Case 1 'Point
            Set Datum = HSFact.AddNewPointDatum(Ref)
        Case 2 'Curve
            Set Datum = HSFact.AddNewCurveDatum(Ref)
        Case 3 'Line
            Set Datum = HSFact.AddNewLineDatum(Ref)
        Case 4 'Circle
            Set Datum = HSFact.AddNewCircleDatum(Ref)
        Case 5 'Surface
            Set Datum = HSFact.AddNewSurfaceDatum(Ref)
        Case 6 'Plane
            Set Datum = HSFact.AddNewPlaneDatum(Ref)
        Case 7 'Volume
            Set Datum = HSFact.AddNewVolumeDatum(Ref)
    End Select
    Call Part.UpdateObject(Datum)
    Set CreateDatum = Datum
    Call HSFact.DeleteObjectForDatum(Ref)
End Function

・このﾏｸﾛは、ProductでもPart単体でも実行可能です。
・Product上でﾏｸﾛを使用し、選択要素が異なるPartで複数選択されていても
　それぞれの形状ｾｯﾄ以下に作成されます。
・上記の例ではﾃﾞｰﾀﾑ化された要素でしたが、ﾃﾞｰﾀﾑ化されていないものでも
　処理が可能です。(作成される対称要素は、ﾃﾞｰﾀﾑ化されます)

対称要素を、選択された要素と同一の形状ｾｯﾄに作成する為、形状ｾｯﾄを取得
しなければならないのですが、ﾃﾞｰﾀﾑ化されていないもの(履歴付き)は簡単です。
しかしﾃﾞｰﾀﾑ化された要素は、何処の形状ｾｯﾄに入っているのか？を探し出す
必要があります。(同じ方法では取得できません)
その為、Partﾌｧｲﾙ内の全ての形状ｾｯﾄを巡回し、探し出しています。
その際、ｵﾌﾞｼﾞｪｸﾄ同士の比較 "Is演算子" を利用してみたのですが、
上手く行かない事があった為、表示されている名前で同一か？をﾁｪｯｸしています。

Private Function GetHybridBodyDatum(HS As HybridShape, HBs As HybridBodies) As HybridBody
    Dim HB As HybridBody
    Dim HSha As HybridShape
    
    For Each HB In HBs
        For Each HSha In HB.HybridShapes
            'If HSha Is HS Then 'これではNG
            If HSha.Name = HS.Name Then
	・
	・

その為、同一の名前の要素がPartﾌｧｲﾙ内にある場合、意図した形状ｾｯﾄ内に
対称要素が作成されない可能性があります。