⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 cbusline.vb

📁 地理信息系统二次开发实例教程VB.NET及源代码
💻 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 + -