Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 1170

# convert simple function to vba

Hi! I have this function... i need to use it in a ms access module...

can you help me? thanks

---------------------------------------------------------------------------------------
// lat1, lon1 double Latitude / Longitude of point 1(decimal degrees)
// lat2, lon2 double Latitude / Longitude of point 2 (decimal degrees)
// units char S-Statute Miles; N-Nautical Miles; K-Kilometers

#define pi 3.14159265358979323846

double DistLatLong(double lat1, double lon1, double lat2, double lon2, char units) {

double dlon, dlat;
dlon = lon2 - lon1;
dlat = lat2 - lat1;
a = (sin(dlat/2))^2 + cos(lat1) * cos(lat2) * (sin(dlon/2))^2;
c = 2 * atan2( sqrt(a), sqrt(1-a) );

// R (Earth Radius) = 3956.0 mi = 3437.7 nm = 6367.0 km

switch(units)
{
case 'S': // STATUTE MILES
R = 3956.0;
break;
case 'N': // NAUTICAL
R = 3437.7;
break;
case 'K': // KILOMETERS
R = 6367.0;
break;
}

return (R * c);
}
0
catalini
• 7
• 5
• 2
2 Solutions

Author Commented:
i've found also this SQL version... is there any way to use it in a ms access query?

CREATE FUNCTION DistLatLong (@lat1 float, @lon1 float, @lat2 float, @lon2 float)
RETURNS float
AS
BEGIN
-- Parameters in RADIANS, result in statute miles
DECLARE @dlon float, @dlat float, @a float, @c float
SET @dlon = @lon2 - @lon1 SET @dlat = @lat2 - @lat1
SET @a = POWER(SIN(@dlat / 2.0), 2.0) +
COS(@lat1) * COS(@lat2) * POWER(SIN(@dlon / 2.0), 2.0)
SET @c = 2.0 * ATN2(SQRT(@a), SQRT(1.0 - @a))
RETURN 3956.0 * @c
END
GO
CREATE FUNCTION dms2rad (@deg int, @min int, @sec float)
RETURNS float
AS
BEGIN
RETURN RADIANS(CONVERT(float, @deg) + CONVERT(float, @min)/60.0 + @sec/3600.0)
END
0

Commented:
try this

Public Function DistLatLong(ByVal lat1 As Double, _
ByVal lon1 As Double, _
ByVal lat2 As Double, _
ByVal lon2 As Double, _
ByVal units As String) As Double

Dim dlon, dlat As Double
Dim a As Double
Dim c As Double
Dim R As Double

dlon = lon2 - lon1
dlat = lat2 - lat1

a = (Sin(dlat / 2)) ^ 2 + Cos(lat1) * Cos(lat2) * (Sin(dlon / 2)) ^ 2
c = 2 * atan2(Sqr(a), Sqr(1 - a))

Sqr
'R (Earth Radius) = 3956.0 mi = 3437.7 nm = 6367.0 km

Select Case units
Case "S" 'STATUE MILES
R = 3956
Case "N"    ' NAUTICAL
R = 3437.7
Case "K" 'KILOMETERS
R = 6367
End Select

DistLatLong = R * c

End Function
0

Commented:
oops, atan2 line needs redoing, forgot that one
0

Author Commented:
thanks... what do you mean with redoing?
0

Commented:
forgot to paste the constant defintion for pi

Const pi = 3.14159265358979

now, here is a function for atan2, I picked it up from the web. The above code was quite easy to do except for atan2 as I didnt know how the calculations work.

So I hope this works for you

Function ATan2(X As Double, Y As Double) As Double
' Si X et Y sont tous deux Ã  zÃ©ro une erreur se produit.
' La valeur de l'axe des X est supposÃ©e Ãªtre +0, allant dans le sens positif dans la direction
' opposÃ©e aux aiguilles d'une montre, et dans le sens nÃ©gatif dans le sens des aiguilles d'une montre.
If X = 0 Then
If Y = 0 Then
ATan2 = 1 / 0
ElseIf Y > 0 Then
ATan2 = pi / 2
Else
ATan2 = -pi / 2
End If
ElseIf X > 0 Then
If Y = 0 Then
ATan2 = 0
Else
ATan2 = Atn(Y / X)
End If
Else
If Y = 0 Then
ATan2 = pi
Else
ATan2 = (pi - Atn(Abs(Y) / Abs(X))) * Sgn(Y)
End If
End If
End Function

