GFMathsmod/GFMaths_Geometrymod.bas

Attribute VB_Name = "GFMaths_Geometrymod"
Option Explicit
'(c)2001, 2011 by Louis. Part of the GFMaths project (at the moment the only GFMaths module).
'
'THIS MODULE IS PLUG‑IN CODE.
'
'NOTE: to avoid decreasing speed by var conversion there
'are several distance function that do the same, but return different
'variable types ('overloaded').
'
'NOTE: the distance function naming works as follows:
'Get[item 1 description][item 2 description]Dist[Long/Single][2D/3D]()
'
'If a function returns a user type then the var type does not appear in
'the function name.
'
'Generally the item that appears in the name first must also be the
'item whose data that is passed first as function parameter.
'Pass the 'easier' item first (Point ‑> Line ‑> Plane).
'
Public Type PointSingle3D
    X As Single
    Y As Single
    Z As Single
End Type
'
Public Type LineSingle3D
    X1 As Single
    Y1 As Single
    Z1 As Single
    X2 As Single
    Y2 As Single
    Z2 As Single
End Type
'
Public Type VectorSingle3D
    X As Single
    Y As Single
    Z As Single
End Type
'
Public Type PlaneSingle3D
    'use to create a Hesse‑plane that has the formula 'a1x + a2y + a3z + a4 = 0'
    a1 As Single
    a2 As Single
    a3 As Single
    a4 As Single
End Type

'*********************************2D DISTANCE FUNCTIONS*********************************
'***LONG***

Public Function GetPointPointDistLong2D(ByVal Point1XPos As Long, ByVal Point1YPos As Long, ByVal Point2XPos As Long, ByVal Point2YPos As Long) As Long
    'On Error Resume Next 'using Pythagoras
    GetPointPointDistLong2D = Sqr(((Point2XPos ‑ Point1XPos) ^ 2&) + ((Point2YPos ‑ Point1YPos) ^ 2&))
End Function

'*****************************END OF 2D DISTANCE FUNCTIONS******************************
'*********************************3D DISTANCE FUNCTIONS*********************************

Public Function GetPointLineDistLong3D(ByVal PointXPos As Long, ByVal PointYPos As Long, ByVal PointZPos As Long, ByVal LineXPos1 As Long, ByVal LineYPos1 As Long, ByVal LineZPos1 As Long, ByVal LineXPos2 As Long, ByVal LineYPos2 As Long, ByVal LineZPos2 As Long, Optional ByRef L As Single = 0) As Long
    'On Error Resume Next 'returns always positive distance amount
    Dim Point As PointSingle3D
    Dim Line As LineSingle3D
    Dim HelpPlane As PlaneSingle3D
    Dim IntersectionPoint As PointSingle3D
    '
    'NOTE: first an auxiliary plane is created that has the passed line as normal vector.
    'Then the intersection point line‑plane is calculated (point lies on auxiliary plane by default),
    'the distance between the intersection point and the point is the distance sought.
    'If L is not in the interval [0; 1] there is not perpendicular line between the point and
    'the line (straight).
    '
    'preset
    Point.X = PointXPos
    Point.Y = PointYPos
    Point.Z = PointZPos
    Line.X1 = LineXPos1
    Line.Y1 = LineYPos1
    Line.Z1 = LineZPos1
    Line.X2 = LineXPos2
    Line.Y2 = LineYPos2
    Line.Z2 = LineZPos2
    'begin
    HelpPlane = GetHelpPlane(Point, Line)
    If GetLinePlaneIntersectionPoint(Line, HelpPlane, IntersectionPoint, L) = True Then
        GetPointLineDistLong3D = CLng(GetPointPointDistSingle3D(IntersectionPoint.X, IntersectionPoint.Y, IntersectionPoint.Z, Point.X, Point.Y, Point.Z))
    Else
        'MsgBox "ERROR", vbOKOnly + vbExclamation
    End If
End Function

