利用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