C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

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

ご相談頂いた内容を実現する為に、テストコードを作成しました。
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" に切り替えながら
座標値を取得しています。
f:id:kandennti:20161207164110p:plain
過去にこちらで行った方法です。
曲線と戦ってみる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優秀ですね。