Advertisement
Guest User

Untitled

a guest
Nov 26th, 2015
104
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Private Const C_RADIUS_EARTH_KM As Double = 6370.97327862
  2. Private Const C_RADIUS_EARTH_MI As Double = 3958.73926185
  3. Private Const C_PI As Double = 3.14159265358979
  4.  
  5. Function GreatCircleDistance(Latitude1 As Double, Longitude1 As Double, _
  6.             Latitude2 As Double, Longitude2 As Double, _
  7.             ValuesAsDecimalDegrees As Boolean, _
  8.             ResultAsMiles As Boolean) As Double
  9.  
  10. Dim Lat1 As Double
  11. Dim Lat2 As Double
  12. Dim Long1 As Double
  13. Dim Long2 As Double
  14. Dim X As Long
  15. Dim Delta As Double
  16.  
  17. If ValuesAsDecimalDegrees = True Then
  18.     X = 1
  19. Else
  20.     X = 24
  21. End If
  22.  
  23. ' convert to decimal degrees
  24. Lat1 = Latitude1 * X
  25. Long1 = Longitude1 * X
  26. Lat2 = Latitude2 * X
  27. Long2 = Longitude2 * X
  28.  
  29. ' convert to radians: radians = (degrees/180) * PI
  30. Lat1 = (Lat1 / 180) * C_PI
  31. Lat2 = (Lat2 / 180) * C_PI
  32. Long1 = (Long1 / 180) * C_PI
  33. Long2 = (Long2 / 180) * C_PI
  34.  
  35. ' get the central spherical angle
  36. Delta = ((2 * ArcSin(Sqr((Sin((Lat1 - Lat2) / 2) ^ 2) + _
  37.     Cos(Lat1) * Cos(Lat2) * (Sin((Long1 - Long2) / 2) ^ 2)))))
  38.    
  39. If ResultAsMiles = True Then
  40.     GreatCircleDistance = Delta * C_RADIUS_EARTH_MI
  41. Else
  42.     GreatCircleDistance = Delta * C_RADIUS_EARTH_KM
  43. End If
  44.  
  45. End Function
  46.  
  47. Function ArcSin(X As Double) As Double
  48.     ' VBA doesn't have an ArcSin function. Improvise.
  49.    ArcSin = Atn(X / Sqr(-X * X + 1))
  50. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement