ich glaube, du hast mich falsch verstanden: das war ein in weiten Teilen funktionierender (noch anzupassender) Lösungsvorschlag!
Du scheinst eine fertige Datei haben zu wollen. Das ist normalerweise nicht so meine Freude beim Helfen, aber ich hatte gerade nochmal Zeit und irgendwie finde ich die Fragestellung (in Teilen) auch interessant.
Wenn man die Erde als eine Kugel annimmt (weißt du, welchen Radius ich da annehmen sollte?), dann sind die Berechnungen (abgesehen von den Polen/Equator 0° Länge und 180° Länge) wirklich für 99% aller Fälle äußerst simpel:
bzw. Ankerkettenlänge bzw. Projektion dieser auf die Wasseroberfläche ...
Das könnte man auch gut und einfach mit Formeln in Excel umsetzen. Vielleicht hilft dir jemand dabei - ich habe da keinen Spaß dran.
Ich habe gerade einige Fehler meines Lösungsvorschlags ausgemerzt und das ganze in Funktionen verpackt, sodass du es vom Tabellenblatt mit einer Formel aufrufen kannst. Dabei habe ich sowohl einen Vorschlag für die Näherung der Erde als Kugel, als auch einen für die Erde als Parallelellipsoid.
. Du rufst sie mit folgenden Parametern auf:
Dabei wird muss die Distanz in Meter angegeben sein.
Die Breite und Länge müssen als Dezimalzahl (Dezimalgrad) angegeben werden.
Code:
Option Explicit
Function udf_ankerkreis_kugel(ByVal Distanz As Double, B As Double, L As Double, Optional Dezimalgrad As Boolean = False)
'Distanz - [m]
'B - geogr. Breite [Dezimalgrad] mit Vorzeichen! -90° <= B <= 90°
'L - geogr. Länge [Dezimalgrad] mit Vorzeichen! -180° <= L <= 180°
'
'Dezimalgrad - False: N 53° 54' 34,999992'' E 20° 54' 27''
' True: N 53,90972222 E 20,9075
Dim R As Double, PI As Double
Dim nb As Double, nl As Double, sb As Double, sl As Double, ol As Double, wl As Double
Dim result(1 To 4, 1 To 1) As Variant
PI = 4 * Atn(1)
Distanz = Abs(Distanz) ' es wird ausschließlich Distanz > 0 akzeptiert!
R = (6378137 + 6356752.3142) / 2 ' angenommenr Radius der Erde (Radien aus WSG84)
nb = B + (Distanz / R) / PI * 180 ' nördl. Breite
nl = L ' nördl. Länge
sb = B - (Distanz / R) / PI * 180 ' südl. Breite
sl = L ' südl. Länge
ol = L + (Distanz / R) / PI * 180 ' östl. Länge
wl = L - (Distanz / R) / PI * 180 ' westl. Länge
If ol > 180 Then ol = ol - 360 ' 0 <= Länge <= 180
If wl < -180 Then wl = wl + 360 '-180 <= Länge <= 0
If nb > 90 Then ' nb !> 90
nb = 180 - nb
nl = (180 - Abs(nl)) * Sgn(nl) * (-1) ' wenn nb>90 => Länge ändert sich!
End If
If sb < -90 Then
sb = -180 - sb
sl = (180 - Abs(sl)) * Sgn(sl) * (-1)
End If
result(1, 1) = geographischeNotation(nb, nl, Dezimalgrad)
result(2, 1) = geographischeNotation(B, ol, Dezimalgrad)
result(3, 1) = geographischeNotation(sb, sl, Dezimalgrad)
result(4, 1) = geographischeNotation(B, wl, Dezimalgrad)
udf_ankerkreis_kugel = result
End Function
Function udf_ankerkreis_ellipsoid(Distanz As Double, B As Double, L As Double, Optional Dezimalgrad As Boolean = False)
'Distanz - [m]
'B - geogr. Breite [Dezimalgrad] mit Vorzeichen! -90° <= B <= 90°
'L - geogr. Länge [Dezimalgrad] mit Vorzeichen! -180° <= L <= 180°
Dim nb As Double, nl As Double, wl As Double, ol As Double, sb As Double, sl As Double
Dim PI As Double, t As Double, t1 As Double, result(1 To 4, 1 To 1) As Variant
PI = 4 * Atn(1)
'Konstanten des Referenzellipsoids WGS84 (siehe: https://de.wikipedia.org/wiki/Referenzellipsoid)
Const r1 As Double = 6378137 'groß e Halbachse [m]
Const r2 As Double = 6356752.3142 'kleine Halbachse [m]
't der Parameterdarstellung der Ellipse eines Längengrades x=r1*cos(t), y=r2*sin(t)
t = Parameter_T_aus_Breite(B, r1, r2) ' -PI <= t <= PI
ol = L + (Distanz / (r1 * Cos(t))) * 180 / PI 'östliche Länge
wl = L - (Distanz / (r1 * Cos(t))) * 180 / PI 'westliche Länge
t1 = Punkt_auf_Ellipse_In_Entfernung(t, r1, r2, Distanz, True)
nb = Atn((r2 * Sin(t1)) / (r1 * Cos(t1))) / PI * 180 'nördliche Breite
t1 = Punkt_auf_Ellipse_In_Entfernung(t, r1, r2, Distanz, False)
sb = Atn((r2 * Sin(t1)) / (r1 * Cos(t1))) / PI * 180 'südliche Breite
If ol > 180 Then ol = ol - 360
If wl < -180 Then wl = wl + 360
If nb > 90 Then
nb = 180 - nb
nl = (180 - Abs(nl)) * Sgn(nl) * (-1)
End If
If sb < -90 Then
sb = -180 - sb
sl = (180 - Abs(sl)) * Sgn(sl) * (-1)
End If
result(1, 1) = geographischeNotation(nb, L, Dezimalgrad)
result(2, 1) = geographischeNotation(B, ol, Dezimalgrad)
result(3, 1) = geographischeNotation(sb, L, Dezimalgrad)
result(4, 1) = geographischeNotation(B, wl, Dezimalgrad)
udf_ankerkreis_ellipsoid = result
End Function
Sub Punkte_im_Norden_Osten_Sueden_Westen()
Dim L As Double, B As Double 'Länge, Breite [Dezimalgrad]
Dim Distanz As Double 'in [m]
' (nl,nb)
' (wl,wb) (L,B) (ol,ob)
' (sl,sb)
Dim nl As Double, nb As Double, wl As Double, wb As Double
Dim ol As Double, ob As Double, sl As Double, sb As Double
Dim PI As Double, t As Double, t1 As Double
PI = 4 * Atn(1)
'Position
B = Tabelle1.[B7] '70 '53.90972222 'Breite [Dezimalgrad]
L = Tabelle1.[H7] '20.9075 'Länge [Dezimalgrad]
'Distanz auf der Erdoberfläche in [m]
Distanz = Tabelle1.[B9]
'Konstanten des Referenzellipsoids. Ich tippe mal auf WGS84 (siehe: https://de.wikipedia.org/wiki/Referenzellipsoid)
Const r1 As Double = 6378137 'groß e Halbachse [m]
Const r2 As Double = 6356752.3142 'kleine Halbachse [m]
t = Parameter_T_aus_Breite(B, r1, r2) 't der Parameterdarstellung der Ellipse eines Längengrades x=r1*cos(t), y=r2*sin(t)
'Punkt im Osten:
ob = B
ol = L + (Distanz / (r1 * Cos(t))) * 180 / PI
If ol > 180 Then ol = ol - 360
'Punkt im Westen:
wb = B
wl = L - (Distanz / (r1 * Cos(t))) * 180 / PI
If wl < -180 Then wl = wl + 360
'Punkt im Norden (Näherung mit Sekante)
t1 = Punkt_auf_Ellipse_In_Entfernung(t, r1, r2, Distanz, True)
nb = Atn((r2 * Sin(t1)) / (r1 * Cos(t1))) / PI * 180 * IIf(t1 > PI / 2, -1, 1)
nl = IIf(t1 > PI / 2, (180 - Abs(L)) * Sgn(L) * (-1), L)
'Punkt im Süden (Näherung mit Sekante)
t1 = Punkt_auf_Ellipse_In_Entfernung(t, r1, r2, Distanz, False)
sb = Atn((r2 * Sin(t1)) / (r1 * Cos(t1))) / PI * 180
sl = L
Dim Dezimalgrad As Boolean
Dezimalgrad = False
Debug.Print "Ankerpunkt: ", B, L, geographischeNotation(B, L, Dezimalgrad)
Debug.Print "Norden ", nb, nl, geographischeNotation(nb, nl, Dezimalgrad)
Debug.Print "Osten ", ob, ol, geographischeNotation(ob, ol, Dezimalgrad)
Debug.Print "Süden ", sb, sl, geographischeNotation(sb, sl, Dezimalgrad)
Debug.Print "Westen ", wb, wl, geographischeNotation(wb, wl, Dezimalgrad)
End Sub
Private Function Parameter_T_aus_Breite(phi As Double, r1 As Double, r2 As Double) As Double
'phi - geogr. Breite [Grad] bzw. [Dezimalgrad]
'die Parametergleichung einer Elipse lautet x = r1*cos(t), y = r2*sin(t) mit -pi <= t <= pi
'die Funktion gibt den Parameter t zurück, der den Winkel phi = arctan(y/x) repräsentiert.
'Der Rückgabewert der Funktion liegt immer zwischen -pi/2 und pi/2
Dim PI As Double, t As Double, dt As Double, x As Double, y As Double, B As Double, phi_ As Double
Dim LoopCounter As Long
PI = 4 * Atn(1)
B = Abs(phi) / 180 * PI 'abs(Breite im Bogenmaß)
t = 0
dt = PI / 10
Do
LoopCounter = LoopCounter + 1
t = t + dt
x = r1 * Cos(t)
y = r2 * Sin(t)
phi_ = Atn(y / x)
If Abs(phi_ - B) < 0.000000001 Then Exit Do
If phi_ > B Then
t = t - dt
dt = dt / 2
End If
If LoopCounter > 100000 Then
MsgBox "Probleme mit der Iteration"
Stop
End If
Loop
' Debug.Print "Iterationsschritte zur Ermittlung von t: ", LoopCounter
Parameter_T_aus_Breite = t * Sgn(phi)
End Function
Private Function Punkt_auf_Ellipse_In_Entfernung(t As Double, r1 As Double, r2 As Double, _
Distanz As Double, Optional nachNorden As Boolean = True) As Double
't, r1, r2 repräsentieren einen Punkt x=r1*cos(t), y=r2*sin(t) auf einer Ellipse
'die Funktion gibt den Parameter t2 zurück, der einen Punkt auf der Ellipse repräsentiert, der
' in der Entfernung Distanz entfernt liegt.
Dim t1 As Double, dt As Double, x As Double, y As Double, x1 As Double, y1 As Double, s As Double, PI As Double
Dim LoopCounter As Long
PI = 4 * Atn(1)
t1 = t
dt = PI * Distanz / ((r1 + r2) / 2) * IIf(nachNorden, 1, -1)
x = r1 * Cos(t): y = r2 * Sin(t)
Do
LoopCounter = LoopCounter + 1
t1 = t1 + dt
x1 = r1 * Cos(t1): y1 = r2 * Sin(t1)
s = Sqr((x - x1) ^ 2 + (y - y1) ^ 2) 'Länge des Sekantenabschnitts
If Abs(s - Distanz) < Distanz / 500 Then Exit Do
If s > Distanz Then
t1 = t1 - dt
dt = dt / 2
End If
If LoopCounter > 100000 Then
MsgBox "Probleme mit der Iteration"
Stop
End If
Loop
' Debug.Print "LoopCounter " & IIf(nachNorden, "Norden: ", "Süden: "), LoopCounter
Punkt_auf_Ellipse_In_Entfernung = t1
End Function
Function geographischeNotation(Breite As Double, Lange As Double, Optional Dezimalgrad As Boolean = False)
'Dezimalgrad => N xx° xx' xx'' E xx° xx' xx''
Dim grad As Integer, min As Integer, sek As Double, resString As String
If Not Dezimalgrad Then
grad = Int(Breite)
min = Int((Breite - grad) * 60)
sek = (Breite - grad - min / 60) * 3600
resString = IIf(Breite > 0, "N ", "S ") & Abs(grad) & "° " & min & "' " & Round(sek, 6) & "'' "
grad = Int(Abs(Lange))
min = Int((Abs(Lange) - grad) * 60)
sek = (Abs(Lange) - grad - min / 60) * 3600
resString = resString & IIf(Lange > 0, "E ", "W ") & grad & "° " & min & "' " & Round(sek, 6) & "''"
geographischeNotation = resString
Else
geographischeNotation = IIf(Breite > 0, "N ", "S ") & Abs(Breite) & " " & IIf(Lange > 0, "E ", "W ") & Abs(Lange)
End If
End Function
PS: mein im Post #12 geposteter Code enthält Denkfehler - ich kann ihn leider nicht mehr editieren.