ご相談頂いた内容を実現する為に、テストコードを作成しました。
3D曲線の端点部分の座標値の取得は、ほぼやったことがありません。
2Dの直線であれば、こちらで端点座標を取得しています。
Drawingの直線を移動する2 - C#ATIA
実は、2Dと異なり3Dの場合はプロパティ等を探しても見当たらないんですよ
端点座標や長さやらが。
Fusion360の場合であれば、こちらの
Help
"getEndPoints" プロパティから端点を取得して簡単に出来そうなのですが、
何故かCATIAは許してくれないんです。 データとして持ってない訳無いのに・・・。
無いものをグズグズ言っていても進まないので、とりあえず出来そうな
方法が2つ有り、両方速度がイマイチだったので海外サイトで調べてもう一つ
見つかりました。
'vba test_Get3dCurveEndPoint using-'KCL0.08' '指定した形状セット内の3D曲線の端点座標を3種類の方法で取得する Sub CATMain() 'ドキュメントのチェック If Not CanExecute(Array("PartDocument", "ProductDocument")) Then Exit Sub '形状セット選択 Dim HB As HybridBody Set HB = KCL.SelectItem("形状セット選択", "HybridBody") If KCL.IsNothing(HB) Then Exit Sub '線の取得 Dim Lines As Collection: Set Lines = GetLines(HB) If IsEmpty(Lines) Then Exit Sub 'ここからテスト Dim EndPnt As Collection 'SelectionSearch KCL.SW_Start Set EndPnt = GetEndPnt_SelectionSearch(Lines) Debug.Print "SelectionSearch : " + CStr(EndPnt.Count) + " : " + CStr(KCL.SW_GetTime) + "秒" 'HybridShapePointOnCurve KCL.SW_Start Set EndPnt = GetEndPnt_HybridShapePointOnCurve(Lines) Debug.Print "HybridShapePointOnCurve : " + CStr(EndPnt.Count) + " : " + CStr(KCL.SW_GetTime) + "秒" 'SPAWorkbench KCL.SW_Start Set EndPnt = GetEndPnt_SPAWorkbench(Lines) Debug.Print "SPAWorkbench : " + CStr(EndPnt.Count) + " : " + CStr(KCL.SW_GetTime) + "秒" End Sub '端点取得-SelectionSearch Private Function GetEndPnt_SelectionSearch(ByRef Lines As Collection) As Collection Dim Doc As PartDocument: Set Doc = Lines.Item(1).Document Dim Sel As Selection: Set Sel = Doc.Selection Dim Se As SelectedElement Dim i& Dim StPos As Variant, EdPos As Variant Dim EndPnt As Collection: Set EndPnt = New Collection CATIA.HSOSynchronized = False For Each Se In Lines With Sel .Clear .Add Se.Value .Search "Topology.CGMVertex,sel" End With StPos = GetVertexCoordinates(Sel.Item2(1)) EdPos = GetVertexCoordinates(Sel.Item2(Sel.Count2)) EndPnt.Add KCL.JoinAry(StPos, EdPos) Next CATIA.HSOSynchronized = True Set GetEndPnt_SelectionSearch = EndPnt End Function '端点データム化から座標取得-GetEndPnt_SelectionSearch用 Private Function GetVertexCoordinates(ByRef Se As SelectedElement) As Variant Dim Doc As PartDocument: Set Doc = Se.Document Dim Pt As Part: Set Pt = Doc.Part Dim Ref As Reference Set Ref = Pt.CreateReferenceFromBRepName(KCL.GetBrepName(Se.Value.Name), Se.Value.Parent) Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory Dim HsPntExp 'As HybridShapePointExplicit Set HsPntExp = Fact.AddNewPointDatum(Ref) Dim Pos(2) As Variant HsPntExp.GetCoordinates Pos GetVertexCoordinates = Pos Fact.DeleteObjectForDatum HsPntExp End Function '端点取得-HybridShapePointOnCurve Private Function GetEndPnt_HybridShapePointOnCurve(ByRef Lines As Collection) As Collection Dim Pt As Part: Set Pt = Lines.Item(1).Document.Part Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory Dim EndPnt As Collection: Set EndPnt = New Collection Dim i& Dim Ref As Reference Dim PntOnCrv As Variant 'HybridShapePointOnCurve Dim StPos(2) As Variant, EdPos(2) As Variant Dim Se As SelectedElement For Each Se In Lines Set Ref = Se.Reference Set PntOnCrv = Fact.AddNewPointOnCurveFromPercent(Ref, 0#, False) Pt.UpdateObject PntOnCrv PntOnCrv.GetCoordinates StPos PntOnCrv.Ratio.Value = 1# Pt.UpdateObject PntOnCrv PntOnCrv.GetCoordinates EdPos EndPnt.Add KCL.JoinAry(StPos, EdPos) Fact.DeleteObjectForDatum PntOnCrv Next Set GetEndPnt_HybridShapePointOnCurve = EndPnt End Function '端点取得-SPAWorkbench Private Function GetEndPnt_SPAWorkbench(ByRef Lines As Collection) As Collection Dim Doc As PartDocument: Set Doc = Lines.Item(1).Document Dim SPAWB As Workbench: Set SPAWB = Doc.GetWorkbench("SPAWorkbench") Dim EndPnt As Collection: Set EndPnt = New Collection Dim Pos(8) As Variant Dim Se As SelectedElement For Each Se In Lines Call SPAWB.GetMeasurable(Se.Reference).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(ByRef HB As HybridBody) As Collection Dim Sel As Selection: Set Sel = KCL.GetParent_Of_T(HB, "PartDocument").Selection CATIA.HSOSynchronized = False Sel.Clear Sel.Add HB Sel.Search "(CATGmoSearch.Line.Visibility=Visible + " + _ "CATGmoSearch.Circle.Visibility=Visible + " + _ "CATGmoSearch.Curve.Visibility=Visible),sel" CATIA.HSOSynchronized = True If Sel.Count2 < 1 Then Exit Function Dim Lines As Collection: Set Lines = New Collection Dim i& For i = 1 To Sel.Count2 Lines.Add Sel.Item2(i) Next Set GetLines = Lines End Function
実行後、形状セットを指定すると形状セット内の3Dな曲線(直線・円弧含む)の
端点座標を取得します。(テストの為、取得した座標値は放棄してます)
イミディエイトウィンドウに3つの異なった取得方法の実行時間が出力されます。
一応、3つの異なった取得方法の説明です。
・GetEndPnt_SelectionSearch
曲線一本一本を選択し、 "トポロジ" - "頂点" を行い、Hitした端点を
データム化し座標値を取得しています。
要は "曲線数 X 2" 個の点を作成し削除している為、処理速度が
遅い事が容易に想像できます。
・GetEndPnt_HybridShapePointOnCurve
曲線上に点を比率で作成し、比率を "0" と "1" に切り替えながら
座標値を取得しています。
過去にこちらで行った方法です。
曲線と戦ってみる9 - C#ATIA
こちらも "曲線数 X 1" 個の点を作成し削除しているため
処理速度が遅いことは、想像出来ていたのですが他の方法を
知りませんでした。
・GetEndPnt_SPAWorkbench
海外で見つけた方法です。 正直、Measurableで端点座標が取得できる
事を知りませんでした。 コードを見ただけで処理速度が速そうなのは
何となくわかりました。
実際にテストを行った結果です。
(本数に統一感が無いのは、適当にサンプルデータを作った為です)
○2本時 SelectionSearch : 2 : 2.009秒 HybridShapePointOnCurve : 2 : 0.031秒 SPAWorkbench : 2 : 0秒 ○260本時 SelectionSearch : 260 : 356.859秒 HybridShapePointOnCurve : 260 : 4.139秒 SPAWorkbench : 260 : 0.25秒 ○4099本時 SelectionSearch : ----- HybridShapePointOnCurve : 4099 : 68.005秒 SPAWorkbench : 4099 : 3.969秒
SelectionSearchタイプの4099本時の結果が無いのですが、
単純計算をしても1~1.5時間かかりそうなので、割愛しました。
SPAWorkbench優秀ですね。