测量方位角计算公式VB源代码

方位角的计算方法有多种，根据公式与工具有不同，现有四种计算方法：一、测量教材上的计算方法，需要判断象限，对了解原理有一定帮助，但在实际工作中不太实用，在此不予介绍，使用此方法计算的VB或VBA代码如下：Public Const PI = 3.14159265359Function Pol（x1 As Double， y1 As Double， x2 As Double， y2 As Double） As Double '计算直线的方位角Dim Sub_y As DoubleSub_y = Abs（y2 - y1）If Sub_y = 0 ThenSub_y = 0.0000000001End IfPol = Atn（（Abs（x2 - x1）） / Sub_y）If x2 > x1 And y2 >= y1 Then '0-90ElseIf x2 < x1 And y2 <= y1 Then '180-270Pol = PI + PolElseIf x2 < x1 And y2 >= y1 Then '270-360Pol = 2 * PI - PolElseIf x2 >= x1 And y2 <= y1 Then '90-180Pol = PI - PolEnd IfEnd Function二、计算器上的pol（）函数，用pol（dx，dy）计算，返回两点间距离与方位角，如角度值为负+360即可，具体使用方法参照说明书上的pol（）函数介绍；三、方位角通用万能公式：此万能公式的VB或VBA代码如下：Public Const PI = 3.14159265359Function Pol（x1 As Double， y1 As Double， x2 As Double， y2 As Double） As Double '计算直线的方位角Dim Sub_x As DoubleSub_x = x2 - x1 + 0.0000000001Pol = PI - Sgn（Sub_x） * PI / 2 - Atn（（y2 - y1） / Sub_x）End Functionsgn（）函数为符号函数：sgn（x）的值只有三个：当x小于0时sgn（x）的值为-1当x大于0时sgn（x）的值为1当x等于0时sgn（x）的值为0计算器上没有此函数，在编程时可用下列代码实现此函数功能：if x<0 thensgn（x）=-1elseif x>0 thensgn（x）=1eslesgn（x）=0end if四、另一个通用公式：S12=sqr（（x2-x1）2+（y2-y1）2）= sqr（△x2+△y2）A12=arcsin（（y2-y1）/S12）S12为测站点1至放样点2的距离；A12为测站点1至放样点2的坐标方位角。

