netlayer.vb

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

        If nEndNode < 0 Or nEndNode >= m_arrNodes.Count Then
            Return -1
        End If

        pNodes = New ArrayList()
        ' 如果两个结点相同
        If nBeginNode = nEndNode Then
            pNodes.Add(nBeginNode)
            Return 0
        End If

        ' 计算nBeginNode到其他所有结点的最短路径
        If Not CalcPath(nBeginNode, nEndNode, bWeight) Then
            Return -1
        End If

        ' 提取从nBeginNode到nEndNode的路径
        ' 从nEndNode向前搜索前趋结点
        Dim nNode As Integer
        nNode = nEndNode
        While True
            ' 如果没有前趋结点，表示不连通
            If m_pPath(nNode).m_nPreNode = -1 Then
                Return -1
            End If

            ' 如果前趋结点为起始结点，路径结束
            If m_pPath(nNode).m_nPreNode = nBeginNode Then
                pNodes.Add(nNode)
                GoTo BreakWhile
            End If

            ' 加入中间结点
            pNodes.Add(nNode)
            nNode = m_pPath(nNode).m_nPreNode
        End While

        ' 加入起点
BreakWhile: pNodes.Add(nBeginNode)
        ' 因为是从nEndNode到nBeginNode加入的，所以要作一次倒序
        pNodes.Reverse()

        Return m_pPath(nEndNode).m_dLength
    End Function

    Private Function CalcPath(ByVal nNode As Integer, ByVal nEndNode As Integer, ByVal bWeight As Boolean) As Boolean
        If nNode < 0 Or nNode >= m_arrNodes.Count Then
            Return False
        End If

        Dim i, j, nNodeNum As Integer
        Dim nLink As Integer
        nNodeNum = m_arrNodes.Count
        If nNodeNum = 0 Then
            Return True
        End If

        Dim pMark(nNodeNum - 1) As Byte ' 处理标志数组
        For i = 0 To nNodeNum - 1
            pMark(i) = 0
        Next

        ' (1) 初始化
        ' 初始化路径数组, 类的构造函数会将长度置为-1, 前趋结点为-1
        m_pPath = Nothing
        ReDim m_pPath(nNodeNum - 1)
        For i = 0 To nNodeNum - 1
            m_pPath(i) = New NetPath()
        Next

        ' 自身
        m_pPath(nNode).m_dLength = 0
        m_pPath(nNode).m_nPreNode = nNode

        ' 对于与该结点直接相连的点, 初始化路径长度为连接弧度的阻力
        For i = 0 To m_arrNodes(nNode).m_arrLinks.Count - 1
            nLink = m_arrNodes(nNode).m_arrLinks(i).nLink
            If m_arrLinks(nLink).m_nFNode = nNode Then
                ' 路径长度, 正向
                If bWeight Then
                    m_pPath(m_arrLinks(nLink).m_nTNode).m_dLength = m_arrLinks(nLink).m_fFromImp
                Else
                    m_pPath(m_arrLinks(nLink).m_nTNode).m_dLength = m_arrLinks(nLink).m_fLength
                End If

                ' 前趋结点, 如果长度<0, 无前趋结点
                If m_pPath(m_arrLinks(nLink).m_nTNode).m_dLength < 0 Then
                    m_pPath(m_arrLinks(nLink).m_nTNode).m_nPreNode = -1
                Else
                    m_pPath(m_arrLinks(nLink).m_nTNode).m_nPreNode = nNode
                End If
            ElseIf m_arrLinks(nLink).m_nTNode = nNode Then
                ' 路径长度, 逆向
                If bWeight Then
                    m_pPath(m_arrLinks(nLink).m_nFNode).m_dLength = m_arrLinks(nLink).m_fToImp
                Else
                    m_pPath(m_arrLinks(nLink).m_nFNode).m_dLength = m_arrLinks(nLink).m_fLength
                End If

                ' 前趋结点, 如果长度<0, 无前趋结点
                If m_pPath(m_arrLinks(nLink).m_nFNode).m_dLength < 0 Then
                    m_pPath(m_arrLinks(nLink).m_nFNode).m_nPreNode = -1
                Else
                    m_pPath(m_arrLinks(nLink).m_nFNode).m_nPreNode = nNode
                End If
            End If
        Next

        ' 开始处理
        Dim nMinNode As Integer
        Dim dDist, dMinDist As Double
        For i = 0 To nNodeNum - 1
            ' (2) 在未处理结点中找出距离值最小的结点
            nMinNode = -1
            dMinDist = 1.7E+308
            For j = 0 To nNodeNum - 1
                ' 让过自身
                If j = nNode Then
                    GoTo ContinueFst
                End If

                ' 让过不连通结点
                If m_pPath(j).m_dLength < 0 Then ' <0 表示无穷大
                    GoTo ContinueFst
                End If

                ' 让过处理过的结点
                If pMark(j) = 1 Then
                    GoTo ContinueFst
                End If

                ' 在未处理过的结点中找出距离最小的结点
                If m_pPath(j).m_dLength < dMinDist Then
                    dMinDist = m_pPath(j).m_dLength
                    nMinNode = j
                End If
