指定した形状ｾｯﾄ内に、新たな形状ｾｯﾄを作成する

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

以下の様な状態のﾌｧｲﾙがあるとします。

ここでﾕｰｻﾞｰが形状ｾｯﾄを指定した際、指定した形状ｾｯﾄが存在し
Partに直接ぶら下がっている形状ｾｯﾄ内に、新たに空の形状ｾｯﾄを
作成します。　言葉で表現するとややこしいです。

実際にﾏｸﾛを実行し "a1" の形状ｾｯﾄを選択した際の状態です。

新たに "a3" の形状ｾｯﾄが作成されます。
ｿｰｽｺｰﾄﾞです。

'vba
'指定した形状ｾｯﾄ内に新たな形状ｾｯﾄを作成
Sub CATMain()
    Call AddNewHybridBodyMain
End Sub

Sub AddNewHybridBodyMain()
    '準備
    Dim Doc As Document
    Set Doc = CATIA.ActiveDocument
    
    Dim Selection1 'As Selection
    Set Selection1 = Doc.Selection
    
    'ﾕｰｻﾞｰ選択
    Dim InputObjectType(0) As Variant
    Dim SelectHybridBody As HybridBody
    InputObjectType(0) = "HybridBody"
    With Selection1
        .Clear
        Result = .SelectElement2(InputObjectType, "形状ｾｯﾄを選択して下さい // [Esc]=ｷｬﾝｾﾙ", False)
        If Result = "Cancel" Then Exit Sub
        Set SelectHybridBody = .Item(1).Value
        .Clear
    End With
    
    '挿入するHybridBodiesを取得
    Dim TargetHybridBodies As HybridBodies
    Set TargetHybridBodies = GetLeafHybridBodies(SelectHybridBody)
    
    'HybridBodyを作成
    Dim AddHybridBody As HybridBody
    Set AddHybridBody = TargetHybridBodies.Add
    AddHybridBody.Name = GetHybridBodyHeaderName(TargetHybridBodies.Name) + CStr(TargetHybridBodies.Count)
End Sub

'ﾊﾟｰﾄに直接ぶら下がっている形状ｾｯﾄを取得
Private Function GetLeafHybridBodies(HB As HybridBody) As HybridBodies
    If HB.Parent.Name = "HybridBodies" Then
        Set GetLeafHybridBodies = HB
    Else
        Dim TempHB As HybridBody
        Set TempHB = HB.Parent 'HybridBodiesをHybridBodyに変換
        Set GetLeafHybridBodies = GetLeafHybridBodies(TempHB)
    End If
End Function

'ｽﾍﾟｰｽより前の文字列のみを返す
Private Function GetHybridBodyHeaderName(Txt As String) As String
    Dim StringAry() As String
    StringAry = Split(Txt, " ")
    GetHybridBodyHeaderName = StringAry(0)
End Function

・このﾏｸﾛは、ProductでもPart単体でも実行可能です。
・先程は "a1" を選択しましたが、"a" "a2" "hoge" の何れを指定しても
　"a3" の形状ｾｯﾄが作成されます。
・新たに作成される形状ｾｯﾄの名前は、Partに直接ぶら下がっている形状ｾｯﾄ名の
　ｽﾍﾟｰｽより前部分(今回は "a") + 形状ｾｯﾄの数です。