测量计算方位角万能通用公式及VB、VBA源代码

使用该公式不用判断象限，直接得出方位角值

设有两点A、B，坐标分别为A（Xa，Ya）、B（Xb、Yb），则
ΔX=Xb−XaΔX=Xb−Xa\Delta X=X_b-X_a
ΔY=Yb−YaΔY=Yb−Ya\Delta Y=Y_b-Y_a
ΔY=ΔY+1−10ΔY=ΔY+1−10\Delta Y=\Delta Y+1^{-10} 为了使除数不为零而加一个很小的数(注：在参与计算前加一个极小值后参与sign函数计算，这样sign(ΔYΔY\Delta Y)就只会出现1或-1两种情况)

则方位角：α=π(1−sign(ΔY)2)−arctan(ΔXΔY)α=π(1−sign(ΔY)2)−arctan(ΔXΔY)\alpha=\pi \left(1-\frac {sign(\Delta Y)}2 \right)-arctan \left( \frac {\Delta X}{\Delta Y} \right) ，计算值单位为弧度，用公式 α=180⋅απα=180⋅απ\alpha=\frac {180\cdot \alpha}\pi 将角度单位换算为十进制度，进而换算为度、分、秒格式。

其中，sign()为求符号函数，有些软件该函数名为sgn()，该函数在计算时若参数ΔXΔX\Delta X<0时其值为-1，ΔXΔX\Delta X>0时值为1，ΔXΔX\Delta X=0时取值为0。使用此公式不用判断所在象限，直接将坐标增量代入即可求出方位角值，在用计算器编程时若没有sign()函数可自行判断并用一个变量代替!

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 FunctionFunction aa(area1 As Double, area2 As Double) As Double
Dim rat As Double
rat = area1 / area2
If (rat < 0.6 Or rat > (1 / 0.6)) And area1 <> 0 And area2 <> 0 Then
aa = (area1 + area2 + sqrt(area1 * area2)) / 3
Else
aa = (area1 + area2) / 2
End If
End FunctionFunction Distance(Sx As Double, Sy As Double, Ex As Double, Ey As Double, Precision As Integer) As Double
Dim DltX As Double, DltY As Double
DltX = Ex - Sx
DltY = Ey - Sy
Distance = Round(Sqr(DltX * DltX + DltY * DltY), Precision)
End FunctionFunction inValue(stgA As Double, Av As Double, stgB As Double, Bv As Double, stgC As Double) As Double
If stgB <> stgA Then
inValue = Av + (Bv - Av) / (stgB - stgA) * (stgC - stgA)
Else
inValue = -9.9999999
End If
End FunctionFunction 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 FunctionFunction 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 FunctionFunction 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'竹山龙背湾 2010-09-08
'判断是否存在坐标系定义表
Function CoSysTableExist() As Boolean
Dim i As Long
CoSysTableExist = False
For i = 1 To Sheets.Count
If Sheets(i).Name = "CoSys" Then
CoSysTableExist = True
Exit For
End If
Next
'If Not CoSysTableExist Then
'Dim NewTable As Sheets
'End If
End Function'查找坐标系名称并返回参数
Function CoSysFndPara(CoSysName As String) As String
Dim FndIndex As Long
If CoSysTableExist ThenFor FndIndex = 1 To 100If Trim(Sheets("CoSys").Range("A" & FndIndex).Text) = Trim(CoSysName) ThenCoSysFndPara = Trim(Sheets("CoSys").Range("B" & FndIndex).Text)                      'AXCoSysFndPara = CoSysFndPara & "," & Trim(Sheets("CoSys").Range("C" & FndIndex).Text) 'AYCoSysFndPara = CoSysFndPara & "," & Trim(Sheets("CoSys").Range("D" & FndIndex).Text) 'AxCoSysFndPara = CoSysFndPara & "," & Trim(Sheets("CoSys").Range("E" & FndIndex).Text) 'AyIf InStr(Trim(Sheets("CoSys").Range("F" & FndIndex).Text), "-") <> 0 ThenCoSysFndPara = CoSysFndPara & "," & Trim(Sheets("CoSys").Range("F" & FndIndex).Text) 'azElseCoSysFndPara = CoSysFndPara & "," & Azimuth(Trim(Sheets("CoSys").Range("B" & FndIndex).Text), Trim(Sheets("CoSys").Range("C" & FndIndex).Text), Trim(Sheets("CoSys").Range("F" & FndIndex).Text), Trim(Sheets("CoSys").Range("G" & FndIndex).Text), 1) 'BY or TypeEnd IfExit ForEnd IfNext
ElseCoSysFndPara = ""
End If
End Function'测图坐标转施工坐标
Function NE2SO_STG(CoSysName As String, P_N As Double, P_E As Double) As Double
Dim coSysParaStr As String
Dim coSysPara
Dim O_X As Double, O_Y As Double, O_Stage As Double, O_Offset As Double, X_Line_Azimuth_Str As Double
'读取坐标系参数
coSysParaStr = CoSysFndPara(CoSysName)
coSysPara = Split(coSysParaStr, ",")
O_X = coSysPara(0)         '基点测图坐标
O_Y = coSysPara(1)
O_Stage = coSysPara(2)     '基点施工坐标
O_Offset = coSysPara(3)
X_Line_Azimuth_Str = StringToRad(coSysPara(4)) '施工坐标系X轴方位角,弧度
NE2SO_STG = Round((P_N - O_X) * Cos(X_Line_Azimuth_Str) + (P_E - O_Y) * Sin(X_Line_Azimuth_Str) + O_Stage, 3)
End Function'测图坐标转施工坐标
Function NE2SO_OFF(CoSysName As String, P_N As Double, P_E As Double) As Double
Dim coSysParaStr As String
Dim coSysPara
Dim O_X As Double, O_Y As Double, O_Stage As Double, O_Offset As Double, X_Line_Azimuth_Str As Double
'读取坐标系参数
coSysParaStr = CoSysFndPara(CoSysName)
coSysPara = Split(coSysParaStr, ",")
O_X = coSysPara(0)         '基点测图坐标
O_Y = coSysPara(1)
O_Stage = coSysPara(2)     '基点施工坐标
O_Offset = coSysPara(3)
X_Line_Azimuth_Str = StringToRad(coSysPara(4)) '施工坐标系X轴方位角,弧度
NE2SO_OFF = Round(-(P_N - O_X) * Sin(X_Line_Azimuth_Str) + (P_E - O_Y) * Cos(X_Line_Azimuth_Str) + O_Offset, 3)
End Function'测图坐标转施工坐标
Function SO2NE_N(CoSysName As String, P_x As Double, P_y As Double) As Double
Dim coSysParaStr As String
Dim coSysPara
Dim O_X As Double, O_Y As Double, O_Stage As Double, O_Offset As Double, X_Line_Azimuth_Str As Double
'读取坐标系参数
coSysParaStr = CoSysFndPara(CoSysName)
coSysPara = Split(coSysParaStr, ",")
O_X = coSysPara(0)         '基点测图坐标
O_Y = coSysPara(1)
O_Stage = coSysPara(2)     '基点施工坐标
O_Offset = coSysPara(3)
X_Line_Azimuth_Str = StringToRad(coSysPara(4)) '施工坐标系X轴方位角,弧度
SO2NE_N = Round(O_X + (P_x - O_Stage) * Cos(X_Line_Azimuth_Str) - (P_y - O_Offset) * Sin(X_Line_Azimuth_Str), 3)
End Function'测图坐标转施工坐标
Function SO2NE_E(CoSysName As String, P_x As Double, P_y As Double) As Double
Dim coSysParaStr As String
Dim coSysPara
Dim O_X As Double, O_Y As Double, O_Stage As Double, O_Offset As Double, X_Line_Azimuth_Str As Double
'读取坐标系参数
coSysParaStr = CoSysFndPara(CoSysName)
coSysPara = Split(coSysParaStr, ",")
O_X = coSysPara(0)         '基点测图坐标
O_Y = coSysPara(1)
O_Stage = coSysPara(2)     '基点施工坐标
O_Offset = coSysPara(3)
X_Line_Azimuth_Str = StringToRad(coSysPara(4)) '施工坐标系X轴方位角,弧度
SO2NE_E = Round(O_Y + (P_x - O_Stage) * Sin(X_Line_Azimuth_Str) + (P_y - O_Offset) * Cos(X_Line_Azimuth_Str), 3)
End Function

