VB平差程序设计复习资料.docVIP

测边交会 Option Compare Database Public 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 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 * cosAB End Sub Private Sub cmd_返回选题界面_Click() DoCmd.OpenForm 选题界面, acNormal, , , , acNormal DoCmd.Close acForm, 测边交会 End Sub Private 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 + 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 + vbExclamation, 提示信息 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 If End Sub Private 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.SetFocus End Sub Private 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.SetFocus End Sub 测角交会 Option Compare Database Const PI = 3.14159265358979 Public DDD_X As Double, DDD_Y As Double 待定点X，Y 角度化弧度 Publ