Public Function GetPointPointDistSingle3D(ByVal Point1X As Single, ByVal Point1Y As Single, ByVal Point1Z As Single, ByVal Point2X As Single, ByVal Point2Y As Single, ByVal Point2Z As Single) As Single
    'On Error Resume Next
    Dim ConnectionVector As VectorSingle3D
    '
    'NOTE: this function returns the point distance, which is the 'connection vector' length.
    '
    ConnectionVector.X = Point2X ‑ Point1X
    ConnectionVector.Y = Point2Y ‑ Point1Y
    ConnectionVector.Z = Point2Z ‑ Point1Z
    '
    GetPointPointDistSingle3D = Abs(Sqr((ConnectionVector.X ^ 2!) + (ConnectionVector.Y ^ 2!) + (ConnectionVector.Z ^ 2!)))
End Function

'*****************************END OF 3D DISTANCE FUNCTIONS******************************
'********************************GEOMETRY HELP FUNCTIONS********************************

Public Function GetHelpPlane(ByRef Point As PointSingle3D, ByRef Line As LineSingle3D) As PlaneSingle3D
    'On Error Resume Next 'creates a plane that has the vector of Line as normal vector and that includes Point
    Dim n0 As Single
    GetHelpPlane.a1 = Line.X2 ‑ Line.X1
    GetHelpPlane.a2 = Line.Y2 ‑ Line.Y1
    GetHelpPlane.a3 = Line.Z2 ‑ Line.Z1
    GetHelpPlane.a4 = ‑(GetHelpPlane.a1 * Point.X + GetHelpPlane.a2 * Point.Y + GetHelpPlane.a3 * Point.Z)
    'NOTE: now we have the "Hesse‑Form" 'a1x + a2y + a3z + a4 = 0'
    If GetHelpPlane.a4 < 0 Then
        n0 = Sqr((GetHelpPlane.a1 ^ 2!) + (GetHelpPlane.a2 ^ 2!) + (GetHelpPlane.a3 ^ 2!))
    Else
        n0 = ‑Sqr((GetHelpPlane.a1 ^ 2!) + (GetHelpPlane.a2 ^ 2!) + (GetHelpPlane.a3 ^ 2!))
    End If
    If Not (n0 = 0) Then 'verify
        'convert HF to HNF
        GetHelpPlane.a1 = GetHelpPlane.a1 / n0
        GetHelpPlane.a2 = GetHelpPlane.a2 / n0
        GetHelpPlane.a3 = GetHelpPlane.a3 / n0
        GetHelpPlane.a4 = GetHelpPlane.a4 / n0
    End If
    'NOTE: now we have the "Hesse‑Normal‑Form mit gerichtetem Abstand".
End Function

Public Function GetLinePlaneIntersectionPoint(ByRef Line As LineSingle3D, ByRef Plane As PlaneSingle3D, ByRef IntersectionPoint As PointSingle3D, Optional ByRef L As Single = 0) As Boolean
    'On Error Resume Next 'returns True if IntersectionPoint has been set, False if there is no intersection point
    Dim Tempsngl!
    '
    'NOTE: the plane has the form: a1x + a2y + a3z + a4 = 0,
    'the line has the format: [point = starting point + L * vector].
    'The line must be inserted into the plane formula and the
    'resulting formula is simplified and solved for L.
    'L is put into the line formula and the result is the intersection point.
    '
    Tempsngl! = ((Plane.a1 * (Line.X2 ‑ Line.X1)) + (Plane.a2 * (Line.Y2 ‑ Line.Y1)) + (Plane.a3 * (Line.Z2 ‑ Line.Z1)))
    If Not (Tempsngl! = 0) Then
        L = (‑(Plane.a1 * Line.X1 + Plane.a2 * Line.Y1 + Plane.a3 * Line.Z1 + Plane.a4)) / Tempsngl!
        IntersectionPoint.X = Line.X1 + L * (Line.X2 ‑ Line.X1)
        IntersectionPoint.Y = Line.Y1 + L * (Line.Y2 ‑ Line.Y1)
        IntersectionPoint.Z = Line.Z1 + L * (Line.Z2 ‑ Line.Z1)
        GetLinePlaneIntersectionPoint = True
    Else
        IntersectionPoint.X = 0 'reset (error)
        IntersectionPoint.Y = 0 'reset (error)
        IntersectionPoint.Z = 0 'reset (error)
        GetLinePlaneIntersectionPoint = False
    End If
End Function

'****************************END OF GEOMETRY HELP FUNCTIONS*****************************


[END OF FILE]