⽤（VB）实现测量坐标转换系统坐标转换系统（VB）东华理⼯⼤学Theory 北京54⾼斯坐标转换西安80⾼斯坐标转换系统1.0版多点处理结果核⼼源代码：'⾼斯坐标转换成⼤地坐标过程Public Sub GausReverse(a As Double, f As Double, x() As Double, y() As Double, RB() As Double, RL() As Double, k As Integer)Dim i As Integer, fxb As Double, fxbl As Double, fybl As Doublee = Sqr(2 *f - f ^ 2)C = a / Sqr(1 - e ^ 2)e2 = e / Sqr(1 - e ^ 2)beita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kB0 = x(i) / (C * beita0)Dofxb = 0fxbl = 0fybl = 0t = Tan(B0)yita = e2 * Cos(B0)n = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)a2 = (1 / 2) * n * Sin(B0) * Cos(B0)a3 = (1 / 6) * n * (Cos(B0)) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(B0) * (Cos(B0)) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4)a5 = (1 / 120) * n * (Cos(B0)) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2) a6 = (1 / 720) * n * Sin(B0) * (Cos(B0)) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = fxb + (C * beita6 + C * beita8 * (Cos(B0)) ^ 2) * (Cos(B0)) ^ 2fxb = (fxb + C * beita4) * (Cos(B0)) ^ 2fxb = (fxb + C * beita2) * Sin(B0) * Cos(B0)fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5RB(i) = (x(i) - fxb - fxbl) / (C * beita0)a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))RL(i) = (y(i) - fybl) / a1If Abs(RB(i) - B0) <= 0.0000000001 And Abs(RL(i) - l0) <= 0.0000000001 ThenRL(i) = zrl + l0Exit DoElseB0 = RB(i)l0 = RL(i)End IfLoopNext iEnd Sub'⼤地坐标B，L转换为⾼斯坐标x,y的过程Public Sub BLHGaus(RB() As Double, RL() As Double, GX() As Double, GY() As Double, a As Double, f As Double, k As Integer)Dim l0 As Double, fxb As Double, gxbl As Double, fybl As Doublebeita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kl0 = RL(i) - zrln = a / Sqr(1 - e ^ 2 * (Sin(RB(i))) ^ 2)t = Tan(RB(i))yita = e2 * Cos(RB(i))a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))a2 = (1 / 2) * n * Sin(RB(i)) * Cos(RB(i))a3 = (1 / 6) * n * (Cos(RB(i))) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4) a5 = (1 / 120) * n * (Cos(RB(i))) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2)a6 = (1 / 720) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = 0fxbl = 0fybl = 0fxb = fxb + (C * beita6 + C * beita8 * (Cos(RB(i))) ^ 2) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita4) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita2) * Sin(RB(i)) * Cos(RB(i))fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5GX(i) = C * beita0 * RB(i) + fxb + fxblGY(i) = a1 * l0 + fyblNext iEnd Sub'三维直⾓坐标XYZ转换成⼤地坐标BLH过程Public Sub BLHXYZ1(SX() As Double, SY() As Double, SZ() As Double, RB() As Double, RL() As Double, RH() As Double, k As Integer, a As Double, f As Double)Dim i As IntegerDim N0 As Double, H0 As Double, B0 As Double, sb As Double, Ni As Doublesb = a * Sqr(1 - e ^ 2)pi = 4 * Atn(1)For i = 1 To kRL(i) = Atn(Abs(SY(i) / SX(i)))If SY(i) > 0 And SX(i) < 0 ThenRL(i) = pi - RL(i)End IfN0 = aH0 = Sqr(SX(i) ^ 2 + SY(i) ^ 2 + SZ(i) ^ 2) - Sqr(a * sb)B0 = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * N0 / (N0 + H0))))DoNi = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)RH(i) = Sqr(SX(i) ^ 2 + SY(i) ^ 2) / Cos(B0) - NiRB(i) = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * Ni / (Ni + RH(i)))))If Abs(RB(i) - B0) < 0.0000000001 And Abs(RH(i) - H0) < 0.0000000001 ThenExit DoElseB0 = RB(i)H0 = RH(i)End IfLoopNext iEnd Sub'最⼩⼆乘法求解七参数布尔萨模型Public Sub SloveBuersa(XD() As Double, XG() As Double, R() As Double, k As Integer) Dim a0 As Double, a1 As Double, a2 As DoubleFor i = 1 To ka0 = XG(i, 1)a1 = XG(i, 2)a2 = XG(i, 3)Call Cjuzhen(a0, a1, a2, G())For j = 1 To 3Next sNext jNext iFor i = 1 To kFor j = 1 To 3LC(3 * (i - 1) + j) = XD(i, j) - XG(i, j) Next jNext iFor i = 1 To 3 * kFor j = 1 To 7ET(j, i) = EC(i, j)Next jNext iFor i = 1 To 7For j = 1 To 7CTC(i, j) = 0For s = 1 To 3 * kCTC(i, j) = CTC(i, j) + ET(i, s) * EC(s, j) Next sNext jNext iFor i = 1 To 7For j = 1 To 7CTC1(i, j) = CTC(i, j)Next jNext iCall Comm.Reverse(CTC(), 7)For i = 1 To 7CTL(i) = 0For j = 1 To 3 * kCTL(i) = CTL(i) + ET(i, j) * LC(j)Next jNext iFor j = 1 To 7R(i) = R(i) + CTC(i, j) * CTL(j)Next jNext iEnd Sub'布尔萨模型系数矩阵⼀部分Public Sub Cjuzhen(x As Double, y As Double, z As Double, D() As Double) For i = 1 To 3D(i, i) = 1Next iD(1, 4) = xD(1, 5) = 0D(1, 6) = -zD(1, 7) = yD(2, 4) = yD(2, 5) = zD(2, 6) = 0D(2, 7) = -xD(3, 4) = zD(3, 5) = -yD(3, 6) = xD(3, 7) = 0End Sub'使⽤七参数求解新坐标系下的坐标Public Sub UseBuersa(XD() As Double, XG() As Double, EC() As Double, R() As Double, k As Integer) Dim a1 As Double, a2 As Double, a3 As Double, CR(1000) As DoubleFor i = 1 To ka1 = XG(i, 1)a2 = XG(i, 2)a3 = XG(i, 3)Call Cjuzhen(a1, a2, a3, G())For j = 1 To 3For s = 1 To 7EC(3 * (i - 1) + j, s) = G(j, s)Next iFor i = 1 To 3 * kCR(i) = 0For j = 1 To 7CR(i) = CR(i) + EC(i, j) * R(j)Next jNext iFor i = 1 To kFor j = 1 To 3XD(i, j) = XG(i, j) + CR(3 * (i - 1) + j)Next jNext iEnd Sub'弧度化为度分秒'弧度化成⾓度Public Sub RuJiao(ByVal rudu As Double, jiaodu As Double) Dim ja As Integer, jb As Integer, jc As Double pi = 4 * Atn(1)jiaodu = rudu * 180 / pija = Fix(jiaodu)jb = Fix((jiaodu - ja) * 60)jc = ((jiaodu - ja) * 60 - jb) * 60jiaodu = ja + jb / 100 + jc / 10000End Sub'矩阵求逆Public Sub Reverse(Ba, n%)Dim k%, K1%, j%, i%Dim C As Double, Aa(100, 200)For i = 1 To nFor j = 1 To nAa(i, j) = Ba(i, j)Next jNext iFor i = 1 To nAa(i, j + n) = 0End IfNext jNext iFor k = 1 To nFor j = k To nIf Aa(j, k) <> 0 Then GoTo 200Next jMsgBox "逆矩阵不存在": Exit Sub 200: For i = 1 To 2 * n C = Aa(k, i)Aa(k, i) = Aa(j, i)Aa(j, i) = CNext iC = 1 / Aa(k, k)For j = 1 To 2 * nAa(k, j) = C * Aa(k, j)Next jFor K1 = 1 To nIf K1 <> k ThenC = -Aa(K1, k)For j = 1 To 2 * nAa(K1, j) = Aa(K1, j) + C * Aa(k, j)Next jEnd IfNext K1Next kFor i = 1 To nFor j = n + 1 To 2 * nAa(i, j - n) = Aa(i, j)Next jNext iNext iEnd Sub'⾓度化成弧度Public Sub JiaoHu(ByVal jiaodu As Double, hudu As Double) Dim ja As Double, jb As Double, jc As Double pi = 4 * Atn(1)ja = Fix(jiaodu)jb = Fix((jiaodu - ja) * 100)jc = ((jiaodu - ja) * 100 - jb) * 100jiaodu = ja + jb / 60 + jc / 3600hudu = jiaodu * pi / 180End Sub。

