先计算出坐标增量： dX=Xb-Xa dY=Yb-Ya dY=dY+1E-10 为了使除数不为零而加一个很小的数   方位角计算万能公式：Az=pi * (1-Sgn(dY)/2)-Atn(dX / dY) 单位为弧度 Az=Az * 180 /pi 单位为度   此公式计算无需判断象限，只需在值小于0时加上360即可！ 其中，sgn()为求符号函数，若dX<0时其值为-1，dX>0时为1，dX=0时为0。使用此公式不用判断所在象限，直接将坐标增量代入即可求出方位角值，在用计算器编程时若没有SGN()函数可自行判断并用一个变量代替! VBA代码： '方位角计算函数 Azimuth() 'Sx为起点X，Sy为起点Y 'Ex为终点X，Ey为终点Y 'Style指明返回值格式 'Style=-1为弧度格式 'Style=0为“DD MM SS”格式 'Style=1为“DD-MM-SS”格式 'Style=2为“DD°MMˊSS""”格式 'Style=其它值时返回十进制度值 Function Azimuth(Sx As Double, Sy As Double, Ex As Double, Ey As Double, Style As Integer) Dim DltX As Double, DltY As Double, A_tmp As Double, Pi As Double Pi = Atn(1) * 4 '定义PI值 DltX = Ex - Sx DltY = Ey - Sy + 1E-20 A_tmp = Pi * (1 - Sgn(DltY) / 2) - Atn(DltX / DltY) '计算方位角 A_tmp = A_tmp * 180 / Pi '转换为360进制角度 Azimuth = Deg2DMS(A_tmp, Style) End Function   '转换角度为度分秒 'Style=-1为弧度格式 'Style=0为“DD MM SS”格式 'Style=1为“DD-MM-SS”格式 'Style=2为“DD°MMˊSS""”格式 'Style=其它值时返回十进制度值 Function Deg2DMS(DegValue As Double, Style As Integer) Dim tD As Integer, tM As Integer, Ts As Double, tmp As Double tD = Int(DegValue) tmp = (DegValue - tD) * 60 tM = Int(tmp) tmp = (tmp - tM) * 60 Ts = Round(tmp, 1) select Case Style Case -1 '返回弧度 Deg2DMS = DegValue * Atn(1) * 4 / 180 Case 0 Deg2DMS = tD & " " & Format(tM, "00") & " " & Format(Ts, "00.0") Case 1 Deg2DMS = tD & "-" & Format(tM, "00") & "-" & Format(Ts, "00.0") Case 2 Deg2DMS = tD & "°" & Format(tM, "00") & "ˊ" & Format(Ts, "00.0") & """" Case Else Deg2DMS = DegValue End Select End Function   Function pol(AX As Double, AY As Double, Bx As Double, By As Double) As String pol = Azimuth(AX, AY, Bx, By, 2) & " " & Distance(AX, AY, Bx, By, 3) End Function   Function rec(alpha As String, dist As Double) As String Dim Alpha_Rad As Double Alpha_Rad = StringToRad(alpha) rec = "dx:" & Round(Cos(Alpha_Rad) * dist, 3) & " dy:" & Round(Sin(Alpha_Rad) * dist, 3) End Function   Function StringToRad(strAz) '将字符串格式方位角转换成弧度格式 Dim azSubStr If strAz <> "" Then azSubStr = Split(strAz, "-") If UBound(azSubStr) = 2 Then StringToRad = (azSubStr(0) + azSubStr(1) / 60 + azSubStr(2) / 3600) * Atn(1) * 4 / 180 Else StringToRad = 0 End If Else StringToRad = 0 End If End Function
上一篇：安全总结