netlayer.vb

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

        For i = 0 To m_arrSegs.Count - 1
            If dRatio < m_arrSegs(i).dRatio Then
                GoTo BreakI
            End If
        Next

BreakI: Dim pSeg As New NetLinkSeg()
        pSeg.nSegID = nSeg
        pSeg.dRatio = dRatio
        m_arrSegs.Insert(i, pSeg)
        Return True
    End Function
End Class
'---------------------------------------------------------------------
Public Class NetPath  ' 网络路径类
    Public m_dLength As Double  ' 该点到给定点的最短路径长度, -1表示不连通
    Public m_nPreNode As Integer   ' 该点在该路径上的前趋结点
    Public Sub New()
        m_dLength = -1
        m_nPreNode = -1
    End Sub
End Class
'---------------------------------------------------------------------
Public Class NetLayer
    Private m_arrLinks As ArrayList  ' 弧段表
    Private m_arrNodes As ArrayList ' 结点表
    Private m_arrStops As ArrayList ' 站点表
    Private m_arrLinkBackups As ArrayList ' 弧段备份表

    Private m_nLinkNum As Integer   ' 原始弧段数目(网络拓扑建立完成后) 
    Private m_nNodeNum As Integer   ' 原始结点数目(网络拓扑建立完成后) 
    Private m_pPath As NetPath()  ' 某一个点到所有点的最短路径
    Private m_layer As MapObjects2.MapLayer = Nothing
    Private m_dataSet As System.Data.DataSet = Nothing

    Public Sub New(ByVal layer As MapObjects2.MapLayer, ByVal dataSet As System.Data.DataSet)
        m_nLinkNum = 0
        m_nNodeNum = 0
        m_pPath = Nothing
        m_dataSet = dataSet
        m_layer = layer
    End Sub

    Public Function ReadNetTable() As Boolean
        m_arrLinks = New ArrayList()
        m_arrNodes = New ArrayList()
        m_arrStops = New ArrayList()
        m_arrLinkBackups = New ArrayList()

        Dim Tbl As System.Data.DataTable = m_dataSet.Tables("AAT")
        Dim rows As System.Data.DataRow() = Tbl.Select()
        Dim myRow As System.Data.DataRow
        For Each myRow In rows
            Dim lk As New NetLink()
            lk.m_GeoID = myRow("GeoID")
            lk.m_nFNode = myRow("FNODE")
            lk.m_nTNode = myRow("TNODE")
            lk.m_fLength = myRow("LENGTH")
            lk.m_fFromImp = myRow("FIMP")
            lk.m_fToImp = myRow("TIMP")
            m_arrLinks.Add(lk)
        Next

        Tbl = m_dataSet.Tables("NAT")
        rows = Tbl.Select()
        For Each myRow In rows
            Dim nNode, nLink As Integer
            Dim x, y, dAngle As Double
            Dim szArcID, szAngle As String

            nNode = myRow("NODEID")
            x = myRow("X")
            y = myRow("Y")
            szArcID = myRow("ARCID").ToString()
            szAngle = myRow("ANGLE").ToString()
            Dim node As New NetNode(x, y)
            m_arrNodes.Add(node)

            Dim nPos As Integer
            Dim szTemp As String
            nPos = szArcID.IndexOf(";")
Continue:   While nPos <> -1
                szTemp = szArcID.Substring(0, nPos)
                nLink = Convert.ToInt32(szTemp)
                szArcID = szArcID.Substring(nPos + 1)

                nPos = szAngle.IndexOf(";")
                If nPos = -1 Then
                    GoTo Continue
                End If
                szTemp = szAngle.Substring(0, nPos)
                dAngle = Convert.ToDouble(szTemp)
                szAngle = szAngle.Substring(nPos + 1)
                node.Add(nLink, dAngle)

                nPos = szArcID.IndexOf(";")
            End While
        Next

        Return True
    End Function

    Public Function PathAnalysis(ByVal x1 As Double, ByVal y1 As Double, _
                                 ByVal x2 As Double, ByVal y2 As Double, _
                                 ByRef PathList As ArrayList) As Boolean
        PathList = New ArrayList()
        Dim pt1 As New NetPoint(x1, y1)
        Dim pt2 As New NetPoint(x2, y2)

        Dim points As New ArrayList()
        points.Add(pt1)
        points.Add(pt2)

        Dim stops As ArrayList = Nothing
        If Not LoadStops(points, stops) Then
            Return False
        End If

        If stops.Count <> 2 Then
            Return False
        End If

        Dim nodes As ArrayList = Nothing
        Dim dDistance As Double
        dDistance = path(stops(0), stops(1), nodes, False)
        If dDistance < 0 Then
            Return False
        End If

        Dim line As NetLine = Nothing
        If Not CreateResultPath(nodes, line, False) Then
            Return False
        End If

        Dim i As Integer
        For i = 0 To line.m_pCoords.Count - 1
            PathList.Add(line.m_pCoords(i).x)
            PathList.Add(line.m_pCoords(i).y)
        Next

        UnloadStops()
        Return True
    End Function

    Private Function LoadStops(ByVal pPoints As ArrayList, ByRef pNodes As ArrayList) As Boolean
        Dim nLineID As Integer
        Dim i, nNewNode As Integer
        Dim ptNearest As NetPoint
        Dim dRatio As Double
        pNodes = New ArrayList()

        ' 先清空站点表
        m_arrStops.Clear()
        Dim nNum As Integer = pPoints.Count