实验报告课程名称：测量程序设计任课老师：段伟姓名：王森学号：1476210082016年12月24日综合实验设计：窗体及代码如下7Part1：封面代码：Private Sub Timer1_Timer()Label1.Left = Label1.Left + 100If Label1.Left + Label1.Width > frmCover.Width ThenTimer2.Enabled = True: Timer1.Enabled = FalseEnd IfEnd SubPrivate Sub Timer2_Timer()Label1.Left = Label1.Left - 100If Label1.Left < 0 ThenTimer1.Enabled = True: Timer2.Enabled = FalseEnd IfEnd SubPrivate Sub Timer3_Timer()Label7.Caption = NowEnd SubPrivate Sub cmdEnter_Click()If i > 2 ThenMsgBox "您已输错密码超过三次，程序将关闭!", , "输入次数超限"EndEnd IfIf txtUserName.Text = "admire" And txtPassWord.Text = "1111" ThenFormMain.Show: Unload MeElseMsgBox "密码错误,请从新输入!" & vbCrLf & "还有" & Str(4 - i) & "次机会!", , "密码错误"txtPassWord.Text = "": txtPassWord.SetFocus: i = i + 1End IfEnd SubPrivate Sub cmdExit_Click() EndEnd SubPart2：主函数代码：Private Sub cmdExit_Click() EndEnd SubPrivate Sub cmdH_Click() FormMain.Hide: frmH.Show End SubPrivate Sub cmdqh_Click() FormMain.Hide: frmqh.Show End SubPrivate Sub cmdS_Click() FormMain.Hide: frmMain.Show End SubPart3：方位角计算Dim iRound%, dblAngle() As Double, n%Const PI = 3.14159265Private Sub Command1_Click()Dim duLA%, fenLA%, miaoLA%, duLB%, fenLB%, miaoLB%, duRA%, fenRA%, miaoRA%, duRB%, fenRB%, miaoRB%Dim duHAL%, fenHAL%, miaoHAL%, duHAR%, fenHAR%, miaoHAR%, duWH%, fenWH%, miaoWH%Dim halfL As Double, halfR As Double, angle As DoubleduLA = Val(Text1.Text)fenLA = Val(Text2.Text)miaoLA = Val(Text3.Text)duLB = Val(Text4.Text)fenLB = Val(Text5.Text)miaoLB = Val(Text6.Text)duRA = Val(Text7.Text)fenRA = Val(Text8.Text)miaoRA = Val(Text9.Text)duRB = Val(Text10.Text)fenRB = Val(Text11.Text)miaoRB = Val(Text12.Text)halfL = (duLB - duLA) + (fenLB - fenLA) / 60 + (miaoLB - miaoLA) / 3600halfR = (duRB - duRA) + (fenRB - fenRA) / 60 + (miaoRB - miaoRA) / 3600If Abs(halfL - halfR) * 3600 > 40 ThenMsgBox "半测回差超限，请检查观测和输入是否正确！", , "角差超限"Exit SubEnd Ifangle = (halfL + halfR) / 2duHAL = Int(halfL)halfL = (halfL - duHAL) * 60fenHAL = Int(halfL)halfL = (halfL - fenHAL) * 60miaoHAL = Int(halfL + 0.5)duHAR = Int(halfR)halfR = (halfR - duHAR) * 60fenHAR = Int(halfR)halfR = (halfR - fenHAR) * 60miaoHAR = Int(halfR + 0.5)duWH = Int(angle)angle = (angle - duWH) * 60fenWH = Int(angle)angle = (angle - fenWH) * 60miaoWH = Int(angle + 0.5)Text13.Text = Str(duHAL)Text14.Text = Str(fenHAL) Text15.Text = Str(miaoHAL) Text16.Text = Str(duHAR)Text17.Text = Str(fenHAR) Text18.Text = Str(miaoHAR) Text19.Text = Str(duWH)Text20.Text = Str(fenWH)Text21.Text = Str(miaoWH) End SubPrivate Sub Command2_Click() Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = ""Text6.Text = ""Text7.Text = ""Text8.Text = ""Text9.Text = ""Text10.Text = ""Text11.Text = ""Text12.Text = ""Text13.Text = ""Text14.Text = ""Text15.Text = ""Text16.Text = ""Text17.Text = ""Text18.Text = ""Text19.Text = ""Text20.Text = ""Text21.Text = ""Text1.SetFocusEnd SubPrivate Sub Command3_Click() EndEnd SubPrivate Sub Command4_Click() n = Val(Text22.Text)ReDim dblAngle(1 To n) As DoubleCommand2_ClickiRound = iRound + 1Label28.Visible = TrueLabel28.Caption = "正在输入第1个测回，共" & Trim(Str(n)) & "个。

