Kurzes Update um das Thema zu beenden: hab das Programm fertig und bin an meine Daten ran gekommen. Die SRTM Daten
hatte ich schon. Interessanterweise sind die GE Daten tatsächlich besser, warum auch immer. Ich hab jetzt was ich wollte. Danke nochmal
Code:
Private Sub cmdHoehe_Click()
GetElev
End Sub
Private Sub GetElev()
Dim sInput As String
Dim sOutput As String
Dim sData As String
Dim cLat As Variant
Dim cLon As Variant
Dim dStart As Double
Dim dEnd As Double
Dim iLen As Integer
Dim dStartDSet As Double
Dim dEndDSet As Double
Dim iLenDSet As Integer
sInput = txtInput.Text
dStart = 1
'GE initialisieren
Dim objGE As Object 'die Anwendung Google Earth (GE)
Dim i As Integer 'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
Dim dblAPo As Double 'Wert der in GE eingestellten Anflug-Geschwindigkeit des AutoPiloten
Dim RelativeToGroundAltitudeGE As Integer
RelativeToGroundAltitudeGE = 1
Dim AbsoluteAltitudeGE As Integer
AbsoluteAltitudeGE = 2
Set objGE = CreateObject("GoogleEarth.ApplicationGE")
With objGE
Do 'Prüfen, ob GE geöffnet, verfügbar, online, nicht busy
DoEvents ' .isonline beim Testen Offline auskommentieren!
Loop Until .IsInitialized = 1 And .IsOnline = 1 And .SearchController.IsSearchInProgress = 0
End With
'Änderung von "AutoPilotSpeed": Einfluss nicht bestätigt --> selbst testen / auskommentieren
dblAPo = objGE.AutoPilotSpeed 'Original-Anfluggeschwindigkeit auslesen
objGE.AutoPilotSpeed = 5 'überschreiben: 5 = Maximum!
Do
DoEvents
'Datensatz lesen - "Lat,Lon,Alt"
dEnd = InStr(dStart, sInput, " ", vbTextCompare)
If dEnd = 0 Then
Exit Do
End If
iLen = dEnd - dStart
sData = Mid(sInput, dStart, iLen)
dStart = dEnd + 1
dStartDSet = 1
'Longtitude holen
dEndDSet = InStr(dStartDSet, sData, ",", vbTextCompare)
iLenDSet = dEndDSet - dStartDSet
cLon = CDbl(Replace(Mid(sData, dStartDSet, iLenDSet), ".", ","))
dStartDSet = dEndDSet + 1
'Latitude holen
dEndDSet = InStr(dStartDSet, sData, ",", vbTextCompare)
iLenDSet = dEndDSet - dStartDSet
cLat = CDbl(Replace(Mid(sData, dStartDSet, iLenDSet), ".", ","))
dStartDSet = dEndDSet + 1
'Kamera setzen und Daten lesen
objGE.SetCameraParams cLat, cLon, 0, RelativeToGroundAltitudeGE, 1000, 0, 0, 5
Set coords = objGE.GetPointOnTerrainFromScreenCoords(0, 0)
sOutput = sOutput & Replace(cLon, ",", ".") & "," & Replace(cLat, ",", ".") & "," & Replace(coords.altitude, ",", ".") & " "
'Sicherheitszähler
iPos = iPos + 1
Loop Until iPos = 10000
txtOutput.Text = sOutput
'txtOutput = sOutput
Set geObj = nothing
End Sub