【源码】球面距离公式计算给定两点的距离

Forcast

      在业务上经常需要计算2个地点的距离，如台风路径预报误差。两点之间的距离实际上是球面距离，参考了网上搜索后，编写了VB源程序，供大家参考。yry,2012.5 Haikou，以下是我的新浪博客相关内容：

http://blog.sina.com.cn/s/blog_0347471501014zu8.html

1. Const EARTH_RADIUS = 6378.137
   
2. Const pi = 3.1415926535898
   
3. Public IS_stationP As Boolean
   
4. 
   
5. Private Sub Command1_Click()
   
6. Dim lon1 As Double, lon2 As Double, lat1 As Double, lat2 As Double
   
7. lon1 = Val(Text1)
   
8. lat1 = Val(Text2)
   
9. lon2 = Val(Text3)
   
10. lat2 = Val(Text4)
    
11. Lab_距离.Caption = "近似距离: " & Format(GetDistance(lat1, lon1, lat2, lon2), "####.0") & " 公里"
    
12. End Sub
    
13. 
    
14. Function rad(ByVal d As Double) As Double
    
15. rad = d * pi / 180
    
16. End Function
    
17. 
    
18. '知道两点经纬度，求近似距离
    
19. Public Function GetDistance(lat1 As Double, lng1 As Double, lat2 As Double, lng2 As Double) As Double
    
20. Dim radlat1 As Double, radlat2 As Double
    
21. Dim a As Double, b As Double, s As Double, Temp As Double
    
22. radlat1 = rad(lat1)
    
23. radlat2 = rad(lat2)
    
24. a = radlat1 - radlat2
    
25. b = rad(lng1) - rad(lng2)
    
26. Temp = Sqr(Sin(a / 2) ^ 2 + Cos(radlat1) * Cos(radlat2) * Sin(b / 2) ^ 2)
    
27. s = 2 * Atn(Temp / Sqr(-Temp * Temp + 1))     '没有反正弦函数，网上找了个
    
28. s = s * EARTH_RADIUS
    
29. GetDistance = s
    
30. End Function

Const EARTH_RADIUS = 6378.137<br /> Const pi = 3.1415926535898<br /> Public IS_stationP As Boolean<br /> <br /> Private Sub Command1_Click()<br /> Dim lon1 As Double, lon2 As Double, lat1 As Double, lat2 As Double<br /> lon1 = Val(Text1)<br /> lat1 = Val(Text2)<br /> lon2 = Val(Text3)<br /> lat2 = Val(Text4)<br /> Lab_距离.Caption = "近似距离: " & Format(GetDistance(lat1, lon1, lat2, lon2), "####.0") & " 公里"<br /> End Sub<br /> <br /> Function rad(ByVal d As Double) As Double<br /> rad = d * pi / 180<br /> End Function<br /> <br /> '知道两点经纬度，求近似距离<br /> Public Function GetDistance(lat1 As Double, lng1 As Double, lat2 As Double, lng2 As Double) As Double<br /> Dim radlat1 As Double, radlat2 As Double<br /> Dim a As Double, b As Double, s As Double, Temp As Double<br /> radlat1 = rad(lat1)<br /> radlat2 = rad(lat2)<br /> a = radlat1 - radlat2<br /> b = rad(lng1) - rad(lng2)<br /> Temp = Sqr(Sin(a / 2) ^ 2 + Cos(radlat1) * Cos(radlat2) * Sin(b / 2) ^ 2)<br /> s = 2 * Atn(Temp / Sqr(-Temp * Temp + 1))     '没有反正弦函数，网上找了个<br /> s = s * EARTH_RADIUS<br /> GetDistance = s<br /> End Function

mofangbao

支持啦，记得以前那个气象计算器里面也有个这个功能，谢谢分享源码！

梨花

好，我也觉得好

flyingbird2008

，学习啦！

天山雪

好像不对   

若当块

感谢分享。。。

SEAMAN

不对  这个

『轩雨』

学习，学习。希望能看懂代码

tibetafa

这个和micaps上的功能相似。。