📄 cbusline.vb
字号:
'---------------------------------------------------------------------
Public Class CGisSegLine
Public m_ptStartPoint As MPoint
Public m_ptEndPoint As MPoint
Public Sub New()
m_ptStartPoint = New MPoint()
m_ptEndPoint = New MPoint()
End Sub
Public Function GetDistance(ByRef point As MPoint, ByRef ptHFoot As MPoint, ByRef distance As Double) As Integer
Dim Px, Py, Ax, Ay, Bx, By As Double
Dim ZERODIST As Double = 0.00000001
Dim AB2, PA2, PB2, AB, PA, PB, S, AREA As Double
Dim med, k1, k2, b1, b2 As Double
Px = point.x
Py = point.y
Ax = m_ptStartPoint.x
Ay = m_ptStartPoint.y
Bx = m_ptEndPoint.x
By = m_ptEndPoint.y
AB2 = (Ax - Bx) * (Ax - Bx) + (Ay - By) * (Ay - By)
PB2 = (Px - Bx) * (Px - Bx) + (Py - By) * (Py - By)
PA2 = (Ax - Px) * (Ax - Px) + (Ay - Py) * (Ay - Py)
If AB2 < ZERODIST Then
med = System.Math.Sqrt(PA2)
distance = med
ptHFoot.x = Ax
ptHFoot.y = Ay
Return -1
End If
If PA2 < ZERODIST Then
med = System.Math.Sqrt(PA2)
distance = med
ptHFoot.x = Ax
ptHFoot.y = Ay
Return -2
End If
If PB2 < ZERODIST Then
med = System.Math.Sqrt(PB2)
distance = med
ptHFoot.x = Bx
ptHFoot.y = By
Return -2
End If
If PA2 + AB2 < PB2 Or AB2 + PB2 < PA2 Then
If PA2 > PB2 Then
med = PB2
ptHFoot.x = Bx
ptHFoot.y = By
Else
med = PA2
ptHFoot.x = Ax
ptHFoot.y = Ay
End If
med = System.Math.Sqrt(med)
distance = med
Return -3
Else
AB = System.Math.Sqrt(AB2)
PA = System.Math.Sqrt(PA2)
PB = System.Math.Sqrt(PB2)
S = (AB + PA + PB) / 2.0
AREA = S
AREA *= (S - PA)
AREA *= (S - PB)
AREA *= (S - AB)
AREA = System.Math.Sqrt(AREA)
med = (2.0 * AREA) / AB
distance = med
med = Ay - By
If med = 0.0 Then
ptHFoot.x = Px
ptHFoot.y = Ay
Return -4
End If
med = Ax - Bx
If med = 0.0 Then
ptHFoot.y = Py
ptHFoot.x = Ax
Return -4
End If
k1 = (Ay - By) / (Ax - Bx)
k2 = -1.0 / k1
b1 = Ay - k1 * Ax
b2 = Py - k2 * Px
S = (b2 - b1) / (k1 - k2)
ptHFoot.x = S
S = k1 * S + b1
ptHFoot.y = S
Return 0
End If
End Function
End Class
'---------------------------------------------------------------------
Public Class CBusLine
'---------------------------------------------------------------------
Public Sub CutLine(ByVal LineSrc As MLine, ByVal pt1 As MPoint, ByVal pt2 As MPoint, ByRef LineRes As MLine)
' 计算某点到线段的距离
Dim dMinDistance1 As Double = 10000.0
Dim dMinDistance2 As Double = 10000.0
Dim dTheDis As Double = 0.0
Dim ptRealFrom, ptRealTo As MPoint
Dim ptTemp As New MPoint()
Dim nPointOrderInMLine1 As Integer = 0
Dim nPointOrderInMLine2 As Integer = 0
Dim SegMLine As New CGisSegLine()
Dim i As Integer
For i = 0 To LineSrc.nPointNumber - 2
SegMLine.m_ptStartPoint.x = LineSrc.pPoint(i).x
SegMLine.m_ptStartPoint.y = LineSrc.pPoint(i).y
SegMLine.m_ptStartPoint.x = LineSrc.pPoint(i + 1).x
SegMLine.m_ptStartPoint.y = LineSrc.pPoint(i + 1).y
SegMLine.GetDistance(pt1, ptTemp, dTheDis)
If dTheDis < dMinDistance1 Then
dMinDistance1 = dTheDis
nPointOrderInMLine1 = i
ptRealFrom = ptTemp
End If
SegMLine.GetDistance(pt2, ptTemp, dTheDis)
If dTheDis < dMinDistance2 Then
dMinDistance2 = dTheDis
nPointOrderInMLine2 = i
ptRealTo = ptTemp
End If
Next
If nPointOrderInMLine2 - nPointOrderInMLine1 > 0 Then
LineRes.nPointNumber = nPointOrderInMLine2 - nPointOrderInMLine1 + 2
ReDim LineRes.pPoint(LineRes.nPointNumber - 1)
LineRes.pPoint(0) = pt1
For i = 1 To LineRes.nPointNumber - 2
LineRes.pPoint(i) = LineSrc.pPoint(nPointOrderInMLine1 + i)
Next
LineRes.pPoint(i) = pt2
Else
LineRes.nPointNumber = nPointOrderInMLine1 - nPointOrderInMLine2 + 2
ReDim LineRes.pPoint(LineRes.nPointNumber - 1)
LineRes.pPoint(0) = pt2
For i = 1 To LineRes.nPointNumber - 2
LineRes.pPoint(i) = LineSrc.pPoint(nPointOrderInMLine2 + i)
Next
LineRes.pPoint(i) = pt1
End If
End Sub
'---------------------------------------------------------------------
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -