ﾎﾞﾃﾞｨ - ﾎﾞﾃﾞｨ の最短距離の測定2

こちらの続きです。
ﾎﾞﾃﾞｨ - ﾎﾞﾃﾞｨ の最短距離の測定1 - C#ATIA

本当はもう一つの方法を書こうと思っていたのですが、
上手く行かないﾊﾟﾀｰﾝがあるので、そちらを解決したいです。

わかりやすいよう、前回のﾎﾞﾃﾞｨにそれぞれに色を付け、事前に
"2要素間の測定" ｺﾏﾝﾄﾞで測定しておきました。

ﾎﾞﾃﾞｨ-2が紫色で、ﾎﾞﾃﾞｨ-3が黄色です。

前回のﾏｸﾛを実行しﾎﾞﾃﾞｨ-2と3を選択すると、こんな感じです。

別に問題ないです。

もう一個ﾎﾞﾃﾞｨｰ4(青色)を作成し、ﾎﾞﾃﾞｨ-3にくっ付けます。
ﾎﾞﾃﾞｨ-4は、測定対象のﾎﾞﾃﾞｨ-2から見ると少し遠い位置です。

この状態で、先日のﾏｸﾛを実行し、ﾎﾞﾃﾞｨ-2とﾎﾞﾃﾞｨ-4を指定
するとこんな感じです。

純粋にﾎﾞﾃﾞｨ-2とﾎﾞﾃﾞｨ-4の最短距離になってしまいます。
本来であれば、ﾎﾞﾃﾞｨ-2とﾎﾞﾃﾞｨ-3の最短距離が欲しいところです。
("2要素間の測定" ｺﾏﾝﾄﾞで ﾎﾞﾃﾞｨ-2 と ﾎﾞﾃﾞｨ-4 を測定すると
　0mmになるのですが、それも困る)

なので、青い面(ﾎﾞﾃﾞｨ-4)をクリックしても、ﾎﾞﾃﾞｨ-3を
取得したいのです。

が、取り組んだところ結構難しいです。
悩んだ結果がこちらです。

'vba
Sub CATMain()
    Dim partDocument1 As PartDocument
    Set partDocument1 = CATIA.ActiveDocument
    
    Dim part1 As Part
    Set part1 = partDocument1.Part
    
    Dim BName1$
    BName1 = SelectItemName$("一つ目のﾎﾞﾃﾞｨを選択して下さい : [Esc]=ｷｬﾝｾﾙ", Array("BiDim")) 'Array("Body"))
    If Len(BName1) < 1 Then Exit Sub
    
    Dim BName2$
    BName2 = SelectItemName$("二つ目のﾎﾞﾃﾞｨを選択して下さい : [Esc]=ｷｬﾝｾﾙ", Array("BiDim")) 'Array("Body"))
    If Len(BName2) < 1 Then Exit Sub
    
    Dim parameters1 As Parameters
    Set parameters1 = part1.Parameters
    
    Dim length1 As Length
    Set length1 = parameters1.CreateDimension("", "LENGTH", 0#)
    
    Dim relations1 As Relations
    Set relations1 = part1.Relations
    
    Dim formula1 As Formula
    Set formula1 = relations1.CreateFormula("", "", length1, "distance(`" + BName1 + "`,`" + BName2 + "`)")
    MsgBox CStr(length1.Value) + "mm"
    
    '以下　式・ﾊﾟﾗﾒｰﾀ削除
    'Dim Sel As Selection
    'Set Sel = CATIA.ActiveDocument.Selection
    'With Sel
    '    .Clear
    '    .Add formula1
    '    .Add length1
    '    .Delete
    'End With
End Sub

'Bodyの選択
Private Function SelectItemName$(ByVal Msg$, ByVal Filter As Variant)
    Dim Sel As Variant: Set Sel = CATIA.ActiveDocument.Selection
    Dim LeafBody As Body
    Do
        Sel.Clear
        Select Case Sel.SelectElement2(Filter, Msg, False)
            Case "Cancel", "Undo", "Redo"
                Exit Function
        End Select
        Set LeafBody = GetLeafBody(Sel.Item(1).Value)
        If Not LeafBody Is Nothing Then
            Exit Do
        End If
        MsgBox "ﾎﾞﾃﾞｨの要素を選択して下さい!"
    Loop
    SelectItemName = LeafBody.Name
    Sel.Clear
End Function

'Treeに直接ぶら下がっているﾎﾞﾃﾞｨの取得
Private Function GetLeafBody(AnyOj As AnyObject) As Body
    If TypeName(AnyOj) = TypeName(AnyOj.Parent) Then
        Set GetLeafBody = Nothing
        Exit Function
    End If
    If TypeName(AnyOj.Parent) = "Bodies" Then
        If AnyOj.InBooleanOperation Then
            Set GetLeafBody = GetLeafBody(AnyOj.Parent)
        Else
            Set GetLeafBody = AnyOj
        End If
    Else
        Set GetLeafBody = GetLeafBody(AnyOj.Parent)
    End If
End Function

GetLeafBody関数を新たに用意しました。　処理としては
Parentﾌﾟﾛﾊﾟﾃｨを利用し、Treeを駆け上がって行く様な再帰処理
です。 (Parentﾌﾟﾛﾊﾟﾃｨは、何れApplicationｸﾗｽの無限ﾙｰﾌﾟに
なってしまう為、途中で抜けるようにしています。)
最初はこれだけで済むと思っていたのですが、FilterTypeの違いや
ｸﾘｯｸする位置によって、Parentﾌﾟﾛﾊﾟﾃｨが安定しない為
以下の部分も修正しました。

CATMainは、SelectElement2を呼び出す際のFilterTypeを
Body → BiDim に変更しました。(BiDimInfiniteでも大丈夫です)

SelectItemName関数は、GetLeafBody関数で上手くﾎﾞﾃﾞｨが取得
出来るまでﾙｰﾌﾟさせる処理にしました。

このFilterTypeの状態だと、ﾎﾞﾃﾞｨとは無関係のｻｰﾌｪｽも選択出来る
のですが、

    BName1 = SelectItemName$("一つ目のﾎﾞﾃﾞｨを選択して下さい : [Esc]=ｷｬﾝｾﾙ", Array("Body"))

のままだと、Treeのﾎﾞﾃﾞｨを選択した場合、ﾎﾞﾃﾞｨを選択したにも
関わらず、うまく取得できませんでした。
その為、ﾎﾞﾃﾞｨとは無関係のｻｰﾌｪｽを選択した場合は、再度選択し
直す様、ﾒｯｾｰｼﾞを出す事にしました。
（何の為の FilterType 何だよ・・・）

もっとｽﾏｰﾄな方法は、あるものでしょうか?