netlayer.vb

用vb.net和gis组建MO实现了一个地名数据库地理信息系统

'---------------------------------------------------------------------
Public Class NetPoint
    Public x As Double   ' 点的横坐标
    Public y As Double  ' 点的纵坐标

    Public Sub New() ' 类的构造函数
        x = 0
        y = 0
    End Sub

    Public Sub New(ByVal x As Double, ByVal y As Double) ' 类的构造函数
        Me.x = x
        Me.y = y
    End Sub
End Class
'---------------------------------------------------------------------
Public Class NetLine
    ' 属性
    Public m_pCoords As ArrayList = Nothing     ' 线上各点的列表
    Private m_layer As MapObjects2.MapLayer = Nothing  ' 对应的图层

    ' 构造函数
    Public Sub New(ByVal layer As MapObjects2.MapLayer)
        m_pCoords = New ArrayList()
        m_layer = layer
    End Sub

    ' 计算线的几何长度
    Public Function CalcLength() As Double
        Dim dLength As Double = 0.0 ' 保存计算出的线几何长度的结果
        Dim nLoop As Integer  ' 保存循环计数

        ' 检查线的有效性
        If m_pCoords.Count < 2 Then
            Return 0.0
        End If

        ' 计算线的几何长度
        Dim dist As Double = 0.0
        For nLoop = 1 To m_pCoords.Count - 1
            dist = Math.Sqrt((m_pCoords(nLoop - 1).x - m_pCoords(nLoop).x) * _
            (m_pCoords(nLoop - 1).x - m_pCoords(nLoop).x) + _
            (m_pCoords(nLoop - 1).y - m_pCoords(nLoop).y) * _
            (m_pCoords(nLoop - 1).y - m_pCoords(nLoop).y))
            dLength += dist
        Next

        Return dLength
    End Function

    ' 通过线的id构造类的m_pCoords属性
    Public Function GetLineData(ByVal id As Integer) As Boolean
        Dim rs As MapObjects2.Recordset
        rs = m_layer.SearchExpression("GeoID = " + id.ToString())

        If rs Is Nothing Then
            Return False
        End If

        rs.MoveFirst()
        If rs.EOF Then
            Return False
        End If

        Dim line As MapObjects2.Line = rs.Fields.Item("shape").Value
        Dim pts As MapObjects2.Points
        pts = line.Parts.Item(0)
        m_pCoords.Clear()

        Dim i As Integer
        For i = 0 To pts.Count - 1
            Dim pt As New NetPoint(pts.Item(i).X, pts.Item(i).Y) ' 构造点
            ' 将该点加入到点列表中
            m_pCoords.Add(pt)
        Next
        Return True
    End Function

    ' 得到距离某点最近的线段，返回该线段的id
    Public Function GetNearestLineData(ByVal x As Double, ByVal y As Double) As Integer
        Dim rs As MapObjects2.Recordset = m_layer.Records
        Dim pt As New MapObjects2.PointClass()
        pt.X = x
        pt.Y = y

        Dim dDist As Double = 9999999
        Dim id As Integer = -1

        rs.MoveFirst()
        While Not rs.EOF
            Dim line As MapObjects2.Line = rs.Fields.Item("shape").Value
            Dim d As Double = line.DistanceTo(pt)

            If dDist > d Then
                dDist = d
                Dim szValue As String = rs.Fields.Item("Geoid").ValueAsString
                id = System.Convert.ToInt32(szValue)
            End If
            rs.MoveNext()
        End While

        If id <> -1 Then
            If Not GetLineData(id) Then
                Return -1
            End If
        End If

        Return id
    End Function

    ' 在类的点列表（m_pCoords）属性中加入一点
    Public Sub AddCoord(ByVal pt As NetPoint)
        m_pCoords.Add(pt)
    End Sub

    ' 判断两点是否重合，只要亮点的距离小于一个极小值，就认为两点重合
    Public Function IsPtCoincide(ByVal ptFirst As NetPoint, ByVal ptSecond As NetPoint) As Boolean
        If Math.Abs(ptFirst.x - ptSecond.x) <= 0.00000001 And _
           Math.Abs(ptFirst.y - ptSecond.y) <= 0.00000001 Then
            Return True
        End If
        Return False
    End Function

    ' 得到与某点最邻近的点
    Public Sub GetNearestPoint(ByVal ptP As NetPoint, ByVal ptA As NetPoint, _
    ByVal ptB As NetPoint, ByRef ptNearest As NetPoint, ByRef dDistance As Double)
        Dim Px, Py, Ax, Ay, Bx, By As Double
        Dim AB2, PA2, PB2, AB, PA, PB, S, AREA As Double
        Dim med, med1, k1, k2, b1, b2 As Double

        ptNearest = New NetPoint()
        dDistance = 0

        If IsPtCoincide(ptA, ptB) Then
            ptNearest = ptA
            Return
        End If

        Px = ptP.x
        Py = ptP.y
        Ax = ptA.x
        Ay = ptA.y
        Bx = ptB.x
        By = ptB.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 PA2 + AB2 < PB2 Or AB2 + PB2 < PA2 Then
            If PA2 > PB2 Then
                med = PB2
                ptNearest.x = Bx
                ptNearest.y = By
            Else
                med = PA2
                ptNearest.x = Ax
                ptNearest.y = Ay
            End If

            med = Math.Sqrt(med)
            dDistance = med
            Return
        End If

        If PA2 < 0.00000001 Or PB2 < 0.00000001 Then
            If PA2 < 0.00000001 Then
                med = Math.Sqrt(PA2)
                dDistance = med
                ptNearest.x = Ax
                ptNearest.y = Ay
                Return
            Else
                med = Math.Sqrt(PB2)
                dDistance = med
                ptNearest.x = Bx
                ptNearest.y = By
                Return
            End If
        End If

        AB = Math.Sqrt(AB2)
        PA = Math.Sqrt(PA2)
        PB = Math.Sqrt(PB2)
        S = (AB + PA + PB) / 2.0
        AREA = S
        AREA *= (S - PA)
        AREA *= (S - PB)
        AREA *= (S - AB)
        AREA = Math.Sqrt(AREA)
        med = (2.0 * AREA) / AB
        dDistance = med

        med = Ay - By
        med1 = Ax - Bx
        If Math.Abs(med) < 0.00000001 Or Math.Abs(med1) < 0.00000001 Then
            If Math.Abs(med) < 0.00000001 Then
                ptNearest.x = Px
                ptNearest.y = Ay
            Else
                ptNearest.y = Py
                ptNearest.x = Ax
            End If
        Else
            k1 = (Ay - By) / (Ax - Bx)
            k2 = -1.0 / k1
            b1 = Ay - k1 * Ax
            b2 = Py - k2 * Px
            S = (b2 - b1) / (k1 - k2)
            ptNearest.x = S
            S = k1 * S + b1
            ptNearest.y = S
        End If
    End Sub

    ' 得到与某点最邻近的点
    Public Sub GetNearestPoint(ByVal point As NetPoint, ByRef ptNearestPoint As NetPoint, _
         ByRef nSegmentIndex As Integer, ByRef dLeastDistance As Double)
        Dim nPointNum As Integer = m_pCoords.Count
        Dim dDistance As Double
        Dim ptTemp As NetPoint

        GetNearestPoint(point, m_pCoords(0), m_pCoords(1), ptNearestPoint, dLeastDistance)
        nSegmentIndex = 0

        ' 遍历每一条弧段来搜索最近的点
        Dim nIndex As Integer
        For nIndex = 1 To nPointNum - 2
            ' 得到最近的点
            GetNearestPoint(point, m_pCoords(nIndex), m_pCoords(nIndex + 1), ptTemp, dDistance)

            ' 比较最小的距离
            If dDistance < dLeastDistance Then
                dLeastDistance = dDistance
                ptNearestPoint = ptTemp
                nSegmentIndex = nIndex
            End If
        Next
    End Sub

    ' 获得根据给定点分裂线得到的两个部分的比例, 但并不真正分裂线
    ' point: 给定点
    ' ptNearestPoint: 分裂线时的分裂点 (返回)
    ' dRatio: 起始结点部分的比例 (返回)
    Public Function GetSplitRatioByNearestPoint(ByVal point As NetPoint, _
           ByRef ptNearest As NetPoint, ByRef dRatio As Double) As Boolean
        Dim nIndex As Integer
        Dim dDistance As Double

        Dim nPointNum As Integer = m_pCoords.Count
        ' 首先得到最近的点和线段索引
        GetNearestPoint(point, ptNearest, nIndex, dDistance)

        ' 检查线上最近的点是否与首尾点相重合
        If nIndex = 0 Then
            If IsPtCoincide(ptNearest, m_pCoords(0)) Then
                dRatio = 0
                Return True
            End If
        End If

        If nIndex = nPointNum - 2 Then
            If IsPtCoincide(ptNearest, m_pCoords(nPointNum - 1)) Then
                dRatio = 1
                Return True
            End If
        End If

        ' 计算分裂出来的第二条线的长度
        Dim nLoop As Integer
        Dim dLength As Double = 0
        ' 如果最近点与本线上的下一点不重合,则需将最近点计算在内
        If Not IsPtCoincide(ptNearest, m_pCoords(nIndex + 1)) Then
            dLength += Math.Sqrt((m_pCoords(nIndex + 1).x - ptNearest.x) * _
            (m_pCoords(nIndex + 1).x - ptNearest.x) + (m_pCoords(nIndex + 1).y _
            - ptNearest.y) * (m_pCoords(nIndex + 1).y - ptNearest.y))
        End If

        For nLoop = nIndex + 2 To nPointNum - 1
            dLength += Math.Sqrt((m_pCoords(nLoop).x - m_pCoords(nLoop - 1).x) _
                       * (m_pCoords(nLoop).x - m_pCoords(nLoop - 1).x) + _
                       (m_pCoords(nLoop).y - m_pCoords(nLoop - 1).y) * _
                       (m_pCoords(nLoop).y - m_pCoords(nLoop - 1).y))
        Next

        dRatio = 1 - dLength / CalcLength()
        Return True
    End Function
