端点一致を探る、組み合わせテスト1

前回の応用です。
3D曲線の端点座標値を取得 - C#ATIA

3D曲線の端点座標一致を探し出す、組み合わせﾃｽﾄｺｰﾄﾞを作りました。
予め書いておくと、何も考えずに単純に作っているので全くﾀﾞﾒのものです。
少ない量であれば、まぁ大丈夫ですが　数が多いと最悪CATIAを強制終了する
必要があるかもしれません。

'vba test_combinations Ver0.01  using-'KCL0.08'
'3D曲線の端点座標同士の一致のﾃｽﾄ
Option Explicit

Const Tolerance = 0.001

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 Msg$
    If Lines.Count > 200 Then
        Msg = CStr(Lines.Count) + "本で実行すると、それなりに時間がかかりますが、実行しますか?"
        If MsgBox(Msg, vbYesNo + vbInformation) = vbNo Then Exit Sub
    End If
    
    KCL.SW_Start
    
    '端点座標取得
    Dim EndPnts As Collection
    Set EndPnts = GetEndPntCoordinates(Lines)
    
    'test
    Dim Dmy
    Dmy = GetSingleIdx(EndPnts)
    
    Debug.Print CStr(EndPnts.Count) + " : " + CStr(KCL.SW_GetTime)
End Sub

'test
Private Function GetSingleIdx(ByVal EndPnts As Collection)
    Dim i&, j&
    For i = 1 To EndPnts.Count
        For j = i + 1 To EndPnts.Count
            Select Case True
                Case IsPosEqual(EndPnts.Item(i)(0), EndPnts.Item(j)(0))
                
                Case IsPosEqual(EndPnts.Item(i)(1), EndPnts.Item(j)(0))
                
                Case IsPosEqual(EndPnts.Item(i)(0), EndPnts.Item(j)(1))
                
                Case IsPosEqual(EndPnts.Item(i)(1), EndPnts.Item(j)(1))
                
            End Select
        Next
    Next
End Function

'座標値一致-ちょっとｲﾝﾁｷ
Private Function IsPosEqual(ByVal P1 As Variant, ByVal P2 As Variant) As Boolean
    IsPosEqual = False
    Dim i&
    For i = 0 To 2
        If Abs(P2(i) - P1(i)) > 0.001 Then Exit Function
    Next
    IsPosEqual = True
End Function

'端点取得
Private Function GetEndPntCoordinates(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 Array(KCL.GetRangeAry(Pos, 0, 2), KCL.GetRangeAry(Pos, 6, 8))
    Next
    Set GetEndPntCoordinates = 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