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

Code:
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