一、输入界面1.单击VB中的“运行”快捷键，弹出图1所示的运行界面图12.在图1中选择按钮，进入坐标正算模式，如图2图2在图2中输入已知点坐标、已知点至未知点的边长和坐标方位角、保留的小数位数，点名可不输入，输入完后，选择“计算”按钮。

如要计算多个点坐标，则计算完一个点后用鼠标单击“刷新”按钮，重复以上操作即可。

若想退出坐标正算功能，用鼠标左键单击“退出”按钮，在弹出的提示框中选择“是”，如图3图33. 在图1中选择按钮，进入坐标反算模式，如图4图4在图4中输入两个已知点坐标、保留的小数位数，点名可不输入，输入完后，选择“计算”按钮。

如要计算多个点坐标，则计算完一个点后用鼠标单击“刷新”按钮，重复以上操作即可。

若想退出坐标反算功能，用鼠标左键单击“退出”按钮，在弹出的提示框中选择“是”，如图3二、输入，输出数据表格中的方位角以小数的形式输入，例如“321°18′56″“的输入格式为321.1856，若度数为321°18′56.5″的输入格式为321.18565，坐标的保留位数保留三位，别的以此类推方位角以小数的形式输入，例如“164°02′02″”的输入格式为164.0202，若度数为164°02′02.5″的输入格式为164.02025，表格中的方位角的小数保留位数为0位三、源代码Private Sub Command1_Click()If Option1.Value = True And Option2.Value = False Thenzhengsuan '当选择坐标正算按钮时调用坐标正算程序End IfIf Option1.Value = False And Option2.Value = True Thenfansuan '当选择坐标反算按钮时调用坐标反算程序End IfEnd Sub'坐标正算程序Private Sub zhengsuan()Dim s As DoubleDim a As DoubleDim x As DoubleDim y As DoubleDim m As DoubleDim n As DoubleDim degree As DoubleDim minute As DoubleDim second As DoubleDim rad As DoubleDim bbt As IntegerDim result As DoubleDim p As Doubles = Val(Text5.Text)a = Val(Text6.Text)Rad_do a, degree, minute, second, rad '调用将度分秒转化为弧度的程序x = Val(Text2.Text) + s * Cos(rad)y = Val(Text3.Text) + s * Sin(rad)p = Fix(x)x = x - pbbt = Val(Text4.Text)Sheru m, n, bbt, x, result '调用奇进偶舍程序Label12.Caption = result + pp = Fix(y)y = y - pSheru m, n, bbt, y, result '调用奇进偶舍程序Label13.Caption = result + pEnd Sub'坐标反算程序Private Sub fansuan()Dim s As DoubleDim x As DoubleDim y As DoubleDim sing As DoubleDim m As DoubleDim n As DoubleDim f As DoubleDim result As DoubleDim bbt As IntegerDim degree As DoubleDim minute As DoubleDim second As DoubleDim rad As DoubleDim p As Doublex = Val(Text5.Text)y = Val(Text6.Text)m = y - Val(Text3.Text)n = x - Val(Text2.Text)If n <> 0 Thenm = m / nrad = Atn(m)sing = Sgn(rad)End Ifdegree_m_s degree, minute, second, rad '调用将弧度转化为度分秒的程序bbt = Val(Text8.Text)m = second * 10 ^ bbtp = Fix(second)second = second - pSheru m, n, bbt, second, result '调用奇进偶舍程序second = result + pfangweijiao degree, minute, second, (x - Val(Text2.Text)), (y - Val(Text3.Text)), sing '调用计算坐标方位角的程序zhuanhua minute, second, degreesecond = second * 10 ^ bbtLabel13.Caption = degree & "." & minute & secondIf minute < 10 ThenLabel13.Caption = degree & "." & "0" & minute & secondEnd IfIf second < 10 ^ (bbt + 1) ThenLabel13.Caption = degree & "." & minute & "0" & secondEnd IfIf minute < 10 And second < 10 ^ (bbt + 1) ThenLabel13.Caption = degree & "." & "0" & minute & "0" & secondEnd If'计算边长Ss = (y - Val(Text3.Text)) ^ 2 + (x - Val(Text2.Text)) ^ 2s = Sqr(s)bbt = Val(Text4.Text)p = Fix(s)s = s - pSheru m, n, bbt, s, result '调用奇进偶舍程序Label12.Caption = result + pEnd Sub'将度分秒化为弧度Private Sub Rad_do(ByVal a As Double, ByVal degree As Double, ByVal minute As Double, ByVal second As Double, ByRef rad As Double)degree = a \ 1a = a - Fix(a)minute = Fix(a * 100)second = (a * 100 - minute) * 100rad = (3600 * degree + 60 * minute + second) / 206264.8063End Sub'将弧度转化为度分秒的程序Private Sub degree_m_s(ByRef degree As Double, ByRef minute As Double, ByRef second As Double, ByRef rad As Double)rad = rad * 180 / 3.1415926535degree = rad \ 1rad = (rad - degree) * 60minute = rad \ 1second = (rad - minute) * 60End Sub'奇进偶舍程序Private Sub Sheru(ByVal m As Double, ByVal n As Double, ByVal bbt As Double, ByVal x As Double, ByRef result As Double)m = x * 10 ^ bbtn = m - m \ 1If n < 0.5 Thenresult = (m \ 1) / 10 ^ bbtElseIf n > 0.5 Thenresult = (m \ 1 + 1) / 10 ^ bbtElseIf (m \ 1) Mod 2 Thenresult = (m \ 1 + 1) / 10 ^ bbtElseresult = (m \ 1) / 10 ^ bbtEnd IfEnd IfEnd Sub'计算坐标方位角的程序Private Sub fangweijiao(ByRef degree As Double, ByRef minute As Double, ByRef second As Double, ByVal m, ByVal n As Double, ByVal sing As Integer)Dim i As IntegerIf sing = 1 ThenIf n < 0 And m < 0 Thendegree = degree + 180End IfElseIf sing = -1 ThenIf n > 0 And m < 0 Thendegree = degree + 179minute = minute + 59second = second + 60ElseIf n < 0 And m > 0 Thendegree = degree + 359minute = minute + 59second = second + 60End IfEnd Ifi = Sgn(n)If m <> 0 ThenIf m < 0 And n = 0 Thendegree = "180"ElseIf m > 0 And n = 0 Thendegree = "0"End IfElseIf i = 1 Thendegree = "90"ElseIf i = -1 Thendegree = "270"ElseMsgBox "您输入了两个相同的点，请重新输入！"End IfEnd IfEnd Sub'当分秒超过60时须向上一级进位及方位角度数超过360°须减360°的程序Private Sub zhuanhua(ByRef minute As Double, ByRef second As Double, ByRef degree As Double)If second >= 60 Thenminute = minute + 1second = second - 60ElseIf second < 0 Thenminute = minute - 1second = second + 60End IfIf minute >= 60 Thendegree = degree + 1minute = minute - 60ElseIf minute < 0 Thendegree = degree - 1minute = minute + 60End IfIf degree >= 360 Thendegree = degree - 360End IfEnd Sub'退出程序Private Sub Command3_Click()If MsgBox("是否退出？", vbYesNo, "提示") = vbYes ThenUnload MeEnd IfEnd Sub'刷新程序Private Sub Command4_Click()Text2.Text = ""Text3.Text = ""Text4.Text = 3Text5.Text = ""Text6.Text = ""Text8.Text = 1Label12.Caption = ""Label13.Caption = ""End Sub'设置窗体的大小，使窗体充满整个屏幕并对label6和label7赋值Private Sub Form_Load()Me.Height = Screen.HeightMe.Width = Screen.WidthMe.Left = 0Me.Top = 0Label6.Caption = "边长（S）"Label7.Caption = "方位角（a）"Label17.Caption = "陈亮编程"Label18.Caption = " 2011.09.05"End Sub'设置坐标正算时Label6.Caption和Label7.Caption的值及设计小数点位数Private Sub Option1_Click()If Option1.Value = True And Option2.Value = False ThenLabel14.Caption = Text1.Text & "—>未知点" & Text7.TextLabel6.Caption = "边长（S）"Label7.Caption = "方位角（a）"Label10.Caption = "X"Label11.Caption = "Y"Text4.Text = 3Text8.Text = 1End IfEnd Sub''设置坐标反算时Label0.Caption和Label1.Caption的值及设计小数点位数Private Sub Option2_Click()If Option1.Value = False And Option2.Value = True ThenLabel6.Caption = "X"Label7.Caption = "Y"Label14.Caption = ""Label10.Caption = "边长（S）"Label11.Caption = "方位角（a）"Text4.Text = 3Text8.Text = 1End IfEnd Sub。

教你如何通过ExcelVBA编写测量坐标计算程序（入门篇）摘要：认识VBA、理解VBA，并利用Office Excel VBA编写测量坐标计算程序。

关键词：Excel VBA 程序坐标编写了解：VBA是什么？简单的说就是一种自动化语言，它可以使常用的程序自动化,可以创建自定义的解决方案。

可以用E xcel的宏语言来使E xcel自动化运行等……Microsoft让它开发出来的应用程序共享一种通用的自动化语言——Visual Basic For Application(VBA)，可以认为VBA是非常流行的应用程序开发语言Visual Basic的子集，事实上VBA是VB应用程序的版本，尽管存在有些不同VBA和VB在结构上仍然十分相似。

如果你已经了解VB会发现学习VBA非常快。

相应的学完VBA会给学习VB打下坚实的基础。

理由：选择Excel VBA编程的理由是因为它的计算功能非常强大，是现今任何编程计算器无法逾越的。

它运用范围广，计算速度快，计算精度高，合理化显示等。

或许很多测量人员对Excel VBA还有些陌生，主要是大家寄托于计算器、电脑、手机PDA等系列软件使用。

Excel VBA对于大多数测量人员而没有系统学过计算机语言程序设计的人群来讲有一定含糊，不过只要有基本数学知识、测量常识和逻辑理解的人，都能通过Excel VBA编写设计出称心如意的测量程序。