ContinueFst: Next

            ' 如果没找到, 则表示与其他点不连通
            If nMinNode = -1 Then
                pMark = Nothing
                Return True
            End If

            ' 处理该距离最小的点
            pMark(nMinNode) = 1

            ' (3) 调整余下的结点的最短路径
            For j = 0 To nNodeNum - 1
                ' 让过自身
                If j = nNode Then
                    GoTo ContinueScd
                End If

                ' 让过处理过的结点
                If pMark(j) = 1 Then
                    GoTo ContinueScd
                End If

                ' 调整未处理过的结点的最短路径
                ' 计算直接相连的结点间的距离
                dDist = GetConnectedDistance(nMinNode, j, bWeight)
                If dDist < 0 Then ' 不连通
                    GoTo ContinueScd
                End If

                ' 更新未处理过的结点的最短路径
                If m_pPath(j).m_dLength < 0 Or _
                 m_pPath(j).m_dLength > m_pPath(nMinNode).m_dLength + dDist Then
                    m_pPath(j).m_dLength = m_pPath(nMinNode).m_dLength + dDist
                    m_pPath(j).m_nPreNode = nMinNode
                End If
ContinueScd: Next j
        Next i

        pMark = Nothing
        Return True
    End Function

    Private Function GetConnectedDistance(ByVal nNode1 As Integer, _
            ByVal nNode2 As Integer, ByVal bWeight As Boolean) As Double
        If nNode1 < 0 Or nNode1 >= m_arrNodes.Count Then
            Return -1
        End If

        If nNode2 < 0 Or nNode2 >= m_arrNodes.Count Then
            Return -1
        End If

        If nNode1 = nNode2 Then
            Return 0
        End If

        Dim nLink As Integer
        Dim dDistance As Double
        Dim dMinDist As Double = 1.7E+308
        Dim nRes As Integer = 0
        Dim i As Integer = 0
        ' 遍历与结点1相连的弧段, 判断弧段的另一端的结点是否为结点2, 是则返回距离
        For i = 0 To m_arrNodes(nNode1).m_arrLinks.Count - 1
            nLink = m_arrNodes(nNode1).m_arrLinks(i).nLink
            If m_arrLinks(nLink).m_nFNode = nNode1 Then
                If m_arrLinks(nLink).m_nTNode = nNode2 Then
                    If bWeight Then
                        dDistance = m_arrLinks(nLink).m_fFromImp
                    Else
                        dDistance = m_arrLinks(nLink).m_fLength
                    End If

                    If dDistance < dMinDist Then
                        dMinDist = dDistance
                        nRes = 1
                    End If
                End If
            ElseIf m_arrLinks(nLink).m_nTNode = nNode1 Then
                If m_arrLinks(nLink).m_nFNode = nNode2 Then
                    If bWeight Then
                        dDistance = m_arrLinks(nLink).m_fToImp
                    Else
                        dDistance = m_arrLinks(nLink).m_fLength
                    End If

                    If dDistance < dMinDist Then
                        dMinDist = dDistance
                        nRes = -1
                    End If
                End If
            End If
        Next

        If nRes = 0 Then
            Return -1
        End If
        Return dMinDist
    End Function

    Private Function CreateResultPath(ByVal pNodes As ArrayList, ByRef line As NetLine, ByVal bWeight As Boolean) As Boolean
        line = New NetLine(m_layer)
        Dim i, j As Integer

        ' 将分析结果结点集转换为线加入到结果图层中
        Dim nNum As Integer
        Dim nRes As Integer
        Dim nNode1, nNode2, nLink As Integer
        Dim dDistance, dRatio As Double
        Dim dTotalImp As Double
        nNum = pNodes.Count

        Dim idLine As Integer
        dTotalImp = 0
        For i = 0 To nNum - 2
            ' 得到连接两个结点的最短弧段
            nNode1 = pNodes(i)
            nNode2 = pNodes(i + 1)
            nRes = IsConnectedDirectly(nNode1, nNode2, nLink, dDistance, bWeight)

            ' 不连通则返回false，这种情况理论上是不可能出现的
            If nRes = 0 Then
                Return False
            End If

            If nLink = -1 Then
                GoTo Continue
            End If

            ' 将该弧段的结点按路径顺序加入到结果图层的线中去
            idLine = m_arrLinks(nLink).m_GeoID
            Dim tmpLine As New NetLine(m_layer)
            tmpLine.GetLineData(idLine)

            ' 只加入起始结点和终止结点之间的点
            Dim dDist As Double
            Dim nSegIndex1, nSegIndex2 As Integer
            Dim ptNearst1, ptNearst2, ptTemp As NetPoint

            ptTemp = New NetPoint()
            ptTemp.x = m_arrNodes(nNode1).x
            ptTemp.y = m_arrNodes(nNode1).y
            tmpLine.GetNearestPoint(ptTemp, ptNearst1, nSegIndex1, dDist)
            ptTemp.x = m_arrNodes(nNode2).x
            ptTemp.y = m_arrNodes(nNode2).y
            tmpLine.GetNearestPoint(ptTemp, ptNearst2, nSegIndex2, dDist)
            dRatio = m_arrLinks(nLink).m_fLength / tmpLine.CalcLength()

            If nRes = 1 Then
                ' 正向
                line.AddCoord(ptNearst1)
                For j = nSegIndex1 To nSegIndex2 - 1
                    line.AddCoord(tmpLine.m_pCoords(j + 1))
                    line.AddCoord(ptNearst2)
                    dTotalImp += m_arrLinks(nLink).m_fFromImp
                Next j
            ElseIf nRes = -1 Then
                ' 逆向
                line.AddCoord(ptNearst1)
                For j = nSegIndex1 To nSegIndex2 - 1
                    line.AddCoord(tmpLine.m_pCoords(j))
                    line.AddCoord(ptNearst2)
                    dTotalImp += m_arrLinks(nLink).m_fToImp
                Next j
            End If

            tmpLine = Nothing

            If line.m_pCoords.Count < 2 Then
                line.m_pCoords.Clear()
                GoTo Continue
            End If
