Entfernung zweier PLZ in km berechnen

  • VB.NET

Es gibt 51 Antworten in diesem Thema. Der letzte Beitrag () ist von toeller.

    Entfernung zweier PLZ in km berechnen

    Hallo Zusammen,

    wir bräuchten für unsere Kalkulation eine Entfernungsberechnung von einer bestimmten PLZ nach allen PLZ in Deutschland. z.B. Entfernung von München - Berlin, München - Hamburg, München - Dortmund usw.

    Immer von der gleichen PLZ aus an alle PLZ in Deutschland.

    Ich wollte als Basis diesen Code hier aus einem anderen Forum verwenden.

    VB.NET-Quellcode

    1. ' Bestimmung der Entfernung zwischen Orten
    2. Public Function getDistance(theMap As String, _
    3. Optional plz1 As String = "", Optional plz2 As String = "", _
    4. Optional ort1 As String = "", Optional ort2 As String = "", _
    5. Optional land1 As String = "", Optional land2 As String = "")
    6. Dim IEApp As Object Dim IEDocument As Object Dim strURL As String
    7. Dim Entfernung As String Dim von As String Dim nach As String
    8. Dim sa As Variant Dim se As Variant Dim strTeile As Variant Dim i As Long
    9. Dim f As Long ' IE-Instanz erstellen
    10. Set IEApp = CreateObject("InternetExplorer.Application") With IEApp
    11. ' IE-Fenster unsichtbar lassen .Visible = False ' von PLZ, Ort, Land
    12. von = plz1 & IIf(Len(ort1) > 0, "," & ort1, "") & IIf(Len(land1) > 0, "," & land1, "")
    13. ' nach PLZ, Ort, Land
    14. nach = plz2 & IIf(Len(ort2) > 0, "," & ort2, "") & IIf(Len(land2) > 0, "," & land2, "")
    15. ' URL aufrufen If theMap = "Google" Then ' Google-Maps
    16. .Navigate "http://maps.google.de/maps?f=d&hl=de&saddr=" & von & "&daddr=" & _
    17. nach & "&output=html" Else ' Microsoft-Maps
    18. .Navigate "http://maps.msn.de/(drkyj4nqdtrplraqamd5lf55)/directionsfind.aspx"
    19. End If ' Warten, bis Seite geladen Do: Loop Until .Busy = False
    20. Do: Loop Until .Busy = False While IEApp.Busy: Wend ' IE-Dokument
    21. Set IEDocument = .Document End With With IEDocument
    22. ' Warten, bis fertig angezeigt Do: Loop Until .readyState <> 4
    23. If theMap <> "Google" Then sa = Split(von, ","): se = Split(nach, ",")
    24. 'PLZ in die Dokument-Felder eintragen
    25. .getElementById("RouteControl_StartZipText").Value = sa(0)
    26. .getElementById("RouteControl_EndZipText").Value = se(0)
    27. ' Ort in die Dokument-Felder eintragen
    28. If Len(ort1) > 0 Then .getElementById("RouteControl_StartCityText").Value = sa(1)
    29. If Len(ort2) > 0 Then .getElementById("RouteControl_EndCityText").Value = se(1)
    30. ' Berechnung klicken .All.RouteControl_AmbiguousButton.Click
    31. End If End With ' Warten... Do DoEvents
    32. Loop Until IEDocument.readyState <> 4
    33. ' Inhalt des Webseiten-Dokuments auslesen und in Zeilen aufplitten
    34. strTeile = Split(IEDocument.Body.innerText, vbCrLf) If theMap = "Google" Then
    35. For i = LBound(strTeile) To UBound(strTeile)
    36. If InStr(1, strTeile(i), "Fahrt:", vbTextCompare) > 0 Then
    37. Entfernung = Trim(Replace(strTeile(i), "Fahrt:", ""))
    38. f = InStr(Entfernung, " km") Entfernung = Left(Entfernung, f - 1)
    39. Exit For End If Next i Else
    40. For i = LBound(strTeile) To UBound(strTeile)
    41. If InStr(1, strTeile(i), "Entfernung:", vbTextCompare) > 0 Then
    42. Entfernung = Replace(Replace(strTeile(i), "Gesamtentfernung: ", ""), _
    43. " Kilometer", "") Exit For End If Next i End If
    44. Entfernung = Replace(Entfernung, ",", ".")
    45. If theMap <> "Google" Then IEApp.Quit ' Objekte zerstören
    46. Set IEDocument = Nothing Set IEApp = Nothing ' Rückgabewert (KM-Entfernung)
    47. getDistance = EntfernungEnd Function
    48. PrivateSub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
    49. Dim km AsString
    50. km = getDistance("Google", "97708", "Bad Bocklet", "97702")
    51. If Len(km) > 0 Then
    52. MsgBox("Die Entfernung beträgt " & km & " km")
    53. MsgBox("Entfernung konnte nicht ermittelt werden!", vbExclamation)
    54. EndIf
    55. EndSub




    Dieser funktioniert leider nicht. Hat jemand eine Idee oder hat schon mal jemand sowas gebraucht?

    Ich habe sowas in PHP mal gemacht, da gibts auch ziemlich einfache Tutorials und Codes zu, basierend auf einer GeoCoords Datenbank. Wenn etwas mit PHP auskennst oder eben allgemein gute Programmierkenntnisse hast, solltest keine Mühe haben den PHP Code in VB umzusetzten, sind eigentlich nur paar mathematische Operationen und SQL Abfragen die du eigentlich 1zu1 übernehmen kannst wenn dir eine SQL Tabelle einrichtest.

    kurztutorial.info/php5/spezial…fernung/PLZEntfernung.php

    toeller schrieb:

    von einer bestimmten PLZ nach allen PLZ in Deutschland.
    Luftlinie?
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Ich bräuchte eigentlich die Entfernung in km von A nach B über die Straße, also nicht Luftlinie.

    Ich habe im Internet noch einen meiner Meinung nach guten Code gefunden.

    VB.NET-Quellcode

    1. Public Class MapService
    3. ''' <summary>
    4. ''' Ermittelt über Google-Maps die KM-Entfernung zweier Orte
    5. ''' </summary>
    6. ''' <param name="source">Ausgangsort</param>
    7. ''' <param name="destination">Zielort</param>
    8. ''' <returns>KM-Entfernung</returns>
    9. Public Shared Function GetKMDistance(ByVal source As String, _
    10. ByVal destination As String) As Integer
    12. Dim response As String = (New WebClient).DownloadString( _
    13. String.Format("http://maps.google.de/maps?f=d&hl=de&saddr={0}&daddr={1}&output=html", _
    14. source, destination))
    16. ' innerhalb des Response-Wertes nach folgendem String suchen
    17. ' Fahrt:</td><td align="right" nowrap class="timedist ul">
    18. ' <div class="noprint"><div>136 km
    19. Dim pattern As String = "Fahrt:\D+(\d+).+?km"
    20. Dim match = Regex.Match(response, pattern)
    21. If Not match.Success OrElse match.Groups.Count < 2 Then
    22. Throw New Exception("Anfrage bei GoogleMaps fehlgeschlagen!")
    23. Else
    24. Return Integer.Parse(match.Groups(1).Value)
    25. End If
    26. End Function
    28. End Class


    Aufruf:

    VB.NET-Quellcode

    1. Dim KM As Integer
    2. KM = MapService.GetKMDistance("86517", "Leipzig")
    3. MsgBox("Die Entfernung beträgt " & KM.ToString() & " KM")



    Es kommt jedoch mit diesem Code immer der Fehler "Anfrage bei Googlemaps fehlgeschlagen"

    Kannst Du den Aufruf iwie im IE oder FF oder so nachvollziehen?
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Snaptu schrieb:

    In deinem Code steht nirgends ein Abfahrtsort.


    Das übergibt er als Parameter an die Funktion:

    toeller schrieb:


    VB.NET-Quellcode

    1. Public Shared Function GetKMDistance(ByVal source As String, _ ByVal destination As String) As Integer
    2. Dim response As String = (New WebClient).DownloadString( _
    3. String.Format("http://maps.google.de/maps?f=d&hl=de&saddr={0}&daddr={1}&output=html",
    4. _ source, destination))


    @TE
    Es scheint, dass der Link von GoogleMaps falsch zusammengestellt wird, vielleicht wurde es seit dem Posten von diesem Code geändert.

    toeller schrieb:

    Wie kann ich da den richtigen rausbekommen?
    Genau das war damit gemeint. :D

    RodFromGermany schrieb:

    Kannst Du den Aufruf iwie im IE oder FF oder so nachvollziehen?
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Ich bin mit Regex noch nicht so warm, habs mir aber trotzdem mal angeguckt und wie es aussieht hat sich die Seite geändert, seit dein Code geschrieben wurde.
    Das ist auch der große Nachteil wenn man Daten direkt aus Websites ausliest: Es besteht immer die Gefahr, dass gar nichts mehr funktioniert...

    Mit dieser Klasse sollte das ganze eigentlich funktionieren. Ich hab einfach Regex durch einen dicken Block aus Stringfunktionen ersetzt (Ich sollte Regex lernen ;))
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class MapService
    3. ''' <summary>
    4. ''' Ermittelt über Google-Maps die KM-Entfernung zweier Orte
    5. ''' </summary>
    6. ''' <param name="source">Ausgangsort</param>
    7. ''' <param name="destination">Zielort</param>
    8. ''' <returns>KM-Entfernung</returns>
    9. Public Shared Function GetKMDistance(ByVal source As String, _
    10. ByVal destination As String) As Integer
    12. Dim response As String = (New WebClient).DownloadString( _
    13. String.Format("http://maps.google.de/maps?f=d&hl=de&saddr={0}&daddr={1}&output=html", _
    14. source, destination))
    15. 'File.WriteAllText(Environment.GetFolderPath(Environment.SpecialFolder.Desktop) + "\respons.txt", response)
    17. 'Als erstes der Index von dem hier: altroute-rcol altroute-info
    18. 'Dann brauchen wir den Index von dem hier: <span>
    19. Dim FirstIndex As Integer = response.IndexOf("altroute-rcol altroute-info")
    20. Dim SecondIndex As Integer = response.IndexOf("<span>", FirstIndex)
    21. Dim ThirdIndex As Integer = response.IndexOf("km", SecondIndex)
    22. 'Zwischen dem zweiten und dem dritten Index stehen jetzt die gesuchten Kilometer
    23. Dim Kilometers As String = response.Substring(SecondIndex, ThirdIndex - SecondIndex)
    24. 'An dieser Stelle ist die Ausgabe sowas wie "<span>xxx", wobei xxx gesucht ist
    25. Kilometers = Kilometers.Replace("<span>", "")
    26. Return Integer.Parse(Kilometers)
    27. End Function
    29. End Class


    EDIT: Nimm lieber die Lösung von EDR, deutlich kürzer und funktioniert genauso gut

Facebook
Telefonspende