目标：基于Excel VBA的测量坐标计算程序的设计目标是将繁琐计算过程转入到计算机中，利用程序语言的重复性原理，在计算机中可将坐标计算得出更精确的结果，使坐标计算更加可靠。

最终目标是让用户可以通过Excel VBA自行完成坐标计算程序设计。

认识：学习VBA到底需要什么基础和了解些什么？学习VBA需要认识英文字母、一般的单词（如：函数所用的过程）、数学基础知识、测量常识、逻辑性思维即可。

在VBA中需要了解VBA的过程、变量、属性、方法、事件、语句等。

方位角计算程序范文方位角是指物体相对于参考方向的角度。

在地球上，常用的参考方向是北。

在计算方位角时，需要知道物体的经纬度以及参考方向的经纬度。

以下是一个计算方位角的程序示例，使用Python语言编写：```pythonimport math#计算两个经纬度之间的距离def calculate_distance(lat1, lon1, lat2, lon2):R=6371#地球半径，单位为公里lat1_rad = math.radians(lat1)lon1_rad = math.radians(lon1)lat2_rad = math.radians(lat2)lon2_rad = math.radians(lon2)dlon = lon2_rad - lon1_raddlat = lat2_rad - lat1_rada = math.sin(dlat/2)**2 + math.cos(lat1_rad) *math.cos(lat2_rad) * math.sin(dlon/2)**2c = 2 * math.atan2(math.sqrt(a), math.sqrt(1-a))distance = R * creturn distance#计算方位角def calculate_bearing(lat1, lon1, lat2, lon2):lat1_rad = math.radians(lat1)lon1_rad = math.radians(lon1)lat2_rad = math.radians(lat2)lon2_rad = math.radians(lon2)dlon = lon2_rad - lon1_rady = math.sin(dlon) * math.cos(lat2_rad)x = math.cos(lat1_rad) * math.sin(lat2_rad) - math.sin(lat1_rad) * math.cos(lat2_rad) * math.cos(dlon) bearing = math.degrees(math.atan2(y, x))return bearing#示例使用lat1 = 39.9075lon1 = 116.3972lat2 = 31.2304lon2 = 121.4737distance = calculate_distance(lat1, lon1, lat2, lon2)bearing = calculate_bearing(lat1, lon1, lat2, lon2)print("距离：", distance, "公里")print("方位角：", bearing, "度")```在这个示例中，我们使用了Haversine公式计算两个经纬度之间的距离，并使用反三角函数计算方位角。

