C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

ボディ - ボディ の最短距離の測定2

こちらの続きです。
ボディ - ボディ の最短距離の測定1 - C#ATIA


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

わかりやすいよう、前回のボディにそれぞれに色を付け、事前に
"2要素間の測定" コマンドで測定しておきました。
f:id:kandennti:20160328185629p:plain
ボディ-2が紫色で、ボディ-3が黄色です。

前回のマクロを実行しボディ-2と3を選択すると、こんな感じです。
f:id:kandennti:20160328185638p:plain
別に問題ないです。

もう一個ボディー4(青色)を作成し、ボディ-3にくっ付けます。
ボディ-4は、測定対象のボディ-2から見ると少し遠い位置です。
f:id:kandennti:20160328185644p:plain

この状態で、先日のマクロを実行し、ボディ-2とボディ-4を指定
するとこんな感じです。
f:id:kandennti:20160328185652p:plain
純粋にボディ-2とボディ-4の最短距離になってしまいます。
本来であれば、ボディ-2とボディ-3の最短距離が欲しいところです。
("2要素間の測定" コマンドで ボディ-2 と ボディ-4 を測定すると
 0mmになるのですが、それも困る)

なので、青い面(ボディ-4)をクリックしても、ボディ-3を
取得したいのです。
f:id:kandennti:20160328185658p:plain
が、取り組んだところ結構難しいです。
悩んだ結果がこちらです。

'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 何だよ・・・)


もっとスマートな方法は、あるものでしょうか?