Hi Mustaffa! I posted this message on MapInfo-L last year. The comments are in my language, but I hope it will help. You need 2 tables. One with polyline and one with vertexes. I've put some english comment belov in the code. If you'll use my code, metion me in your theseis. Best wishes, Jure Ravnik Ecological Engineering Institute Ljubljanska 9 2000 Maribor Slovenia Tel:+ 386 62 300 48 11 Fax:+ 386 62 300 48 35 mailto:[EMAIL PROTECTED] -----Izvorno sporočilo----- Od: Jure Ravnik [SMTP:[EMAIL PROTECTED]] Poslano: 1. april 1999 7:41 Za: '[EMAIL PROTECTED]' Zadeva: MI MB Shortest Path Hi Tyson and the List, Here's the VB5.0 and MAPX solution of the shortest path problem. It's my first VB program, so its very simple and slow. But it works fine. The sub to call is MinLenTree(beginning vertex, end vertex). The program selects the solution and displays the results in a another form. If you just need a algorithm, study the sub MinLentree from the label zacetek: to the if that has goto zacetek. I had to write this in a hurry so the algorithm that I came up with is the simplest you can think of. I'm sure that better ones can be found in books. I can suggest : GRAPHENTEORIE mit Algoritmen und Anwendungen Author : Hartmut Noltemeier Publisher : Walter de Gruyter Date : Berlin, New York, 1976 Yours, Jure. Jure Ravnik Ecological Engineering Institute Slovenia [EMAIL PROTECTED] Option Explicit Const CUSTOM_INFO_TOOL As Integer = 5 Dim ds As MapXLib.Dataset Dim dsvozli As MapXLib.Dataset Dim fld As MapXLib.Field Public l As Object 'Layer Public lvozli As Object Public f As Object 'Feature Public fvozli1 As Object Public fvozli2 As Object Private Sub form_load() 'odprem mapinfo tabelo Set l = Map1.Layers.Add("your paths table(polylines)") Set ds = Map1.Datasets.Add(miDataSetLayer, l) 'The ds dataset should include a column "dolzina" that has a length od the polyline, '"odvozla" that has a integer number of the beginnig vertex and "dovozla" that has 'an integer number of the end vertex ' odprem vozle Set lvozli = Map1.Layers.Add("table of point vertex (first and last points of polylines)") Set dsvozli = Map1.Datasets.Add(miDataSetLayer, lvozli, "vozli") ' nastavim labeliranje Set lvozli.LabelProperties.Dataset = dsvozli Set lvozli.LabelProperties.DataField = dsvozli.Fields("vozelid") lvozli.LabelProperties.Offset = 8 lvozli.AutoLabel = True Dim fvozli As MapXLib.Feature End Sub Public Function dol(odv As Integer, dov As Integer) Dim i As Integer For i = 1 To ds.RowCount If ds(i, "odvozla") = odv And ds(i, "dovozla") = dov Then dol = ds(i, "dolzina") End If Next End Function Public Function voz2pov(odv As Integer, dov As Integer) Dim i As Integer voz2pov = -1 For i = 1 To ds.RowCount If ds(i, "odvozla") = odv And ds(i, "dovozla") = dov Then voz2pov = i End If Next End Function Public Function vozpovmat(i As Integer, j As Integer) ' matrika naj bo oblike p1 p2 p3 p4 ... ' v1 ' v2 ' vrne + ce je i ta povezava usmerjena v j to vozlisce ' vrne - ce je i ta povezava usmerjena stran od j tega vozlisca ' vrne 0 ce i ta povezava ne dostopa do j tega vozlisca ' i gre po povezavah, j po vozlih vozpovmat = 0 If ds(i, "odvozla") = j Then vozpovmat = -1 End If If ds(i, "dovozla") = j Then vozpovmat = 1 End If End Function Public Sub minlentree(zacvoz As Integer, konvoz As Integer) formMinDre.MousePointer = vbHourglass Dim drevo As Variant Dim drevesa As Variant Dim resitev As Variant Dim dolzina As Variant Dim i As Integer Dim j As Integer Dim k As Integer Dim ii As Integer Dim tmp As Integer Dim tmp1 As Integer Dim konec As Boolean Dim neses As Integer Dim stresitev As Integer Dim najkrajsa As Integer Dim dolmin As Double Dim stdreves As Integer Dim istodrevo As Boolean Dim povezavaobs As Boolean Dim nv As String 'Dim zadnja As Boolean Dim zacetek As Label 'Form1.MousePointer = vbHourglass resitev = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) dolzina = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) drevo = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) drevesa = Array(drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo, drevo) j = 1 drevesa(j)(1) = 1 drevesa(j)(2) = zacvoz stdreves = 1 istodrevo = True 'zadnja = False neses = 0 'Debug.Print vozpovmat(1, 1) zacetek: neses = neses + 1 ' do katerih vozlov tece povezavaobs = False If drevesa(j)(1) > 0 Then tmp = drevesa(j)(drevesa(j)(1) + 1) istodrevo = True For i = 1 To ds.RowCount If vozpovmat(i, tmp) = -1 Then ' ce sem tu not je i vozlisce s katerim je povezava povezavaobs = True If istodrevo Then drevesa(j)(1) = drevesa(j)(1) + 1 drevesa(j)(drevesa(j)(1) + 1) = ds(i, "dovozla") istodrevo = False 'zadnja = True Else ' tu naredim novo drevo 'zadnja = False stdreves = stdreves + 1 ' prepisem staro For ii = 1 To drevesa(j)(1) drevesa(stdreves)(ii) = drevesa(j)(ii) Next drevesa(stdreves)(drevesa(stdreves)(1) + 1) = ds(i, "dovozla") End If 'istodrevo End If 'matrika Next 'i End If ' drevo se ni reseno oziroma izpeljano do konca ' tu imam nekaj novih dreves ' ali smo prisli kje do konca? For k = 1 To stdreves If drevesa(k)(1) > 0 Then If drevesa(k)(drevesa(k)(1) + 1) = konvoz Then stresitev = stresitev + 1 resitev(stresitev) = k drevesa(k)(1) = -drevesa(k)(1) istodrevo = True If k = j Then j = j + 1 povezavaobs = True ' da ga naslednji if ne poveca se enkrat End If 'k=j End If 'eureka End If Next 'k ' samo ena povezava 'If zadnja = True Then ' j = j + 1 ' istodrevo = True ' End If If povezavaobs = False Then ' prisli smo do konca drevesa If drevesa(j)(1) > 0 Then drevesa(j)(1) = 0 If j < stdreves Then j = j + 1 istodrevo = True End If End If ' ali so vsa drevesa izpeljana do konca konec = True For k = 1 To stdreves If drevesa(k)(1) > 0 Then konec = False End If Next 'Debug.Print stdreves, j, drevesa(j)(1) If neses > 50 Then konec = True If konec = False Then GoTo zacetek 'izracunaj dolzine resitev For k = 1 To stresitev For i = 2 To -drevesa(resitev(k))(1) tmp = drevesa(resitev(k))(i) tmp1 = drevesa(resitev(k))(i + 1) dolzina(k) = dolzina(k) + dol(tmp, tmp1) Next Next ' izberi najkrajso resitev dolmin = 1000000 najkrajsa = 0 For k = 1 To stresitev If dolzina(k) < dolmin Then dolmin = dolzina(k) najkrajsa = k End If Next ' selectiraj najkrajso l.Selection.ClearSelection 'For k = 1 To stresitev For i = 2 To -drevesa(resitev(najkrajsa))(1) tmp = drevesa(resitev(najkrajsa))(i) tmp1 = drevesa(resitev(najkrajsa))(i + 1) l.Selection.SelectByID voz2pov(tmp, tmp1), miSelectionAppend Next 'Next 'izpis nv = Chr(13) + Chr(10) 'Debug.Print "Stevilo resitev", stresitev, "najk", najkrajsa formrepmintree.Text1 = "Stevilo resitev=" + Str(stresitev) + nv + "Najkrajša=" + Str(najkrajsa) For k = 1 To stresitev 'Debug.Print "-" + "resitev :", k, "dolzina", dolzina(k) formrepmintree.Text1 = formrepmintree.Text1 + nv + nv + "Resitev :" + Str(k) + nv + "Dolzina=" + Str(dolzina(k)) + " m." + nv For i = 2 To -drevesa(resitev(k))(1) + 1 'Debug.Print drevesa(resitev(k))(i) formrepmintree.Text1 = formrepmintree.Text1 + Str(drevesa(resitev(k))(i)) Next Next formMinDre.MousePointer = vbDefault formrepmintree.Caption = "Rezultati izračuna minimalnega drevesa" formrepmintree.Show vbModal End Sub ---------------------------------------------------------------------- To unsubscribe from this list, send e-mail to [EMAIL PROTECTED] and put "unsubscribe MAPINFO-L" in the message body, or contact [EMAIL PROTECTED] ---------------------------------------------------------------------- To unsubscribe from this list, send e-mail to [EMAIL PROTECTED] and put "unsubscribe MAPINFO-L" in the message body, or contact [EMAIL PROTECTED]
