Positions Berechnung mit VB6

sorry, wenn ich den alten beitrag nochmal hochhole...

ich benutze folgendes modul um die gps-daten (512X.2722=51° 2X.2722min x 121X.0787=12° 1X.0787min) in grad umzuwandeln (51,33787° x 12,234645°)

' quelle: http://www.planet-source-code.com/vb...63143&lngWId=1

Option Explicit
Option Base 1

'The RMC-Datasentence (RMC=recommended minimum sentence C)
'is a recommendation for the minimum, that a GPS-Receiver should give back.
'It looks like this: "$GPRMC,191410,A,4735.5634,N,00739.3538,E,0.0,0.0,181102,0.4,E,A*19"
Public Sub decodeRMC(ByVal inp As String, _
            Optional ByRef UtcTime As String, _
            Optional ByRef ReceiverWarning As Boolean, _
            Optional ByRef Latitude As Double, _
            Optional ByRef LatitudeDir As String, _
            Optional ByRef Longitude As Double, _
            Optional ByRef LongitudeDir As String, _
            Optional ByRef SpeedKMH As Double, _
            Optional ByRef Course As Double, _
            Optional ByRef DateStamp As String, _
            Optional ByRef MagneticDeclination As Double, _
            Optional ByRef Checksum As Boolean)
    On Error Resume Next
    inp = UCase(Trim(inp))
    'Checking initstring. Must be the same for all RMC sentences.
    If Left(inp, 1) <> "$" Or Mid(inp, 4, 3) <> "RMC" Then Checksum = False: Exit Sub
    'Extracting that part of the sentence that is needed to calculate the checksum
    Dim ChkDat As String
    ChkDat = Mid(inp, 2, InStr(2, inp, "*") - 2)
    'For compatibility with split function
    inp = Replace(inp, ",,", ", ,")
    'Splitting sentence
    Dim Dat As Variant
    Dat = Split(inp, ",")
    'Calculating checksum and comparing it
    Dim ChkSum As String
    ChkSum = Dat(UBound(Dat))
    ChkSum = Right(ChkSum, Len(ChkSum) - InStr(1, ChkSum, "*"))
    If calcChecksum(ChkDat) = Hex2Dec(ChkSum) Then Checksum = True Else Checksum = False: Exit Sub
    'UtcTime
    UtcTime = Left(Dat(2), 6)
    If UtcTime <> " " Then UtcTime = Left(UtcTime, 2) & ":" & Mid(UtcTime, 3, 2) & ":" & Right(UtcTime, 2) Else UtcTime = ""
    'ReceiverWarning
    If Dat(3) = "A" Or Dat(3) = "" Then ReceiverWarning = False Else ReceiverWarning = True
    'Length
    Dim sp As Integer
    sp = InStr(1, Dat(4), ".")
    Latitude = CDbl(Left(Dat(4), sp - 3)) + CDbl(CDbl(Replace(Mid(Dat(4), sp - 2), ".", ",")) / 60)
    Latitude = Round(Latitude, 8)
    'LengthDir
    LatitudeDir = Dat(5)
    'Width
    sp = InStr(1, Dat(6), ".")
    Longitude = CDbl(Left(Dat(6), sp - 3)) + CDbl(CDbl(Replace(Mid(Dat(6), sp - 2), ".", ",")) / 60)
    Longitude = Round(Longitude, 8)
    'WidthDir
    LongitudeDir = Dat(7)
    'SpeedKMH (needs to be converted from knots)
    SpeedKMH = Replace(CStr((Dat(8) * 0.54)), ".", ",")
    'Course without movement
    Course = Replace(CStr(Dat(9)), ".", ",")
    'DateStamp
    DateStamp = Left(Dat(10), 6)
    If DateStamp <> " " Then DateStamp = Left(DateStamp, 2) & "." & Mid(DateStamp, 3, 2) & "." & Mid(DateStamp, 5) Else DateStamp = ""
    'MagneticDeclination
    MagneticDeclination = Replace(CStr(Dat(11)), ".", ",")
End Sub

