こちらの続きです。
ボディの体積をダンプする4 - C#ATIA
中途半端な状態で止まっていましたが、やっと取り組めました。
・CATIAの場合、体積が単純なプロパティでは取得出来ない
・VBAのクラスに拡張プロパティのような考えが無い
を考慮すると、
ソート関数(ソート対象の配列, 比較のための配列)
のような関数を作る事にしました。
Option Explicit
Sub CATMain()
Dim doc As partDocument
Set doc = CATIA.ActiveDocument
Dim pt As Part
Set pt = doc.Part
Dim bodyAry As Variant
bodyAry = get_bodies_array(pt.bodies)
Dim volumeAry As Variant
volumeAry = get_bodies_volume(bodyAry)
dump_pair bodyAry, volumeAry, "-- ソート前 --"
Dim sortedBodyAry As Variant
sortedBodyAry = insertion_sort(bodyAry, volumeAry)
volumeAry = get_bodies_volume(sortedBodyAry)
dump_pair sortedBodyAry, volumeAry, vbCrLf & "-- ソート後 --"
End Sub
Private Function insertion_sort( _
ByVal targetAry As Variant, _
ByVal comparisonAry As Variant _
) As Variant
Dim zip() As Variant
zip = zip_array(targetAry, comparisonAry)
Dim low As Long
low = LBound(zip)
Dim upp As Long
upp = UBound(zip)
Dim i As Long, j As Long
Dim tmp As Variant
For i = low + 1 To upp
tmp = zip(i)
For j = i - 1 To low Step -1
If zip(j)(1) > tmp(1) Then
zip(j + 1) = zip(j)
Else
Exit For
End If
Next
zip(j + 1) = tmp
Next
Dim unzip() As Variant
unzip = unzip_array(zip)
insertion_sort = unzip(0)
End Function
Private Function unzip_array( _
ByVal ary As Variant _
) As Variant
Dim ary1() As Variant
ary1 = create_array(UBound(ary))
Dim ary2() As Variant
ary2 = create_array(UBound(ary))
Dim i As Long
For i = 0 To UBound(ary)
Set ary1(i) = ary(i)(0)
ary2(i) = ary(i)(1)
Next
unzip_array = Array(ary1, ary2)
End Function
Private Function zip_array( _
ByVal ary1 As Variant, _
ByVal ary2 As Variant _
) As Variant
Dim zip() As Variant
zip = create_array(UBound(ary1))
Dim i As Long
For i = 0 To UBound(ary1)
zip(i) = Array(ary1(i), ary2(i))
Next
zip_array = zip
End Function
Private Function create_array( _
count As Long _
) As Variant
Dim ary() As Variant
ReDim ary(count)
create_array = ary
End Function
Private Function get_bodies_volume( _
ByVal bodyAry As Variant) _
As Variant
get_bodies_volume = Array()
If UBound(bodyAry) < 1 Then Exit Function
Dim pt As Part
Set pt = get_parent_of_T(bodyAry(0), "Part")
Dim volumeAry() As Variant
volumeAry = create_array(UBound(bodyAry))
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
Dim i As Long
For i = 0 To UBound(bodyAry)
Set bdy = bodyAry(i)
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
volumeAry(i) = volume
Next
get_bodies_volume = volumeAry
End Function
Private Function get_bodies_array( _
ByVal bodyLst As bodies) _
As Variant
Dim ary() As Variant
ary = create_array(bodyLst.count - 1)
Dim i As Long
For i = 1 To bodyLst.count
Set ary(i - 1) = bodyLst.Item(i)
Next
get_bodies_array = ary
End Function
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_pair( _
ByVal bodyAry As Variant, _
ByVal volumeAry As Variant, _
Optional ByVal msg = "")
dump msg
Dim i As Long
For i = 0 To UBound(bodyAry)
dump bodyAry(i).name & " : " & Format(volumeAry(i), "0.00000000000000000000000")
Next
End Sub
Private Sub dump( _
ByVal msg As String)
Debug.Print msg
End Sub
試しにこの様な適当なデータを作成し実行してみます。
結果はこちら。一応出来ています。
-- ソート前 --
ﾊﾟｰﾂ ﾎﾞﾃﾞｨｰ : 0.00077597338543667900000
ﾎﾞﾃﾞｨｰ.3 : 0.00026000000000000000000
ﾎﾞﾃﾞｨｰ.4 : 0.00056500000000000000000
ﾎﾞﾃﾞｨｰ.5 : 0.00006338919271492180000
ﾎﾞﾃﾞｨｰ.6 : 0.00000031415926535897900
-- ソート後 --
ﾎﾞﾃﾞｨｰ.6 : 0.00000031415926535897900
ﾎﾞﾃﾞｨｰ.5 : 0.00006338919271492180000
ﾎﾞﾃﾞｨｰ.3 : 0.00026000000000000000000
ﾎﾞﾃﾞｨｰ.4 : 0.00056500000000000000000
ﾊﾟｰﾂ ﾎﾞﾃﾞｨｰ : 0.00077597338543667900000
・・・指数表記だとパッと見で判断しにくかったですが、
どうやるのが良いのだろう？
これ、安全か？ と言われるとちょっと例外処理やら、
配列の先頭のインデックスの判断とか、zipライクな関数で
二つの配列サイズが未チェックだとか省いているので、
ちょっと怪しいです。
仮に、体積ではなく表面積にしたいのであれば、
insertion_sort関数の第二引数の配列を変更すれば良いので、
多少は柔軟性を持っているはず。
クイックソートで無いのですが、CATIAでソートが必要になる場面は
それ程大きいサイズにならないと思うので、大丈夫じゃないかな？
