Tree順にボディ,形状セット,時系列形状セット名の取得

先日見つけたこちらのトピですが、
CATIA V5 - CATScript - Identify Order of Geometric Sets and Bodies in CATPart - DASSAULT: CATIA products - Eng-Tips
Treeに並んでいる順に、ボディと形状セット名を取得したい
と言う内容です。

検索で選択状態にすれば、Tree順に取得出来たはずなので
サンプルを作ってみたのですが、よく読んだら解決されていた
いたようでした・・・。　折角作ったので記載しておきます。

Treeに直接ぶら下がっているものだけで、子以下のものは取得しません。

'VBA Tree順にボディ,形状セット,時系列形状セット名の取得

Option Explicit

Sub CATMain()

    'start check
    If Not CanExecute("PartDocument") Then Exit Sub
    
    'doc
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    'AllContainer
    Dim bodys As Object
    Set bodys = GetAllContainers(doc)
    If bodys Is Nothing Then
        MsgBox "Element not found", vbExclamation
        Exit Sub
    End If
    
    'LeafContainer
    Set bodys = GetLeafContainerNames(doc, bodys)
    If bodys Is Nothing Then
        MsgBox "Element not found", vbExclamation
        Exit Sub
    End If
    
    'done
    MsgBox Join(bodys.ToArray(), vbCrLf)
End Sub

Private Function GetAllContainers( _
    ByVal doc As PartDocument) As Object
    
    Set GetAllContainers = Nothing
    
    Dim sel As selection
    Set sel = doc.selection
    
    'Search
    Dim word As String
    word = "(CATPrtSearch.BodyFeature + " & _
            "CATPrtSearch.OpenBodyFeature + " & _
            "CATPrtSearch.MMOrderedGeometricalSet),in"
    
    CATIA.HSOSynchronized = False
    sel.Clear
    
    sel.Search word
    If sel.Count2 < 1 Then Exit Function
    
    Dim ary As Object
    Set ary = InitLst()
    
    Dim i As Long
    For i = 1 To sel.Count2
        ary.Add sel.Item(i).Value
    Next
    
    sel.Clear
    CATIA.HSOSynchronized = True
    
    Set GetAllContainers = ary
End Function

Private Function GetLeafContainerNames( _
    ByVal doc As PartDocument, _
    ByVal lst As Object) As Object
    
    Set GetLeafContainerNames = Nothing
    
    'Leaf HybridBodies
    Dim hBdys As Variant
    hBdys = Lst2Ary(doc.Part.HybridBodies)
    
    'Leaf OrderedGeometricalSets
    Dim odrds As Variant
    odrds = Lst2Ary(doc.Part.OrderedGeometricalSets)
    
    'is Leaf?
    Dim leafs As Object
    Set leafs = InitLst()
    
    Dim v As Variant
    For Each v In lst
        Select Case TypeName(v)
            Case "Body"
                If v.InBooleanOperation = False Then
                    leafs.Add v.Name
                End If
            Case "HybridBody"
                If UBound(filter(hBdys, GetInternalName(v))) > -1 Then
                    leafs.Add v.Name
                End If
            Case "OrderedGeometricalSet"
                If UBound(filter(odrds, GetInternalName(v))) > -1 Then
                    leafs.Add v.Name
                End If
        End Select
    Next
    If leafs.count < 1 Then Exit Function
    
    Set GetLeafContainerNames = leafs
End Function

'list2array
Private Function Lst2Ary( _
    ByVal lst As Object) As Variant

    If lst.count < 1 Then Exit Function

    Dim ary As Object
    Set ary = InitLst()
    
    Dim v As Variant
    For Each v In lst
        ary.Add GetInternalName(v)
    Next
    
    Lst2Ary = ary.ToArray()
End Function

'InternalName
Private Function GetInternalName( _
    ByVal AOj As AnyObject) As String
    If AOj Is Nothing Then
        GetInternalName = Empty
        Exit Function
    End If
    GetInternalName = AOj.GetItem("ModelElement").InternalName
End Function

'DotNet ArrayList
Private Function InitLst() As Object
    Set InitLst = CreateObject("System.Collections.ArrayList")
End Function

'OK?
Private Function CanExecute( _
    ByVal docType As String) As Boolean
    
    CanExecute = False
    
    If CATIA.Windows.count < 1 Then
        MsgBox "Please open the file", vbExclamation
        Exit Function
    End If
    
    Dim doc As Document
    Set doc = CATIA.ActiveDocument
    
    If Not TypeName(doc) = docType Then
        MsgBox docType & " Only!", vbExclamation
        Exit Function
    End If
    
    CanExecute = True
End Function