天涯之外

导航

已知经纬度求距离的函数

这个是已知两点求距离的,你看看有没有帮助

希望对你有点帮助! 
  '---------------------------------------------------------------------- 
  '已知经纬度求距离的函数 
  '---------------------------------------------------------------------- 
  Function  Countdistance(ByVal  lon1  As  Double,  ByVal  lat1  As  Double,  ByVal  lon2  As  Double,  ByVal  lat2  As  Double)  As  Double 
  Dim  d  As  Double 
  Dim  a1,  a2,  b1,  b2  As  Double 
  a1  =  lat1  *  0.0174532925194 
  a2  =  lat2  *  0.0174532925194 
  b1  =  lon1  *  0.0174532925194 
  b2  =  lon2  *  0.0174532925194 
  Countdistance  =  ArcCos(Math.Cos(a1)  *  Math.Cos(a2)  *  Math.Cos(b1)  *  Math.Cos(b2)  +  Math.Cos(a1)  *  Math.Sin(b1)  *  Math.Cos(a2)  *  Math.Sin(b2)  +  Math.Sin(a1)  *  Math.Sin(a2))  *  6371 
   
  End  Function 
   
  Public  Function  ArcCos(ByVal  X  As  Double)  As  Double 
  If  CStr(X)  =  "1"  Then 
        ArcCos  =  0 
        Exit  Function 
  ElseIf  CStr(X)  =  "-1"  Then 
        ArcCos  =  3.14159265358979 
        Exit  Function 
  Else 
        ArcCos  =  Atn(-X  /  Sqr(-X  *  X  +  1))  +  2  *  Atn(1) 
  End  If 
  End  Function

posted on 2009-03-01 02:03  天涯之外  阅读(808)  评论(0编辑  收藏  举报