ボディの体積をダンプする1

ちょっと、やろうとした事の手前で、苦戦しました。

CATIA V5でPart内の全てのボディの体積をダンプさせてみました。

'vba

Option Explicit

Sub CATMain()
    Dim doc As partDocument
    Set doc = CATIA.ActiveDocument
    
    Dim pt As Part
    Set pt = doc.Part
    
    Dim spaWb As SPAWorkbench
    Set spaWb = pt.Parent.GetWorkbench("SPAWorkbench")

    Dim bdy As Body
    Dim bodyRef As Reference
    Dim meas As Measurable
    Dim shape As AnyObject
    Dim volume As Double
    For Each bdy In pt.Bodies
        Set shape = get_last_shape(bdy)
        If shape Is Nothing Then
            volume = 0
        Else
            Set bodyRef = pt.CreateReferenceFromObject(shape)
            Set meas = spaWb.GetMeasurable(bodyRef)
            volume = meas.volume
        End If

        dump bdy.name & " : " & volume
    Next
End Sub


Private Function get_last_shape( _
    ByVal bdy As Body) _
    As AnyObject

    Set get_last_shape = Nothing

    If bdy.shapes.count < 1 Then Exit Function

    Dim pt As Part
    Set pt = get_parent_of_T(bdy, "Part")
    
    Dim shapes As shapes
    Set shapes = bdy.shapes
    
    Dim i As Long
    For i = shapes.count To 1 Step -1
        If Not IsEmpty(shapes.Item(i)) Then
            If False = pt.IsInactive(shapes.Item(i)) Then
                Set get_last_shape = shapes.Item(i)
                Exit Function
            End If
        End If
    Next
End Function


Private Function get_parent_of_T( _
    ByVal aoj As AnyObject, _
    ByVal t As String) _
    As AnyObject
    
    Dim aojName As String
    Dim parentName As String
    
    On Error Resume Next
        Set aoj = asDisp(aoj)
        aojName = aoj.name
        parentName = aoj.Parent.name
    On Error GoTo 0

    If TypeName(aoj) = TypeName(aoj.Parent) And _
       aojName = parentName Then
        Set get_parent_of_T = Nothing
        Exit Function
    End If
    If TypeName(aoj) = t Then
        Set get_parent_of_T = aoj
    Else
        Set get_parent_of_T = get_parent_of_T(aoj.Parent, t)
    End If
End Function


Private Function asDisp( _
    o As INFITF.CATBaseDispatch) _
    As INFITF.CATBaseDispatch

    Set asDisp = o
End Function


Private Sub dump( _
    ByVal msg As String)
    
    Debug.Print msg
End Sub

過剰な程の処理を行っている可能性は感じています。

結構忘れてます・・・。正直なところ衝撃的です。
・ボディの体積を得るには、直接ボディにはプロパティ(やメソッド)が無い
・Measurable経由となるが、ボディのリファレンスではない
・Measurableで得られる単位は多分メートルが基準

適当なデータで実行してみるとこんな結果です。

ﾊﾟｰﾂ ﾎﾞﾃﾞｨｰ : 0
ﾎﾞﾃﾞｨｰ.2 : 0.000336
ﾎﾞﾃﾞｨｰ.3 : 1.38230076757951E-04

GUIでボディ2の体積を確認すると(体積の単位はmm3で設定してます)

国際的にメートル法なので、そうなるのか・・・。