利用Google Directions API (Google Map) http://code.google.com/intl/zh-CN/apis/maps/documentation/directions/
和VB.net 输入目的地(支持中文地址、经纬度等)计算出距离。
如:输入 北京|上海|天津
运行程序 会计算从A地出发依次到北京、上海、天津 三地的总距离,可选择是否包含返回的距离(天津到A地的距离)。
如果需要线路优化 可以参照API 介绍中的 optimize:true。开启后会自动安排路线。

已经在VB.net 2003 通过测试。

做的着急有些地方直接复制的,代码没有优化,有些重复,但不影响最终使用。

'需要以下命名空间
Imports System.web
Imports System.Xml
Imports System.IO

'需要声明的变量
Dim gstrPatch As String = "C:\XXX\map.xml"

    Private Sub btnCalc_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCalc.Click
     '判断输入的目的地是否为空。
        If txtROAD_ROUTE.Text = "" Then Exit Sub

        Try

          If MsgBox("路程距离数据会受到网络、关键字的影响,可能与实际距离相差很大,仅供参考。", MsgBoxStyle.YesNo, "系统提示") = MsgBoxResult.No Then Exit Sub
  
          Dim arrROAD As String()
          Dim strWaypoints As String  
          Dim i As Integer = 0
  
          arrROAD = txtROAD_ROUTE.Text.Split("|")
          Dim arrCalc(arrROAD.Length - 1) As String
      '对搜索的目的地编码
          For t As Integer = 0 To arrROAD.Length - 1
              arrROAD(t) = HttpUtility.UrlEncode(arrROAD(t), System.Text.Encoding.UTF8)  
          Next
         
      '编码重组
          For t As Integer = 0 To arrROAD.Length - 2
              If strWaypoints = "" Then
                  strWaypoints = arrROAD(t)
              Else
                  strWaypoints = strWaypoints & "|" & arrROAD(t)
              End If
          Next
         
      '39.049435,121.782503 为出发地 经纬度,可以替换成路名、地名等,注意中文请注意转码。
          Dim strURL As String
          strURL = "<a href="http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination">http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination</a>=" & arrROAD(arrROAD.Length - 1) & _
                  "&waypoints=" & strWaypoints & _
                  "&sensor=false"
  
          Dim myWebClient As New System.Net.WebClient
          'myWebClient.DownloadFile("<a href="http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination">http://maps.google.com/maps/api/directions/xml?origin=39.049435,121.782503&destination</a>=" & strdifang & "&waypoints=&sensor=false", "C:\msdn.xml")
          myWebClient.DownloadFile(strURL, gstrPatch)
  
          Dim xmlDoc As New XmlDocument
          Dim XmlFileName As String = gstrPatch
  
          If File.Exists(XmlFileName) Then
              xmlDoc.Load(XmlFileName)
              Dim nodeList As XmlNodeList = xmlDoc.SelectSingleNode("DirectionsResponse").ChildNodes
              Dim xn1 As XmlNode
              Dim xn2 As XmlNode
              Dim xn3 As XmlNode
                  For Each xn1 In nodeList
                      For Each xn2 In xn1
                          For Each xn3 In xn2
                              If xn3.Name = "distance" Then
                                  arrCalc(i) = xn3.ChildNodes.Item(1).InnerText
                                  i = i + 1
                              End If
                          Next
                      Next
                  Next
          End If
  
          Dim douKM As Double
          Dim strLast As String
  
          If MsgBox("是否计算往返路程?", MsgBoxStyle.YesNo, "系统提示") = MsgBoxResult.Yes Then
              strURL = "<a href="http://maps.google.com/maps/api/directions/xml?origin">http://maps.google.com/maps/api/directions/xml?origin</a>=" & arrROAD(arrROAD.Length - 1) & "&destination=39.049435,121.782503" & _
                       "&sensor=false"
              myWebClient.DownloadFile(strURL, gstrPatch)
              '*计算
  
              Dim xmlDoc2 As New XmlDocument
              Dim XmlFileName2 As String = gstrPatch
  
              If File.Exists(XmlFileName2) Then
                  xmlDoc2.Load(XmlFileName2)
                  Dim nodeList As XmlNodeList = xmlDoc2.SelectSingleNode("DirectionsResponse").ChildNodes
                  Dim xn12 As XmlNode
                  Dim xn22 As XmlNode
                  Dim xn32 As XmlNode
                      For Each xn12 In nodeList
                          For Each xn22 In xn12
                              For Each xn32 In xn22
                                  If xn32.Name = "distance" Then
                                      strLast = xn32.ChildNodes.Item(1).InnerText
                                  End If
                              Next
                          Next
                      Next
              End If
  
              For r As Integer = 0 To arrCalc.Length - 1
                  douKM = douKM + CType(Replace(arrCalc(r), " km", ""), Double)
              Next
  
              douKM = douKM + CType(Replace(strLast, " km", ""), Double)
          Else
              For r As Integer = 0 To arrCalc.Length - 1
                  douKM = douKM + CType(Replace(arrCalc(r), " km", ""), Double)
              Next
          End If
      '显示距离 KM 单位
          txtDISTANCE.Text = douKM

        Catch ex As Exception
            MsgBox("获取距离数据失败。")
        End Try

    End Sub

分类:

.NET,

最后更新: 7 1 月, 2014

标签:

,