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