Office: Geodaten umrechnen

drzwockel · 15. Oktober 2013

Hallo Excel-Gemeinde,

ich stehe vor dem Problem, dass ich Daten in einer Karte darstellen so, die Rohdaten aber als Gauß-Krüger 2 Werte vorliegen. Ich benötige sie aber in Längen- und Breitengrade.

Nach einer erfolglosen Suche und dem Angebot, was vermeintlich helfen sollte, raucht mir nun der Kopf.

Hat jemand eine Idee, Hinweis auf Quellen oder ein Lösungsansatz?

Vielen Dank

:)

jack_D · 17. Oktober 2013

Mir hat bei ähnlichen Fragestellungen diese Seite geholfen

Online-Umrechner in alle Koordinatensysteme | UTM, WGS.. | mit Karte

grüße

Edith sagt.
"Google hilft dir"
http://www.google.de/url?sa=t&rct=j&...54176721,d.bGE

drzwockel · 17. Oktober 2013

Hallo jack_D,

sicherlich eine Hilfe, allerdings für die Massenverarbeitung (ca. 900 - 1000 Datensaätze) und das jeden Tag, eher unpraktisch.

Trotzdem vielen Dank!

jack_D · 17. Oktober 2013

hast du dir die verlinkte Tabelle mal angeschaut?

drzwockel · 17. Oktober 2013

Hallo jack_D,

die verlinkte Tabelle hattest Du später eingefügt ... die habe ich erst gesehen, nach dem ich Dir eine Antwort gegeben hatte.

Ich konnte sie aber erst jetzt öffnen, da ich noch in einem Termin war. Ich schaue sie mir jetzt aber intensiver an. Es scheint der Lösung sicherlich ein Stück weit beizutragen :-)

Danke schon einmal ...

drzwockel · 17. Oktober 2013

Hallo jack_D,

auf das Tabellenseite 2 scheint die Lösung zu liegen ... meine Gauß Krüger Werte werden dort schön in Länge und Breite umgerechnet ... soweit, so gut!

Leider bräuchte ich hier eine Lösung für VBA, so dass ich Zeile für Zeile meine Datensätze konvertieren kann.

Zurzeit weiß ich da nicht, wo wie ansetzen soll bzw. kann. Es scheint ein unlösbares Problem zu sein. Wobei Probleme ja eigentlich Herausforderungen darstellen.

Trotzdem Vielen Dank!

Hat jemand weitere Ideen ... *frown.gif*

drzwockel · 17. Oktober 2013

Hallo Excel Gemeinde,

jetzt habe ich eine wahrscheinlich guten Lösungsansatz gefunden, da ist die XLS-Datei auf dem Server nicht mehr verfügbar. *mad.gif*

Hier mal der Code und im Anschluß meine Fragen:

Ursprungsquelle:

Code:

'*******************************************************************************
Function phiBreite(Meridianbogenlaenge, a, b) 'in rad

Dim N, alpha, beta, gamma, delta, epsilon, phi_q

N = (a - b) / (a + b)

alpha = (a + b) / 2 * (1 + 1 / 4 * N ^ 2 + 1 / 64 * N ^ 4)

beta = 3 / 2 * N - 27 / 32 * N ^ 3 + 269 / 512 * N ^ 5

gamma = 21 / 16 * N ^ 2 - 55 / 32 * N ^ 4

delta = 151 / 96 * N ^ 3 - 417 / 128 * N ^ 5

epsilon = 1097 / 512 * N ^ 4

phi_q = Meridianbogenlaenge / alpha

phiBreite = phi_q + beta * Sin(2 * phi_q) + gamma * Sin(4 * phi_q) + delta * Sin(6 * phi_q) + epsilon * Sin(8 * phi_q)

End Function

'*******************************************************************************
Function Meridianbogen(phi, a, b) ' in m

Dim N, alpha, beta, gamma, delta, epsilon

N = (a - b) / (a + b)

alpha = (a + b) / 2 * (1 + 1 / 4 * N ^ 2 + 1 / 64 * N ^ 4)

beta = -3 / 2 * N + 9 / 16 * N ^ 3 - 3 / 32 * N ^ 5

gamma = 15 / 16 * N ^ 2 - 15 / 32 * N ^ 4

delta = -35 / 48 * N ^ 3 + 105 / 256 * N ^ 5

epsilon = 315 / 512 * N ^ 4

