Navigation computation 1

[fingers]

Does anyone have VB6 code to compute distance and heading given starting lat/lon and ending lat/lon?

I have the trig formulae but VB doesn't have the acos function and I haven't been able to work around it.

I guess I should have paid more attention in high school trig!!!

Any hints would be appreciated.

Thanks

Fingers

 

[gmmastros]

Here's the distance calculation to get you started. It will take a little more searching to come up with the heading. I have it somewhere.

Public Function CalculateDistance(ByVal StartLongitude As Single, ByVal StartLatitude As Single, ByVal EndLongitude As Single, ByVal EndLatitude As Single) As Single
    
    Dim DeltaX As Single
    Dim DeltaY As Single
    Dim DeltaXMeters As Single
    Dim DeltaYMeters As Single
    Dim MetersPerDegreeLong As Single
    Dim CenterY As Single
    
    DeltaX = Abs(EndLongitude - StartLongitude)
    DeltaY = Abs(EndLatitude - StartLatitude)
    CenterY = (StartLatitude + EndLatitude) / 2
    MetersPerDegreeLong = MetresPerDegreeLong(CenterY)
    DeltaXMeters = DeltaX * MetersPerDegreeLong
    DeltaYMeters = DeltaY * 111113.519
    CalculateDistance = Sqr(DeltaXMeters * DeltaXMeters + DeltaYMeters * DeltaYMeters) / 1609.344

End Function

Private Function MetresPerDegreeLong(ByVal Latitude As Single)
    
    Dim gEARTH_CIRCUM_METRES As Single
    
    gEARTH_CIRCUM_METRES = 6378007 * 2 * 3.14159265

    MetresPerDegreeLong = (Cos(Latitude * (3.14159265 / 180)) * gEARTH_CIRCUM_METRES) / 360
    
End Function

Notice that I am using single's here. That is as much resolution as I need because the 5th digit of precision represents approximately 3 feet. If you need more resolution than that, you could easily change the data types to doubles.

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[gmmastros]

Arc Cosine can be derived from other trig functions like this...

Public Function ArcCos(ByVal Angle As Double) As Double

    ArcCos = Atn(-Angle / Sqr(-Angle * Angle + 1)) + 2 * Atn(1)

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom

 

[gmmastros]

Found it. Hope this is what you were looking for.

Public Function CalculateBearing(ByVal Lat1 As Double, ByVal Lon1 As Double, ByVal Lat2 As Double, ByVal Lon2 As Double) As String

    Dim dLat1 As Double
    Dim dLon1 As Double
    Dim dLat2 As Double
    Dim dLon2 As Double
    Dim dBearing As Double
    
    dLat1 = Deg2Rad(Lat1)
    dLon1 = Deg2Rad(Lon1)
    dLat2 = Deg2Rad(Lat2)
    dLon2 = Deg2Rad(Lon2)
    
    ' The bearing should be "IDLE" if the bus doesn't move
    If Map.Distance(Lon1, Lat1, Lon2, Lat2) < 0.02 Then
        CalculateBearing = Bearing
    End If
    
    dBearing = GetBearing(dLat1, dLon1, dLat2, dLon2)
    CalculateBearing = GetDirectionBearingFromDegrees(Rad2Deg(dBearing))
    
End Function


Private Function Deg2Rad(ByVal Deg As Double) As Double
    
    Deg2Rad = Deg * PI / 180
    
End Function


Private Function Rad2Deg(ByVal Rad As Double) As Double
    
    Rad2Deg = Rad * 180 / PI
    
End Function

Private Function GetDirectionBearingFromDegrees(ByVal Deg As Double) As String
    
    If Deg < -157.5 Then
        GetDirectionBearingFromDegrees = "S"
        Exit Function
    End If
    
    If Deg < -112.5 Then
        GetDirectionBearingFromDegrees = "SW"
        Exit Function
    End If
    
    If Deg < -67.5 Then
        GetDirectionBearingFromDegrees = "W"
        Exit Function
    End If
    
    If Deg < -22.5 Then
        GetDirectionBearingFromDegrees = "NW"
        Exit Function
    End If
    
    If Deg < 22.5 Then
        GetDirectionBearingFromDegrees = "N"
        Exit Function
    End If
    
    If Deg < 67.5 Then
        GetDirectionBearingFromDegrees = "NE"
        Exit Function
    End If
    
    If Deg < 112.5 Then
        GetDirectionBearingFromDegrees = "E"
        Exit Function
    End If
        
    If Deg < 157.5 Then
        GetDirectionBearingFromDegrees = "SE"
        Exit Function
    End If
    
    GetDirectionBearingFromDegrees = "S"
    
End Function


Private Function GetBearing(ByVal p1Lat As Double, ByVal p1Lon As Double, ByVal p2Lat As Double, ByVal p2Lon As Double) As Double

    Dim x As Double
    Dim y As Double
    
    y = Math.Sin(p1Lon - p2Lon) * Math.Cos(p2Lat)
    x = Math.Cos(p1Lat) * Math.Sin(p2Lat) - Math.Sin(p1Lat) * Math.Cos(p2Lat) * Math.Cos(p1Lon - p2Lon)
    
    GetBearing = Atan2(-y, x)     
End Function


Private Function Atan2(ByVal y As Double, ByVal x As Double) As Double

    If x > 0 Then
        Atan2 = Atn(y / x)
    ElseIf x < 0 Then
        Atan2 = Atn(y / x) + PI
    Else
        Atan2 = PI / 2 * Sgn(y)
    End If
    
End Function

-George

Strong and bitter words indicate a weak cause. - Fortune cookie wisdom