'The GGA-Datasentence contains the most important information about GPS-position and accuracy.
'it looks like: "$GPGGA,191410,4735.5634,N,00739.3538,E,1,04,4.4,351.5,M,48.0,M,,*45"
Public Sub decodeGGA(ByVal inp As String, _
            Optional ByRef UtcTime As String, _
            Optional ByRef Latitude As Double, _
            Optional ByRef LatitudeDir As String, _
            Optional ByRef Longitude As Double, _
            Optional ByRef LongitudeDir As String, _
            Optional ByRef Quality As String, _
            Optional ByRef SatellitesIV As Integer, _
            Optional ByRef HDOP As Double, _
            Optional ByRef AltitudeSea As Double, _
            Optional ByRef AltitudeSeaUnit As String, _
            Optional ByRef AltitudeEllipsoid As Double, _
            Optional ByRef AltitudeEllipsoidUnit As String, _
            Optional ByRef Checksum As Boolean)
    On Error Resume Next
    inp = UCase(Trim(inp))
    'Checking initstring. Must be the same for all GGA sentences.
    If Left(inp, 1) <> "$" Or Mid(inp, 4, 3) <> "GGA" Then Checksum = False: Exit Sub
    'Extracting that part of the sentence that is needed to calculate the checksum
    Dim ChkDat As String
    ChkDat = Mid(inp, 2, InStr(2, inp, "*") - 2)
    'For compatibility with split function
    inp = Replace(inp, ",,", ", ,")
    'Splitting sentence
    Dim Dat As Variant
    Dat = Split(inp, ",")
    'Calculating checksum and comparing it
    Dim ChkSum As String
    ChkSum = Dat(UBound(Dat))
    ChkSum = Right(ChkSum, Len(ChkSum) - InStr(1, ChkSum, "*"))
    If calcChecksum(ChkDat) = Hex2Dec(ChkSum) Then Checksum = True Else Checksum = False: Exit Sub
    'UtcTime
    UtcTime = Left(Dat(2), 6)
    If UtcTime <> " " Then UtcTime = Left(UtcTime, 2) & ":" & Mid(UtcTime, 3, 2) & ":" & Right(UtcTime, 2) Else UtcTime = ""
    'Length
    Dim sp As Integer
    sp = InStr(1, Dat(3), ".")
    Latitude = CDbl(Left(Dat(3), sp - 3)) + CDbl(CDbl(Replace(Mid(Dat(3), sp - 2), ".", ",")) / 60)
    Latitude = Round(Latitude, 8)
    'LengthDir
    LatitudeDir = Dat(4)
    'Width
    sp = InStr(1, Dat(5), ".")
    Longitude = CDbl(Left(Dat(5), sp - 3)) + CDbl(CDbl(Replace(Mid(Dat(5), sp - 2), ".", ",")) / 60)
    Longitude = Round(Longitude, 8)
    'WidthDir
    LongitudeDir = Dat(6)
    'Quality: 0-invalid, 1-gps, 2-dgps, 6-guessed
    Quality = "unknown"
    If Dat(7) = 0 Then Quality = "no fix"
    If Dat(7) = 1 Then Quality = "GPS fix"
    If Dat(7) = 2 Then Quality = "DGPS fix"
    If Dat(7) = 6 Then Quality = "guessed"
    'Satellites in view
    SatellitesIV = Dat(8)
    'HDOP: horizontal dilution of precision (accuracy)
    HDOP = Replace(CStr(Dat(9)), ".", ",")
    'Altitude over sea
    AltitudeSea = Replace(CStr(Dat(10)), ".", ",")
    'Altitude over sea unit
    AltitudeSeaUnit = Dat(11)
    'Altitude over ellipsoid
    AltitudeEllipsoid = Replace(CStr(Dat(12)), ".", ",")
    'Altitude over ellipsoid unit
    AltitudeEllipsoidUnit = Dat(13)
End Sub