Meridianbogen = alpha * (phi + beta * Sin(2 * phi) + gamma * Sin(4 * phi) + delta * Sin(6 * phi) + epsilon * Sin(8 * phi))

End Function

'*******************************************************************************
Function Geo2GK(Laenge, Breite, a, b, Hauptmeridian, Winkeleinheit, GK)

Select Case Winkeleinheit
Case 1
Laenge = CArc(1, Laenge) 'Dezimale Koordinaten nach rad
Breite = CArc(1, Breite) 'Dezimale Koordinaten
Case 2
Laenge = CArc(2, Laenge) 'Geographische Koordinaten nach rad
Breite = CArc(2, Breite) 'Geographische Koordinaten
End Select

If GK > 0 Then
Geo2GK = Geo2GK_Hoch(Laenge, Breite, a, b, Hauptmeridian)
Else
Geo2GK = Geo2GK_Rechts(Laenge, Breite, a, b, Hauptmeridian)
End If

End Function

'*******************************************************************************
Private Function Geo2GK_Hoch(lambda, phi, a, b, lambda0)

Dim e2, eta2, N, t, l

If a = 0 Or b = 0 Then
a = 6377397.15508
b = 6356078.9629
End If

e2 = (a ^ 2 - b ^ 2) / b ^ 2

eta2 = e2 * Cos(phi) ^ 2

N = a ^ 2 / (b * (1 + eta2) ^ 0.5)

t = Tan(phi)

l = lambda - lambda0 * 3.14159265359 / 180

Geo2GK_Hoch = Meridianbogen(phi, a, b) + t / 2 * N * Cos(phi) ^ 2 * l ^ 2 _
+ t / 24 * N * Cos(phi) ^ 4 * (5 - t ^ 2 + 9 * eta2 + 4 * eta2 ^ 2) * l ^ 4 _
+ t / 720 * N * Cos(phi) ^ 6 * (61 - 58 * t ^ 2 + t ^ 4 + 270 * eta2 - 330 * t ^ 2 * eta2) * l ^ 6 _
+ t / 40320 * N * Cos(phi) ^ 8 * (1385 - 3111 * t ^ 2 + 543 * t ^ 4 - t ^ 6) * l ^ 8

End Function

'*******************************************************************************
Private Function Geo2GK_Rechts(lambda, phi, a, b, lambda0)

Dim e2, eta2, N, t, l

If a = 0 Or b = 0 Then
a = 6377397.15508
b = 6356078.9629
End If

e2 = (a ^ 2 - b ^ 2) / b ^ 2

eta2 = e2 * Cos(phi) ^ 2

N = a ^ 2 / (b * (1 + eta2) ^ 0.5)

t = Tan(phi)

l = lambda - lambda0 * 3.14159265359 / 180

Geo2GK_Rechts = lambda0 / 3 * 1000000 + 500000 + N * Cos(phi) * l _
+ 1 / 6 * N * Cos(phi) ^ 3 * (1 - t ^ 2 + eta2) * l ^ 3 _
+ 1 / 120 * N * Cos(phi) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * eta2 - 58 * t ^ 2 * eta2) * l ^ 5 _
+ 1 / 5040 * N * Cos(phi) ^ 7 * (61 - 479 * t ^ 2 + 179 * t ^ 4 - t ^ 6) * l ^ 7

End Function

'*******************************************************************************
Function GK2Geo(Rechts, Hoch, lambda0, a, b, Flag, Winkeleinheit)

If Flag > 0 Then
GK2Geo = GK2Geo_Breite(Rechts, Hoch, lambda0, a, b)
Else
GK2Geo = GK2Geo_Laenge(Rechts, Hoch, lambda0, a, b)
End If

Select Case Winkeleinheit
Case 3
GK2Geo = CArc(3, GK2Geo) 'rad nach dez
Case 5
GK2Geo = CArc(5, GK2Geo) 'rad nach geo
End Select

End Function

'*******************************************************************************
Private Function GK2Geo_Breite(Rechts, Hoch, lambda0, a, b)

Dim phi_f, eta2_f, Nf, tf, y0

If a = 0 Or b = 0 Then
a = 6377397.15508
b = 6356078.9629
End If

y0 = Rechts - lambda0 / 3 * 1000000 - 500000

phi_f = phiBreite(Hoch, a, b)

eta2_f = (a ^ 2 - b ^ 2) / b ^ 2 * Cos(phi_f) ^ 2

Nf = a ^ 2 / (b * (1 + eta2_f) ^ 0.5)