Continue: For i = 0 To nNum - 1
            ' 计算距离该点最近的线
            Dim line As New NetLine(m_layer)
            nLineID = line.GetNearestLineData(pPoints(i).x, pPoints(i).y)
            If nLineID = -1 Then
                line = Nothing
                Return False
            End If

            ' 计算该点分裂该线的位置, 并不实际分裂该线, 
            ' 只是计算分裂的比例(, 用于更改弧段表和结点表)
            dRatio = 0
            line.GetSplitRatioByNearestPoint(pPoints(i), ptNearest, dRatio)

            ' 更新弧段表和结点表
            UpdateLinkNodeTable(nLineID, ptNearest, dRatio, nNewNode)
            line = Nothing

            If pNodes.Count > 0 Then
                If pNodes(pNodes.Count - 1) = nNewNode Then
                    GoTo Continue
                End If
            End If

            pNodes.Add(nNewNode)
        Next

        ' 填充需要返回的结点数组
        If pNodes.Count = 0 Then
            pNodes = Nothing
            Return False
        End If
        Return True
    End Function

    Private Function UpdateLinkNodeTable(ByVal nLineID As Integer, _
                     ByVal ptNearest As NetPoint, ByVal dRatio As Double, _
                     ByRef nNewNode As Integer) As Boolean
        Dim i, j As Integer
        Dim bFound As Boolean
        Dim dRatio2 As Double
        Dim nCurLink, nNewLink As Integer
        Dim nCurFNode, nCurTNode As Integer
        nNewNode = -1

        ' 与某条弧段的首点或者位点重合, 不需要更改弧段表和结点表
        If Math.Abs(dRatio) < 0.00000001 Then
            ' 首点
            nCurLink = GetNode(nLineID, nCurFNode, nCurTNode)
            nNewNode = nCurFNode
            Return True
        ElseIf Math.Abs(1 - dRatio) < 0.00000001 Then
            ' 尾点
            nCurLink = GetNode(nLineID, nCurFNode, nCurTNode)
            nNewNode = nCurTNode
            Return True
        End If

        bFound = False
        For i = 0 To m_arrLinkBackups.Count - 1
            If m_arrLinkBackups(i).m_Link.m_GeoID = nLineID Then
                bFound = True
                GoTo BreakI
            End If
        Next

BreakI: If bFound Then
            For j = 0 To m_arrLinkBackups(i).m_arrSegs.Count - 1
                ' 如果新点与原有的点重合, 则直接返回原来的点
                Dim r As Double = m_arrLinkBackups(i).m_arrSegs(j).dRatio
                If Math.Abs(r - dRatio) < 0.00000001 Then
                    If j = 0 Then
                        nCurLink = GetNode(nLineID, nCurFNode, nCurTNode)
                        nNewNode = nCurTNode
                        Return True
                    Else
                        nCurLink = m_arrLinkBackups(i).m_arrSegs(j - 1).nSegID
                        nNewNode = m_arrLinks(nCurLink).m_nTNode
                        Return True
                    End If
                End If

                ' 没有重合的点
                r = m_arrLinkBackups(i).m_arrSegs(j).dRatio
                If dRatio < r Then
                    GoTo BreakJ
                End If
            Next