'The GSA-Datasentence contains information about the PRN-Numbers of the satellites that are used
'for calculating the actual position and some more detailed info about the accuracy.
'it looks like: "$GPGSA,A,3,,,,15,17,18,23,,,,,,4.7,4.4,1.5*3F"
Public Sub decodeGSA(ByVal inp As String, _
            Optional ByRef AutoSel As Boolean, _
            Optional ByRef mode As String, _
            Optional ByRef prn As Variant, _
            Optional ByRef PDOP As Double, _
            Optional ByRef HDOP As Double, _
            Optional ByRef VDOP As Double, _
            Optional ByRef Checksum As Boolean)
    On Error Resume Next
    inp = UCase(Trim(inp))
    'Checking initstring. Must be the same for all GSA sentences.
    If Left(inp, 1) <> "$" Or Mid(inp, 4, 3) <> "GSA" Then Checksum = False: Exit Sub
    'Extracting that part of the sentence that is needed to calculate the checksum
    Dim ChkDat As String
    ChkDat = Mid(inp, 2, InStr(2, inp, "*") - 2)
    'For compatibility with split function
    inp = Replace(inp, ",,", ", ,")
    'Splitting sentence
    Dim Dat As Variant
    Dat = Split(inp, ",")
    'Calculating checksum and comparing it
    Dim ChkSum As String
    ChkSum = Dat(UBound(Dat))
    ChkSum = Right(ChkSum, Len(ChkSum) - InStr(1, ChkSum, "*"))
    If calcChecksum(ChkDat) = Hex2Dec(ChkSum) Then Checksum = True Else Checksum = False: Exit Sub
    'Auto Selection Mode
    If Dat(2) = "A" Then AutoSel = True Else AutoSel = False
    'Mode
    mode = "unknown"
    If Dat(3) = "3" Then mode = "3D-Fix"
    If Dat(3) = "2" Then mode = "2D-Fix"
    If Dat(3) = "1" Then mode = "No-Fix"
    'PRN-Numbers
    ReDim prn(12)
    Dim i As Integer
    For i = 4 To 15
        If IsNumeric(Dat(i)) Then prn(i - 3) = CInt(Dat(i)) Else prn(i - 3) = ""
    Next
    'PDOP in meters
    PDOP = Replace(CStr(Dat(16)), ".", ",")
    'HDOP horizontal dilution of precision in meters
    HDOP = Replace(CStr(Dat(17)), ".", ",")
    'VDOP vertical dilution of precision in meters
    VDOP = Replace(Left(CStr(Dat(18)), InStr(1, Dat(18), "*") - 1), ".", ",")
End Sub

'              sn ed azi dB ------------ ------------ ------------
'$GPGSV,3,1,12,22,89,000,00,14,59,000,00,15,53,000,00,18,51,000,00*7F
'              ------------ ------------ ---------- ----------
'$GPGSV,3,2,12,09,47,000,00,19,15,000,00,21,13,000,,31,13,000,*7C
'              ------------ ---------- ------------ ------------
'$GPGSV,3,3,12,03,06,000,00,11,04,000,,28,02,000,00,05,01,000,00*77

'$GPGSV,3,1,12,22,89,000,00,14,59,000,00,15,53,000,00,18,51,000,00*7F
'$GPGSV,3,2,12,09,47,000,00,19,15,000,00,21,13,000,,31,13,000,*7C
'$GPGSV,3,3,12,03,06,000,00,11,04,000,,28,02,000,00,05,01,000,00*77
'GSV - Satellites in view
'        1 2 3 4 5 6 7     n
'        | | | | | | |     |
' $--GSV,x,x,x,x,x,x,x,...*hh<CR><LF>
'  1) total number of messages
'  2) message number
'  3) satellites in view
'  4) satellite number
'  5) elevation in degrees
'  6) azimuth in degrees to true
'  7) SNR in dB
'  more satellite infos like 4)-7)
'  n) checksum
  
Public Sub decodeGSV(ByVal inp As String, _
            Optional ByRef tnm As Integer, _
            Optional ByRef mn As Integer, _
            Optional ByRef SatsInView As Integer, _
            Optional ByRef SatNr As Variant, _
            Optional ByRef Elevation As Variant, _
            Optional ByRef Azimuth As Variant, _
            Optional ByRef SNRdB As Variant, _
            Optional ByRef Checksum As Boolean)
    On Error Resume Next
    inp = UCase(Trim(inp))
    'Checking initstring. Must be the same for all GSV sentences.
    If Left(inp, 1) <> "$" Or Mid(inp, 4, 3) <> "GSV" Then Checksum = False: Exit Sub
    'Extracting that part of the sentence that is needed to calculate the checksum
    Dim ChkDat As String
    ChkDat = Mid(inp, 2, InStr(2, inp, "*") - 2)
    ChkDat = ChkDat
    'For compatibility with split function
    inp = Replace(inp, ",,", ", ,")
    'Splitting sentence
    Dim Dat As Variant
    Dat = Split(inp, ",")
    'Cutting what we won't need
    inp = Right(inp, Len(inp) - 7)
    inp = Left(inp, InStr(1, inp, "*") - 1)
    'Calculating checksum and comparing it
    Dim ChkSum As String
    ChkSum = Dat(UBound(Dat))
    ChkSum = Right(ChkSum, Len(ChkSum) - InStr(1, ChkSum, "*"))
    Dim ccs As Integer, dcs As Long
    ccs = calcChecksum(ChkDat)
    dcs = Hex2Dec(ChkSum)
    If ccs = dcs Then Checksum = True Else Checksum = False: Exit Sub
    'total number of messages
    tnm = CInt(Dat(1))
    'message number
    mn = CInt(Dat(2))
    'Satellites in View
    SatsInView = Dat(3)
    Dim i As Integer
    Dim sp As Integer
    'Satellite-Numbers
    ReDim SatNr(4)
    For i = 1 To 4
        sp = InStr(1, Dat(3 + i), "*")
        If sp > 0 Then Dat(3 + i) = Left(Dat(3 + i), sp - 1)
        SatNr(i) = Dat(3 + i)
    Next
    'Elevations
    ReDim Elevation(4)
    For i = 1 To 4
        sp = InStr(1, Dat(7 + i), "*")
        If sp > 0 Then Dat(7 + i) = Left(Dat(7 + i), sp - 1)
        Elevation(i) = Dat(7 + i)
    Next
    'Azimuth's
    ReDim Azimuth(4)
    For i = 1 To 4
        sp = InStr(1, Dat(11 + i), "*")
        If sp > 0 Then Dat(11 + i) = Left(Dat(11 + i), sp - 1)
        Azimuth(i) = Dat(11 + i)
    Next
    'SNRdB's
    ReDim SNRdB(4)
    For i = 1 To 4
        sp = InStr(1, Dat(15 + i), "*")
        If sp > 0 Then Dat(15 + i) = Left(Dat(15 + i), sp - 1)
        SNRdB(i) = Dat(15 + i)
    Next
