Где ошибка в моей функции MS ACCESS VBA для вычисления новой координаты широты / долготы? - PullRequest
Новая
       16

Где ошибка в моей функции MS ACCESS VBA для вычисления новой координаты широты / долготы?

0 голосов
/ 14 апреля 2019

Я написал функцию MS Access VBA для вычисления новых координат широты / долготы по азимуту и ​​расстоянию. Однако это возвращает неправильные результаты, и я не могу понять, почему. Я использовал формулы в https://www.movable -type.co.uk / scripts / latlong.html Однако, когда я проверяю его на калькуляторе на этой странице, он дает неверные результаты. Например, NewLatLong(0, 0, 500, "K", 45) дает широту 5,54656612024095E-02 и долготу 0. Широта верна после преобразования в градусы для сравнения с калькулятором на странице, но почему долгота возвращается в ноль? Параметры для NewLatLong - это исходная широта и долгота в градусах, расстояние, единица расстояния (K = километры) и направление по часовой стрелке с севера в градусах.

MS Access не имеет всех требуемых тригонометрических функций. Я предоставил новые. Они были отдельно протестированы и, по-видимому, функционируют правильно.

Я не вижу, что не так с моим кодом. Может ли кто-нибудь помочь. 

Public Function NewLatLong(latD As Double, longD As Double, distance As Double, unit As String, bearingD As Double) As Double()
    Dim latlong(2) As Double
    Dim latR As Double, bearingR As Double
    latR = Radians(latD)
    bearingR = Radians(bearingD)
    Dim cosAngDistance As Double, sinAngDistance As Double
    cosAngDistance = Cos(distance / EarthRadius(unit))
    sinAngDistance = Sin(distance / EarthRadius(unit))
    latlong(0) = ArcSine(Sin(latR) * cosAngDistance + Cos(latR) * sinAngDistance * Cos(bearingR))
    latlong(1) = (Radians(longD) + ArcTan2(Sin(bearingR) * sinAngDistance * Cos(latR), cosAngDistance - Sin(latR) * Sin(latlong(0))) + 540) Mod 360 - 180
    NewLatLong = latlong
    Debug.Print latlong(0) & " " & latlong(1)
End Function

Public Function EarthRadius(unit As String) As Double
    If (unit = "M") Then
        EarthRadius = 3963
    ElseIf (unit = "K") Then
        EarthRadius = 6371
    Else
        EarthRadius = 3443.753
    End If
End Function


Public Function Pi() As Double
    Pi = 4 * Atn(1)
End Function

Public Function ArcCosine(value As Double) As Double
    ArcCosine = Atn(-value / Sqr(-value * value + 1)) + 2 * Atn(1)
End Function

Public Function ArcSine(value As Double) As Double
    ArcSine = Atn(value / Sqr(-value * value + 1))
End Function

Public Function ArcTan2(y As Double, x As Double) As Double
    If x > 0 Then
        ArcTan2 = Atn(y / x)
    ElseIf x < 0 Then
        ArcTan2 = Sgn(y) * (Pi() - Atn(Abs(y / x)))
    ElseIf y = 0 Then
        ArcTan2 = 0
    Else
        ArcTan2 = Sgn(y) * Pi() / 2
    End If
End Function

Public Function Radians(degrees As Double) As Double
    Radians = degrees * Pi() / 180
End Function

Ответы [ 2 ]

2 голосов
/ 14 апреля 2019

Хорошие новости и плохие новости. Хорошая новость в том, что ваш код работает почти идеально, плохая новость в том, что оператор Mod всегда возвращает целое число независимо от типов его параметров (почему Microsoft !? Почему!?).

Вместо latlong(1) = (Radians(longD) + ArcTan2(Sin(bearingR) * sinAngDistance * Cos(latR), cosAngDistance - Sin(latR) * Sin(latlong(0))) + 540) Mod 360 - 180 используйте код ниже, чтобы найти долготу 

Dim tempLong As Double
tempLong = Radians(longD) + ArcTan2(Sin(bearingR) * sinAngDistance * Cos(latR), cosAngDistance - Sin(latR) * Sin(latlong(0)))
' set longitude if calculated value less than 1
If tempLong < 1 Then
    latlong(1) = tempLong
' if greater than 1, add decimal part back to modulus result
Else
    Dim decLong As Double
    decLong = tempLong
    While decLong > 1
        decLong = decLong - 1
    Wend
    latlong(1) = ((tempLong + 540) Mod 360 - 180) + decLong
End If
1 голос
/ 14 апреля 2019

Я добавил свою собственную функцию мода, которая корректно работает с двойниками. 

Public Function ModDouble(dividend As Double, divisor As Double) As Double
    Dim x As Double
    x = Int(dividend / divisor)
    ModDouble = dividend - (x * divisor)
End Function

Это делает оригинальный код работать нормально, используя 

latlong(1) = ModDouble(radians(longD) + ArcTan2(Sin(bearingR) * sinAngDistance * Cos(latR), cosAngDistance - Sin(latR) * Sin(latlong(0))) + 540, 360) - 180

Но я собираюсь отметить ответ BankBuilder как правильный, поскольку он в основном обнаружил ошибку, которую я никогда бы не нашел.

...