BreakJ:     If j = 0 Then
                ' 第一段
                nCurLink = GetNode(nLineID, nCurFNode, nCurTNode)
                If nCurLink = -1 Then
                    Return False
                End If

                ' 更新结点表
                nNewLink = m_arrLinks.Count
                Dim pNode As New NetNode(ptNearest.x, ptNearest.y)
                pNode.Add(nNewLink, -1)
                pNode.Add(nCurLink, -1)
                m_arrNodes.Add(pNode)

                m_arrNodes(nCurTNode).Remove(nCurLink)
                m_arrNodes(nCurTNode).Add(nNewLink, -1)

                ' 更新弧段表
                nNewNode = m_arrNodes.Count - 1
                dRatio2 = m_arrLinkBackups(i).m_arrSegs(0).dRatio
                Dim pLink As New NetLink()
                pLink.m_GeoID = nLineID
                pLink.m_nFNode = nNewNode
                pLink.m_nTNode = m_arrLinks(m_arrLinkBackups(i).m_arrSegs(0).nSegID).m_nFNode
                pLink.m_fLength = m_arrLinks(nCurLink).m_fLength * (dRatio2 - dRatio)
                pLink.m_fFromImp = m_arrLinks(nCurLink).m_fFromImp * (dRatio2 - dRatio)
                pLink.m_fToImp = m_arrLinks(nCurLink).m_fToImp * (dRatio2 - dRatio)
                m_arrLinks.Add(pLink)

                m_arrLinks(nCurLink).m_nTNode = nNewNode
                m_arrLinks(nCurLink).m_fLength = m_arrLinks(nCurLink).m_fLength * dRatio
                m_arrLinks(nCurLink).m_fFromImp = m_arrLinks(nCurLink).m_fFromImp * dRatio
                m_arrLinks(nCurLink).m_fToImp = m_arrLinks(nCurLink).m_fToImp * dRatio

                m_arrLinkBackups(i).Add(nNewLink, dRatio)
            ElseIf j = m_arrLinkBackups(i).m_arrSegs.Count Then
                ' 最后一段
                nCurLink = m_arrLinkBackups(i).m_arrSegs(j - 1).nSegID
                nCurFNode = m_arrLinks(nCurLink).m_nFNode
                nCurTNode = m_arrLinks(nCurLink).m_nTNode

                ' 更新结点表
                nNewLink = m_arrLinks.Count
                Dim pNode As New NetNode(ptNearest.x, ptNearest.y)
                pNode.Add(nNewLink, -1)
                pNode.Add(nCurLink, -1)
                m_arrNodes.Add(pNode)

                Dim dAngle As Double = m_arrNodes(nCurTNode).GetLinkAngle(nCurLink)  ' 最后一段保留原角度
                m_arrNodes(nCurTNode).Remove(nCurLink)
                m_arrNodes(nCurTNode).Add(nNewLink, dAngle)

                ' 更新弧段表
                nNewNode = m_arrNodes.Count - 1
                Dim pLink As New NetLink()
                pLink.m_GeoID = nLineID
                pLink.m_nFNode = nNewNode
                pLink.m_nTNode = nCurTNode
                pLink.m_fLength = m_arrLinks(i).m_fLength * (1 - dRatio)
                pLink.m_fFromImp = m_arrLinks(i).m_fFromImp * (1 - dRatio)
                pLink.m_fToImp = m_arrLinks(i).m_fToImp * (1 - dRatio)
                m_arrLinks.Add(pLink)

                dRatio2 = m_arrLinkBackups(i).m_arrSegs(j - 1).dRatio
                m_arrLinks(nCurLink).m_nTNode = nNewNode
                m_arrLinks(nCurLink).m_fLength = m_arrLinks(nCurLink).m_fLength * (dRatio - dRatio2)
                m_arrLinks(nCurLink).m_fFromImp = m_arrLinks(nCurLink).m_fFromImp * (dRatio - dRatio2)
                m_arrLinks(nCurLink).m_fToImp = m_arrLinks(nCurLink).m_fToImp * (dRatio - dRatio2)
                m_arrLinkBackups(i).Add(nNewLink, dRatio)
            Else
                ' 中间某一段
                nCurLink = m_arrLinkBackups(i).m_arrSegs(j - 1).nSegID
                nCurFNode = m_arrLinks(nCurLink).m_nFNode
                nCurTNode = m_arrLinks(nCurLink).m_nTNode

                ' 更新结点表
                nNewLink = m_arrLinks.Count
                Dim pNode As New NetNode(ptNearest.x, ptNearest.y)
                pNode.Add(nNewLink, -1)
                pNode.Add(nCurLink, -1)
                m_arrNodes.Add(pNode)

                m_arrNodes(nCurTNode).Remove(nCurLink)
                m_arrNodes(nCurTNode).Add(nNewLink, -1)

                ' 更新弧段表
                nNewNode = m_arrNodes.Count - 1
                dRatio2 = m_arrLinkBackups(i).m_arrSegs(j).dRatio
                Dim pLink As New NetLink()
                pLink.m_GeoID = nLineID
                pLink.m_nFNode = nNewNode
                pLink.m_nTNode = nCurTNode
                pLink.m_fLength = m_arrLinks(i).m_fLength * (dRatio2 - dRatio)
                pLink.m_fFromImp = m_arrLinks(i).m_fFromImp * (dRatio2 - dRatio)
                pLink.m_fToImp = m_arrLinks(i).m_fToImp * (dRatio2 - dRatio)
                m_arrLinks.Add(pLink)

                dRatio2 = m_arrLinkBackups(i).m_arrSegs(j - 1).dRatio
                m_arrLinks(nCurLink).m_nTNode = nNewNode
                m_arrLinks(nCurLink).m_fLength = m_arrLinks(nCurLink).m_fLength * (dRatio - dRatio2)
                m_arrLinks(nCurLink).m_fFromImp = m_arrLinks(nCurLink).m_fFromImp * (dRatio - dRatio2)
                m_arrLinks(nCurLink).m_fToImp = m_arrLinks(nCurLink).m_fToImp * (dRatio - dRatio2)
                m_arrLinkBackups(i).Add(nNewLink, dRatio)
            End If
        Else
            nCurLink = GetNode(nLineID, nCurFNode, nCurTNode)
            If nCurLink = -1 Then
                Return False
            End If

            nNewLink = m_arrLinks.Count
            ' 备份
            Dim pBackup As New NetLinkBackup()
            pBackup.m_nIndex = nCurLink
            pBackup.m_Link.Copy(m_arrLinks(nCurLink))
            pBackup.Add(nNewLink, dRatio)
            m_arrLinkBackups.Add(pBackup)

            ' 更新结点表
            Dim pNode As New NetNode(ptNearest.x, ptNearest.y)
            pNode.Add(nNewLink, -1)
            pNode.Add(nCurLink, -1)
            m_arrNodes.Add(pNode)

            Dim dAngle As Double = m_arrNodes(nCurTNode).GetLinkAngle(nCurLink) ' 最后一段保留原角度
            m_arrNodes(m_arrLinks(nCurLink).m_nTNode).Remove(nCurLink)
            m_arrNodes(m_arrLinks(nCurLink).m_nTNode).Add(nNewLink, dAngle)

            ' 更新弧段表
            nNewNode = m_arrNodes.Count - 1
            Dim pLink As New NetLink()
            pLink.m_GeoID = nLineID
            pLink.m_nFNode = nNewNode
            pLink.m_nTNode = m_arrLinks(nCurLink).m_nTNode
            pLink.m_fLength = m_arrLinks(nCurLink).m_fLength * (1 - dRatio)
            pLink.m_fFromImp = m_arrLinks(nCurLink).m_fFromImp * (1 - dRatio)
            pLink.m_fToImp = m_arrLinks(nCurLink).m_fToImp * (1 - dRatio)
            m_arrLinks.Add(pLink)

            m_arrLinks(nCurLink).m_nTNode = nNewNode
            m_arrLinks(nCurLink).m_fLength = m_arrLinks(nCurLink).m_fLength * dRatio
            m_arrLinks(nCurLink).m_fFromImp = m_arrLinks(nCurLink).m_fFromImp * dRatio
            m_arrLinks(nCurLink).m_fToImp = m_arrLinks(nCurLink).m_fToImp * dRatio
        End If

        Return True
    End Function

    Private Function GetNode(ByVal nLineID As Integer, ByRef nFNode As Integer, _
                             ByRef nTNode As Integer) As Integer
        nFNode = -1
        nTNode = -1
        Dim i As Integer
        For i = 0 To m_arrLinks.Count - 1
            If nLineID = m_arrLinks(i).m_GeoID Then
                nFNode = m_arrLinks(i).m_nFNode
                nTNode = m_arrLinks(i).m_nTNode
                Return i
            End If
        Next

        Return -1
    End Function

    Private Function Path(ByVal nBeginNode As Integer, ByVal nEndNode As Integer, _
                     ByRef pNodes As ArrayList, ByVal bWeight As Boolean) As Double
        pNodes = Nothing
        If nBeginNode < 0 Or nBeginNode >= m_arrNodes.Count Then
            Return -1
        End If