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
  • Last Modified:

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
Asked:
catalini
  • 7
  • 5
  • 2
2 Solutions
 
cataliniAuthor 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
 
rockiroadsCommented:
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
 
rockiroadsCommented:
oops, atan2 line needs redoing, forgot that one
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
cataliniAuthor Commented:
thanks... what do you mean with redoing?
0
 
rockiroadsCommented:
forgot to paste the constant defintion for pi

add this to the top of your module

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
' Retourne l'ArcTangente basé sur les coordonnées de X et Y
' 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
 
cataliniAuthor Commented:
thanks a lot... i will try it very soon... if i have problems i will tell you! :-))))
0
 
rockiroadsCommented:
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
 
rockiroadsCommented:
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
 
cataliniAuthor Commented:
great!
0
 
harfangCommented:
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
 
harfangCommented:
Hello rockiroads,

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)

And this in the address bar of your browser:

    javascript: alert(Math.atan2(1,10)+'\n'+Math.atan2(10,1))
    javascript: alert(Math.atan2(10,12))  // to compare with 0.876058051

But you were fast... as usual

(°v°)
0
 
rockiroadsCommented:
Catalini, Ive got a rogue statement

Sqr


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


0
 
rockiroadsCommented:
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
 
cataliniAuthor Commented:
thanks to both of you!!!!!
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

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