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

SPAWorkbenchで端点を取得する方法が、桁違いに速い事はわかったのですが
実際ﾃｽﾄしてみると体感的にかなり遅いんです。
その為、形状ｾｯﾄを指定した後の時間を測定するように変更してみました。

'vba test_Get3dCurveEndPoint2 using-'KCL0.08'

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 IsEmpty(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 = 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(ByVal 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

ﾃｽﾄは4099個だけですが、こんな感じです。

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

座標値の取得ではなく、それ以前の処理がかなり遅いんです。
原因は恐らくGetLines関数のこちらだろうと思われます。

    ・・・
    Dim Lines As Collection: Set Lines = New Collection
    Dim i&
    For i = 1 To Sel.Count2
        Lines.Add Sel.Item2(i)  '←恐らくここが遅い!
    Next
    ・・・

検索で取得したものをｺﾚｸｼｮﾝに代入している部分が、非常に時間が
かかるようです。　代入を高速に行う方法は･･･無さそうです。
それなら、代入無しで選択した状態のままで処理してみようと考え
以下の様に変更しました。

'vba test_Get3dCurveEndPoint3 using-'KCL0.08'
'指定した形状ｾｯﾄ内の3D曲線の端点座標を代入しないで取得する

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
    If Not GetLines(HB) Then Exit Sub
    Debug.Print "3D曲線を取得 : " + CStr(KCL.SW_GetTime) + "s"
    
    'SPAWorkbench
    KCL.SW_Start
    Dim EndPnt As Collection
    Set EndPnt = GetEndPnt_SPAWorkbench(HB)
    Debug.Print "端点座標取得 : " + CStr(KCL.SW_GetTime) + "s" + vbNewLine + CStr(EndPnt.Count) + "個"
    Debug.Print
End Sub

'端点取得-SPAWorkbench
Private Function GetEndPnt_SPAWorkbench(ByVal HB As HybridBody) As Collection
    Dim Doc As PartDocument: Set Doc = KCL.GetParent_Of_T(HB, "PartDocument")
    Dim Sel As Selection: Set Sel = Doc.Selection
    Dim SPAWB As Workbench: Set SPAWB = Doc.GetWorkbench("SPAWorkbench")
    Dim EndPnt As Collection: Set EndPnt = New Collection
    Dim Pos(8) As Variant
    Dim i&
    For i = 1 To Sel.Count2
        Call SPAWB.GetMeasurable(Sel.Item2(i).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(ByVal HB As HybridBody) As Boolean
    GetLines = False
    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
    GetLines = True
End Function

結果はこちら。

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

ﾄｰﾀﾙ時間的に、逆効果です･･･。　CATIAへのｱｸｾｽ自体が遅いような気がします。

ｺﾚｸｼｮﾝを諦め、型定義した配列で

'vba test_Get3dCurveEndPoint4 using-'KCL0.08'
'型定義し代入

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 SelectedElement: Lines = GetLines(HB)
    If IsEmpty(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 Variant) As Collection
    Dim Doc As PartDocument: Set Doc = Lines(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 i&
    For i = 1 To UBound(Lines)
        Call SPAWB.GetMeasurable(Lines(i).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(ByVal HB As HybridBody) As SelectedElement()
    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 SelectedElement: ReDim Lines(Sel.Count2)
    
    Dim i&
    For i = 1 To Sel.Count2
        Set Lines(i) = Sel.Item2(i)
    Next
    GetLines = Lines
End Function

結果は、

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

少し速いけど、誤差かどうか迷うﾚﾍﾞﾙ。
ん～　もうちょっと何とかしたい。

C#ATIA

↑ﾀｲﾄﾙ詐欺　主にFusion360API　偶にCATIA V5 VBA(絶賛ネタ切れ中)

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