tf = Tan(phi_f)

GK2Geo_Breite = phi_f + tf / (2 * Nf ^ 2) * (-1 - eta2_f) * y0 ^ 2 _
+ tf / (24 * Nf ^ 4) * (5 + 3 * tf ^ 2 + 6 * eta2_f - 6 * tf ^ 2 * eta2_f - 3 * eta2_f ^ 2 - 9 * tf ^ 2 * eta2_f ^ 2) * y0 ^ 4 _
+ tf / (720 * Nf ^ 6) * (-61 - 90 * tf ^ 2 - 45 * tf ^ 4 - 107 * eta2_f + 162 * tf ^ 2 * eta2_f + 45 * tf ^ 4 * eta2_f) * y0 ^ 6 _
+ tf / (40320 * Nf ^ 8) * (1385 + 3633 * tf ^ 2 + 4095 * tf ^ 4 + 1575 * tf ^ 6) * y0 ^ 8

End Function

'*******************************************************************************
Private Function GK2Geo_Laenge(Rechts, Hoch, lambda0, a, b)

Dim phi_f, eta2_f, Nf, tf, y0

If a = 0 Or b = 0 Then
a = 6377397.15508
b = 6356078.9629
End If

y0 = Rechts - lambda0 / 3 * 1000000 - 500000
phi_f = phiBreite(Hoch, a, b)

eta2_f = (a ^ 2 - b ^ 2) / b ^ 2 * Cos(phi_f) ^ 2

Nf = a ^ 2 / (b * (1 + eta2_f) ^ 0.5)

tf = Tan(phi_f)

GK2Geo_Laenge = lambda0 * 3.14159265359 / 180 + 1 / (Nf * Cos(phi_f)) * y0 + 1 / (6 * Nf ^ 3 * Cos(phi_f)) * (-1 - 2 * tf ^ 2 - eta2_f) * y0 ^ 3 + _
1 / (120 * Nf ^ 5 * Cos(phi_f)) * (5 + 28 * tf ^ 2 + 24 * tf ^ 4 + 6 * eta2_f + 8 * tf ^ 2 * eta2_f) * y0 ^ 5 + _
1 / (5040 * Nf ^ 7 * Cos(phi_f)) * (-61 - 662 * tf ^ 2 - 1320 * tf ^ 4 - 720 * tf ^ 6) * y0 ^ 7

End Function

'*******************************************************************************
Private Function Grad_GGMMSS(W_Dez)

Dim Grad, Rest, Minuten, Sekunden

Grad = Fix(W_Dez)
Rest = W_Dez - Grad
Minuten = Fix(Rest * 60)
Sekunden = (Rest - Minuten / 60) * 3600

Grad_GGMMSS = Format(Grad, "00") & Format(Minuten, "00") & Format(Sekunden, "00.0000")

End Function

'*******************************************************************************
'
'Achtung : In der Excel-Tabelle wird im String als Dezimal-Trenner wieder das Komma gesetzt. Toll
' aber innerhalb der Funktion auch. D.h. VBA erkennt die Nachkommastellen nicht mehr, wenn
' man die Val-Funktion benutzt.
'
'*******************************************************************************
Private Function aaa(Wert)
SWert = Format(Wert, "0000000.00##########")
aaa = SWert
End Function
Private Function aba(Wert)
SWert = Format(Wert, "0000000.00##########")
aba = Val(Left$(SWert, 3))
End Function
Private Function aab(Wert)
SWert = Format(Wert, "0000000.00##########")
aab = Val(Mid$(SWert, 4, 2))
End Function
Private Function aac(Wert)
SWert = Format(Wert, "0000000.00")
aac = Val(Mid$(SWert, 6, 2) & "." & Mid$(SWert, 9))
End Function
Private Function dd(Wert)
SWert = Format(Wert, "0000000.00")
dd = Val(Mid$(SWert, 6))
End Function

'*******************************************************************************
Private Function GGMMSS_Grad(Wert As Variant)

Dim SWert As String

SWert = Format(Wert, "0000000.00##########")
GGMMSS_Grad = Val(Left$(SWert, 3)) + Val(Mid$(SWert, 4, 2)) / 60 + _
Val(Mid$(SWert, 6, 2) & "." & Mid$(SWert, 9)) / 3600

End Function

'*******************************************************************************
Function CArc(Flag, Winkel)

