愛(ài)華網(wǎng)在業(yè)務(wù)上經(jīng)常需要計(jì)算2個(gè)地點(diǎn)的距離，如臺(tái)風(fēng)路徑預(yù)報(bào)誤差。兩點(diǎn)之間的距離實(shí)際上是球面距離，參考了網(wǎng)上搜索后，編寫(xiě)了VB源程序，供大家參考。yry,2012.5Haikou
Const EARTH_RADIUS = 6378.137
Const pi = 3.1415926535898
Public IS_stationP As Boolean
Private Sub Command1_Click()
Dim lon1 As Double, lon2 As Double, lat1 As Double, lat2 AsDouble
lon1 = Val(Text1)
lat1 = Val(Text2)
lon2 = Val(Text3)
lat2 = Val(Text4)
Lab_距離.Caption = "近似距離: " &Format(GetDistance(lat1, lon1, lat2, lon2), "####.0")& " 公里"
End Sub
Function rad(ByVal d As Double) As Double
rad = d * pi / 180
End Function
'知道兩點(diǎn)經(jīng)緯度，求近似距離
Public Function GetDistance(lat1 As Double, lng1 As Double, lat2 AsDouble, 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))'沒(méi)有反正弦函數(shù)，網(wǎng)上找了個(gè)
s = s * EARTH_RADIUS
GetDistance = s
End Function
愛(ài)華網(wǎng)本文地址 » http://www.klfzs.com/a/25101014/211512.html
