By Crystal Long
The shortest distance between 2 points is a straight line. Here is a function to do that. It does not take curvature or routes into account.
GetDistance Function for VBA
Function GetDistance(pLat1 As Double, pLng1 As Double _
, pLat2 As Double, pLng2 As Double _
, Optional pWhich As Integer = 1 _
) As Double
'12-13-08, 12-22
' calculates distance between 2 points of Latitude and Longitude
' in Statute Miles, Kilometers, or Nautical Miles
' crystal strive4peac2012 at yahoo.com
' http://www.rogersaccesslibrary.com/forum/topic604_post622.html#622
'PARAMETERS
' pLat1 is Latitude of the first point in decimal degrees
' pLng1 is Longitude of the first point in decimal degrees
' pLat2 is Latitude of the second point in decimal degrees
' pLng2 is Longitude of the second point in decimal degrees
On Error Resume Next
Dim EarthRadius As Double
Select Case pWhich
Case 2:
EarthRadius = 6378.7
Case 3:
EarthRadius = 3437.74677
Case Else
EarthRadius = 3963
End Select
' Radius of Earth:
' 1 3963.0 (statute miles)
' 2 6378.7 (kilometers)
' 3 3437.74677 (nautical miles)
' to convert degrees to radians, divide by 180/pi, which is 57.2958
GetDistance = 0
Dim X As Double
X = (Sin(pLat1 / 57.2958) * Sin(pLat2 / 57.2958)) _
+ (Cos(pLat1 / 57.2958) * Cos(pLat2 / 57.2958) * Cos(pLng2 / 57.2958 - pLng1 / 57.2958))
GetDistance = EarthRadius * Atn(Sqr(1 - X ^ 2) / X)
End Function
You can find this sample here: http://rogersaccesslibrary.com/forum/getdistance-function-for-latitudes-and-longitudes_topic604.html
No comments:
Post a Comment