こちらの続きです。
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なのかな?)