《VB平差程序设计复习资料》由会员分享，可在线阅读，更多相关《VB平差程序设计复习资料（8页珍藏版）》请在金锄头文库上搜索。
1、测边交会Option Compare DatabasePublic DDD_X As Double, DDD_Y As Double 待定点X，Y 已知A、B两点坐标及观测的边长计算待定点坐标,BCJSDDDZB的中文意思是由观测边长计算待定点坐标Public Sub BCJSDDDZB(xa As Double, ya As Double, xb As Double, yb As Double, L1 As Double, L2 As Double) Dim SAB As Double, L As Double, H As Double, cosAB As Double, sinAB As
2、Double SAB = Sqr(xb - xa) * (xb - xa) + (yb - ya) * (yb - ya) L = (L1 * L1 + SAB * SAB - L2 * L2) / (2 * SAB) H = Sqr(L1 * L1 - L * L) cosAB = (xb - xa) / SAB sinAB = (yb - ya) / SAB DDD_X = xa + L * cosAB + H * sinAB DDD_Y = ya + L * sinAB - H * cosABEnd SubPrivate Sub cmd_返回选题界面_Click() DoCmd.Open
3、Form 选题界面, acNormal, , , , acNormal DoCmd.Close acForm, 测边交会End SubPrivate Sub cmd_计算_Click() Dim xa As Double, ya As Double, xb As Double, yb As Double, L1 As Double, L2 As Double If IsNull(Me.txt_Xa) Or IsNull(Me.txt_Ya) Or IsNull(Me.txt_Xb) Or IsNull(Me.txt_Yb) Then MsgBox 请输入完整的坐标数据！, vbOKCancel
4、 + vbInformation, 提示 End If If IsNull(Me.txt_L1) Or IsNull(Me.txt_L2) Then MsgBox 请输入完整的观测边长数据！, vbOKCancel + vbInformation, 提示 End If xa = Me.txt_Xa: ya = Me.txt_Ya xb = Me.txt_Xb: yb = Me.txt_Yb L1 = Me.txt_L1: L2 = Me.txt_L2 If (xb - xa) = 0 And (yb - ya) = 0 Then MsgBox 您选择的是同一个点！, vbOKOnly + vb
5、Exclamation, 提示信息 Else Call BCJSDDDZB(xa, ya, xb, yb, L1, L2) Me.txt_DX = Format(DDD_X, 0.000) Me.txt_DY = Format(DDD_Y, 0.000) End IfEnd SubPrivate Sub cmd_数据清空_Click() Me.txt_Xa = : Me.txt_Ya = Me.txt_Xb = : Me.txt_Yb = Me.txt_L1 = : Me.txt_L2 = Me.txt_DX = : Me.txt_DY = Me.txt_Xa.SetFocusEnd SubP
6、rivate Sub Form_Load() Me.txt_Xa = : Me.txt_Ya = Me.txt_Xb = : Me.txt_Yb = Me.txt_L1 = : Me.txt_L2 = Me.txt_DX = : Me.txt_DY = Me.txt_Xa.SetFocusEnd Sub测角交会Option Compare DatabaseConst PI = 3.14159265358979Public DDD_X As Double, DDD_Y As Double 待定点X，Y角度化弧度Public Function AngleToRadian(ByVal alfa As
7、 Double) As Double alfa = alfa + 0.00000000000001 Dim alfa1 As Double, alfa2 As Double alfa1 = Fix(alfa) + Fix(alfa - Fix(alfa) * 100#) / 60# alfa2 = (alfa * 100# - Fix(alfa * 100#) / 36# AngleToRadian = (alfa2 + alfa1) * PI / 180#End Function已知A、B两点坐标及观测的角度计算待定点坐标,JDJSDDDZB的中文意思是由观测角度计算待定点坐标Public
8、Sub JDJSDDDZB(xa As Double, ya As Double, xb As Double, yb As Double, JDA As Double, JDB As Double) Dim tanA As Double, tanB As Double JDA = AngleToRadian(JDA) JDB = AngleToRadian(JDB) tanA = Tan(JDA) tanB = Tan(JDB) DDD_X = (xa * tanA + xb * tanB + (yb - ya) * tanA * tanB) / (tanA + tanB) DDD_Y = (
9、ya * tanA + yb * tanB + (xa - xb) * tanA * tanB) / (tanA + tanB)End SubPrivate Sub cmd_返回选题界面_Click() DoCmd.OpenForm 选题界面, acNormal, , , , acNormal DoCmd.Close acForm, 测角交会End SubPrivate Sub cmd_计算_Click() Dim xa As Double, ya As Double, xb As Double, yb As Double, JDA As Double, JDB As Double If Is
10、Null(Me.txt_Xa) Or IsNull(Me.txt_Ya) Or IsNull(Me.txt_Xb) Or IsNull(Me.txt_Yb) Then MsgBox 请输入完整的坐标数据！, vbOKCancel + vbInformation, 提示 End If If IsNull(Me.txt_JDA) Or IsNull(Me.txt_JDB) Then MsgBox 请输入完整的观测角度数据！, vbOKCancel + vbInformation, 提示 End If xa = Me.txt_Xa: ya = Me.txt_Ya xb = Me.txt_Xb: yb
11、 = Me.txt_Yb JDA = Me.txt_JDA: JDB = Me.txt_JDB If (xb - xa) = 0 And (yb - ya) = 0 Then MsgBox 您选择的是同一个点！, vbOKOnly + vbExclamation, 提示信息 Else Call JDJSDDDZB(xa, ya, xb, yb, JDA, JDB) Me.txt_DX = Format(DDD_X, 0.000) Me.txt_DY = Format(DDD_Y, 0.000) End IfEnd SubPrivate Sub cmd_数据清空_Click() Me.txt_X
12、a = : Me.txt_Ya = Me.txt_Xb = : Me.txt_Yb = Me.txt_JDA = : Me.txt_JDB = Me.txt_DX = : Me.txt_DY = Me.txt_Xa.SetFocusEnd SubPrivate Sub Form_Load() Me.txt_Xa = : Me.txt_Ya = Me.txt_Xb = : Me.txt_Yb = Me.txt_JDA = : Me.txt_JDB = Me.txt_DX = : Me.txt_DY = Me.txt_Xa.SetFocusEnd Sub后方交会Option Compare Dat
13、abaseOption ExplicitPublic XP As Double, YP As Double 后方交会时计算待定点XP、YPConst PI = 3.14159265358979角度化弧度Public Function AngleToRadian(ByVal alfa As Double) As Double alfa = alfa + 0.00000000000001 Dim alfa1 As Double, alfa2 As Double alfa1 = Fix(alfa) + Fix(alfa - Fix(alfa) * 100#) / 60# alfa2 = (alfa
14、* 100# - Fix(alfa * 100#) / 36# AngleToRadian = (alfa2 + alfa1) * PI / 180#End Function 已知A、B两点坐标计算方位角,JSFWJ的中文意思是计算方位角 _ 提示此函数处理的坐标是包括带号的Public Function JSFWJ(xa As Double, ya As Double, xb As Double, yb As Double) As Double 已知A、B两点坐标计算方位角 Dim vx As Double, vy As Double Dim N0 As Integer N0 = Fix(ya /
