めもがき

曲線の始点終点どっちが近いのかな？判断

曲線の始点終点どっちが近いのかな？判断 - C#ATIA

関連のなにか。

実環境が無いのでスペルミス上等ということで。

Option Explicit

Private Sub Sample(crv As INFITF.Reference, pln As INFITF.Reference)
    
    Dim measureCrv As SPATypeLib.Measurable
    Set measureCrv = GetMeasurable(crv)
    Select Case measureCrv.GeometryName
        Case CatMeasurableCurve, CatMeasurableCircle, CatMeasurableLine 'OK
        Case Else: Err.Raise 13
    End Select
    
    Dim A As Double, B As Double, C As Double, D As Double
    ComputePlaneEquationABCD pln, A, B, C, D
    
    Dim onCrvPointsCoordinates(0 To 8) As Variant
    Call asDisp(measureCrv).GetPointsOnCurve(onCrvPointsCoordinates)
    
    'Start point coordinates
    Dim ptX As Double, ptY As Double, ptZ As Double
    ptX = onCrvPointsCoordinates(0)
    ptY = onCrvPointsCoordinates(1)
    ptZ = onCrvPointsCoordinates(2)
    
    '面の方程式と、始点から伸びる直線上の点の座標の方程式を解く
    
    'Origin point coordinates as ptX, ptY, ptZ
    'Plane projection point coordinates as prjX, prjY , prjZ
    'Distance of origin to projection as L
    
    'A * prjX + B * prjY + C * prjZ = D
    'prjX = ptX + A * L
    'prjY = ptY + B * L
    'prjZ = ptZ + C * L
    
    Dim L As Double
    L = (D + A * ptX + B * ptY + C * ptZ) / _
        (A ^ 2 + B ^ 2 + C ^ 2)
    Dim prjX As Double, prjY As Double, prjZ As Double
    prjX = ptX + A * L
    prjY = ptY + B * L
    prjZ = ptZ + C * L
    
    Debug.Print ComputeScalar(ptX - prjX, ptY - prjY, ptZ - prjZ)
    
End Sub

'Plane Equation
'Ax + By + Cz = D
Private Sub ComputePlaneEquationABCD( _
              iPlane As INFITF.Reference, _
        ByRef oA As Double, _
        ByRef oB As Double, _
        ByRef oC As Double, _
        ByRef oD As Double _
    )
    
    Dim measurePln As SPATypeLib.Measurable
    Set measurePln = GetMeasurable(iPlane)
    Select Case measureCrv.GeometryName
        Case CatMeasurablePlane 'OK
        Case Else: Err.Raise 13
    End Select
    
    Dim planeComponents(0 To 8) As Variant
    Call asDisp(measurePln).GetPlane(planeComponents)
    
    
    Dim x1st As Double, y1st As Double, z1st As Double
    x1st = planeComponents(3)
    y1st = planeComponents(4)
    z1st = planeComponents(5)
    
    Dim x2nd As Double, y2nd As Double, z2nd As Double
    x2nd = planeComponents(6)
    y2nd = planeComponents(7)
    z2nd = planeComponents(8)
    
    Dim planeNomalDirection() As Double
    planeNomalDirection = CrossProduct( _
        x1st, y1st, z1st, _
        x2nd, y2nd, z2nd _
    )
    
    Let oA = planeNomalDirection(0)
    Let oB = planeNomalDirection(1)
    Let oC = planeNomalDirection(2)
    
    Dim plnOriginX As Double, plnOriginY As Double, plnOriginZ As Double
    plnOriginX = planeComponents(0)
    plnOriginY = planeComponents(1)
    plnOriginZ = planeComponents(2)
    
    Let oD = ComputeScalar(plnOriginX, plnOriginY, plnOriginZ)
End Sub

'ベクトルの外積
Public Function CrossProduct( _
        iX1 As Double, iY1 As Double, iZ1 As Double, _
        iX2 As Double, iY2 As Double, iZ2 As Double _
    ) As Double() 'Double(0 To 2)
    
    Const X = 0, Y = 1, Z = 2
    Dim resultVector(0 To 2) As Double
    resultVector(X) = iY1 * iZ2 - iZ1 * iY2
    resultVector(Y) = iZ1 * iX2 - iX1 * iZ2
    resultVector(Z) = iX1 * iY2 - iY1 * iX2
    
    Let CrossProduct = resultVector
End Function

'ベクトルから大きさを求める
Public Function ComputeScalar( _
                 iX As Double, _
                 iY As Double, _
        Optional iZ As Double = 0# _
    ) As Double
    
    Let ComputeScalar = VBA.Math.Sqr(iX ^ 2 + iY ^ 2 + iZ ^ 2)
    
End Function

'てきとう
Public Function GetMeasurable(iRef As INFITF.Reference) As SPATypeLib.Measurable
    Dim doc As INFITF.Document
    Set doc = GetModelElement(iRef).Document
    Dim spaWb As SPATypeLib.SPAWorkbench
    Set spaWb = doc.GetWorkbench("SPAWorkbench")
    Set GetMeasurable = spaWb.GetMeasurable(iRef)
End Function

'[選択要素からﾄﾞｷｭﾒﾝﾄを取得する - C#ATIA](http://kantoku.hatenablog.com/entry/2016/04/07/183709 "選択要素からﾄﾞｷｭﾒﾝﾄを取得する - C#ATIA")
Public Function GetModelElement(iAnyObject As INFITF.AnyObject) As INFITF.ModelElement
    Set GetModelElement = iAnyObject.GetItem("ModelElement")
End Function

'disable VBE static syntax check.
Private Function asDisp(o As INFITF.CATBaseDispatch) As INFITF.CATBaseDispatch
    Set asDisp = o
End Function

参考

選択要素からﾄﾞｷｭﾒﾝﾄを取得する - C#ATIA
GetDirectionが上手く行かない2 - C#ATIA