坐标正算、反算计算方法及在Excel 中的VBA 编程测量中经常需要将某点相对坐标系坐标转换成线路的里程、偏距，或根据线路某一里程偏距计算出对应的相对坐标系坐标，为寻求一种快速简单高效的计算方法，本文对线路正算反算的原理进行了阐述，并结合Excel VBA 编程，将编程和Excel 的拖拽的功能相结合，编制出实用计算表，特别适用于需要大量计算边桩、围护桩的情况。

关键词：坐标方位角坐标正算坐标反算 V AB 编程循环迭代直接算法一、坐标方位角的反算1.坐标方位角反算如图1所示，已知点A 、B 的坐标，求直线AB坐标方位角α。

图1坐标方位角反算直线AB 之间的坐标增量：AB B AAB B Ax x x y y y ∆=−∆=−当0,0AB AB x y ∆>∆>时，角α位于第一象限角：arctan ABABy x α∆=∆当0,0AB AB x y ∆<∆>时，角α位于第二象限角：arctan 180AB ABy x α∆=+°∆当0,0AB AB x y ∆<∆<时，角α位于第三象限角：arctan 180AB ABy x α∆=+°∆当0,0AB AB x y ∆>∆<时，角α位于第二象限角：arctan360AB AB y x α∆=+°∆2.坐标方位角反算的VBA 编程可用VBA 将上述过程定义为一个名为angel()的函数，代码如下：Function angel(x0As Double, y0 As Double, x1 As Double, y1 As Double) As Double dx = x1- x0dy = y1- y0If dx > 0 And dy > 0 Thenangel = Atn(dy / dx)End IfIf dx < 0 And dy > 0 Thenangel = Atn(dy / dx) + 3.14159265358979End IfIf dx < 0 And dy < 0 Thenangel = Atn(dy / dx) + 3.14159265358979End IfIf dx > 0 And dy < 0 Thenangel = Atn(dy / dx) + 3.14159265358979 * 2End IfEnd Function二、直线段坐标正算与反算1.直线段正算图2直线段计算已知HZ 点坐标（x1,y1）、里程N HZ ，ZH 点坐标（x2,y2），正算时已知P 点对应的中桩里程Np 和偏距e （规定沿着线路前进方向，左边偏距为负，右边偏距为正），Np>N HZ ，求P 点对应的坐标。

