VB程序，路径问题，求修改

思路可能有点问题:

创新互联从2013年成立，先为共青城等服务建站，共青城等地企业，进行企业商务咨询服务。为共青城企业网站制作PC+手机+微官网三网同步一站式服务解决您的所有建站问题。

看下图:

根据楼主的思路,A到D最短的路径是A-B-C-D,实际上这是最长的路径

最短的路径应该是A-C-D

一个VB自动实现最短路径的程序

最近我也在整这个呢，据说找最短路径的是A*算法,不过我不喜欢看别人的代码（因为看不懂）只看原理，你可以找一下AStar算法方面的资料，原理比较简单，不过实现起来比较麻烦，我用的是VB.NET实现的，我用用它来走迷宫，而且找的是最短路径，经过几天努力，基本实现了（见 ），不过还有很多有待改进的地方。我不是计算机专业的，当然也没学过数据结构，你那两个问题我都搞不懂，不过有一点提示就是A星算法。

用vb.net编写的floyd算法求两点间的最短路径，怎么输出path经过的顶点序列？

用递归调用 Sub Path(ByVal i As Integer, ByVal j As Integer)

Dim k As Integer

Dim x1, y1, x2, y2 As Integer

k = s(i, j)

If k = 0 Then

Exit Sub

End If

Path(i, k)

Path(k, j)

VB 坐标最短路径

做出来了，代码如下，可能有点乱，但我测试可用

Private Function OrderXY(X() As Double, Y() As Double)

Dim i, j, k, m, n, num, temp As Double

Dim NewX() As Double

Dim NewY() As Double

Dim Smin As Double '定义最短总距离

If UBound(X()) UBound(Y()) Then MsgBox "坐标错误": Exit Function '防止数据错误

n = UBound(X())

ReDim p(n) As Long

p(0) = 0: num = 1

For i = 1 To n

p(i) = i 'p()数组依次存储从0到n共n+1个数

num = num * i '计算num，num表示的是n个坐标（除X(0),Y(0)以外)共有n！种排列

Next

ReDim Stance(num - 1) As Double '定义数组存储每种连接方法的总距离

ReDim NewX(n)

ReDim NewY(n)

For i = 0 To n - 1 'Stance（0）是按照原坐标顺序依次连接的总距离

Stance(0) = Stance(0) + Sqr((Y(i + 1) - Y(i)) * (Y(i + 1) - Y(i)) + (X(i + 1) - X(i)) * (X(i + 1) - X(i)))

Next

Smin = Stance(0)

For k = 0 To n

NewX(k) = X(k)

NewY(k) = Y(k)

Next

i = n - 1

'下面对p()数组的n个数（除0以外）进行排列，每产生一种排列方式，坐标数组的数据就对应交换，并计算这一路径的总距离

Do While i 0

If p(i) p(i + 1) Then

For j = n To i + 1 Step -1 '从排列右端开始

If p(i) = p(j) Then Exit For '找出递减子序列

Next

temp = p(i): p(i) = p(j): p(j) = temp '将递减子序列前的数字与序列中比它大的第一个数交换

temp = X(i): X(i) = X(j): X(j) = temp '与之对应的X Y也交换

temp = Y(i): Y(i) = Y(j): Y(j) = temp

For j = n To 1 Step -1 '将这部分排列倒转

i = i + 1

If i = j Then Exit For

temp = p(i): p(i) = p(j): p(j) = temp

temp = X(i): X(i) = X(j): X(j) = temp

temp = Y(i): Y(i) = Y(j): Y(j) = temp

Next

m = m + 1

For k = 0 To n - 1

Stance(m) = Stance(m) + Sqr((Y(k + 1) - Y(k)) * (Y(k + 1) - Y(k)) + (X(k + 1) - X(k)) * (X(k + 1) - X(k)))

Next

If Stance(m) = Smin Then

Smin = Stance(m)

For k = 0 To n

NewX(k) = X(k): NewY(k) = Y(k)

Next

End If

i = n

End If

i = i - 1

Loop

For k = 0 To n

X(k) = NewX(k): Y(k) = NewY(k)

Next '此时的X（） Y（） 就按照最短路径排列

End Function

用vb.netl编写的floyd算法求两点间的最短路径，怎么输出path经过的顶点序列？

Function Min(x() as integer,y() as integer) as double

dim i,j,k,a

dim m() as double

dim s() as string

dim mins as string

redim m(ubound(x),ubound(x))

redim s(ubound(x),ubound(x))

