C#ATIA

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

3D曲線の端点座標値を取得3

こちらの続きです。
3D曲線の端点座標値を取得2 - C#ATIA


未だにこだわっているのですが、何とかもうちょっと速くしたいので。

3D曲線を取得するコードを書くのが面倒だったので、検索で済ませていたのですが
真面目にHybridShapesから探し出すように修正してみました。
正確には、前回までのものと同等ではないのですが・・・。(表示/非表示を見てません)

'vba test_Get3dCurveEndPoint6 using-'KCL0.08'
'非検索
Option Explicit

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("PartDocument,ProductDocument") Then Exit Sub
    
    '形状セット選択
    Dim Hb As HybridBody
    Set Hb = KCL.SelectItem("形状セット選択", "HybridBody")
    If KCL.IsNothing(Hb) Then Exit Sub
        
    Debug.Print "--- start ---"
        
    '線の取得
    KCL.SW_Start
    Dim Lines As Collection: Set Lines = GetLines(Hb)
    If KCL.IsNothing(Lines) Then Exit Sub
    Debug.Print "3D曲線を取得 : " + CStr(KCL.SW_GetTime) + "s"
    
    'SPAWorkbench
    KCL.SW_Start
    Dim EndPnt As Collection
    Set EndPnt = GetEndPnt_SPAWorkbench(Lines)
    Debug.Print "端点座標取得 : " + CStr(KCL.SW_GetTime) + "s" + vbNewLine + CStr(EndPnt.Count) + 

"個"
    Debug.Print
End Sub

'端点取得-SPAWorkbench
Private Function GetEndPnt_SPAWorkbench(ByVal Lines As Collection) As Collection
    Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(Lines.Item(1), "PartDocument")
    Dim SPAWB As Workbench: Set SPAWB = Doc.GetWorkbench("SPAWorkbench")
    Dim Pt As Part: Set Pt = Doc.Part
    Dim EndPnt As Collection: Set EndPnt = New Collection
    Dim Pos(8) As Variant
    Dim Hs As HybridShape
    Dim Ref As Reference
    For Each Hs In Lines
        Set Ref = Pt.CreateReferenceFromObject(Hs)
        Call SPAWB.GetMeasurable(Ref).GetPointsOnCurve(Pos)
        EndPnt.Add KCL.JoinAry(KCL.GetRangeAry(Pos, 0, 2), KCL.GetRangeAry(Pos, 6, 8))
    Next
    Set GetEndPnt_SPAWorkbench = EndPnt
End Function

'線取得
Private Function GetLines(ByVal Hb As HybridBody) As Collection
    Dim Hss As HybridShapes: Set Hss = Hb.HybridShapes
    If Hss.Count < 1 Then Exit Function
    
    Dim Pt As Part: Set Pt = KCL.GetParent_Of_T(Hb, "PartDocument").Part
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    Dim Lines As Collection: Set Lines = New Collection
    Dim Ref As Reference
    Dim Hs As HybridShape
    For Each Hs In Hss
        Set Ref = Pt.CreateReferenceFromObject(Hs)
        Select Case Fact.GetGeometricalFeatureType(Ref)
            Case 2, 3, 4
                Lines.Add Hs
        End Select
    Next
    Set GetLines = Lines
End Function

結果はこちら

--- start ---
3D曲線を取得 : 5.582s
端点座標取得 : 5.044s
4099個

あぁやっぱり速いんだ。 HSOSynchronizedプロパティをFalseに出来るように
なってから、検索も手段の一つとしても良いのかな? と思っていたのですが
やっぱり遅いんですね。

上記のコードは真面目にReferenceを取得しているのですが、これをインチキ臭い
こんな感じに変更しても、テストデータではエラーにならないんです。

'vba test_Get3dCurveEndPoint7 using-'KCL0.08'
'非検索
Option Explicit

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("PartDocument,ProductDocument") Then Exit Sub
    
    '形状セット選択
    Dim Hb As HybridBody
    Set Hb = KCL.SelectItem("形状セット選択", "HybridBody")
    If KCL.IsNothing(Hb) Then Exit Sub
        
    Debug.Print "--- start ---"
        
    '線の取得
    KCL.SW_Start
    Dim Lines As Collection: Set Lines = GetLines(Hb)
    If KCL.IsNothing(Lines) Then Exit Sub
    Debug.Print "3D曲線を取得 : " + CStr(KCL.SW_GetTime) + "s"
    
    'SPAWorkbench
    KCL.SW_Start
    Dim EndPnt As Collection
    Set EndPnt = GetEndPnt_SPAWorkbench(Lines)
    Debug.Print "端点座標取得 : " + CStr(KCL.SW_GetTime) + "s" + vbNewLine + CStr(EndPnt.Count) + "個"
    Debug.Print
End Sub

'端点取得-SPAWorkbench
Private Function GetEndPnt_SPAWorkbench(ByVal Lines As Collection) As Collection
    Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(Lines.Item(1), "PartDocument")
    Dim SPAWB As Workbench: Set SPAWB = Doc.GetWorkbench("SPAWorkbench")
    Dim Pt As Part: Set Pt = Doc.Part
    Dim EndPnt As Collection: Set EndPnt = New Collection
    Dim Pos(8) As Variant
    Dim Hs As HybridShape
    For Each Hs In Lines
        Call SPAWB.GetMeasurable(Hs).GetPointsOnCurve(Pos)
        EndPnt.Add KCL.JoinAry(KCL.GetRangeAry(Pos, 0, 2), KCL.GetRangeAry(Pos, 6, 8))
    Next
    Set GetEndPnt_SPAWorkbench = EndPnt
End Function

'線取得
Private Function GetLines(ByVal Hb As HybridBody) As Collection
    Dim Hss As HybridShapes: Set Hss = Hb.HybridShapes
    If Hss.Count < 1 Then Exit Function
    
    Dim Pt As Part: Set Pt = KCL.GetParent_Of_T(Hb, "PartDocument").Part
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    Dim Lines As Collection: Set Lines = New Collection
    Dim Hs As HybridShape
    For Each Hs In Hss
        Select Case Fact.GetGeometricalFeatureType(Hs)
            Case 2, 3, 4
                Lines.Add Hs
        End Select
    Next
    Set GetLines = Lines
End Function

結果はこちら

--- start ---
3D曲線を取得 : 4.061s
端点座標取得 : 1.48s
4099個

さらに半分ほどの時間になりました。
何をしたかと言いますと、例えばGetLines関数の

    ・・・
    For Each Hs In Hss
        Set Ref = Pt.CreateReferenceFromObject(Hs) 'ここ
        Select Case Fact.GetGeometricalFeatureType(Ref) 'ここ
            Case 2, 3, 4
                Lines.Add Hs
        End Select
    Next
    ・・・

PartオブジェクトのCreateReference~でReferenceを取得しているのですが、
これを省略して

    ・・・
    For Each Hs In Hss
        Select Case Fact.GetGeometricalFeatureType(Hs) 'ここ
            Case 2, 3, 4
                Lines.Add Hs
        End Select
    Next
    ・・・

Referenceを取得せずに直接オブジェクトをGetGeometricalFeatureType関数の
引数に入れてしまいます。 本来GetGeometricalFeatureType関数の
引数の型はReference型なのですが、エラーにならないんです。
昔から幾つか気が付いているのですが、VBAのずさんな型管理に救われて
いるような気がします。 一方 "CATIAのマクロの Reference って何?" と
聞かれても、答えられない原因になってます。
(AutomationManualを見ると継承されていないので、Mixinなのかな?)