# 我的 MS ACCESS VBA 函数计算新的纬度/经度坐标的错误在哪里？

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
Dim cosAngDistance As Double, sinAngDistance As Double
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
ElseIf (unit = "K") Then
Else
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
``````

``````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
``````

0条评论