Dim fso As New FileSystemObject, ts As TextStream, Fl As File, fname As StringDim jd(100, 5) As Double, jdy(100, 2) As Double, zjd As Integer, ld(100000, 3) As Double, zld As LongConst pi = 3.1415926Dim ls As Double, r As DoubleDim gll As Double, gx As Double, gy As Double, gzx As Double, gzy As Double, gyx As Double, gyy As DoubleDim th As Double, lh As Double, ly As Double, eh As Double, b0 As Double, p As Double, q As DoubleDim jdl As Double, zhl As Double, hyl As Double, yhl As Double, hzl As Double, qzl As DoubleDim xx() As Double, Y() As Double, zx() As Double, zy() As Double, yx() As Double, yy() As DoublePrivate Sub cd1_Click(Index As Integer)Dim tr() As String, m(10) As Integer '定义过程级变量Dim i As Integer, j As Integer, k As Integer, h As IntegerCommonDialog1.ShowOpenfname = CommonDialog1.FileName '将用户在"打开"对话框中选择的文件名对变量fname赋值If fname <> "" Then '若无此判断当对话框中选择取消时、下面赋值语句将出错Set ts = fso.OpenTextFile(fname) '将fname作为文本文件打开,并设置句柄j = 0: k = 0: p = 0: h = 0'j是测站数累计变量,k是已知点累计变量,l（j）、ns（j）分别是方向值、边长累积计数Do While ts.AtEndOfLine <> True '前测型循环，进入循环的条件是没有读到文件结束尾b = ts.ReadLine '读一行，置入bb = Trim(b): i = 1: '删除B可能有的前导和尾随空格，i是工作变量， m(i) = InStr(b, ",") '查行中第一个逗号的左数位置,并保存在整形数组变量m(i)中ReDim tr(10)Do While m(i) <> 0 '前测型Do... Loop循环，成立条件是该行字符串中有逗号tr(i) = Mid(b, m(i - 1) + 1, m(i) - m(i - 1) - 1) '提取指定位置开始的指定数目字符。

vb坐标方位角算法流程
计算两个地点之间的方位角（或方向角）可以使用以下算法流程：
1. 获取两个地点的经纬度坐标。

假设地点A的经纬度坐标为（lonA，latA），地点B的经纬度坐标为（lonB，latB）。

2. 将经纬度坐标转换为弧度表示。

使用以下公式：
radLonA = lonA * (PI / 180)
radLatA = latA * (PI / 180)
radLonB = lonB * (PI / 180)
radLatB = latB * (PI / 180)
3. 计算方位角。

使用以下公式：
dLon = radLonB - radLonA
y = sin(dLon) * cos(radLatB)
x = cos(radLatA) * sin(radLatB) - sin(radLatA) * cos(radLatB) * cos(dLon)
angle = atan2(y, x)
4. 将方位角转换为度数表示。

使用以下公式：
angleDegrees = angle * (180 / PI) + 360 (取模 360)
注意：以上算法中，PI代表圆周率，atan2函数返回的角度范围是[-PI, PI]，需转换为[0, 360]的度数表示。

这个算法可以计算地球上两个地点之间的方位角。

请注意，这只是一个简单的算法，不考虑地球的形状和其他因素，可能在极端情况下存在一定的误差。

对于更精确的计算，需要考虑使用更复杂的模型和算法。