youmapx
路人甲
路人甲
  • 注册日期2004-11-26
  • 发帖数108
  • QQ
  • 铜币491枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1705回复:4

mapx+vb 建立拓扑图层

楼主#
更多 发布于:2005-03-23 12:13
<P>   MAPX :用VB建立拓扑LAYER用于网络分析(如最短路径)????????</P>
<P>哪位大侠知道建立拓扑LAYER的VB程序????????</P>
喜欢0 评分0
gis
gis
管理员
管理员
  • 注册日期2003-07-16
  • 发帖数15945
  • QQ554730525
  • 铜币25337枚
  • 威望15352点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
  • 帝国沙发管家
  • GIS帝国明星
  • GIS帝国铁杆
1楼#
发布于:2005-03-23 16:26
我这里有些mapinfo的建立topo和查找路径的程序,改天发上来,大家看看
举报 回复(0) 喜欢(0)     评分
wangjh
论坛版主
论坛版主
  • 注册日期2003-08-22
  • 发帖数994
  • QQ55359982
  • 铜币2579枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2005-03-24 09:26
好。期待
网 站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年,最近被盗了,郁闷!!!)
举报 回复(0) 喜欢(0)     评分
youmapx
路人甲
路人甲
  • 注册日期2004-11-26
  • 发帖数108
  • QQ
  • 铜币491枚
  • 威望0点
  • 贡献值0点
  • 银元0个
3楼#
发布于:2005-03-24 13:13
非常感谢!!!!!
举报 回复(0) 喜欢(0)     评分
echo2003
点子王
点子王
  • 注册日期2003-07-28
  • 发帖数2453
  • QQ76947571
  • 铜币5473枚
  • 威望1点
  • 贡献值0点
  • 银元0个
  • GIS帝国居民
4楼#
发布于:2005-03-24 16:13
<P>[转载]:结合图形数据就可以了!</P><P>最短路径算法源码 </P><P>
Public Function shortpath(startno As Integer, endno As Integer) As Single
以开始点,结束点为参数。
Dim result() As Single
Dim result1 As Integer
定义结果点
Dim s1 As Single
Dim min As Single
Dim ii, i, j, aa As Integer
Dim yc() As Boolean
Dim ycd() As Boolean
Dim rs1() As Single
Dim no() As Integer
Dim nopoint As Integer
ReDim yc(1 To maxno) As Boolean
ReDim ycd(1 To maxno) As Boolean
ReDim rs1(1 To maxno) As Single
ReDim result(1 To 2, 1 To maxno) As Single
定义结果,其中result(1,maxno)为结果点,result(2,maxno)为结果长度。
For i = 1 To maxno// maxno为网中最大的节点数。
  yc(i) = False //标记已经查过的点。
  ycd(i) = False //标记已经作结果点用过的点
  rs1(i) = 1E+38 //假设从起点到任一点的距离都为无穷大
Next i
ll = startno //设置开始点。
yc(ll) = True //标记开始点为真。即已经作结果点用过。
j = 0
For aa = 1 To maxno
先从与开始点相连的终点寻找
  For i = 1 To indexa1(2, ll) //以与ll点相连的起点的个数循环
    result1 = b1(indexa1(1, ll) - i + 1)找出与LL点相连的终点的点号
    s1 = c1(indexa1(1, ll) - i + 1) + result(2, ll)找出长度并求和
    If yc(result1) = True Then GoTo 200如果以被经查过进行下一个
    If ycd(result1) = True Then//如果已经作为结果点判断哪一个长
      If rs1(result1) >= s1 Then//如果这一点到起点的长度比现在的路线长,替代
        rs1(result1) = s1
        result(1, result1) = ll//设置到这点的最短路径的前一点为LL点(精华部分)
        result(2, result1) = s1设置到这点的最短路径长度
        GoTo 200
      Else
        GoTo 200
      End If
    End If
    '如果上面的条件都不符合则进行下面的语句
    ycd(result1) = True
    rs1(result1) = s1
    result(1, result1) = ll
    result(2, result1) = s1
    '每找到一个点加一,为了下面的判断
    j = j + 1
    ReDim Preserve no(1 To j) As Integer
    '从新 定义数组并使其值为当前的点号
    no(j) = result1
  200 Next I
  '再从与开始点相连的终点寻找,与上面一样不再标注
  For i = 1 To indexb2(2, ll)
    result1 = a2(indexb2(1, ll) - i + 1)
    s1 = c2(indexb2(1, ll) - i + 1) + result(2, ll)
    If yc(result1) = True Then GoTo 300
    If ycd(result1) = True Then
      If rs1(result1) >= s1 Then
        rs1(result1) = s1
        result(1, result1) = ll
        result(2, result1) = s1
        GoTo 300
      Else
        GoTo 300
      End If
    End If
    ycd(result1) = True
    rs1(result1) = s1
    result(1, result1) = ll
    result(2, result1) = s1
    j = j + 1
    ReDim Preserve no(1 To j) As Integer
    no(j) = result1
  300 Next I</P><P>  '设置最小为无穷大,最短路径点为空
  min = 1E+38
  minpoint = Null
  (优化部分)
  找出已经查过点中长度最短的点
  For i = aa To j
    If min > rs1(no(i)) Then
      ii = i
      min = rs1(no(i))
      minpoint = no(i)
    End If
  Next I
  '如果没有结果,即起点与终点没有通路退出程序
  If min = 1E+38 Then Exit Function
  '(重点优化)将两点互换,减少循环。
  no(ii) = no(aa)
  no(aa) = minpoint
  '标记已经作为结果点判断过
  yc(minpoint) = True
  ll = minpoint
  '判断结果点是否等于终点,如果等于则已经找到最短路径
  If minpoint = endno Then Exit For
Next aa
'返回最短路径长度
Stpath = result(2, endno)
End Function
</P>
举报 回复(0) 喜欢(0)     评分
游客

返回顶部