Distance Between 2 Points On Earth
Wie weit ist es von Mettmann nach Düsseldorf, oder von Mettmann nach Frankfurt ? Früher gab es mal so kleine Geräte, mit denen man in einer Karte die Entfernung zwischen zwei Städten dadurch bestimmen konnte, daÃ? man mit diesem Gerät die Strecke zwischen Start- und Zielort entlangfuhr. Die Entfernung lieÃ? sich dann auf einer analogen Scala ablesen; vorausgesetzt, man hatte den MaÃ?stab der verwendeten Karte richtig eingestellt.
Heute in digitalen Zeitalter stehen dazu weit bessere, genauere Methoden zur Verfügung. GPS z.B. ist eine davon. Viele Autos ( meines nicht ) haben bereits ein solches System eingebaut. Man kann Start- und Endpunkt eingeben und erfährt sogleich neben anderen Informationen die exakte zurückzulegende Strecke; auf den Meter genau (?).
Wie aber kann man auch Lotus Notes dazu bewegen, die Entfernung zwischen zwei Staedten zu berechnen ?
Im deutschen Notes Forum wurde diese Frage gestellt. Allerdings wurde hier nach einer Funktion gefragt, die z.B. Filialen in einem vorgegebenen Umkreis zum Standort anzeigt / auflistet.
Ich möchte mich hier zunächst einmal darauf beschränken, eine Funktion vorzustellen, die es ermöglicht, auf Grundlage vorgegebenen Ortskoordinaten die Entfernung zwischen zwei Orten zu berechnen.
die Originalformel von http://www.gumo.de/ ( Visual Basic-Funktion zur Berechnung der Entfernung zwischen zwei Punkten auf der Erdoberfläche ) habe ich nach Lotus Script portiert.
Die Koordinaten müssen folgendermaÃ?en aufgebaut sein:
Mettmann 06E59 51N15
das bedeutet Mettmann liegt 51°15’00″Nord und 06°59’00″Ost.
Die Koordinaten habe ich einer Auflistung entnommen, die unter http://www.themamundi.de/aws/tabel/tbmain.htm zu finden ist. Es werden gröÃ?tenteils die Sekunden bei den Koordinaten weggelassen; die Formel kann aber auch mit Koordinaten der Form 06E5922 51N1501 rechnen.
Hier ein Beispiel zum Funktionsaufruf.
Sub Click(Source As Button)
'Mettmann 06E59 51N15
'Düsseldorf 06E47 51N14
Msgbox dblDistanceBetween2PointsOnEarth ( "51N15" , "06E59" , "51N14 " , "06E47" )
End Sub
Function dblDistanceBetween2PointsOnEarth( c1N As String, c1E As String, c2N As String, c2E As String ) As Double
'Die Funktion liefert die Entfernung zweier Punkte auf der Erdoberfl?che in km.
'Das Verfahren ber?cksichtigt die Erdabplattung und ist auch für sehr kleine Entfernungen genau.
'Keine Ber?cksichtigung der Höhe ?ber N.N.!
'Quelle: Jean Meeus - Astronomische Algorithmen (Auflage 1992, Verlag Johann Ambrosius Barth), Seite 93f, 118ff '
Dim phi1_rad As Double
Dim lambda1_rad As Double
Dim phi2_rad As Double
Dim lambda2_rad As Double
Dim F As Double
Dim sinF2 As Double
Dim cosF2 As Double
Dim G As Double
Dim sinG2 As Double
Dim cosG2 As Double
Dim dl As Double
Dim s As Double
Dim C As Double
Dim om As Double
Dim R As Double
Dim cosD As Double
Dim D As Double
Dim H1 As Double
Dim H2 As Double
Dim DEG As String
Dim MMSS As String
'Needed constants Const
Const RADIAN = Pi / 180
' mittlerer Erdradius in km
Const MEAN_RADIUS = 6371.299
' Abplattung der Erde
Const FLATTENING_FACTOR = 1 / 298.257
' Ã?quatoradius in km
Const EQUATOR_RADIUS = 6378.14
'Convert to radians
MMSS= atWord (c1N,"N",2)
DEG = atWord (c1N,"N",1)
If Len (MMSS) = 4 Then
phi1_rad = (DEG + (Left$(MMSS,2) / 60) + (Right$(MMSS,2) / 3600)) * RADIAN
Else
phi1_rad = (DEG + (MMSS / 60)) *RADIAN
End If
MMSS= atWord (c1E,"E",2)
DEG = atWord (c1E,"E",1)
If Len (MMSS) = 4 Then
lambda1_rad = (DEG + (Left$(MMSS,2) / 60) + (Right$(MMSS,2) / 3600)) * RADIAN
Else
lambda1_rad = (DEG + (MMSS / 60)) * RADIAN
End If
MMSS= atWord (c2E,"E",2)
DEG = atWord (c2E,"E",1)
If Len (MMSS) = 4 Then
lambda2_rad = (DEG + (Left$(MMSS,2) / 60) + (Right$(MMSS,2) / 3600)) * RADIAN
Else
lambda2_rad = (DEG + (MMSS / 60)) * RADIAN
End If
MMSS= atWord (c2N,"N",2)
DEG = atWord (c2N,"N",1)
If Len (MMSS) = 4 Then
phi2_rad = (DEG + (Left$(MMSS,2) / 60) + (Right$(MMSS,2) / 3600)) * RADIAN
Else
phi2_rad = (DEG + (MMSS / 60)) * RADIAN
End If
'Check on precise calculation
cosD = Sin(phi1_rad) * Sin(phi2_rad) + Cos(phi1_rad) * Cos(phi2_rad) * Cos(lambda1_rad - lambda2_rad)
If cosD < 0.999995 Then'Distance is long
F = (phi1_rad + phi2_rad) / 2
sinF2 = (Sin(F)) ^ 2
cosF2 = (Cos(F)) ^ 2
G = (phi1_rad - phi2_rad) / 2
sinG2 = (Sin(G)) ^ 2
cosG2 = (Cos(G)) ^ 2
dl = (lambda1_rad - lambda2_rad) / 2
s = sinG2 * (Cos(dl)) ^ 2 + cosF2 * (Sin(dl)) ^ 2
C = cosG2 * (Cos(dl)) ^ 2 + sinF2 * (Sin(dl)) ^ 2
om = Atn(Sqr(s / C))
R = Sqr(s * C) / om
H1 = (3 * R - 1) / (2 * C)
H2 = (3 * R + 1) / (2 * s)
dblDistanceBetween2PointsOnEarth = 2 * om * EQUATOR_RADIUS *_
(1+ FLATTENING_FACTOR * H1 * sinF2 * cosG2 - FLATTENING_FACTOR * H2 * cosF2 * sinG2 )
Else 'Distance is short
dblDistanceBetween2PointsOnEarth = Sqr(((lambda2_rad - lambda1_rad) *_
Cos((phi1_rad + phi2_rad) / 2)) ^ 2 + (phi2_rad - phi1_rad) ^ 2) * MEAN_RADIUS
End If
End Function
Diese Formel gilt für Erdkoordinaten auf der nördlichen Erdhalbkugel und Werte die östlich von Greenwich liegen. Also Erdkoordinaten mit einem N und O. Die gleiche Formel kann man auch für alle anderen Koordianten benutzen, man muÃ? nur bei Süd- und Westwerten jeweils ein Minus davorstellen. Also S und W Werte mit -1 multiplizieren! Zum Splitten der Koordinatendaten wird die Funktion atWord verwendet. atWord ist das Lotus Script Ã?quivalent zu @Word
Function atWord ( sourceString As String, separator As String, number As Integer ) As String
searchString$=SourceString & separator
' add one separator to catch also the last substring
For i% = 1 To number
pos%=Instr(searchString$, separator)
If pos%=0 Then
Exit For
substring$=Left(searchString$,pos%-1)
searchString$=Mid(searchString$, pos%+1)
Next
If pos% > 0 Then
atWord=substring$
Else
atWord=""
End If
End Function