VB.NET编程判断点是否在直线上和直线是否相交

VB.NET编程判断点是否在直线上和直线是否相交

VB.NET不再支持 Type 结构体，改用 Structure 命名结构体，结构体可以将矢量类化，便于编程语言的简洁、区分识别，下列程序实现坐标点是否在直线上，直线是否相交。

函数模块：

Imports System.Math

Module MainModule
    ''' <summary>定义坐标点结构体</summary>
    Public Structure CoordDot
        ''' <summary>北向</summary>
        Dim XB As Double
        ''' <summary>东向</summary>
        Dim YL As Double
        ''' <summary>高程</summary>
        Dim ZH As Double
    End Structure

    ''' <summary>定义矩形结构体</summary>
    Public Structure Rectangle
        ''' <summary>X 最小</summary>
        Dim xMin As Double
        ''' <summary>X 最大</summary>
        Dim xMax As Double
        ''' <summary>Y 最小</summary>
        Dim yMin As Double
        ''' <summary>Y 最大</summary>
        Dim yMax As Double
    End Structure

    ''' <summary>计算两矢量的叉积</summary>
    ''' <param name="OneDot">第一坐标点</param> 
    ''' <param name="TwoDot">第二坐标点</param> 
    Public Function CrossProduct(OneDot As CoordDot, TwoDot As CoordDot) As Double
        Return OneDot.XB * TwoDot.YL - OneDot.YL * TwoDot.XB
    End Function

    ''' <summary>计算两矢量的差</summary>
    ''' <param name="OneDot">第一坐标点(起点)</param> 
    ''' <param name="TwoDot">第二坐标点(终点)</param> 
    Public Function VectorDiffer(OneDot As CoordDot, TwoDot As CoordDot) As CoordDot
        Dim t As CoordDot
        t.XB = TwoDot.XB - OneDot.XB
        t.YL = TwoDot.YL - OneDot.YL
        Return t
    End Function
    
    ''' <summary>以两点为对角顶点创建一个矩形</summary>
    ''' <param name="OneDot">第一坐标点</param>
    ''' <param name="TwoDot">第二坐标点</param>
    Public Function CreateRectangle(OneDot As CoordDot, TwoDot As CoordDot) As Rectangle
        Dim rec As Rectangle
        rec.xMin = OneDot.XB
        rec.xMax = TwoDot.XB
        rec.yMin = OneDot.YL
        rec.yMax = TwoDot.YL
        Dim T As Double
        If rec.xMin > rec.xMax Then
            T = rec.xMin
            rec.xMin = rec.xMax
            rec.xMax = T
        End If
        If rec.yMin > rec.yMax Then
            T = rec.yMin
            rec.yMin = rec.yMax
            rec.yMax = T
        End If
        Return rec
    End Function
    
    ''' <summary>判断点是否在矩形内</summary>
    ''' <param name="AnyDot">任一坐标点</param>
    ''' <param name="r">矩形</param>
    Public Function PointInRec(AnyDot As CoordDot, r As Rectangle) As Boolean
        If r.xMin <= AnyDot.XB And AnyDot.XB <= r.xMax And r.yMin <= AnyDot.YL And AnyDot.YL <= r.yMax Then
            Return True
        Else
            Return False
        End If
    End Function

    ''' <summary>判断坐标点是否在线段上</summary>
    ''' <param name="AnyDot">任一坐标点</param>
    ''' <param name="StartDot">线段的起点</param>
    ''' <param name="EndDot">线段的终点</param>
    Public Function PointOnSegment(AnyDot As CoordDot, StartDot As CoordDot, EndDot As CoordDot) As Boolean
        Dim rec As Rectangle = CreateRectangle(StartDot, EndDot) ' 创建外接矩形
        ' 判断点是否在线段上
        If Not PointInRec(AnyDot, rec) Then   ' 如果点在线段的外接矩形外，则必定不在线段上，直接返回假
            Return False
        Else
            If CrossProduct(VectorDiffer(AnyDot, StartDot), VectorDiffer(EndDot, StartDot)) = 0 Then   ' 如果点在外接矩形内，则继续计算叉积，判断点是否在线段所在的直线上
                Return True
            Else
                Return False
            End If
        End If
    End Function

    ''' <summary>判断两线段是否相交</summary>
    ''' <param name="OneLineDotA">第一线段起端点</param>
    ''' <param name="OneLineDotB">第一线段止端点</param>
    ''' <param name="TwoLineDotA">第二线段起端点</param>
    ''' <param name="TwoLineDotB">第二线段止端点</param>
    ''' <returns></returns>
    Public Function SegmentCross(OneLineDotA As CoordDot, OneLineDotB As CoordDot, TwoLineDotA As CoordDot, TwoLineDotB As CoordDot) As Boolean
        If Not (Min(OneLineDotA.XB, OneLineDotB.XB) <= Max(TwoLineDotA.XB, TwoLineDotB.XB) And
                Min(TwoLineDotA.YL, TwoLineDotB.YL) <= Max(OneLineDotA.YL, OneLineDotB.YL) And
                Min(TwoLineDotA.XB, TwoLineDotB.XB) <= Max(OneLineDotA.XB, OneLineDotB.XB) And
                Min(OneLineDotA.YL, OneLineDotB.YL) <= Max(TwoLineDotA.YL, TwoLineDotB.YL)) Then
            Return False
        End If

        Dim u As Double = (TwoLineDotA.XB - OneLineDotA.XB) * (OneLineDotB.YL - OneLineDotA.YL) - (OneLineDotB.XB - OneLineDotA.XB) * (TwoLineDotA.YL - OneLineDotA.YL)
        Dim v As Double = (TwoLineDotB.XB - OneLineDotA.XB) * (OneLineDotB.YL - OneLineDotA.YL) - (OneLineDotB.XB - OneLineDotA.XB) * (TwoLineDotB.YL - OneLineDotA.YL)
        Dim w As Double = (OneLineDotA.XB - TwoLineDotA.XB) * (TwoLineDotB.YL - TwoLineDotA.YL) - (TwoLineDotB.XB - TwoLineDotA.XB) * (OneLineDotA.YL - TwoLineDotA.YL)
        Dim z As Double = (OneLineDotB.XB - TwoLineDotA.XB) * (TwoLineDotB.YL - TwoLineDotA.YL) - (TwoLineDotB.XB - TwoLineDotA.XB) * (OneLineDotB.YL - TwoLineDotA.YL)

        Return (u * v <= 0.00000001 And w * z <= 0.00000001)
    End Function
End Module    

测试代码：

 Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  Dim LineOneCoordOne As CoordDot, LineOneCoordTwo As CoordDot
  Dim LineTwoCoordOne As CoordDot, LineTwoCoordTwo As CoordDot
  LineOneCoordOne.XB = 3110923.940 
  LineOneCoordOne.YL = 396820.504
  LineOneCoordTwo.XB = 3111371.454
  LineOneCoordTwo.YL = 395940.923

  LineTwoCoordOne.XB = 3112538.739 
  LineTwoCoordOne.YL = 396326.287
  LineTwoCoordTwo.XB = 3112317.795
  LineTwoCoordTwo.YL = 397256.372
  
  Dim Test As Boolean = SegmentCross(LineOneCoordOne, LineOneCoordTwo, LineTwoCoordOne, LineTwoCoordTwo) '判断是否相交
  If Test then
     Console.WriteLine(Test)
     MessageBox.Show("线段相交", "通知", MessageBoxButtons.OK, MessageBoxIcon.Information)
  Else
     MessageBox.Show("线段未相交", "通知", MessageBoxButtons.OK, MessageBoxIcon.Information)
  End if
 
End Sub