End Class
'---------------------------------------------------------------------
Public Class NetEdge
    Public nLink As Integer    ' 连接的弧段索引(数组下标索引)
    Public fAngle As Double    ' 该弧段的水平夹角

    Public Sub New()  ' 构造函数
        nLink = -1
        fAngle = 0
    End Sub
End Class
'---------------------------------------------------------------------
Public Class NetNode
    Inherits NetPoint

    Public m_arrLinks As ArrayList = Nothing  ' 与该点连接的弧段数组, 弧段按角度排序

    Public Sub New()
        m_arrLinks = New ArrayList()
    End Sub

    Public Sub New(ByVal x As Double, ByVal y As Double)
        Me.x = x
        Me.y = y
        m_arrLinks = New ArrayList()
    End Sub

    ' 加入一个连接的弧段(调用前需确定弧段是连接在该点上的)
    Public Function Add(ByVal nLink As Integer, ByVal dAngle As Double) As Boolean
        '/ 结点连接的弧段按角度排序
        Dim i As Integer
        For i = 0 To m_arrLinks.Count - 1
            If dAngle < m_arrLinks(i).fAngle Then
                GoTo BreakI
            End If
        Next

BreakI: Dim pEdge As New NetEdge()
        pEdge.nLink = nLink
        pEdge.fAngle = dAngle
        m_arrLinks.Insert(i, pEdge)

        Return True
    End Function

    ' 删除一个已连接的弧段
    Public Function Remove(ByVal nLink As Integer) As Boolean
        Dim i As Integer
        For i = 0 To m_arrLinks.Count - 1
            If nLink = m_arrLinks(i).nLink Then
                m_arrLinks.RemoveAt(i)
                Return True
            End If
        Next

        Return False
    End Function

    ' 得到一个连接弧段的角度
    Public Function GetLinkAngle(ByVal nLink As Integer) As Double
        Dim i As Integer
        For i = 0 To m_arrLinks.Count - 1
            If nLink = m_arrLinks(i).nLink Then
                Return m_arrLinks(i).fAngle
            End If
        Next

        Return -1
    End Function