Select Case Flag
Case 1 ' dez nach rad
CArc = Winkel * 3.14159265359 / 180
Case 2 ' geo nach rad
CArc = GGMMSS_Grad(Winkel) * 3.14159265359 / 180
Case 3 ' rad nach dez
CArc = Winkel * 180 / 3.14159265359
Case 4 ' geo nach dez
CArc = GGMMSS_Grad(Winkel)
Case 5 ' rad nach geo
CArc = Grad_GGMMSS(Winkel * 180 / 3.14159265359)
Case 6 ' dez nach geo
CArc = Grad_GGMMSS(Winkel)
Case Else
CArc = "#WERT!"
End Select

End Function

'*******************************************************************************
Function GK2GK(Rechts, Hoch, lambda0, lambda1, a, b, GK)

Dim Laenge, Breite

Laenge = GK2Geo(Rechts, Hoch, lambda0, a, b, 0, 0)
Breite = GK2Geo(Rechts, Hoch, lambda0, a, b, 1, 0)
GK2GK = Geo2GK(Laenge, Breite, a, b, lambda1, Winkeleinheit, GK)

End Function

'*******************************************************************************
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bei der Funktion werden die Folgenden Parameter verlangt:

Function GK2Geo(Rechts, Hoch, lambda0, a, b, Flag, Winkeleinheit)

Rechts und Hoch verstehe ich ja noch, aber was muss als lambda0, a, b, Flag und Winkeleinheit eingetragen werden?

Hat jemand diesen Code schon mal gesehen oder nutzt ihn vielleicht???

Vielen Dank

jack_D · 17. Oktober 2013

Hallo und Guten Morgen

ich glaub dein Problem ist tatsächlich eher ein (anwendungs-)mathematisches.
Daher würde ich denken du bist effektiver, wenn du in einem Matheforum oder besser noch in einem Geodäsieforum um hilfe ersuchst.

Nicht das ich nicht helfen will, aber das ist so tief in der Materie.
So dass ich auch denke, wäüre es Zufall wenn hier jemand ist, der da drin steckt-.

Grüße

EarlFred · 17. Oktober 2013

Hallo Name?,

ohne mir den Formelwust angeschaut zu haben, riecht das für mich spontan nach Helmert-Transformation.
Im Link findest Du auch Standardparametersätze, die Du möglicherweise verwenden kannst.
Alles ohne Gewähr - musst Du Dich selbst mal mit beschäftigen. Mir fehlt sowohl Zeit als auch Lust dazu.

Der Hinweis auf ein Fachforum ist gut, dem würde ich mal nachgehen. Vielleicht bekommst Du dort auch Kalkulationstabellen für Deine Zwecke oder zumindest die notwendigen Erläuterungen, die Du für die Berechnungsmethoden brauchst. In der Excel-OH finde ich zumindest keine Hinweise *wink.gif*

[Edit]
Was sagt denn der Verfasser des Codes? Hast Du den schon befragt?
[/Edit]

Grüße
EarlFred

thunder1902 · 17. Oktober 2013

Genau das gleiche Problem habe ich auch wie der Threadersteller...

Hab schon das ganze Internet abgegrast - aber außer des hier gezeigten Scripts hab ich auch nichts besseres gefunden.

... und ich frage mich auch, was lambda0, a, b, Flag, Winkeleinheit bedeuten soll....

drzwockel · 17. Oktober 2013

Hallo jack_D,
hallo EarlFred,

vielen Dank für die Informationen. Ich werde eure Vorschläge nacheinander mal abarbeiten. Mal schauen, ob ich da zu einem brauchbaren Ergebnis kommen werde *wink.gif* .

Wenn ich etwas gefunden habe, werde ich es hier dann posten.

Gruß vom Doc

Office: Geodaten umrechnen

Geodaten umrechnen

Geodaten umrechnen

Geodaten umrechnen

Geodaten umrechnen

Geodaten umrechnen - Similar Threads - Geodaten umrechnen

Wechselkurs umrechnen ueber Umweg

Umrechnen von Platzierung in Punkte (umgekehrte Reihenfolge)

Gewürfelte Binärzahlen umrechnen (1,2,3,=0 und 4,5,6=1)

MsgBox mit Berechnung und Eintrag in Tabelle

Umrechnung Spaltenbreite und Zeilenhöhe in mm

Geodaten aus Adressen (Strasse, HausNr, PLZ, Ort) ermitteln

Stunden in Arbeitszeit umrechnen