Continue: Next i

        Return True
    End Function

    Private Function IsConnectedDirectly(ByVal nNode1 As Integer, _
            ByVal nNode2 As Integer, ByRef nLink As Integer, _
            ByRef dDistance As Double, ByVal bWeight As Boolean) As Integer
        nLink = -1
        dDistance = 0
        If nNode1 < 0 Or nNode1 >= m_arrNodes.Count Then
            Return 0
        End If

        If nNode2 < 0 Or nNode2 >= m_arrNodes.Count Then
            Return 0
        End If

        If nNode1 = nNode2 Then
            Return 1
        End If

        Dim i As Integer = 0
        Dim nRes As Integer = 0
        Dim nMinLink As Integer = -1
        Dim dMinDist As Double = 1.7E+308
        ' 遍历与结点1相连的弧段, 判断弧段的另一端的结点是否为结点2
        For i = 0 To m_arrNodes(nNode1).m_arrLinks.Count - 1
            nLink = m_arrNodes(nNode1).m_arrLinks(i).nLink
            If m_arrLinks(nLink).m_nFNode = nNode1 Then
                If m_arrLinks(nLink).m_nTNode = nNode2 Then
                    If bWeight Then
                        dDistance = m_arrLinks(nLink).m_fFromImp
                    Else
                        dDistance = m_arrLinks(nLink).m_fLength
                    End If

                    If dDistance < dMinDist Then
                        dMinDist = dDistance
                        nMinLink = nLink
                        nRes = 1
                    End If
                End If
            ElseIf m_arrLinks(nLink).m_nTNode = nNode1 Then
                If m_arrLinks(nLink).m_nFNode = nNode2 Then
                    If bWeight Then
                        dDistance = m_arrLinks(nLink).m_fToImp
                    Else
                        dDistance = m_arrLinks(nLink).m_fLength
                    End If

                    If dDistance < dMinDist Then
                        dMinDist = dDistance
                        nMinLink = nLink
                        nRes = -1
                    End If
                End If
            End If
        Next

        If nRes = 0 Then
            nLink = -1
            dDistance = -1
            Return 0
        End If

        nLink = nMinLink
        dDistance = dMinDist
        Return nRes
    End Function

    Private Function UnloadStops() As Boolean
        Dim i, j As Integer
        Dim nLink, nNode As Integer
        Dim dAngle As Double
        ' 清空站点表
        m_arrStops.Clear()

        ' 利用备份数据, 恢复弧段表和结点表, 并清除备份数据
        For i = 0 To m_arrLinkBackups.Count - 1
            nLink = m_arrLinkBackups(i).m_nIndex
            ' 恢复弧段表
            m_arrLinks(nLink).Copy(m_arrLinkBackups(i).m_Link)

            ' 恢复点表
            nNode = m_arrLinks(nLink).m_nTNode
            dAngle = m_arrNodes(nNode).GetLinkAngle(nLink)

            For j = m_arrNodes(nNode).m_arrLinks.Count - 1 To 0 Step -1
                If m_arrNodes(nNode).m_arrLinks(j).nLink >= m_nLinkNum Then
                    m_arrNodes(nNode).m_arrLinks.RemoveAt(j)
                End If
            Next

            m_arrNodes(nNode).Add(nLink, dAngle)
        Next

        m_arrLinkBackups.Clear()
        m_pPath = Nothing
        Return True
    End Function


End Class
'---------------------------------------------------------------------