End Sub
  
  
  
'Helper functions:
'=================

Function calcChecksum(inp As String) As Integer
    Dim i As Integer, s As Integer
    s = 0
    For i = 1 To Len(inp)
        s = s Xor Asc(Mid(inp, i, 1))
    Next
    calcChecksum = s
End Function

Function Hex2Dec(HexNum As Variant) As Long
    Hex2Dec = "&h" & HexNum
End Function


'Compatibility functions:
'========================

Function Split(sIn As String, sDel As String) As Variant
    Dim i As Integer, x As Integer, s As Integer, t As Integer
    i = 1: s = 1: t = 1: x = 1
    ReDim tArr(1 To x) As Variant
    If InStr(1, sIn, sDel) <> 0 Then
        Do
            ReDim Preserve tArr(1 To x) As Variant
            tArr(i) = Mid(sIn, t, InStr(s, sIn, sDel) - t)
            t = InStr(s, sIn, sDel) + Len(sDel)
            s = t
            If tArr(i) <> "" Then i = i + 1
            x = x + 1
        Loop Until InStr(s, sIn, sDel) = 0
        ReDim Preserve tArr(1 To x) As Variant
        tArr(i) = Mid(sIn, t, Len(sIn) - t + 1)
    Else
        tArr(1) = sIn
    End If
    Split = tArr
End Function

Function Round(ByVal Value As Variant, Optional ByVal digits As Integer = 0) As Variant
  Dim i As Long
  Dim Pot10(-28 To 28) As Variant
  If i = 0 Then
    For i = LBound(Pot10) To UBound(Pot10)
      Pot10(i) = CDec(10 ^ i)
    Next i
  End If
  On Error Resume Next
    If Value > 0 Then
      Round = Int(Value * Pot10(digits) + 0.5) * Pot10(-digits)
    Else
      Round = -Int(-Value * Pot10(digits) + 0.5) * Pot10(-digits)
    End If
    If Err.Number Then Round = Value
  On Error GoTo 0
End Function

Function Replace(strString As String, Find As String, strReplace As String) As String
    Dim ss As Long
    ss = InStr(1, strString, Find)
    If ss > 0 Then
        strString = Left(strString, ss - 1) & strReplace & Right(strString, Len(strString) - (ss + (Len(Find) - 1)))
        Replace = Replace(strString, Find, strReplace)
    Else
        Replace = strString
    End If
End Function

wenn ich nun L1, L2, G1, G2 durch die errechneten koordinaten ersetze, dann müßte ich doch ebenfalls die entfernung ermittelt bekommen, kann das einer bestätigen? oder gibt es vielleicht andere gps-projekte die sich näher mit der entfernungsberechnung beschäftigen? hat vielleicht schon einer ein fertiges beispielprojekt, da ich mir nicht sicher bin ob ich mit der oben genannten methode ein korrektes ergebniss erhalte oder ob da irgendwo doch ein fehler drin ist.

vielleicht kann einer weiterhelfen.
mfg.

ok, ich komme immer auf falsche ergebnisse, im deut. raum muß man wohl folgende konstante benutzen: distance = dist * 111.12 '<- den wert hab ich aus einer exel-koordinaten-umrechnungstabelle

