两点坐标间距离的算法以及验证【转】
看了通过两个点的经纬度计算距离这篇,据说是Google里扒来的算法,于是决定验证一下。
东改西改改成了个VB的代码,通过计算发现非常正确。
用30,120和31,121两个坐标点进行验证,同Mapinfo中计算的结果非常的相近。
后来又把坐标系直接当成直角坐标系来计算,发现误差很大。
于是仍然用直角坐标系方法来计算,给纬度加上了个0.86的参数,这样计算下来和结果相近。
不上传文件了,直接贴代码了。代码如下:(五个TEXT,三个Button)
Const EARTH_RADIUS = 6378.137
Const Pi = 3.1415926535898
Function rad(ByVal d As Double) As Double
rad = d * Pi / 180
End Function
Function GetDistance(lat1 As Double, lng1 As Double, lat2 As Double, lng2 As Double) As Double
Dim radlat1 As Double, radlat2 As Double
Dim a As Double, b As Double, s As Double, Temp As Double
radlat1 = rad(lat1)
radlat2 = rad(lat2)
a = radlat1 - radlat2
b = rad(lng1) - rad(lng2)
Temp = Sqr(Sin(a / 2) ^ 2 + Cos(radlat1) * Cos(radlat2) * Sin(b / 2) ^ 2)
s = 2 * Atn(Temp / Sqr(-Temp * Temp + 1)) '没有反正弦函数,网上找了个
s = s * EARTH_RADIUS
GetDistance = s
End Function
Private Sub Command1_Click()
Text5.Text = Str(GetDistance(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text), Val(Text4.Text)))
End Sub
Private Sub Command2_Click()
Text5.Text = Str((Sqr((Val(Text3.Text) - Val(Text1.Text)) ^ 2 + (Val(Text4.Text) - Val(Text2.Text)) ^ 2)) * 111.3199338)
End Sub
Private Sub Command3_Click()
Text5.Text = Str((Sqr((Val(Text3.Text) * 0.86 - Val(Text1.Text) * 0.86) ^ 2 + (Val(Text4.Text) - Val(Text2.Text)) ^ 2)) * 111.3199338)
End Sub
东改西改改成了个VB的代码,通过计算发现非常正确。
用30,120和31,121两个坐标点进行验证,同Mapinfo中计算的结果非常的相近。
后来又把坐标系直接当成直角坐标系来计算,发现误差很大。
于是仍然用直角坐标系方法来计算,给纬度加上了个0.86的参数,这样计算下来和结果相近。
不上传文件了,直接贴代码了。代码如下:(五个TEXT,三个Button)
Const EARTH_RADIUS = 6378.137
Const Pi = 3.1415926535898
Function rad(ByVal d As Double) As Double
rad = d * Pi / 180
End Function
Function GetDistance(lat1 As Double, lng1 As Double, lat2 As Double, lng2 As Double) As Double
Dim radlat1 As Double, radlat2 As Double
Dim a As Double, b As Double, s As Double, Temp As Double
radlat1 = rad(lat1)
radlat2 = rad(lat2)
a = radlat1 - radlat2
b = rad(lng1) - rad(lng2)
Temp = Sqr(Sin(a / 2) ^ 2 + Cos(radlat1) * Cos(radlat2) * Sin(b / 2) ^ 2)
s = 2 * Atn(Temp / Sqr(-Temp * Temp + 1)) '没有反正弦函数,网上找了个
s = s * EARTH_RADIUS
GetDistance = s
End Function
Private Sub Command1_Click()
Text5.Text = Str(GetDistance(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text), Val(Text4.Text)))
End Sub
Private Sub Command2_Click()
Text5.Text = Str((Sqr((Val(Text3.Text) - Val(Text1.Text)) ^ 2 + (Val(Text4.Text) - Val(Text2.Text)) ^ 2)) * 111.3199338)
End Sub
Private Sub Command3_Click()
Text5.Text = Str((Sqr((Val(Text3.Text) * 0.86 - Val(Text1.Text) * 0.86) ^ 2 + (Val(Text4.Text) - Val(Text2.Text)) ^ 2)) * 111.3199338)
End Sub