Hi Isaac
John is right - you are returning Null for aCos(1), when in fact you should
return zero.
FWIW, here is my aCos function:
Public Function aCos(x As Double) As Double
If Abs(x) < 1 Then
aCos = (pi / 2) - Atn(x / Sqr(1 - x * x))
ElseIf x = 1 Then
aCos = 0
ElseIf x = -1 Then
aCos = pi
Else
Err.Raise 5, "aCos", "aCos argument must be between -1 and 1"
End If
End Function
However, I think the problem is that you are passing a value outside the
range [-1..1]. I can't see how this could happen, because
Abs(Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) *
Cos(deg2rad(lat2)) * Cos(deg2rad(lon1 - lon2)))
should always be <=1.
Here is my Distance function. It is very similar to yours, but does the
calculations based on kilometres:
Public Function Distance( _
ByVal lat1 As Double, _
ByVal lon1 As Double, _
ByVal lat2 As Double, _
ByVal lon2 As Double, _
Optional unit As String = "km") As Double
' assumes spherical earth
' based on Spherical Cosines algorithm described here:
' http://en.wikipedia.org/wiki/Great-circle_distance
' latitude-longitude are degrees with fractions expressed as decimals
' unit beginning with "m" = miles; "n" = nautical miles; otherwise
kilometres
Const Radius As Double = 6372.8 ' earth's root mean square radius in
kilometres
Dim Arc As Double
If (lat1 = lat2) And (lon1 = lon2) Then
Distance = 0
Exit Function
End If
lat1 = DegToRad(lat1)
lon1 = DegToRad(lon1)
lat2 = DegToRad(lat2)
lon2 = DegToRad(lon2)
Arc = aCos((Sin(lat1) * Sin(lat2)) + _
(Cos(lat1) * Cos(lat2) * Cos(lon1 - lon2)))
Distance = Arc * Radius
Select Case Left(unit, 1)
Case "m": Distance = Distance * 0.621371 ' miles
Case "n": Distance = Distance * 0.5399 ' nautical miles
' Case Else 'kilometres
End Select
Distance = Round(Distance, 2)
End Function
Both my function and yours give very similar results, and I cannot make
either fail. Could you please post some sample arguments that cause yours
to break?
Best wishes,
Graham
> From: MS_Access_Professionals@yahoogroups.com
[mailto:MS_Access_Professionals@yahoogroups.com] On Behalf Of Crystal
> Sent: Wednesday, 1 February 2012 11:56
> To: MS_Access_Professionals@yahoogroups.com
> Subject: Re: [MS_AccessPros] Error received in VBA calculation of distance
between geo coordinates
>
>
> Hi Isaac,
>
> you can put this statement in your code:
> '~~~~~~~~~~~~~~~
> Stop
> '~~~~~~~~~~~~~~~
>
> then press F8 to step through the code one line at a time.
>
> press CTRL-G to turn on the Immediate window. to find out a value of a
variable, type this:
> ? MyVariablename
> and press ENTER
>
> when you want to execute the next line of code, if you are in the
Immediate window, click on the titlebar for the code windows and press F8
>
> as you probably realize, we can't travel as the crow flies so calculating
ditance from coordinates won't really be how far you have to go ;)
>
> If you do not figure out the problem, Please post the code that is doing
the calculations
>
> Warm Regards,
> Crystal
>
> Microsoft MVP
> remote programming and training
>
> Access Basics by Crystal
> http://www.AccessMVP.com/strive4peace
> Free 100-page book that covers essentials in Access
>
> *
> (: have an awesome day :)
> *
>
> ________________________________
> From: Isaac
> Subject: [MS_AccessPros] Error received in VBA calculation of distance
between geo coordinates
>
> Pros: I know this is a shot in the dark, but my math skills are just not
up to debugging this function. Thank you in advance for any
thoughts/comments/suggestions:
>
> We have a database of property locations which are geocoded and when a
property is selected, one of the things the database does is it provides a
list of neighboring properties, sorted by distance. Occasionally the
database will throw an error: "Run-time error '5': Invalid procedure call or
argument".
>
> I choose to debug and it takes me to the function below (I used
apostrophes to break out the function where the error is)
>
> I know it is a mathematical error in that my function is generating a
value that is out of range, but I can't figure out why one property (one set
of coordinates) throws the error and why another does not.
>
> For example a property with the coordinates of 40.9454923 , -72.8867217
throws the error while 40.9567969 , -72.9755829 does not. I can't figure out
how to do the math in my head. I know there is a way to let the VBA editor
go through the code step by step and display the values in the immediate
window, but I can't get it to go through all the steps.
>
> Thanks,
>
> Isaac Richter
>
> ______________________________________
>
> Option Compare Database
> Option Explicit
>
> ' This routine calculates the distance between two points (given the
latitude/longitude of those points). It is being
> 'used to calculate distance between two ZIP Codes or Postal Codes
>
> 'Definitions
> ' South latitudes are negative, east longitudes are positive
>
> 'Passed to function
> 'lat1, lon1 = Latitude and Longitude of point 1 (in decimal degrees)
> 'lat2, lon2 = Latitude and Longitude of point 2 (in decimal degrees)
> 'unit = the unit you desire for results where 'M' is statute miles
(default)
> ' 'K' is kilometers
> ' 'N' is nautical miles
>
> Const pi = 3.14159265358979
> Global PropertyLat
> Global PropertyLong
> Public lngMap As Long
> Global lngComparablesDistance As Long
>
> Function Distance(lat1, lon1, lat2, lon2, unit)
> Dim theta, dist
> theta = lon1 - lon2
> dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) *
Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
> dist = acos(dist)
> dist = rad2deg(dist)
> Distance = dist * 60 * 1.1515
> Select Case UCase(unit)
> Case "K"
> Distance = Distance * 1.609344
> Case "N"
> Distance = Distance * 0.8684
> End Select
> End Function
>
> *****************************
> Below this is where the error is
> *****************************
>
> ' This function get the arccos function from arctan function
> '
> Function acos(Rad)
> If Abs(Rad) <> 1 Then
> acos = pi / 2 - Atn(Rad / Sqr(1 - Rad * Rad))
> ElseIf Rad = -1 Then
> acos = pi
> End If
> End Function
>
> *****************************
> Above this is where the error is
> *****************************
>
> ' This function converts decimal degrees to radians
> '
> Function deg2rad(Deg)
> deg2rad = CDbl(Deg * pi / 180)
> End Function
> ' This function converts radians to decimal degrees
> '
> Function rad2deg(Rad)
> rad2deg = CDbl(Rad * 180 / pi)
> End Function
>
> 'Demo
> 'response.Write distance(32.9697, -96.80322, 29.46786, -98.53506, "M") & "
Miles<br>"
> 'response.Write distance(32.9697, -96.80322, 29.46786, -98.53506, "K") & "
Kilometers<br>"
> 'response.Write distance(32.9697, -96.80322, 29.46786, -98.53506, "N") & "
Nautical Miles<br>"
>
> Function GetDistance(Latitude, Longitude)
>
> If ((Not IsNull(PropertyLat)) And (Not IsNull(PropertyLong))) Then
> GetDistance = Distance(PropertyLat, PropertyLong, Latitude,
Longitude, "M")
> End If
>
> End Function
Tidak ada komentar:
Posting Komentar