Einzelnen Beitrag anzeigen
Alt 06.10.2009, 19:58   #11 (permalink)
redilS
Extrem Performer
 
Benutzerbild von redilS
 

Registriert seit: 22.11.2004
Beiträge: 1.169

redilS ist jedem bekanntredilS ist jedem bekanntredilS ist jedem bekanntredilS ist jedem bekanntredilS ist jedem bekannt

Standard AW: Google Earth - Bodenhöhe auslesen

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
redilS ist offline   Mit Zitat antworten