weiß vielleicht einer warum gerade "111.12"? woraus/wie errechnet sich dieser wert bzw. woher kommen die "60" aus dem obigen code?

mfg.

[gpsklaus]

Hallo

> weiß vielleicht einer warum gerade "111.12"? woraus/wie errechnet sich dieser wert bzw. woher kommen die "60" aus dem obigen code?


Der Wert kommt mir irgendwie bekannt vor. Der Abstand zwischen zwei Breitengraden beträgt 111Km ( oder vielleicht auch: 111.12 Km ?).
Das kann doch kein Zufall sein?

Klaus

[gpsklaus]

Hallo,
ich habe den Code von SOMMER am PDA unter Verwendung von "eVB" ausprobiert. Zum Testen wurden allerdings nur fixe Eingangsdaten verwendet.
Wenn man den Entfernungsparameter "dist" mit 1.852 multipliziert, erhält man Entfernungsangaben in Km. Von einem Breitengrad zum nächsten ergibt das exakt 111.12KM. Der Abstand zwischen zwei Längengraden variiert dagegen in Abhängigkeit vom Breitengrad. Im mittleren Teil von Deutschland sind es etwa 70Km. Soweit scheint der Code also zu funktionieren. Nicht klargekommen bin ich dagegen mit der verwendeten Richtungsberechnung. Deshalb habe ich hierfür stattdessen eine vorhandene Routine eingebaut. Sie ist auch im beigefügten Code zu finden.

Klaus

Option Explicit

Dim Lat1
Dim Lon1
Dim Lat2
Dim Lon2
Dim L1
Dim L2
Dim G1
Dim G2

Const pi = 3.14159265358979
Const radian = 0.017453292  'pi/180

Private Sub Command2_Click()

'Lat1 = (Text1.Text + (Text2.Text / 60) + (Text3.Text / 3600))
'Lon1 = -(Text4.Text + (Text5.Text / 60) + (Text6.Text / 3600))

'Lat2 = (Text7.Text + (Text8.Text / 60) + (Text9.Text / 3600))
'Lon2 = -(Text10.Text + (Text11.Text / 60) + (Text12.Text / 3600))

Lat1 = 50.96
Lon1 = 8.2
Lat2 = 49.96
Lon2 = 8.2

L1 = Lat1
L2 = Lon1
G1 = Lat2
G2 = Lon2

Text1.Text = L1
Text2.Text = L2
Text3.Text = G1
Text4.Text = G2

'Distanzberechnung
Dim theta, dist, Deg

theta = Lon1 - Lon2
dist = Sin(deg2rad(Lat1)) * Sin(deg2rad(Lat2)) + Cos(deg2rad(Lat1)) * Cos(deg2rad(Lat2)) * Cos(deg2rad(theta))
dist = acos(dist)
dist = rad2deg(dist)
Text5.Text = (Int(dist * 6000 + 0.5) / 100) * 1.852
  
'Richtungsbrechnung
Dim ga, zw, bear

If dist > 0 Then

Lon1 = Lon1 * radian
Lat1 = Lat1 * radian
Lon2 = Lon2 * radian
Lat2 = Lat2 * radian

ga = Lon1 - Lon2
zw = Cos(Lat1) * Cos(Lon1 - Lon2) * Cos(Lat2) + Sin(Lat1) * Sin(Lat2)
zw = Atn(zw / Sqr(1 - zw * zw))
zw = pi / 2 - zw

bear = ((Sin(Lat2) - Sin(Lat1) * Cos(zw)) / (Cos(Lat1) * Sin(zw)))
bear = Atn(bear / Sqr(1 - bear * bear))
bear = (pi / 2 - bear) / radian

    If Sin(ga) >= 0 Then
        bear = 360 - bear
    End If
End If

bear = Int(bear * 10 + 0.5) / 10
If bear = 0 Then bear = 360
Text6.Text = bear

End Sub

Function acos(rad)
  If Abs(rad) <> 1 Then
    acos = pi / 2 - Atn(rad / Sqr(1 - rad * rad))
  ElseIf rad = -1 Then
    acos = pi
  End If
End Function

Function deg2rad(Deg)
    deg2rad = CDbl(Deg * pi / 180)
End Function

Function rad2deg(rad)
    rad2deg = CDbl(rad * 180 / pi)
End Function

Private Sub Form_OKClick()
    App.End
End Sub

[Vogon]

...Wenn man den Entfernungsparameter "dist" mit 1.852 multipliziert, erhält man Entfernungsangaben in Km...

Wer wissen möchte warum das so ist: http://de.wikipedia.org/wiki/Nautische_Meile