End Class
'---------------------------------------------------------------------
' 网络弧段(链)类
Public Class NetLink
    Public m_GeoID As Integer ' 弧段ID(GeoID)
    Public m_nFNode As Integer  ' 起始结点(数组下标索引)
    Public m_nTNode As Integer  ' 终止结点(数组下标索引)
    Public m_fLength As Double  ' 长度
    Public m_fFromImp As Double  ' 正向阻力(阻力系数*长度 或 (1+阻力系数)*长度)
    Public m_fToImp As Double  ' 逆向阻力

    Public Sub New()  ' 构造函数
        m_GeoID = -1
        m_nFNode = -1
        m_nTNode = -1
        m_fLength = 0
        m_fFromImp = 0
        m_fToImp = 0
    End Sub

    Public Sub Copy(ByVal link As NetLink) ' 拷贝另一网络弧段类的数据
        m_GeoID = link.m_GeoID
        m_nFNode = link.m_nFNode
        m_nTNode = link.m_nTNode
        m_fLength = link.m_fLength
        m_fFromImp = link.m_fFromImp
        m_fToImp = link.m_fToImp
    End Sub

    Public Function IsEqual(ByVal link As NetLink) As Boolean ' 判断两网络弧段类是否相同
        If m_GeoID = link.m_GeoID Then
            Return True ' 如果ID号相同，则返回true
        Else
            Return False
        End If
    End Function
End Class
'---------------------------------------------------------------------
Public Class NetLinkSeg  ' 表示网络弧段上一节的类
    Public nSegID As Integer   ' 分裂点后面的部分的弧段索引（数组下标索引）
    Public dRatio As Double ' 分裂点前面的到起始结点部分的比例
End Class
'---------------------------------------------------------------------
' 用于备份弧段的类
Public Class NetLinkBackup
    Public m_nIndex As Integer   ' 弧段的索引
    Public m_Link As NetLink = Nothing ' 备份的弧段对象
    Public m_arrSegs As ArrayList  ' 该弧段被多次分割的比例列表

    Public Sub New()
        m_nIndex = -1
        m_Link = New NetLink()
        m_arrSegs = New ArrayList()
    End Sub

    Public Function Add(ByVal nSeg As Integer, ByVal dRatio As Double) As Boolean
        Dim i As Integer