测量计算方位角万能通用公式及VB、VBA源代码相关推荐

计算递归算法时间复杂度通用公式
最近看<算法导论>公开课视频,虽然本科没有学过此类课程,但也能感觉得出来教学水平高于母校,在此就吐槽这一句,进入正题. 第一二课讲到一种分析递归算法的时间复杂度的方法--递归树.长期处于学 ...
线路测量通用公式的推导及编程
wyqzm网友: 问几个问题1.点到中线的垂距计算公式是怎么推导出来的,就是那个S＝(XA-XB)SIN....我怎么也看不明白这是一个什么样的公式?别笑话哦! 2.假如一条线路有很多的曲线组合,怎么 ...
利用Gauss-Legendre 5点通用公式计算线路中边桩坐标并计算放样数据
.正算主程序 GSZS 10→DimZ "X0"?I:"Y0"?S:"K0" ?O:"F0"?G:"KN&q ...
坐标方位角计算通用公式
坐标方位角计算通用公式:http://www.docin.com/p-465612644.html 坐标方位角计算通用公式及编程方法:http://www.docin.com/p-875488803. ...
c语言simpson积分计算方法,数值分析复化Simpson积分公式和复化梯形积分公式计算积分的通用程序...
数值分析复化Simpson积分公式和复化梯形积分公式计算积分的通用程序数值分析第五次程序作业 PB09001057 孙琪 [问题] 分别编写用复化Simpson积分公式和复化梯形积分公式计算积分的通 ...
试列出种计算机组生产率的公式,农业机械化生产学思考题
从可持续观点,今后在农业机械化发展中要注意什么问题? 7. 我国有哪些典型的机械化农业生产体系?试指出北京郊区在相同的自然经济条件下,为什么会出现一年两熟和两年三熟机械化生产体系?各有何优缺点? 第二 ...
2023年系统集成项目管理工程师【计算要点和常用公式】
一.常用缩写缩写含义 PV 计划费用 AC 实际费用 EV 挣值 SV 进度偏差 CV 成本偏差 SPI 进度绩效指数 CPI 成本绩效指数 BAC 完工预算 EAC 完工估算 ETC 完工尚需估 ...
python画位势高度图_位势高度计算中气压-高度公式的简化及其误差
位势高度计算中气压高度公式的简化及其误差崔喜爱 1 顾浩 2 曹云昌 1 [摘要] 摘要:对高空气象学领域而言 , 位势高度是重要的一个参量,为天气学和气候学业务应用所提供的高度一般是位势高度. ...
信捷XDPLC十轴(包含)及以下万能通用程序模板，用进制数据和S状态完美结合
信捷XDPLC十轴(包含)及以下万能通用程序模板,用进制数据和S状态完美结合. 各提示,报警,数据计算处理,再次细分. 通过十几年电气非标项目的自身摸索,结合日本,台湾,韩国等电气工程师同仁编程特点, ...

测量计算方位角万能通用公式及VB、VBA源代码

使用该公式不用判断象限，直接得出方位角值

测量计算方位角万能通用公式及VB、VBA源代码相关推荐

最新文章

热门文章