for i=1 to ubound(x)-1 '从起始点0点到i点的距离

m(i,0)=((x(i)-x(0))^2+(y(i)-y(0))^2)^0.5

s(i,0)="0-" cstr(i)

next

'从起始点开始经过K个点后到达i点的最短距离m(i,k)，s为各点的连线如"0-3-2-1-4"

for k=1 to ubound(x)-2

for i=1 to ubound(x)-1

m(i,k)=10^307

for j=1 to ubound(x)-1

if instr(s(j,k-1),cstr(i))=0 then'避免重复走一点

a=((x(i)-x(j))^2+(y(i)-y(j))^2)^0.5

if a+m(j,k-1)m(i,k) then

m(i,k)=a+m(j,k-1)

s(i,k)=s(j,k-1) "-" cstr(i)

endif

end if

next

next

next

'计算经过各点后到达最后一个点的最短距离

min=10^307

for j=1 to ubound(x)-1

a=((x(ubound(x))-x(j))^2+(y(ubound(x))-y(j))^2)^0.5

if a+m(j，ubound(x)-2)min then

min=a+m(j，ubound(x)-2)

mins=s(j，ubound(x)-2) "-" cstr(ubound(x))

end if

next

msgbox "最短距离:" min vbcrlf "最短路径:" mins

End function

private sub Command1_Click

dim x(5) as integer

dim y(5) as integer

dim m as double

x(0)=0

y(0)=0

x(1)=40

y(1)=600

......

x(5)=1000

y(5)=1000

m=min(x,y)

End sub

求一个关于 dijkstra 用vb 编辑的程序 用于计算多个点关于其中某点的最短路径问题

Option Explicit

Private Sub Command1_Click()

Dim a() As Double, bigN As Double, s As String, items As Variant, items1 As Variant

Dim maxNode As Long, i As Long, j As Long

Dim s1$, s2$, s3$, s4$, s5$, s6$, s7$, s8$, s9$

'assume all the data are much smaller than 1E+20

bigN = 1E+20

'following s is the input data for the matrix a(), m will be the above big number

'for bigger problem, the data in matrix a() should be read from a text file

s = "0,3,m,3,m,m,m,m,m;3,0,3,m,2,m,m,m,m;m,2,0,m,m,4,m,m,m;3,m,m,0,3,m,3,m,m;m,2,m,3,0,2,m,3,m;m,m,4,m,2,0,m,m,5;m,m,m,3,m,m,0,4,m;m,m,m,m,3,m,4,0,2;m,m,m,m,m,5,m,2,0"

items = Split(s, ";")

maxNode = UBound(items)

ReDim a(maxNode, maxNode)

For i = 0 To maxNode

items1 = Split(items(i), ",")

For j = 0 To maxNode

If items1(j) = "m" Then

a(i, j) = bigN

Else

a(i, j) = items1(j)

End If

Next j

Next i

Print "The Adjacency Matrix:"

PrintOut a()

Floyd a()

End Sub

Private Sub Floyd(a() As Double)

'All-Pairs Shortest Paths (Floyd's algorithm), coded by btef (please let this line remain)

Dim maxNode As Long, b() As String

Dim ii As Long, i As Long, j As Long

maxNode = UBound(a)

ReDim b(maxNode, maxNode)

For i = 0 To maxNode

For j = 0 To maxNode

If a(i, j) 1E+20 Then

b(i, j) = i "-" j

End If

Next j

Next i

'PrintOut b()

For ii = 0 To maxNode

For i = 0 To maxNode

If i ii Then

For j = 0 To maxNode

If j ii And j i Then

If a(i, ii) + a(ii, j) a(i, j) Then

a(i, j) = a(i, ii) + a(ii, j)

b(i, j) = b(i, ii) Mid(b(ii, j), InStr(b(ii, j), "-"))

End If

End If

Next j

End If

Next i

'PrintOut a()

'PrintOut b()

Next ii

Print "The Shortest Distances:"

PrintOut a()

Print "The Shortest Paths:"

PrintOut b()

End Sub

Private Sub PrintOut(a As Variant)

Dim i As Long, j As Long, maxNode As Long

maxNode = UBound(a)

For i = 0 To maxNode

For j = 0 To maxNode

Print a(i, j),

Next j

Print

Next i

Print String(88, "-")

End Sub

大概是这样

分享标题：关于vbnet计算最短路径的信息
文章分享：http://sczitong.cn/article/dsegcoi.html