Zurück zur Homepage

Gauss-Krüger nach Grad.
Berechnungen an Ellipsen

 Beispieldatei (GaussEllipse.zip 33 kB)  

Ich stand vor der Aufgabe, Gauss-Krüger Koordinaten in Grad umzurechnen. Nachdem ich erst einmal herausgefunden hatte, was es mit diesen Koordinaten auf sich hat (Wikipedia), machte ich mich auf die Suche nach einer VBA-Funktion. Leider ohne Erfolg ;-(

Also musste ich mir die Funktionen zur Umrechnung selber schreiben. Die nun vorliegenden sind das Ergebnis umfangreicher Recherchen und funktionieren recht gut.
 

 

Public Function Längengrad(Hochwert As Double, Rechtswert As DoubleAs Double
Dim dblRechts     As Double
Dim dblSektor     As Double
Dim dblÄquator    As Double
Dim dblPolar      As Double
Dim dblE          As Double
Dim dblN          As Double
Dim dblAlpha      As Double
Dim dblBeta       As Double
Dim dblGamma      As Double
Dim dblDelta      As Double
Dim dblEpsilon    As Double
Dim dblY0         As Double
Dim dblL0         As Double
Dim dblY          As Double

Dim dblBNull      As Double
Dim dblBf         As Double

Dim dblNf         As Double
Dim dblEf         As Double
Dim dblTf         As Double

Dim adblB(1 To 2) As Double
Dim adblL(1 To 2) As Double
Dim dblBreite     As Double
Dim dblLänge      As Double

Dim Pi            As Double

Pi = 3.14159265358979

dblÄquator = 6377397.155
dblPolar = 6356078.962
dblE = (dblÄquator ^ 2 - dblPolar ^ 2) / dblÄquator ^ 2
dblN = (dblÄquator - dblPolar) / (dblÄquator + dblPolar)
dblAlpha = (dblÄquator + dblPolar) / 2 * (1 + 0.25 * dblN ^ 2 + (1 / 64) * dblN ^ 4)
dblBeta = (3 / 2) * dblN - (27 / 32) * dblN ^ 3 + (269 / 512) * dblN ^ 5
dblGamma = (21 / 16) * dblN ^ 2 - (55 / 32) * dblN ^ 4
dblDelta = (151 / 96) * dblN ^ 3 - (417 / 128) * dblN ^ 5
dblEpsilon = (1097 / 512) * dblN ^ 4

dblY0 = Int(Rechtswert / 10 ^ 6)
dblL0 = dblY0 * 3
dblY = Rechtswert - dblY0 * 10 ^ 6 - 500000
dblBNull = Hochwert / dblAlpha
dblBf = dblBNull + dblBeta * Sin(2 * dblBNull) + _
   dblGamma * Sin(4 * dblBNull) + _
   dblDelta * Sin(6 * dblBNull) + _
   dblEpsilon * Sin(8 * dblBNull)

dblNf = dblÄquator / (1 - dblE * Sin(dblBf) ^ 2) ^ 0.5
dblEf = (dblÄquator ^ 2 / dblPolar ^ 2 * dblE * Cos(dblBf) ^ 2) ^ 0.5
dblTf = Tan(dblBf)

adblB(1) = dblTf / 2 / dblNf ^ 2 * (-1 - dblEf ^ 2) * dblY ^ 2
adblB(2) = dblTf / 24 / dblNf ^ 4 * (5 + 3 * dblTf ^ 2 + _
   6 * dblEf ^ 2 - 6 * dblTf ^ 2 * dblEf ^ 2 - 4 * dblEf ^ 4 - _
   9 * dblTf ^ 2 * dblEf ^ 4) * dblY ^ 4
dblBreite = (dblBf + adblB(1) + adblB(2)) * 180 / Pi

adblL(1) = 1 / dblNf / Cos(dblBf) * dblY
adblL(2) = 1 / 6 / dblNf ^ 3 / Cos(dblBf) * _
   (-1 - 2 * dblTf ^ 2 - dblEf ^ 2) * dblY ^ 3
   
dblLänge = dblL0 + (adblL(1) + adblL(2)) * 180 / Pi

Längengrad = dblLänge
End Function

Public Function Breitengrad(Hochwert As Double, Rechtswert As DoubleAs Double
Dim dblRechts     As Double
Dim dblSektor     As Double
Dim dblÄquator    As Double
Dim dblPolar      As Double
Dim dblE          As Double
Dim dblN          As Double
Dim dblAlpha      As Double
Dim dblBeta       As Double
Dim dblGamma      As Double
Dim dblDelta      As Double
Dim dblEpsilon    As Double
Dim dblY0         As Double
Dim dblL0         As Double
Dim dblY          As Double

Dim dblBNull      As Double
Dim dblBf         As Double

Dim dblNf         As Double
Dim dblEf         As Double
Dim dblTf         As Double

Dim adblB(1 To 2) As Double
Dim adblL(1 To 2) As Double
Dim dblBreite     As Double
Dim dblLänge      As Double

Dim Pi            As Double

Pi = 3.14159265358979

dblÄquator = 6377397.155
dblPolar = 6356078.962
dblE = (dblÄquator ^ 2 - dblPolar ^ 2) / dblÄquator ^ 2
dblN = (dblÄquator - dblPolar) / (dblÄquator + dblPolar)
dblAlpha = (dblÄquator + dblPolar) / 2 * (1 + 0.25 * dblN ^ 2 + (1 / 64) * dblN ^ 4)
dblBeta = (3 / 2) * dblN - (27 / 32) * dblN ^ 3 + (269 / 512) * dblN ^ 5
dblGamma = (21 / 16) * dblN ^ 2 - (55 / 32) * dblN ^ 4
dblDelta = (151 / 96) * dblN ^ 3 - (417 / 128) * dblN ^ 5
dblEpsilon = (1097 / 512) * dblN ^ 4

dblY0 = Int(Rechtswert / 10 ^ 6)
dblL0 = dblY0 * 3
dblY = Rechtswert - dblY0 * 10 ^ 6 - 500000
dblBNull = Hochwert / dblAlpha
dblBf = dblBNull + dblBeta * Sin(2 * dblBNull) + _
   dblGamma * Sin(4 * dblBNull) + _
   dblDelta * Sin(6 * dblBNull) + _
   dblEpsilon * Sin(8 * dblBNull)

dblNf = dblÄquator / (1 - dblE * Sin(dblBf) ^ 2) ^ 0.5
dblEf = (dblÄquator ^ 2 / dblPolar ^ 2 * dblE * Cos(dblBf) ^ 2) ^ 0.5
dblTf = Tan(dblBf)

adblB(1) = dblTf / 2 / dblNf ^ 2 * (-1 - dblEf ^ 2) * dblY ^ 2
adblB(2) = dblTf / 24 / dblNf ^ 4 * (5 + 3 * dblTf ^ 2 + _
   6 * dblEf ^ 2 - 6 * dblTf ^ 2 * dblEf ^ 2 - 4 * dblEf ^ 4 - _
   9 * dblTf ^ 2 * dblEf ^ 4) * dblY ^ 4
dblBreite = (dblBf + adblB(1) + adblB(2)) * 180 / Pi

adblL(1) = 1 / dblNf / Cos(dblBf) * dblY
adblL(2) = 1 / 6 / dblNf ^ 3 / Cos(dblBf) * _
   (-1 - 2 * dblTf ^ 2 - dblEf ^ 2) * dblY ^ 3
dblLänge = dblL0 + (adblL(1) + adblL(2)) * 180 / Pi

Breitengrad = dblBreite
End Function

 

 Nebenbei werden auch einige allgemeine Funktionen vorgestellt, die sich mit Ellipsen beschäftigen. Diese sind ein Überbleibsel aus dem Versuch, die Grundlagen zu verstehen.

 

Public Function X_Ellipse(RadiusX As Double, RadiusY As Double, _
   
ByVal Winkel As DoubleAs Double
   
Dim Pi   As Double
   Pi = 3.14159265358979
   Winkel = Winkel * Pi / 180
   X_Ellipse = Cos(Winkel) / _
      Sqr((Cos(Winkel) / RadiusX) ^ 2 + (Sin(Winkel) / RadiusY) ^ 2)
End Function

Public Function Y_Ellipse(RadiusX As Double, RadiusY As Double, _
   
ByVal Winkel As DoubleAs Double
   
Dim Pi   As Double
   Pi = 3.14159265358979
   Winkel = Winkel * Pi / 180
   Y_Ellipse = Sin(Winkel) / _
      Sqr((Cos(Winkel) / RadiusX) ^ 2 + (Sin(Winkel) / RadiusY) ^ 2)
End Function

Public Function Umfang_Ellipse(RadiusX As Double, RadiusY As DoubleAs Double
   
Dim Pi   As Double
   Pi = 3.14159265358979
   Umfang_Ellipse = 2 * RadiusX * Pi * _
      ((3 / 4) * (1 + RadiusY / RadiusX) - Sqr(RadiusY / RadiusX) / 2)
End Function

Public Function Brennpunkt_Ellipse(RadiusX As Double, RadiusY As DoubleAs Double
   Brennpunkt_Ellipse = Sqr(RadiusX ^ 2 - RadiusY ^ 2)
End Function

Public Function Formfaktor_Ellipse(RadiusX As Double, RadiusY As DoubleAs Double
   Formfaktor_Ellipse = _
      ((3 / 4) * (1 + RadiusY / RadiusX) - Sqr(RadiusY / RadiusX) / 2)
End Function

Public Function GeogrBreite_Ellipse(RadiusX As Double, RadiusY As Double, _
   
ByVal Winkel As DoubleAs Double
   
Dim Pi   As Double
   Pi = 3.14159265358979
   Winkel = Winkel * Pi / 180
   GeogrBreite_Ellipse = Atn(Tan(Winkel) / _
      ((3 / 4) * (1 + RadiusY / RadiusX) - Sqr(RadiusY / RadiusX) / 2) ^ 2) * 180 / Pi
End Function

 

Mit der Prozedur MeterZuBreite habe ich dann versucht, iterativ den Breitengrad eines Hochwertes zu berechnen. Ausgehend vom Äquator werden jeweils zwei dicht nebeneinander liegende Punkte festgelegt, die Abstände errechnet und solange summiert, bis man auf die Meterzahl des Hochwertes kommt.
Man berechnet also quasi iterativ die Bogenlänge indem man Teilsehnen aufaddiert. Je kürzer dabei der Abstand der einzelnen Teilpunkte, um so besser wird die Annäherung an die Kurvenlänge. Ich glaube, das nennt man ein KURVENINTEGRAL erster Art. Das funzt aber bei der Erde nicht sehr genau.

Public Sub MeterZuBreite()
Dim dblÄquator    As Double
Dim dblPolar      As Double
Dim dblSehne      As Double

Dim dblX1         As Double
Dim dblX2         As Double
Dim dblX3         As Double

Dim dblY1         As Double
Dim dblY2         As Double
Dim dblY3         As Double

Dim dblWinkel     As Double
Dim dblBreite     As Double
Dim dblLänge      As Double
Dim i             As Double
Dim a             As Double

Dim Pi            As Double
Pi = 3.14159265358979

dblÄquator = 6377397.155
dblPolar = 6356078.962

dblLänge = 5580415



dblX2 = dblÄquator
For i = 0 To 90 Step 0.001

   dblWinkel = i * Pi / 180
   
   dblX1 = Cos(dblWinkel) / _
      Sqr((Cos(dblWinkel) / dblÄquator) ^ 2 + (Sin(dblWinkel) / dblPolar) ^ 2)
   dblX3 = dblX2 - dblX1
   
   dblY1 = Sin(dblWinkel) / _
      Sqr((Cos(dblWinkel) / dblÄquator) ^ 2 + (Sin(dblWinkel) / dblPolar) ^ 2)
   dblY3 = dblY2 - dblY1
   
   dblSehne = dblSehne + Sqr(dblX3 ^ 2 + dblY3 ^ 2)
   
If dblSehne >= dblLänge Then Exit For
   dblX2 = dblX1
   dblY2 = dblY1
Next
dblWinkel = Atn(Tan(dblWinkel) / _
      ((3 / 4) * (1 + dblPolar / dblÄquator) - _
      Sqr(dblPolar / dblÄquator) / 2) ^ 2) * 180 / Pi
End Sub

Der Umfang einer normalen Ellipsen lässt sich damit aber recht gut errechnen, wenn man die Prozedur etwas umschreibt. Der Wert dblSehne enthält dann nach dem Verlassen der For-Next-Schleife den Umfang der Ellipse.

Public Sub Umfang()
Dim dblÄquator    As Double
Dim dblPolar      As Double
Dim dblSehne      As Double

Dim dblX1         As Double
Dim dblX2         As Double
Dim dblX3         As Double

Dim dblY1         As Double
Dim dblY2         As Double
Dim dblY3         As Double

Dim dblWinkel     As Double
Dim dblBreite     As Double

Dim i             As Double
Dim a             As Double

Dim Pi            As Double
Pi = 3.14159265358979

dblÄquator = 20
dblPolar = 10




dblX2 = dblÄquator
For i = 0 To 360 Step 0.001

   dblWinkel = i * Pi / 180
   
   dblX1 = Cos(dblWinkel) / _
      Sqr((Cos(dblWinkel) / dblÄquator) ^ 2 + (Sin(dblWinkel) / dblPolar) ^ 2)
   dblX3 = dblX2 - dblX1
   
   dblY1 = Sin(dblWinkel) / _
      Sqr((Cos(dblWinkel) / dblÄquator) ^ 2 + (Sin(dblWinkel) / dblPolar) ^ 2)
   dblY3 = dblY2 - dblY1
   
   dblSehne = dblSehne + Sqr(dblX3 ^ 2 + dblY3 ^ 2)
   dblX2 = dblX1
   dblY2 = dblY1
Next
MsgBox 
"Umfang : " & dblSehne, , "Äquator = " & dblÄquator & "     Pol = " & dblPolar
End Sub