distance.rar

Function distance(lng1 As Double, lat1 As Double, lng2 As Double, lat2 As Double) Dim Radius As Double Dim DisA As Double Dim DisB As Double Dim DisC As Double Dim Dpwr2 As Double Dim DisD As Double Dim Long1 As Double Dim Lati1 As Double Dim Long2 As Double Dim Lati2 As Double Dim DeltaLng As Double Dim DeltaLat As Double Dim x As Double Const EarthRadius = 6371000 'METER Const PI = 3.14159265358979 Long1 = PI * lng1 / 180 '转换为弧度 Long2 = PI * lng2 / 180 Lati1 = PI * lat1 / 180 Lati2 = PI * lat2 / 180 DeltaLng = Long2 - Long1 DeltaLat = Lati2 - Lati1 Radius = Cos(Lati1) DisA = Radius * Sin(DeltaLng) DisB = Radius * (1 - Cos(DeltaLng)) DisC = DeltaLat Dpwr2 = DisA ^ 2 + DisB ^ 2 + DisC ^ 2 - 2 * DisB * DisC * Sin((Lati1 + Lati2) / 2) '余弦定理，cos已转为sin DisD = Sqr(Dpwr2) x = DisD / 2 distance = Asin(x) * 2 * EarthRadius End Function Function Atn2(atnX As Double, atnY As Double) As Double Dim atnPI If atnX < 0 Then atnPI = 3.14159265358979 End If If atnX = 0 Then If atnY >= 0 Then Atn2 = 1.570796327 Else Atn2 = -1.570796327 End If Else Atn2 = Atn(atnY / atnX) + atnPI End If End Function Function Max(maxVal1 As Variant, maxVal2 As Variant) As Variant If maxVal2 > maxVal1 Then Max = maxVal2 Else Max = maxVal1 End If End Function Function Min(minVal1 As Variant, minVal2 As Variant) As Variant If minVal2 < minVal1 Then Min = minVal2 Else Min = minVal1 End If End Function Function Acos(acosVal As Double) As Double If acosVal = 1 Then Acos = 0 ElseIf acosVal = -1 Then Acos = -3.14159265358979 Else Acos = Atn(-acosVal / Sqr(-acosVal * acosVal + 1)) + 2 * Atn(1) End If End Function Function Asin(asinVal As Double) As Double If asinVal = 1 Then Asin = 1.570796327 ElseIf asinVal = -1 Then Asin = -1.570796327 Else Asin = Atn(asinVal / Sqr(-asinVal * asinVal + 1)) End If End Function Function Inside360(Angle As Double) '输入角度，输出范围0~360 Inside360 = (Angle + 1440) Mod 360 End Function Function Inside180(Angle As Double) '输入角度，输出范围-180~180 Angle = Inside360(Angle) If Angle > 180 Then Inside180 = Angle - 360 Else Inside180 = Angle End If End Function Function MappingTo90(Angle As Double) '输入角度，输出范围-90~90 Angle = Inside360(Angle) If Angle < 90 Then '以y轴为坐标轴，映射到第一第四象限 MappingTo90 = Angle ElseIf Angle > 270 Then MappingTo90 = Angle - 360 Else MappingTo90 = 180 - Angle End If End Function Function Radians(Angle As Double) Radians = Angle / 180 * 3.14159265358979 End Function