Bearing between two points

[Luki117]

Hello,



i want to calculate the bearing between two airports. I have all GPS coordiantes in a table in this format: xx.xxxx and open them in four textfields (Text19,Text21,Text36,Text38) in a form.

I found these modul for the calculation:

Function BerechneGradzahl(Text38 As Double, Text21 As Double, Text36 As Double, text19 As Double) As Double
Dim deltaX As Double
Dim deltaY As Double
Dim winkel As Double


deltaX = Me.Text38 - Me.Text21
deltaY = Me.Text36 - Me.text19

If deltaX = 0 Then
If deltaY > 0 Then
angleInDegrees = 90
ElseIf deltaY < 0 Then
angleInDegrees = 270
Else
angleInDegrees = 0 ' Punkte sind identisch
End If
Else
angle = Atn(deltaY / deltaX)

angleInDegrees = angle * 57.2974693617699

If deltaX < 0 Then
angleInDegrees = angleInDegrees + 180
ElseIf deltaY < 0 Then
angleInDegrees = angleInDegrees + 360
End If
End If

BerechneGradzahl = angleInDegrees
End Function

I call this function with this code:

Private Sub Befehl35_Click()

Dim grad As Double
grad = BerechneGradzahl(Me.text19, Me.Text21, Me.Text36, Me.Text38)
MsgBox "Der Winkel zwischen den Punkten beträgt: " & grad & " Grad"
End Sub

Unfortunately it brings a wrong result. For EDDH (53.6304,9.9882) > EDDM (48.3538,11.7861) it calculates 288° instead of 168°.

Can anyone help me please to get am odea whats wrong with the code? Thanks in advance!

[jojowhite]

ChatGPT has this:

Const PI As Double = 3.14159265358979


Function GetBearingAngle(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Double
    Dim radLat1 As Double, radLat2 As Double
    Dim radLon1 As Double, radLon2 As Double
    Dim deltaLon As Double
    Dim y As Double, x As Double
    Dim bearing As Double
    
    ' Convert degrees to radians
    radLat1 = lat1 * PI / 180
    radLat2 = lat2 * PI / 180
    radLon1 = lon1 * PI / 180
    radLon2 = lon2 * PI / 180
    
    deltaLon = radLon2 - radLon1
    
    y = Sin(deltaLon) * Cos(radLat2)
    x = Cos(radLat1) * Sin(radLat2) - Sin(radLat1) * Cos(radLat2) * Cos(deltaLon)
    
    bearing = Atn2(y, x) ' Custom function defined below
    
    ' Convert from radians to degrees
    bearing = bearing * 180 / PI
    
    ' Normalize to 0-360
    If bearing < 0 Then
        bearing = bearing + 360
    End If
    
    GetBearingAngle = bearing
End Function


' VBA doesn't have Atn2, so we define it
Private Function Atn2(y As Double, x As Double) As Double
    If x > 0 Then
        Atn2 = Atn(y / x)
    ElseIf x < 0 Then
        Atn2 = Atn(y / x) + PI * Sgn(y)
    ElseIf y <> 0 Then
        Atn2 = PI / 2 * Sgn(y)
    Else
        Atn2 = 0 ' undefined, both x and y are 0
    End If
End Function

using your sample coordinate in immediate window:

?GetBearingAngle(53.6304,9.9882,48.3538,11.7861)

the result:

167.190985737513

[Welshgasman]

Give your controls meaningful names.

[June7]

Don't prefix variables with Me. That is referencing controls on form, not the declared variables. If you don't reference variables, don't bother declaring them.
Don't give variables same names as controls.

Declare all variables:
Dim angleInDegrees As Double, Angle As Double

Should use indentation in code to make it more readable.

With original code:
?BerechneGradzahl(53.6304,9.9882,48.3538,11.7861)
39.960743405306
?BerechneGradzahl(48.3538,53.6304,11.7861,9.9882)
161.183888613463
?BerechneGradzahl(53.6304,48.3538,9.9882,11.7861)
341.183888613463
?BerechneGradzahl(11.7861,9.9882,48.3538,53.6304)
288.813456978426
?BerechneGradzahl(9.9882,11.7861,53.6304,48.3538)
108.813456978425


Better go with jojo's version.