0

Author Commented:
thanks a lot... i will try it very soon... if i have problems i will tell you! :-))))
0

Commented:
here is the site that I got atan2 from

http://mypage.bluewin.ch/w.stucki/Programmes.htm

So I dont know what value it returns to your C code.

The code has been converted, u can compare the two and easily spot the comparisons/differences

0

Commented:
To prove whether that atan2 function worked, I checked in Excel

atan2 works in Excel so I did

=atan2(10,12)

this set the cell value to be 0.876058051

Now I called the atan2 function provided, and it returned 0.876058050598193

so pretty close, dont u think
0

Author Commented:
great!
0

Commented:
Hello catalini

Took me a while, because ATan2 is not a standard function in VB... Here we go:

------------------------------------------------------------------------------->8----
Option Explicit

Const PI = 3.14159265358979
Const D2R = PI / 180#

Function ATan2(Y As Double, X As Double) As Double
'
' Returns the ArcTangent based on X and Y coordinates
' If both X and Y are zero an error will occur.
'
' The positive X axis is assumed to be 0, going poistive in the
' counterclockwise direction, and negative in the clockwise direction.
'
If X = 0 Then
If Y = 0 Then
ATan2 = 1 / 0
ElseIf Y > 0 Then
ATan2 = PI / 2
Else
ATan2 = -PI / 2
End If
ElseIf X > 0 Then
If Y = 0 Then
ATan2 = 0
Else
ATan2 = Atn(Y / X)
End If
Else
If Y = 0 Then
ATan2 = PI
Else
ATan2 = (PI - Atn(Abs(Y) / Abs(X))) * Sgn(Y)
End If
End If
End Function

Function DistLatLong( _
Lat1 As Double, Lon1 As Double, _
Lat2 As Double, Lon2 As Double, _
units As String) As Double
'
' Retruns the "great circle distance" between two points given by
' their latitudes and logitudes, in decimal degrees.
' units is a single char to choose the unit: 'S', 'N' or 'K'
'
Dim dlon As Double, dlat As Double
Dim a As Double, C As Double, R As Double

Lat1 = Lat1 * D2R
Lon1 = Lon1 * D2R
Lat2 = Lat2 * D2R
Lon2 = Lon2 * D2R

dlon = Lon2 - Lon1
dlat = Lat2 - Lat1
a = Sin(dlat / 2) ^ 2 + Cos(Lat1) * Cos(Lat2) * Sin(dlon / 2) ^ 2
C = 2 * ATan2(Sqr(a), Sqr(1 - a))

' R (Earth Radius) = 3956.0 mi = 3437.7 nm = 6367.0 km
Select Case units
Case "S":    R = 3956#   ' STATUTE MILES
Case "N":    R = 3437.7  ' NAUTICAL
Case "K":    R = 6367#   ' KILOMETERS
Case Else:   R = 1
End Select

DistLatLong = (R * C)

End Function
------------------------------------------------------------------------------->8----

Whatever you do, check out the function and compare results with:
http://www.movable-type.co.uk/scripts/LatLong.html

Cheers!
(Â°vÂ°)
0

Commented:

We found the same ATan2 function, but you forgot to reverse the arguments. Microsoft ATan2 is not the same as atan2 in the rest of the computing world, don't ask me why...

Try this in VB:

? Excel.WorksheetFunction.Atan2(1,10)

javascript: alert(Math.atan2(10,12))  // to compare with 0.876058051

But you were fast... as usual

(Â°vÂ°)
0

Commented:
Catalini, Ive got a rogue statement

Sqr

its just above the comment for 'R (Earth Radius)

0

Commented:
Hi Harfang,

yes, the atan2 functions are the same, and my test comparison was in excel. I didnt have any other tools

see my previous post about the test that I did

Anyway, Catalini will soon find out if it works or not and possibly where its failing so that it can be corrected

0

Author Commented:
thanks to both of you!!!!!
0

## Featured Post

• 7
• 5
• 2
Tackle projects and never again get stuck behind a technical roadblock.