水准网平差(VB代码)

合集下载

VB测量平差程序设计讲稿

Case 0 '读入观测值文件Text1.Visible = FalseCommonDialog1.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)Do While m(i) <> 0 '前测型Do... Loop循环，成立条件是该行字符串中有逗号tr(i) = Mid(B, m(i - 1) + 1, m(i) - m(i - 1) - 1) '提取指定位置开始的指定数目字符。

i = i + 1m(i) = InStr(m(i - 1) + 1, B, ",") '从上一个找到的逗号位置起，查找下一个逗号的位置LoopIf m(i) = 0 And i > 1 Then tr(i) = Right(B, Len(B) - m(i - 1)) '处理一行中最后一个逗号后的字符串'以下部分是将存储在数组变量m(i)中的字符分类存放到方向、边长、已知坐标、网型信息等数组中If p = 0 Then '读到的是文件第一行。

实验一matlab完成水准网平差

实验一matlab完成水准网平差实验一 matlab完成水准网平差实验数据：水准网有2个已知点，3个未知点，7个测段。

已知点高程H1=5.016M H2=6.016h1=1.359; h2=2.009; h3=0.363; h4=1.012; h5=0.657; h6=0.238; h7=-0.595;S1=1.1 S2=1.7 S3=2.3 S4=2.7 S5=2.4 S6=1.4 S7=2.6求解（1）求个待定点高程,H5的高差中误差；3、4号点的高程中误差。

课程设计内容1、平差程序设计思路：使用间接平差法求解（1）由题意知必要观测数t=3，选取3、4、5号点高程X1、X2、X3为参数。

（2）误差方程：V1=x1v2=x2v3=x1v4=x2v5=x2-x1+h2-h1-h5v6=x3-x1v7=-x3(3)取1M 的观测高程为单位权观测，即 p=1/s；(4)求法方程：Nbbx-W=0 Nbb=b’pbW=b’pl(5)求的平差值x=Nbb^-1*W L=l+V V=bx-l （6）高差权函数式：k=-x1+x2(6)求中误差：单位权中误差δ0，协因数阵Nbb^-1.求得中误差δ2、平差程序流程代码说明：h1=1.359;h2=2.009;h3=0.363;h4=1.012;h5=0.657;h6=0.238;h7=-0.595;H1=5.016H2=6.016h=[h1 h2 h3 h4 h5 h6 h7]'s=[1.1 1.7 2.3 2.7 2.4 1.4 2.6]'B=[1 0 0 ;0 1 0;1 0 0;0 1 0 ; -1 1 0 ; -1 0 1 ;0 0 -1 ] p=diag(1./s)l=[0;0;4;3;7;2;0]W=B'*p*lNbb=B'*p*Bx=inv(Nbb)*WV=(B*x-l)H=h+V/1000Q=inv(Nbb)n=7;t=3;j=V'*p*Vd= sqrt(j/4)f=[-1 1 0]'q=f'*Q*fD=d*sqrt(q)D1=d*sqrt(Q)(3) 平差程序流程代码说明: clc cleardisp(‘观测高差，单位m’)h1=1.359;h2=2.009;h3=0.363;h4=1.012;h5=0.657;h6=0.238;h7=-0.595;H1=5.016 % 已知点高程，单位mH2=6.016 % 已知点高程，单位mh=[h1 h2 h3 h4 h5 h6 h7]'s=[1.1 1.7 2.3 2.7 2.4 1.4 2.6]' %S是线路长度disp(‘系数矩阵B、l’)B=[1 0 0 ;0 1 0;1 0 0;0 1 0 ; -1 1 0 ;-1 0 1 ;0 0 -1 ]p=diag(1./s) %定义权阵l=[0;0;4;3;7;2;0]W=B'*p*lNbb=B'*p*Bdisp(‘参数的解’)x=inv(Nbb)*WV=(B*x-l) % 误差方程(mm)。

水准网平差(VB代码)

误差理论与测量平差础）课程设计报告系（部）：土木工程系实习单位：山东交通学院班级：测绘084学生姓名：田忠星学号080712420带队教师：夏小裕﹑周宝兴时间：10 年12 月13 日到10 年12 月19 日山东交通学院目录：1.摘要P32.概述P33.水准网间接平差程序设计思路P3—P44.平差程序流程图P4—P65.程序源代码及说明P7—P236.计算结果P23—P267.总结P26—P27一：摘要在测量工作中，为了能及时发现错误和提高测量成果的精度，常作多余观测，这就产生了平差问题。

在一个平差问题中，当所选的独立参数X?的个数等于必要观测数t 时，可将每个观测值表达成这t 个参数的函数，组成观测方程，这种以观测方程为函数模型的平差方法，就是间接平差。

二：概述：该课程设计的主要目是对水准网进行间接平差，在输入数据后依次计算高程近似值﹑误差方程和平差计算。

三：水准网间接平差程序设计思路1．根据平差问题的性质，选择t 个独立量（既未知点的高程）作为参数X?2.将每一个观测量的平差值（既观测的高程差值）分别表达成L L V3．由误差方程系数 B 和自由项组成法方程，法方程个数等于参数的个数t ；4. 解算法方程，求出参数X?,计算参数（高程）的平差值X?=X0 +x? ；5．由误差方程计算V，求出观测量（高差）平差值L L V 6.评定精度单位权中误差平差值函数的中误差四：平差程序流程图1．已知数据的输入需要输入的数据包括水准网中已知点数﹑未知点数以及这些点的点号，已知高程和高差观测值﹑距离观测值。

程序采用文件方式进行输入，约定文件输入的格式如下：第一行：已知点数﹑未知点数﹑观测值个数第二行：点号（已知点在前，未知点在后）第三行：已知高程（顺序与上一行的点号对应）第四行：高差观测值，按“起点点号，终点点号。

高差观测值，距离观测值”的顺序输入。

本节中使用的算例的数据格式如下2,3,7 1,2,3,4,5 5.016,6.016 1,3,1.359,1.11,4,2.009,1.7 2,3,0.363,2.3 2,4,1.012,2.7 3,4,0.657,2.4 3,5,0.238,1.4 5,2,-0.595,2.6 2.平差计算过程V TPV rV TPVnus（1）近似高程的计算。

水准网平差(VB代码)

（误差理论与测量平差础）课程设计报告系（部）：土木工程系实习单位：山东交通学院班级：测绘084学生姓名：田忠星学号********* 带队教师：夏小裕﹑周宝兴时间：10 年12 月13日到10 年12 月19日山东交通学院目录：1.摘要P32.概述P33.水准网间接平差程序设计思路P3—P44. 平差程序流程图P4—P65. 程序源代码及说明P7—P236. 计算结果P23—P267. 总结P26—P27一：摘要在测量工作中，为了能及时发现错误和提高测量成果的精度，常作多余观测，这就产生了平差问题。

在一个平差问题中，当所选的独立参数Xˆ的个数等于必要观测数t时，可将每个观测值表达成这t个参数的函数，组成观测方程，这种以观测方程为函数模型的平差方法，就是间接平差。

二：概述：该课程设计的主要目是对水准网进行间接平差，在输入数据后依次计算高程近似值﹑误差方程和平差计算。

三：水准网间接平差程序设计思路1．根据平差问题的性质，选择t个独立量（既未知点的高程）作为参数Xˆ2. 将每一个观测量的平差值（既观测的高程差值）分别表达成3．由误差方程系数B和自由项组成法方程，法方程个数等于参数的个数t ；4. 解算法方程，求出参数Xˆ,计算参数（高程）的平差值Xˆ=X0 +xˆ；5．由误差方程计算V，求出观测量(高差)平差值6.评定精度单位权中误差VLL+ =∧VLL+ =∧平差值函数的中误差四：平差程序流程图1．已知数据的输入需要输入的数据包括水准网中已知点数﹑未知点数以及这些点的点号，已知高程和高差观测值﹑距离观测值。

高差观测值，距离观测值”的顺序输入。

本节中使用的算例的数据格式如下2,3,71,2,3,4,55.016,6.0161,3,1.359,1.11,4,2.009,1.7 2,3,0.363,2.3,ˆ20s u n PV V r PV V T T +-==σ.ˆˆˆ0ˆϕϕϕσσQ =2,4,1.012,2.73,4,0.657,2.43,5,0.238,1.45,2,-0.595,2.62.平差计算过程（1）近似高程的计算。

水准网的条件平差

云南旅游职业学院专科毕业（设计）论文目录目录 (1)观测误差 (2)摘要： (2)关键词: (2)引言 (3)1水准测量 (4)1.1水准测量的原理 (4)1.2水准网 (5)2条件平差 (6)2。

1衡量精度的指标 (6)2。

2条件平差的原理 (8)3水准网的平差 (14)3.1必要观测与多余观测 (14)3。

2条件方程 (14)3。

3条件平差法方程式 (15)3.4条件平差的精度评定 (15)3。

5水准网的条件平差 (18)致谢 (21)参考文献 (21)1云南旅游职业学院专科毕业（设计）论文观测误差—由观测者、外界环境引起的偶然误差学生： xxx 指导教师：xxx摘要:对一系列带有偶然误差的观测值，采用合理的的方法消除它们间的不符值，得出未知量的最可靠值；以及评定测量成果的精度.关键词：偶然误差；观测值；精度2云南旅游职业学院专科毕业（设计）论文引言测量工作中，要确定地面点的空间位置，就必须进行高程测量，确定地面点的高程。

几何水准测量是高程测量中最基本、最精密的一种方法。

通过测量仪器，工具等任何手段获得的以数字形式表示的空间信息，即观测量。

然而，测量是一个有变化的过程，受仪器、观测值、外界环境因素的影响，观测的结果与客观上存在的一个能反映其真正大小的数值,即真值（理论值），有一定的差异。

可以说在测量中产生误差是不可避免的.所以，观测值不能准确得到，在测量上称这种差异为观测误差。

根据其对观测结果影响的性质，可将误差分为系统误差和偶然误差两种。

前者可以通过在观测过程中采取一定的措施和在观测结果中加入改正数，消除或减弱它的影响，使其达到忽略不计的程度。

但是，观测结果中，不可避免地包含了后者,它是不可消除的，但可以选择较好的观测条件或采用适当的数据处理方法减弱它。

现在我们要讨论的就是采用适当的数据处理方法来减弱其对水准测量中的影响。

3云南旅游职业学院专科毕业（设计）论文41 水准测量1。

1 水准测量的原理1。

水准网条件平差.

10
10
ˆ hˆ ：（11）计算 P1 至 P2 点观测高差平差值的精度 12
ˆ h ˆ 式，得其权函数式系数 f T 0 0 1 0，则：由 2 h 2 P P 3 1 2
'T ˆh ˆ ˆ Q f ˆ ˆL ˆ f 2 0.39 0.86 0.36m m 0 0 2 QL
2 1 k a 0 0 1 4 k b 1 0解 Nhomakorabea法方程得：
k a 0.14 K k b 0.29
7
7
（4）计算改正数，由V P 1 AT K 可计算得到
V 0.14 0.14 0.57 0.29
2
ˆ P：（10）计算 P2点高程平差值的中误差
ˆ 式，可得权函数系数 f T 0 0 0 1，则： ˆ H h 由 1 H 1 2 C 4
ˆP ˆ 0 Q ˆ 0 f1T QL ˆL ˆ f1 0.39 0.71 0.33m m
2 1 1
,则
0 1 0 0
0 0 2 0
0 0 0 1
（3）法方程的组成与解算。
组成法方程
AP1 AT K W 0
1 1 1 0 0 0 0 1 1 1 0 0
6
0 1 0 0
0 0 2 0
6
0 1 0 1 1 k 0 a 0 0 1 k 0 0 1 b 1 0 1
V T PV 0.29 2 ˆ 0.15m m r 2
2 0
2 ˆ0 ˆ0 0.39 mm
9
9
（9）计算观测值平差的协因数：

vb水准

导线测量平差水准测量平差VB程序导线测量, 水准测量, 程序符合导线平差程序如下：Const pi As Double = 3.14159265358979 Private Sub Command1_Click() Form8.Hide mj = Val(Text1.Text) If list1.Text = "等精度" Then ma = Val(Text2.Text) mb = Val(Text3.Text) End If If Opt1.Value Then ij = 1 ElseIf Opt2.V alue Then ij = Val(Text4.Text) End If CommonDialog1.ShowOpen On Error GoTo errorhandler Open CommonDialog1.FileName For Input As #1 If Form8.Caption = "闭合导线" Then Input #1, bi1, bi2 End If Dim a1() Do n1 = n1 + 1 ReDim Preserve a1(1 To n1) Input #1, a1(n1) Loop Until Left(a1(n1), 1) = "*" n1 = (n1 - 1) / 3 ReDim Preserve a1(1 To 3 * n1) Dim c() Do t = t + 1 ReDim Preserve c(1 To t) Input #1, c(t) Loop Until Left(c(t), 1) = "*" t = t - 1 ReDim Preserve c(1 To t) Dim b1() If list1.Text = "等精度" Then '等精度时，取角度和距离观测值Do n2 = n2 + 1 ReDim Preserve b1(1 To n2) Input #1, b1(n2) Loop Until Left(b1(n2), 1) = "*" n2 = (n2 - 1) / 4 ReDim Preserve b1(1 To 4 * n2) Dim d1() Do While Not EOF(1) n3 = n3 + 1 ReDim Preserve d1(1 To n3) Input #1, d1(n3) Loop n3 = n3 / 3 ElseIf list1.Text = "不等精度" Then '不等精度时，取角度和距离观测值以及中误差Dim b5() Do n2 = n2 + 1 ReDim Preserve b1(1 To 4 * n2), b5(1 To n2) Input #1, b1(4 * n2 - 3), b1(4 * n2 - 2), b1(4 * n2 - 1), b1(4 * n2), b5(n2) Loop Until Left(b1(4 * n2 - 3), 1) = "*" Dim d4() ReDim d1(1 To 3), d4(1 To 1) d1(1) = b1(4 * n2 - 2): d1(2) = b1(4 * n2 - 1) d1(3) = b1(4 * n2): d4(1) = b5(n2) n2 = n2 - 1 ReDim Preserve b1(1 To 4 * n2), b5(1 To n2) n3 = n3 + 1 Do While Not EOF(1) n3 = n3 + 1 ReDim Preserve d1(1 To 3 * n3), d4(1 To n3) Input #1, d1(3 * n3 - 2), d1(3 * n3 - 1), d1(3 * n3), d4(n3) Loop End If Close #1 n6 = 0 Dim ax1() If Form8.Caption = "附有条件的导线网" Then '如是附有条件的导线，取条件CommonDialog1.ShowOpen Open CommonDialog1.FileName For Input As #2 Do While Not EOF(2) n6 = n6 + 1 ReDim Preserve ax1(1 To n6) Input #2, ax1(n6) Loop n6 = n6 / 4 Close #2 End If For i = 1 To n2 If b1(4 * i - 3) Like b1(4 * i - 2) Or b1(4 * i - 3) Like b1(4 * i - 1) Or b1(4 * i - 2) Like b1(4 * i - 1) Then MsgBox "角度观测中，第" & i & "行存在重复点名！", , "错误" Exit Sub End If Next For i = 1 To n3 If d1(3 * i - 2) Like d1(3 * i - 1) Then MsgBox "边长观测中，第" & i & "行存在重复点名！", , "错误" Exit Sub End If Next Dim b11(), d11() ReDim b11(1 To 4 * n2), d11(1 To 3 * n3) For i = 1 To n2 For i1 = 1 To t If b1(4 * i - 3) Like c(i1) Then b11(4 * i - 3) = i1 + n1 GoTo 1 End If Next For i1 = 1 To n1 If b1(4 * i - 3) Like a1(3 * i1 - 2) Then b11(4 * i - 3) = i1 GoTo 1 End If Next int8 = MsgBox("角度观测中，第" & i & "行存在错误测站点" & b1(4 * i - 3) & "！", , "错误！") If int8 = vbOK Then Exit Sub 1: For i1 = 1 To t If b1(4 * i - 2) Like c(i1) Then b11(4 * i - 2) = i1 + n1 GoTo 2 End If Next For i1 = 1 To n1 If b1(4 * i - 2) Like a1(3 * i1 - 2) Then b11(4 * i - 2) = i1 GoTo 2 End If Next int8 = MsgBox("角度观测中，第" & i & "行存在错误后视点" & b1(4 * i - 2) & "！", , "错误！") If int8 = vbOK Then Exit Sub 2: For i1 = 1 To t If b1(4 * i - 1) Like c(i1) Then b11(4 * i - 1) = i1 + n1 GoTo 3 End If Next For i1 = 1 To n1 If b1(4 * i - 1) Like a1(3 * i1 - 2) Then b11(4 * i - 1) = i1 GoTo 3 End If Next int8 = MsgBox("角度观测中，第" & i & "行存在错误前视点" & b1(4 * i - 1) & "！", , "错误！") If int8 = vbOK Then Exit Sub 3: b11(4 * i) = b1(4 * i) Next For i = 1 To n3 For i1 = 1 To t If d1(3 * i - 2) Like c(i1) Then d11(3 * i - 2) = i1 + n1 GoTo 4 End If Next For i1 = 1 To n1 If d1(3 * i - 2) Like a1(3 * i1 - 2) Then d11(3 * i - 2) = i1 GoTo 4 End If Next int8 = MsgBox("边长观测中，第" & i & "行存在错误点" & d1(3 * i - 2) & "！", , "错误！") If int8 = vbOK Then Exit Sub 4: For i1 = 1 To t If d1(3 * i - 1) Like c(i1) Then d11(3 * i - 1) = i1 + n1 GoTo 5 End If Next For i1 = 1 To n1 If d1(3 * i - 1) Like a1(3 * i1 - 2) Then d11(3 * i - 1) = i1 GoTo 5 End If Next int8 = MsgBox("边长观测中，第" & i & "行存在错误点" & d1(3 * i - 1) & "！", , "错误！") If int8 = vbOK Then Exit Sub 5: d11(3 *i) = d1(3 * i) Next Dim x0() If Form8.Caption = "附合导线" Then ReDim x0(1 To 2 * t + 2) x0() = 附合导线(a1(), b11(), d11(), t) fx = x0(2 * t + 1) '坐标闭合差fy = x0(2 * t + 2) fs = Sqr(fx * fx + fy * fy) fx = Format(fx * 100, "0.0") fy = Format(fy * 100, "0.0") s = 0 For i = 1 To n3 '全长相对闭合差s = s + d1(3 * i) Next fs = Int(s / fs) For i = 1 To n2 '方位闭合差If b11(4 * i - 3) <= n1 And b11(4 * i - 2) <= n1 Then i1 = b11(4 * i - 3): i2 = b11(4 * i - 2) x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) x2 = a1(3 * i2 - 1): y2 = a1(3 * i2) aq = xlu(x2, y2, x1, y1) ElseIf b11(4 * i - 3) <= n1 And b11(4 * i - 1) <= n1 Then i1 = b11(4 * i - 3): i2 = b11(4 * i - 1) x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) x2 = a1(3 * i2 - 1): y2 = a1(3 * i2) az = xlu(x1, y1, x2, y2) End If bb = bb + hu(b1(4 * i)) Next bb = (aq + bb - n2 * pi - az) * 206264.806247096 bb = Format(bb, "0.00") bb1 = mj * Sqr(n2) bb1 = Format(bb1, "0.00") ReDim Preserve x0(1 To 2 * t) ElseIf Form8.Caption = "闭合导线" Then ReDim x0(1 To 2 * t + 2) x0() = 附合导线(a1(), b11(), d11(), t) fx = x0(2 * t + 1) '坐标闭合差fy = x0(2 * t + 2) fs = Sqr(fx * fx + fy * fy) fx = Format(fx * 100, "0.0") fy = Format(fy * 100, "0.0") s = 0 For i = 1 To n3 s = s + d1(3 * i) Next fs = Int(s / fs) For i = 1 To n2 bb = bb + hu(b1(4 * i)) Next If bi1 = 0 Then '方位闭合差If bi2 = 0 Then bb = (bb - (n2 - 2) * pi) * 206264.806247096 ElseIf bi2 = 1 Then bb = (bb - (n2 + 2) * pi) * 206264.806247096 End If ElseIf bi1 = 1 Then For i = 1 To n2 If b11(4 * i - 3) <= n1 And b11(4 * i - 2) <= n1 Then i1 = b11(4 * i - 3): i2 = b11(4 * i - 2) x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) x2 = a1(3 * i2 - 1): y2 = a1(3 * i2) aq = xlu(x2, y2, x1, y1) End If Exit For Next If bi2 = 0 Then bb = (bb - aq - (n2 - 3) * pi) * 206264.806247096 ElseIf bi2 = 1 Then bb = (bb - aq - (n2 + 1) * pi) * 206264.806247096 End If End If bb1 = mj * Sqr(n2) bb1 = Format(bb1, "0.00") ReDim Preserve x0(1 To 2 * t) ElseIf Form8.Caption = "导线网平差" Then ReDim ax1(0) ReDim x0(1 To 2 * t) x0() = 导线网(a1(), b11(), d11(), ax1(), t) Else ReDim x0(1 To 2 * t) x0() = 导线网(a1(), b11(), d11(), ax1(), t) End If mj1 = mj For ii = 1 To ij Dim b2(), l2(), p() ReDim Preserve b2(1 To n2, 1 To 2 * t), l2(1 To n2), p(1 To n2 + n3) l2() = 角常系数1(a1(), b11(), x0()) b2() = 方系数2(a1(), b11(), x0()) Dim b3(), l3() ReDim b3(1 To n3, 1 To 2 * t), l3(1 To n3) b3() = 边系数2(a1(), d11(), x0()) l3() = 边常数项1(a1(), d11(), x0()) Dim b(), l() ReDim Preserve b(1 To n2 + n3, 2 * t), l(1 To n2 + n3) For j = 1 To 2 * t For i = 1 To n2 If b2(i, j) = "" Then b2(i, j) = 0 End If b(i, j) = 10 ^ 4 * b2(i, j) / 206264.806247096 If list1.Text = "等精度" Then p(i) = 1 ElseIf list1.Text = "不等精度" Then p(i) = mj1 * mj1 / (b5(i) * b5(i)) End If l(i) = 10 ^ 4 * l2(i) / 206264.806247096 Next For i = 1 To n3 If b3(i, j) = "" Then b3(i, j) = 0 End If b(i + n2, j) = b3(i, j) If list1.Text = "等精度" Then p(i + n2) = 2350.4 * mj1 * mj1 / ((ma + mb * d1(3 * i) / 1000) * (ma + mb * d1(3 * i) / 1000)) ElseIf list1.Text = "不等精度" Then p(i + n2) = 2350.4 * mj1 * mj1 / (d4(i) * d4(i)) End If l(i + n2) = l3(i) Next Next If Form8.Caption = "附有条件的导线网" Then '如是附有条件的导线，计算系数Dim ax(), lx() ReDim ax(1 To 2 * t, 1 To n6), lx(1 To n6) For i = 1 To n6 For i1 = 1 To n1 If ax1(4 * i - 3) Like a1(3 * i1 - 2) Then x1 = a1(3 * i1 - 1): y1 = a1(3 * i1) GoTo 111 End If Next i1 = i1 - 1 For i2 = 1 To t If ax1(4 * i - 3) Like c(i2) Then x1 = x0(2 * i2 - 1): y1 = x0(2 * i2) GoTo 111 End If Next 111: For i3 = 1 To n1 If ax1(4 * i - 2) Like a1(3 * i3 - 2) Then x1 = a1(3 * i3 - 1): y1 = a1(3 * i3) GoTo 112 End If Next i3 = i3 - 1 For i4 = 1 To t If ax1(4 * i - 2) Like c(i4) Then x2 = x0(2 * i4 - 1): y2 = x0(2 * i4) GoTo 112 End If Next 112: ss1 = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)) x3 = x2 - x1: y3 = y2 - y1 If ax1(4 * i) = 0 Then '如是方位角时，计算系数lx(i) = 10000 * (xlu(x1, y1, x2, y2) - hu(ax1(4 * i - 1))) If ax1(4 * i - 3) <> a1(3 * i1 - 2) Then ax(2 * i2 - 1, i) = 10000 * y3 / (ss1 * ss1) ax(2 * i2, i) = -10000 * x3 / (ss1 * ss1) End If If ax1(4 * i - 2) <> a1(3 * i3 - 2) Then ax(2 * i4 - 1, i) = -10000 * y3 / (ss1 * ss1) ax(2 * i4, i) = 10000 * x3 / (ss1 * ss1) End If ElseIf ax1(4 * i) = 1 Then '如是距离，计算系数lx(i) = ss1 - ax1(4 * i - 1) If ax1(4 * i- 3) <> a1(3 * i1 - 2) Then ax(2 * i2 - 1, i) = -x3 / ss1: ax(2 * i2, i) = -y3 / ss1 End If If ax1(4 * i -2) <> a1(3 * i3 - 2) Then ax(2 * i4 - 1, i) = x3 / ss1: ax(2 * i4, i) = y3 / ss1 End If End If Next Fori = 1 To 2 * t For j = 1 To n6 If ax(i, j) = "" Then ax(i, j) = 0 End If Next Next End If Dim u(), nni(), xx(), nni1() ReDim u(1 To 2 * t), nni(1 To t * (2 * t + 1)) nni() = 法系数(b(), p()) u() = 常数项(b(), p(), l()) If Form8.Caption = "附有条件的导线网" Then ReDim nni1(1 To (2 * t + n6) * (2 * t + n6 + 1) / 2) nni1() = 附有条件的法方程(nni(), ax()) ReDim Preserve u(1 To 2 * t + n6) For i = 1 To n6 u(2 * t + i) = lx(i) Next nni1() = ni(nni1(), 2 * t + n6) xx() = bx(nni1(), u()) ReDim Preserve xx(1 To 2 * t) nni() = 条件从有到无(nni1(), t, n6) Else nni() = ni(nni(), 2 * t) xx() = bx(nni(), u()) End IfFor i = 1 To 2 * tx0(i) = x0(i) + xx(i)NextDim v(), fz()ReDim v(1 To n2 + n3), fz(1 To 2 * t)v() = 改正数(b(), xx(), l())Dim v1(), v2()ReDim v1(1 To n2), v2(1 To n3)For i = 1 To n2v1(i) = v(i) * 206264.806247096 / 10000m1 = m1 + v1(i) * v1(i)Nextm1 = Sqr(m1 / (n2 - 1)): m1 = Format(m1, "0.00")For i = 1 To n3v2(i) = v(i + n2)Nextmm0 = 单位权中误差(v(), p())mm0 = Sqr(mm0 / (n2 + n3 - 2 * t + n6))m0 = mm0 * 206264.806247096 / 10000If Optd2.Value Thenmj1 = m0End IfNextDim vas1 As String * 5, vas2 As String * 5, vas3 As String * 5, vas4 As String * 20Dim vas5 As String * 10, vas6 As String * 20txt = txt & Chr(13) & Chr(10)txt = txt & "导线平差成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "角度观测成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "-------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & "测站" & Space(1) & "后视" & Space(1) & "前视" & Space(1) & "方向观测值(°′″)" & Space(1) & "改正数(″)" & Space(1) & "方向平差值(°′″)" & Space(1) & Chr(13) & Chr(10)Dim f(), f1(), f2()ReDim f(1 To n2)f() = 角度平差值(v1(), b1())For i = 1 To n2ReDim f1(1 To 3), f2(1 To 3)f1() = 度分离(b1(4 * i))v1(i) = Format(v1(i), "0.00")f2() = 度分离(f(i))LSet vas1 = b1(4 * i - 3)LSet vas2 = b1(4 * i - 2)LSet vas3 = b1(4 * i - 1)LSet vas4 = f1(1) & Space(1) & f1(2) & Space(1) & f1(3)LSet vas5 = v1(i)LSet vas6 = f2(1) & Space(1) & f2(2) & Space(1) & f2(3)txt = txt & vas1 & vas2 & vas3 & vas4 & vas5 & vas6 & Chr(13) & Chr(10)Nexttxt = txt & "---------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "边长观测成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "---------------------------------------------------------------------" & Chr(13) & Chr(10) Dim bz()ReDim bz(1 To n3 + 3)bz() = 边长相对中误差(mm0, nni(), b3(), d1())Dim bc()ReDim bc(1 To n3)bc = 边长平差值(v2(), d1())txt = txt & "起点" & Space(1) & "终点" & Space(1) & "观测边长(m)" & Space(1) & "改正数(mm)" & "边长平差值(m)" & Space(1) & "边长观测值的相对中误差" & Chr(13) & Chr(10) Dim vas7 As String * 12, vas8 As String * 12For i = 1 To n3v2(i) = v2(i) * 1000: v2(i) = Format(v2(i), "0.0")LSet vas1 = d1(3 * i - 2)LSet vas2 = d1(3 * i - 1)LSet vas7 = d1(3 * i)LSet vas5 = v2(i)LSet vas8 = bc(i)LSet vas6 = "1:" & Space(1) & bz(i)txt = txt & vas1 & vas2 & vas7 & vas5 & vas8 & vas6 & Chr(13) & Chr(10)Nexttxt = txt & "--------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "点位误差及误差椭圆" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "---------------------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & "点号" & Space(1) & "误差X(mm)" & Space(1) & "误差Y(mm)" & Space(1) & "点位误差(mm)" & Space(1) & "椭圆长轴E(mm)" & Space(1) & "椭圆短轴(mm)" & Space(1) & "方位角(°′″)" & Chr(13) & Chr(10)Dim dw(), e()ReDim dw(1 To 3 * t), e(1 To 3 * t)dw() = 点位误差(mm0, t, nni())e() = 点位误差椭圆(mm0, t, nni())Dim vas9 As String * 10, vas10 As String * 10, vas11 As String * 12, vas12 As String * 12For i = 1 To tf1() = 度分离(e(3 * i))LSet vas1 = c(i)LSet vas9 = dw(3 * i - 2)LSet vas10 = dw(3 * i - 1)LSet vas7 = dw(3 * i)LSet vas8 = e(3 * i - 2)LSet vas11 = e(3 * i - 1)LSet vas12 = f1(1) & Space(1) & f1(2) & Space(1) & f1(3)txt = txt & vas1 & vas9 & vas10 & vas7 & vas8 & vas11 & vas12 & Chr(13) & Chr(10)Nexttxt = txt & "---------------------------------------------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "坐标成果表" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "----------------------------------------------" & Chr(13) & Chr(10)txt = txt & "点号" & Space(2) & "坐标X(m)" & Space(12) & "坐标Y(m)" & Space(11) & Chr(13) & Chr(10)For i = 1 To n1LSet vas1 = a1(3 * i - 2)LSet vas4 = a1(3 * i - 1)LSet vas6 = a1(3 * i)txt = txt & vas1 & vas4 & vas6 & Chr(13) & Chr(10)NextFor i = 1 To tx0(2 * i - 1) = Format(x0(2 * i - 1), "0.0000"): x0(2 * i) = Format(x0(2 * i), "0.0000")LSet vas1 = c(i)LSet vas4 = x0(2 * i - 1)LSet vas6 = x0(2 * i)txt = txt & vas1 & vas4 & vas6 & Chr(13) & Chr(10)Nextm0 = Format(m0, "0.0")txt = txt & "---------------------------------------------" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)txt = txt & "整网精度评定" & Chr(13) & Chr(10)txt = txt & Chr(13) & Chr(10)Dim vass As String * 20, vas17 As String * 20txt = txt & "----------------------------------------------" & Chr(13) & Chr(10) LSet vass = "导线全长:"LSet vas17 = bz(n3 + 3) & "Km"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "验前测角中误差:"LSet vas17 = mj & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "验后测角中误差:"LSet vas17 = m1 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)If Form8.Caption = "附合导线" ThenLSet vass = "实测角度闭合差:"LSet vas17 = bb & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "允许角度闭合差:"LSet vas17 = bb1 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标闭合差(cm):"LSet vas17 = "fx=" & fx & Space(1) & "fy=" & fytxt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标增量相对差:"LSet vas17 = "1:" & fstxt = txt & vass & vas17 & Chr(13) & Chr(10)ElseIf Form8.Caption = "闭合导线" Thenbb = Format(bb, "0.0")LSet vass = "角度闭合差:"LSet vas17 = bb & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "允许角度闭合差:"LSet vas17 = bb1 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标闭合差(cm):"LSet vas17 = "fx=" & fx & Space(1) & "fy=" & fytxt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "坐标增量相对差:"LSet vas17 = "1:" & fstxt = txt & vass & vas17 & Chr(13) & Chr(10)End IfLSet vass = "单位权中误差:"LSet vas17 = m0 & "″"txt = txt & vass & vas17 & Chr(13) & Chr(10)LSet vass = "最弱边相对中误差" & "(" & d1(3 * bz(n3 + 1) - 2) & "-" & d1(3 * bz(n3 + 1) - 1) & ")" & ":"LSet vas17 = "1:" & bz(n3 + 2)txt = txt & vass & vas17 & Chr(13) & Chr(10)Form1.Text1.Alignment = 2Form1.Text1.Text = txterrorhandler:If Err.Number = 75 ThenExit SubEnd If100: End SubPrivate Sub list1_Click()If list1.Text = "不等精度" Then '等精度和不等精度的互换Label1.Caption = "单位权中误差(″)"Text2.BackColor = &H80000004Text2.Locked = TrueText3.BackColor = &H80000004Text3.Locked = TrueElseIf list1.Text = "等精度" ThenLabel1.Caption = "测角中误差(″)"Text2.BackColor = &H80000005Text2.Locked = FalseText3.BackColor = &H80000005Text3.Locked = FalseEnd IfEnd SubPrivate Sub Opt1_Click()If Opt1.Value ThenFrame3.Enabled = FalseLabel5.Enabled = FalseText4.BackColor = &H80000004Text4.Text = 1Text4.Locked = TrueOptd1.Enabled = FalseOptd2.Enabled = FalseEnd IfEnd SubPrivate Sub Opt2_Click()If Opt2.Value ThenFrame3.Enabled = TrueLabel5.Enabled = TrueText4.BackColor = &H80000005 Text4.Locked = FalseOptd1.Enabled = TrueOptd1.Value = TrueOptd2.Enabled = TrueEnd IfEnd SubPrivate Function 查错(a1(), n1, n2)End Function[em1][em1][em1]。

四等水准测量VB 程序代码

四等水准测量VB 程序Private Sub Command1_Click()Dim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SingleBBU = Val(ltrim$(rtrim$(Text1.Text) ))BBM = Val(ltrim$(rtrim$(Text2.Text) ))BBL = Val(ltrim$(rtrim$(Text3.Text) ))BRM = Val(ltrim$(rtrim$(Text4.Text) ))BK = Val(ltrim$(rtrim$(Text9.Text) ))FBU = Val(ltrim$(rtrim$(Text5.Text) ))FBM = Val(ltrim$(rtrim$(Text6.Text) ))FBL = Val(ltrim$(rtrim$(Text7.Text) ))FRM = Val(ltrim$(rtrim$(Text8.Text) ))FK = Val(ltrim$(rtrim$(Text10.Text) ))bdh = (BBM - FBM) '黑面高差'fdh = (BRM - FRM) '红面高差'If BK > FK Thenfdh = fdh - 0.1Elsefdh = fdh + 0.1End IfIf Abs((BBU - BBL) - (FBU - FBL)) * 100 > 3 Then MsgBox "前后视距较差超限"Exit Sub '退出程序'ElseIf Abs(BBM + BK - BRM) > 0.003 Then MsgBox "后视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(FBM + FK - FRM) > 0.003 Then MsgBox "前视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(bdh - fdh) > 0.005 ThenMsgBox "黑红面所测高差较差超限"Exit Sub '退出程序'Elsedh = Format((bdh + fdh) / 2, "0.0000") '计算高差'MsgBox "测站高差="& Str$(dh) &”m”,vbokonly,”计算结果” End IfDim hsjl As SingleDim qsjl As SingleDim qhsjc As SingleDim qhsjljc As SingleDim hchhmdsc As SingleDim qchhmdsc As SingleDim hmgc As SingleDim hmgc1 As SingleDim hhmgczc As Singlehsjl = (BBU - BBL) * 100qsjl = (FBU - FBL) * 100qhsjc = qsjl - hsjlhchhmdsc = BBU - BRMqchhmdsc = FBU - FRMhmgc = BBM - FBMhmgc1 = BRM - FRMhhmgczc = hmgc - hmgc1Text1.Text = Format(hsjl, "0.0000")Text2.Text = Format(qsjl, "0.0000")Text3.Text = Format(qhsjc, "0.0000")Text4.Text = Format(qhsjljc, "0.0000")Text5.Text = Format(hchhmdsc, "0.0000")Text6.Text = Format(qchhmdsc, "0.0000")Text7.Text = Format(hmgc, "0.0000")Text9.Text = Format(hhmgczc, "0.0000")Text8.Text = Format(hmgc1, "0.0000")End SubDim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SinglePrivate Sub Combo1_Click()Dim ReTxt As StringReTxt = Combo1.ListIndexBK = Combo1.List(ReTxt)End SubPrivate Sub Combo2_Click()Dim ReTxt As StringReTxt = Combo2.ListIndexFK = Combo2.List(ReTxt)End SubPrivate Sub Command1_Click()BBU = Val(LTrim$(RTrim$(Text1.Text))) BBM = Val(LTrim$(RTrim$(Text2.Text))) BBL = Val(LTrim$(RTrim$(Text3.Text))) BRM = Val(LTrim$(RTrim$(Text4.Text)))FBU = Val(LTrim$(RTrim$(Text5.Text))) FBM = Val(LTrim$(RTrim$(Text6.Text))) FBL = Val(LTrim$(RTrim$(Text7.Text))) FRM = Val(LTrim$(RTrim$(Text8.Text)))Dim BBU As SingleDim BBM As SingleDim BBL As SingleDim BRM As SingleDim BK As SingleDim FBU As SingleDim FBM As SingleDim FBL As SingleDim FRM As SingleDim FK As SinglePrivate Sub Combo1_Click()Dim ReTxt As StringReTxt = Combo1.ListIndexBK = Combo1.List(ReTxt)End SubPrivate Sub Combo2_Click()Dim ReTxt As StringReTxt = Combo2.ListIndexFK = Combo2.List(ReTxt)End SubPrivate Sub Command1_Click()BBU = Val(LTrim$(RTrim$(Text1.Text)))BBM = Val(LTrim$(RTrim$(Text2.Text)))BBL = Val(LTrim$(RTrim$(Text3.Text)))BRM = Val(LTrim$(RTrim$(Text4.Text)))FBU = Val(LTrim$(RTrim$(Text5.Text)))FBM = Val(LTrim$(RTrim$(Text6.Text)))FBL = Val(LTrim$(RTrim$(Text7.Text)))FRM = Val(LTrim$(RTrim$(Text8.Text)))bdh = (BBM - FBM) '黑面高差'fdh = (BRM - FRM) '红面高差'If BK > FK Thenfdh = fdh - 100Elsefdh = fdh + 100End IfIf Abs((BBU - BBL) - (FBU - FBL)) * 0.1 > 3 Then MsgBox "前后视距较差超限"Exit Sub '退出程序'ElseIf Abs(BBM + BK - BRM) > 3 Then MsgBox "后视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(FBM + FK - FRM) > 3 Then MsgBox "前视黑~红面读数较差超限"Exit Sub '退出程序'ElseIf Abs(bdh - fdh) > 5 ThenMsgBox "黑红面所测高差较差超限"Exit Sub '退出程序'Elsedh = Format((bdh + fdh) / 2, "0.0000") '计算高差' Text10.Text = dh / 1000End IfEnd SubPrivate Sub Command2_Click()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = ""Text6.Text = ""Text7.Text = ""Text8.Text = ""Text9.Text = ""Text10.Text = ""Text1.SetFocusEnd Sub。

四等水准附和导线、闭合导线平差VB代码

程序说明:数据录入文件的存储格式为:按每一测站的距离、高差形式存储,平差之前需要输入测站总数,依次点击“平差计算”、“成果分析”、“成果输出“。

Dim ds() As Single, ht() As Single, detht() As Single, zh() As Single 'ht测量高差,deth高差改正数,zh点高程Dim fht As Single, n As Integer, fr As Single, sds As Single 'fht 高差闭合差,n测站数,fr高差闭差合限差,sds线路总长Private Sub Command3_Click()EndEnd SubPrivate Sub Command5_Click()Dim i As Integern = Val(Text3.Text)If n = 0 ThenMsgBox "请输入测站数"Exit SubEnd IfReDim ht(n) As Single, ds(n) As Single, detht(n) As Single, zh(n) As SingleCD.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"CD.ShowOpenstrfilename = CD.FileNameOpen strfilename For Input As #1For i = 1 To nInput #1, ds(i), ht(i)If ds(i) > 160 ThenMsgBox "第" & i & "测站视距超限"Exit SubEnd IfNext iClose #1MsgBox "数据已录入"End SubPrivate Sub Command6_Click()Dim i As Integer, sht As Single, x As Single Dim a As Single, b As Singlesds = 0sht = 0For i = 1 To nsds = sds + ds(i)sht = sht + ht(i) Next iIf Option1.Value Thena = Val(Text1.Text)b = Val(Text2.Text) fht = sht - (a - b) ElseIf Option2.Value Then a = Val(Text1.Text) fht = shtEnd IfEnd Ifzh(0) = aFor i = 1 To nx = -fht * ds(i) / sdsdetht(i) = xht(i) = ht(i) + detht(i)zh(i) = zh(i - 1) + ht(i)Next iMsgBox "平差计算已完成"End SubPrivate Sub Command7_Click()Dim x As Singlefr = 40 * Sqr(sds / 1000)x = Abs(fht)If x > fr ThenMsgBox "线路全长高差闭合差超限,但系统已按照平差原理平差,如需保存结果,请点击“成果保存”按钮"Exit SubElseMsgBox "线路全长高差闭合差符合限差要求,如需保存结果,请点击“成果保存”按钮"End IfEnd SubPrivate Sub Command8_Click()Dim i As IntegerCD.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"CD.ShowOpenstrfilename = CD.FileNameOpen strfilename For Output As #2For i = 1 To nPrint #2, "第" & i & "测站视线长:" & ds(i) & "m",Print #2, "高差改正数:" & Format(detht(i), "0.000") & "m",Print #2, "改后高差:" & Format(ht(i), "0.000") & "m",Print #2, "高程:" & Format(zh(i), "0.000") & "m"Next iPrint #2, "路线全长:" & Format(sds / 1000, "0.000") & "km"Print #2, "路线全长高差闭合差:" & Format(fht, "0.000") & "m" Print #2, "限差:" & Format(fr / 1000, "0.000") & "m"Print #2, "解算人:×××"Print #2, "时间:" & DateClose #2MsgBox "成果已保存"End Sub。

基于VB的水准网结点平差及精度评定

＠
２１ＳｉＴｃ．ｎｒ．０２ｃｅｈＥｇ．ｇ
建筑技术
基于ＶＢ的水准网结点平差及精度评定
吕翠华陈秀萍李明
（昆明冶金高等专科学校测绘学院，云南省测绘产品检测站，昆明６０３）５０３
摘要关键词
主要讨论利用结点法进行水准网平差的问题。通过对平差模型的分析，出利用迭代法进行结点式平差计算，出提导结点平差水准网精度评定文献标志码高程Ａ
３１５２
科
学
技
术
与
工
程
பைடு நூலகம்１２卷
Ｐ（＋ｈ）＋Ｐ（Ｂ＋ｈ）＋Ｐ（１月１２Ｈ２５２一ｈ）５
ａ１一，Ｐ＋Ｐ
，
＋Ｐ
彘（＋３ｍｍｏ２）
由＝ｍ得到：２：ｍｏｍｏ＝ｍ２
。
．
（）１Ｐ（ｃ＋ｈ）＋Ｐ（ｌ３Ｈ３４月Ｄ＋ｈ）＋Ｐ（４５１＋ｈ）５
２１０２年２月２９日收到
如图１所示，Ｅ、的高程平差值为、，设Ｆ点则列出结点表达式（）式（）１、２。
第一作者简介：吕翠华（９６）女，１７一，云南宣威人，教授，副工学硕
士，研究方向：测绘与地理信息系统应用。
式中，为与待定点ｉ连的各条水准路线另一端相点的协因数，当该端点是已知点时，协因数值为其零；＾为与待定点ｉＱ，相连的各条水准路线观测高差的权倒数。若以水准路线长定权，则＝１，

基于 VB 的水准网经典平差系统的开发与应用

基于 VB 的水准网经典平差系统的开发与应用张广宇;欧阳兆灼;那福超;杨帆【摘要】根据水准网数据特征，按已知数据、观测数据以及水准网边和点的相对位置关系设计了数据组织结构。

基于间接平差模型，在VB环境下设计开发了水准网平差系统。

选取了一组水准网数据，计算了水准网的高程平差值、高程中误差、高差平差值和高差中误差，并与已有计算结果作了对比，验证了程序编制的正确性和系统运行的可靠性。

%On the basis of the data structuredesigned ,according to the known data ,observation data and the relation of points and lines by the characteristics of the leveling net .Using VB to code ,designes and developes an adjustment system of levelling net ,based on indirect adjustment model .Choosing a set of levelling net data to calculate adjusted value and mean square error of elevation and elevation difference ,and makes a comparison with existing results ,and verification the validity of the programming and the reliability of the system .【期刊名称】《中国矿业》【年(卷),期】2014(000)0z2【总页数】4页(P354-357)【关键词】水准网;间接平差;中误差;VB;高差【作者】张广宇;欧阳兆灼;那福超;杨帆【作者单位】中国地质大学北京地球科学与资源学院，北京100083; 中国地质调查局沈阳地质调查中心，辽宁沈阳110034;中国地质调查局沈阳地质调查中心，辽宁沈阳110034;中国地质调查局沈阳地质调查中心，辽宁沈阳110034;中国地质调查局沈阳地质调查中心，辽宁沈阳110034【正文语种】中文【中图分类】P207水准测量是建立高程控制的一种常规方法，也是高精度沉降监测的主要手段之一。

水准网平差、矩阵运算MFC代码

误差理论与测量平差上机指导书钱建国张恒憬编写辽宁工程技术大学测绘与地理科学学院测绘工程系目录Visual C++平差编程实现 (2)1矩阵加法 (2)2矩阵乘法 (2)3 矩阵转置 (4)4 矩阵求逆 (4)5 水准网间接平差实例（分组选做） (11)Matlab平差编程实现（分组选做） (19)1 间接平差 (19)Visual C++平差编程实现一、实验名称：解算法方程。

二、实验目的和任务：掌握矩阵加法、乘法与求逆的通用程序的编写。

三、实验要求：1每人独立编写出矩阵加法与乘法的程序，并上机调试通过；2采用VC++6.0开发平台，C或者C++语言编写程序；3写出矩阵运算的结果。

四、实验内容：1矩阵加法矩阵加法的示例函数(C语言)void JZjiafa(double a[15][15],double b[15][15],double c[15][15],intm,int n){for (int i=0;i<=m-1;i++)for(int j=0;j<=n-1;j++){c[i][j]=a[i][j]+b[i][j];}return;}2矩阵乘法矩阵乘法的示例程序(C语言)#include "stdafx.h"void matrixMultiply(double a[14][15],double b[15][13], doublec[14][13],long m,long n,long k){for (long i = 0; i<= m-1; i++){for (long j=0; j<=k-1; j++){c[i][j] =0.0;for (long q=0; q<=n-1;q++){c[i][j] = c[i][j] + a[i][q] * b[q][j];}}}return;}int main(int argc, char* argv[]){long n,m,k,i,j;double a[14][15],c[14][13],b[15][13];FILE *stream;stream = fopen("矩阵输入.txt","r");fscanf(stream,"%ld %ld",&n,&m);for (i=0;i<n;i++){for(j=0;j<m;j++){fscanf(stream,"%lf",&a[i][j]);}}fscanf(stream,"%ld %ld",&m,&k);for(i=0;i<m;i++){for(j=0;j<k;j++){fscanf(stream,"%lf",&b[i][j]);}}fclose(stream);matrixMultiply(a,b,c,4,5,3);stream = fopen("矩阵计算结果.txt","w");for (i=0;i<=3;i++){for(j=0;j<=2;j++)fprintf(stream,"%16.7e ",c[i][j]);fprintf(stream,"\n");}fprintf(stream,"\n");fclose(stream);return 0;}3 矩阵转置矩阵的转置示例函数(C语言)double JZzhuanzhi(double a[15][15], double b[15][15], int m,int n) {{for(int i=0;i<m;i++)for(int j=0;j<n;j++)b[j][i]=a[i][j];}return 0.0;}4 矩阵求逆矩阵求逆的示例函数(C语言)int invGJ(double **a,int n){int *is,*js,i,j,k,l,u,v;double d,p;is=(int *)malloc(n*sizeof(int));js=(int *)malloc(n*sizeof(int));for(k=0;k<=n-1;k++){d=0.0;for(i=k;i<=n-1;i++)for(j=k;j<=n-1;j++){l=i*n+j;p=fabs(a[i][j]);if(p>d){d=p;is[k]=i;js[k]=j;}}if(d+1.0==1.0){free(is);free(js);printf("error not inv\n");return (0);}if(is[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=is[k]*n+j;p=a[k][j];a[k][j]=a[is[k]][j];a[is[k]][j]=p;}if(js[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+js[k];p=a[i][k];a[i][k]=a[i][js[k]];a[i][js[k]]=p;}l=k*n+k;a[k][k]=1.0/a[k][k];for(j=0;j<=n-1;j++)if(j!=k){u=k*n+j;a[k][j]=a[k][j]*a[k][k];}for(i=0;i<=n-1;i++)if(i!=k)for(j=0;j<=n-1;j++)if(j!=k){u=i*n+j;a[i][j]=a[i][j]-a[i][k]*a[k][j];}for(i=0;i<=n-1;i++)if(i!=k){u=i*n+k;a[i][k]=-a[i][k]*a[k][k];}}for(k=n-1;k>=0;k--){if(js[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=js[k]*n+j;p=a[k][j];a[k][j]=a[js[k]][j];a[js[k]][j]=p;}if(is[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+is[k];p=a[i][k];a[i][k]=a[i][is[k]];a[i][is[k]]=p;}}free(is);free(js);return (1);} int invGJ(double **a,int n){int *is,*js,i,j,k,l,u,v;double d,p;is=(int *)malloc(n*sizeof(int));js=(int *)malloc(n*sizeof(int));for(k=0;k<=n-1;k++){d=0.0;for(i=k;i<=n-1;i++)for(j=k;j<=n-1;j++){l=i*n+j;p=fabs(a[i][j]);if(p>d){d=p;is[k]=i;js[k]=j;}}if(d+1.0==1.0){free(is);free(js);printf("error not inv\n");return (0);}if(is[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=is[k]*n+j;p=a[k][j];a[k][j]=a[is[k]][j];a[is[k]][j]=p;}if(js[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+js[k];p=a[i][k];a[i][k]=a[i][js[k]];a[i][js[k]]=p;}l=k*n+k;a[k][k]=1.0/a[k][k];for(j=0;j<=n-1;j++)if(j!=k){u=k*n+j;a[k][j]=a[k][j]*a[k][k];}for(i=0;i<=n-1;i++)if(i!=k)for(j=0;j<=n-1;j++)if(j!=k){u=i*n+j;a[i][j]=a[i][j]-a[i][k]*a[k][j];}for(i=0;i<=n-1;i++)if(i!=k){u=i*n+k;a[i][k]=-a[i][k]*a[k][k];}}for(k=n-1;k>=0;k--){if(js[k]!=k)for(j=0;j<=n-1;j++){u=k*n+j;v=js[k]*n+j;p=a[k][j];a[k][j]=a[js[k]][j];a[js[k]][j]=p;}if(is[k]!=k)for(i=0;i<=n-1;i++){u=i*n+k;v=i*n+is[k];p=a[i][k];a[i][k]=a[i][is[k]];a[i][is[k]]=p;}}free(is);free(js);return (1);}矩阵求逆函数的调用(C语言)#include <stdio.h>#include <stdlib.h>#include <math.h>int invGJ(double **a,int n);void main(){int i,j;double **AA;//首先对二维指针Naa分配内存，采用C语言的方法/* AA=(double **)malloc(sizeof(double)*2);for(i=0;i<2;i++){AA[i]=(double *)mallo(sizeof(double)*2);}*///首先对二维指针Naa分配内存，采用C++语言的方法AA=new double * [2];for(i=0;i<2;i++){AA[i]=new double[2];}double BB[2][2]={1,2,3,4};for(i=0;i<2;i++){for(j=0;j<2;j++){AA[i][j]=BB[i][j];}}//调用矩阵求逆函数invGJ(AA,2);printf("矩阵AA的逆阵如下\n");for(i=0;i<2;i++){for(j=0;j<2;j++){printf("%10.4lf",AA[i][j]);}printf("\n");}double CC[2][2];printf("AA与其逆阵的乘积如下(理论上是单位阵)\n"); for(i=0;i<2;i++){for(j=0;j<2;j++){CC[i][j]=0.0;for(int k=0;k<2;k++){CC[i][j]+=AA[i][k]*BB[k][j];}printf("%10.4lf",CC[i][j]);}printf("\n");}//C 语言释放AA 二维指针的方法 /* for(i=0;i<2;i++){free(AA[i]);}free(AA);*/ //C++语言释放AA 二维指针的方法 for(i=0;i<2;i++) { delete AA[i]; } delete AA;}5 水准网间接平差实例（分组选做）例1：在图1所示的水准网中，已知水准点A 的高程为H A =237.483，为求B 、C 、D 三点的高程，进行了水准测量，测得高差5×1L和水准路线的长度5×1S ，其结果见表1，试按间接平差求定B 、C 、D 三点的高程平差值。

利用VB编程实现电子水准测量手簿的自动检查

利用VB编程实现电子水准测量手簿的自动检查作者：王凯来源：《科技创新导报》2017年第30期摘要：随着现代测绘科技、仪器的发展进步，测绘技术装备发生了革命性变化。

电子水准仪逐渐取代了传统光学水准仪，在水准测量作业中发挥着越来越重要的作用。

外业利用电子水准仪进行水准测量结束后，通过内业处理将数据转换为ExcelL格式的电子水准测量记录手簿，但是由于数据量较大，因此手工检查比较费时，且容易出现漏检的情况。

本文论述了利用VB编程，实现对电子水准测量记录手簿中单元格的数据进行检查，自动标记出超限的数据，实现水准手簿内业检查的自动化，提高内业工作效率。

关键词：VB Excel 电子水准测量手簿自动检查中图分类号：P22 文献标识码：A 文章编号：1674-098X（2017）10（c）-0140-031 引言水准测量是利用水准仪提供的水平视线测定两点间的高差，进而求得测点高程的方法，它是高程测量中最基本、精度最高的一种方法，在国家高程控制测量、工程勘察和施工放样中得到广泛应用。

电子水准仪在现今的水准测量中发挥着重要作用，与传统光学水准仪相比有以下特点。

（1）读数客观：不存在误记问题，没有人为读数误差。

（2）精度高：视线高和视距读数都是采用大量条码分划图像经处理后取平均得出来的，因此削弱了标尺分划误差的影响。

多数仪器都有进行多次读数取平均的功能，可以削弱外界条件影响，不熟练的作业人员也能进行高精度测量。

（3）速度快：由于省去了报数、听记、现场计算的时间以及人为出错的重测数量，测量时间与传统仪器相比可以节省1/3左右。

（4）效率高：只需调焦和按键就可以自动读数，减轻了劳动强度。

电子水准仪外业测量结束后，内业数据处理软件可以将外业测量数据处理成规范的电子水准测量记录手簿。

图1为一段标准的电子水准手簿记录格式，计算机中电子文档保存为Excel 软件的XLS或XLSX格式。

实际测量工作中，由于路线较长，观测天数多，测站较多，某些测站难免会产生一些超限的读数，如视线长度、视距差、视距累积差超限等。

GPS基线向量网平差VB程序设计

GPS基线向量网平差程序设计前言GPS技术以其定位精度高，观测自动化,不需测站间通视及网型与精度关系不大的优势,已成为建立城市及工程控制网的主要技术手段之一。

而与常规地面网相比,GPS控制网的数据处理有其自身的特点，由于基线向量是不可独立于坐标系而存在的特殊观测值，所以在平差时或平差后必须转入测区所在的坐标系统。

本论文讨论了GPS基线向量的转换和平差问题及工程控制测量实用的方法，并运用VB程序设计语言完成了大地空间直角坐标向大地坐标的转换、大地坐标向高斯平面坐标的转换、二维基线向量网平差的功能。

1GPS原理1.1 GPS的简介全球定位系统（全局位置系统，GPS）是美国从上世纪70年代开始研制，历时20年，耗资200亿美元，于1994年全面建成的利用导航卫星进行测时和测距，具有在海、陆、空进行全方位实时三维导航与定位能力的新一代卫星导航与定位系统。

它是继阿波罗登月计划、航天飞机后的美国第三大航天工程。

如今，GPS已经成为当今世界上最实用，也是应用最广泛的全球精密导航、指挥和调度系统。

它主要由三大子系统构成：空间卫星系统、地面监控系统、用户接收系统。

1.2 GPS定位原理GPS系统采用高轨测距体制，以观测站至GPS卫星之间的距离作为基本观测量。

为了获得距离观测量，主要采用两种方法：一是测量GPS卫星发射的测距码信号到达用户接收机的传播时间，即伪距测量；一是测量具有载波多普勒频移的GPS卫星载波信号与接收机产生的参考载波信号之间的相位差，即载波相位测量。

采用伪距观测量定位速度最快，而采用载波相位观测量定位精度最高。

通过对４颗或４颗以上的卫星同时进行伪距或相位的测量即可推算出接收机的三维位置。

按定位方式，GPS 定位分为单点定位和相对定位（差分定位）。

单点定位就是根据一台接收机的观测数据来确定接收机位置的方式，它只能采用伪距观测量。

相对定位（差分定位）是根据两台以上接收机的观测数据来确定观测点之间的相对位置的方法，它既可采用伪距观测量也可采用相位观测量。

基于VB环境下水准网平差程序设计研究

水准网间接平差设计流程大致分为５个步骤，
则如果有托个观测值，总的误差方程为：则
Ｔｒ
一
＾
Ｔｒ
一
Ｔ
／ｒ、
分别是已知观测数据输人、测数据信息提取、观未知点近似高程计算、差方程系数矩阵Ａ和Ｌ生误
成、求解未知参数值。
“
式中
下水准网平差程序设计研究
未知点平差后的高程最或然值。
１３
２１已知数据输入和观测数据信息提取．已知数据按照一定的格式编辑在文本文档中，按行读取到程序中，据输入后，序首先对已知数程
其中为每段高差的水平距离
。
因此只要确定
出矩阵Ａ和矩阵Ｌ就可求出高程改正值，而求出进
如果，点都为未知点，两则误差方程为：
未知点高程的最或然值。
＋一一＋￡
，
（）２水准网间接平差程序设计思路４
高差组成的误差方程的系数组成矩阵Ａ。矩阵Ｌ
２
Ａ
Ｃ
３５．２
１．４２
中的元素则为相应的终点近似高程或减去起点的相应近似高程或已知高程以及观测高差的值。
２４求解未知点高程改正值．
３
４
５
Ａ
Ｂ
Ｂ

VB开发水准测量平差软件的方法

VB开发水准测量平差软件的方法摘要：本文介绍了应用Visual Basic6.0开发的水准测量平差软件的方法。

通过软件自动生成EXCEL格式的水准测量平差计算表格进行数据处理，快速、准确计算出待求点的高程。

关键词：VB；数据处理;水准测量水准测量平差计算就是对合格的高差予以调整。

将闭合差以相反的符号按与各段水准路线长度（或按测站数）成正比的办法调整到各段高差上，求出改正后的高差再推算高程。

手工计算速度慢、工作效率低，同时易出现计算错误，而Visual Basic6.0是一种简单易学的可视化语言，用其进行编程计算就显得方便灵活。

本文结合作者工作的实践，详细地介绍了用VB开发水准测量平差软件的方法及应用。

1.VB语言的特点(1).面向对象和可视化的程序设计。

(2).事件驱动的运行机制。

(3).结构化的程序设计语言。

(4).多种数据库访问能力。

(5).提供了功能完备的应用程序集成开发环境。

(6).方便使用的联机帮助功能。

2.水准测量平差计算的方法(1).计算高差闭合差fh。

fh=Σh测 -（H终-H始）fh允=±20(按四等水准测量限差)fh≤fh允(合格)fh允—允许闭合差；Σh测—实测的各段高差和；H始—起点高程；H终—终点高程；(2).计算高差改正数Vi。

Σn —总测站数或路线总长度(km)；ni —分段测站数或分段路线长度(km)；(3).计算改正后高差h改i。

h改i=h测¬ + Vi(4).计算待求点高程Hi。

Hi=Hi-1+ h改i3．软件的开发原理首先在VB中设计了一个固定的界面（图3.1），添加相应功能键及数据输入文本框，通过输入相应的数据，利用VB编程实现自动生成电子表格；通过VB操作电子表格里数据进行平差计算。

根据不同的平差方法，本软件设置按距离进行平差和按测站数进行平差两种计算方法。

图3.1水准测量平差软件界面3.1参数输入方式数据输入设计成两种方式；一种是先建立文本格式(txt)的参数文件，通过编写程序代码实现直接读取数据。

平差程序核心代码(VB)

原文地址：平差程序核心代码（VB）作者：俞礼彬平差核心代码群：Const PI = 3.14159265358932'求AB的坐标方位角，输入是两点坐标，输出的是弧度值Public Function DirectAB(Xa#, Y a#, Xb#, Yb#) As Double Dim detX#, detY#, tana#detX = Xb - XadetY = Yb - Y aIf Abs(detX) < 0.000001 ThenIf detY > 0 ThenDirectAB = PI / 2ElseDirectAB = PI * 3 / 2End IfElsetana = detY / detXDirectAB = Atn(tana)If detX < 0 ThenDirectAB = PI + DirectABElseIf detX > 0 And detY < 0 ThenDirectAB = PI * 2 + DirectABEnd IfEnd IfEnd Function'弧度化为度.分秒的形式：输入弧度值，输出度.分秒（各占两位）Public Function HuToDo(ByV al Hu As Double) As Single Dim du%, fen%, miao%Hu = Hu * 180 / PIdu = Fix(Hu)Hu = (Hu - du) * 60fen = Fix(Hu)Hu = (Hu - fen) * 60miao = Fix(Hu + 0.5)If miao = 60 Thenfen = fen + 1miao = 0End IfIf fen = 60 Thendu = du + 1fen = 0End IfHuToDo = du + fen / 100 + miao / 10000End Function'将度.分秒形式化为弧度：输入为度.分秒形式，输出为弧度Public Function DoToHu(ByV al DoFenMiao As Double) As Single Dim du%, fen%, miao%, angle#du = Fix(DoFenMiao)DoFenMiao = (DoFenMiao - du) * 100fen = Fix(DoFenMiao)miao = (DoFenMiao - fen) * 100angle = du + fen / 60 + miao / 3600DoToHu = angle * PI / 180End Function'矩阵转置的通用过程Public Sub MatrixTrans(A, c)Dim i%, j%Dim R1%, C1%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "输入的矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1ReDim c(1 To C1, 1 To R1)For i = 1 To R1For j = 1 To C1c(j, i) = A(i, j)Next jNext iEnd Sub'矩阵相加的通用过程Public Sub MatrixPlus(A, b, c)Dim i%, j%Dim R1%, C1%, R2%, C2%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "第一个矩阵维数不对！"Exit SubEnd IfOn Error Resume NextC2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "第二个矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1R2 = UBound(b, 1) - LBound(b, 1) + 1If R1 <> R2 Or C1 <> C2 ThenMsgBox "输入的两个矩阵维数不等，不能相加！"Exit SubEnd IfReDim c(1 To m, 1 To n) As DoubleFor i = 1 To mFor j = 1 To nc(i, j) = A(i, j) + b(i, j)Next jNext iEnd Sub'矩阵相减的通用过程Public Sub MatrixMinus(A, b, c)Dim i%, j%Dim R1%, C1%, R2%, C2%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "第一个矩阵维数不对！"Exit SubEnd IfOn Error Resume NextC2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "第二个矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1R2 = UBound(b, 1) - LBound(b, 1) + 1If R1 <> R2 Or C1 <> C2 ThenMsgBox "输入的两个矩阵维数不等，不能相减！"Exit SubEnd IfReDim c(1 To m, 1 To n) As DoubleFor i = 1 To mFor j = 1 To nc(i, j) = A(i, j) - b(i, j)Next jNext iEnd Sub'矩阵相乘：输入矩阵或数Qa、Qb，自动识别它们的维数，并输出它们的乘积QnPublic Sub Matrix_Multy(Qn, Qa, Qb)Dim ia%, ib%, ic%Dim ai%, bi%, ci%Dim e1 As Boolean, e2 As Boolean, e3 As Boolean, e4 As Boolean, e5 As Boolean, e6 As Boolean, e7 As BooleanOn Error Resume Next '看Qa是不是一维数组ic = UBound(Qa, 2) - LBound(Qa, 2)If Err Then e1 = TrueOn Error Resume Next '看Qa是不是一维数组ib = UBound(Qb, 2) - LBound(Qb, 2)If Err Then e2 = TrueIf e1 = False And e2 = False Then '二维矩阵相乘For ai = LBound(Qa, 1) To UBound(Qa, 1)For bi = LBound(Qb, 2) To UBound(Qb, 2)For ci = LBound(Qa, 2) To UBound(Qa, 2)Qn(ai, bi) = Qn(ai, bi) + Qa(ai, ci) * Qb(ci, bi)Next ciNext biNext aiElseIf e1 = True And e2 = False ThenOn Error Resume Nextia = UBound(Qa) - LBound(Qa)If Err Then e6 = TrueIf e6 Then '数乘以二维矩阵For ai = LBound(Qb, 1) To UBound(Qb, 1)For bi = LBound(Qb, 2) To UBound(Qb, 2)Qn(ai, bi) = Qa * Qb(ai, bi)Next biNext aiElse '一维矩阵乘以二维矩阵For ci = LBound(Qb, 2) To UBound(Qb, 2)For ai = LBound(Qa, 1) To UBound(Qa, 1)Qn(ci) = Qn(ci) + Qa(ai) * Qb(ai, ci)Next aiNext ciEnd IfElseIf e1 = False And e2 = True ThenOn Error Resume Nextic = UBound(Qb) - LBound(Qb)If Err Then e7 = TrueIf e7 Then '二维矩阵乘以数For ai = LBound(Qa, 1) To UBound(Qa, 1)For bi = LBound(Qa, 2) To UBound(Qa, 2)Qn(ai, bi) = Qa(ai, bi) * QbNext biNext aiElse '二维矩阵乘以一维矩阵For ai = LBound(Qa, 1) To UBound(Qa, 1)For bi = LBound(Qa, 2) To UBound(Qa, 2)Qn(ai) = Qn(ai) + Qa(ai, bi) * Qb(bi)Next biNext aiEnd IfElseDim errT As IntegerOn Error Resume Next '结果是否是一个数errT = UBound(Qn)If Err Then e3 = TrueIf e3 Then '一维矩阵乘以一维矩阵得一个数For ai = LBound(Qa, 1) To UBound(Qa, 1)For bi = LBound(Qa, 2) To UBound(Qa, 2)Qn = Qn + Qa(ai) * Qb(bi)Next biNext aiExit SubEnd IfOn Error Resume Next '是否是数乘一维矩阵ia = UBound(Qa) - LBound(Qa)If Err Then e4 = TrueIf e4 ThenFor bi = LBound(Qa, 2) To UBound(Qa, 2)Qn(bi) = Qa * Qb(bi)Next biExit SubEnd IfOn Error Resume Next '是否是一维矩阵乘数ib = UBound(Qb) - LBound(Qb)If Err Then e5 = TrueIf e5 ThenFor ai = LBound(Qa, 1) To UBound(Qa, 1)Qn(ai) = Qa(ai) * QbNext aiExit SubEnd If'一维矩阵相乘结果是二维矩阵For ai = LBound(Qa, 1) To UBound(Qa, 1)For bi = LBound(Qa, 2) To UBound(Qa, 2)Qn(ai, bi) = Qa(ai) * Qb(bi)Next biNext aiEnd IfEnd Sub'矩阵相乘的通用过程Public Sub MatrixMulti(A, b, c)Dim i%, j%, K%Dim R1%, C1%, R2%, C2%On Error Resume NextC1 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "第一个矩阵维数不对！"Exit SubEnd IfOn Error Resume NextC2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "第二个矩阵维数不对！"Exit SubEnd IfR1 = UBound(A, 1) - LBound(A, 1) + 1R2 = UBound(b, 1) - LBound(b, 1) + 1If C1 <> R2 ThenMsgBox "输入的两个矩阵大小不对，不能相乘！"Exit SubEnd Ifm = R1: s = C1: n = C2ReDim c(1 To m, 1 To n) As DoubleFor i = 1 To mFor j = 1 To nFor K = 1 To sc(i, j) = c(i, j) + A(i, K) * b(K, j)Next KNext jNext iEnd Sub'列选主元法Guass约化求解线性方程组Public Sub MajorInColGuass(A, b, X)Dim Row%, Col%, n% '矩阵大小Dim iStep%, iRow%, iCol% '循环变量Dim L() As Double '各行的约化系数'计算并检查矩阵的大小Row = UBound(A, 1) - LBound(A, 1) + 1Col = UBound(A, 2) - LBound(A, 2) + 1If Row <> Col ThenMsgBox "方程组的系数矩阵有误！"Exit SubEnd If'准备约化过程的变量和数组n = UBound(b) - LBound(b) + 1If n <> Row ThenMsgBox "方程组的系数矩阵与常数项大小不符！"Exit SubEnd IfReDim L(2 To Row) As DoubleDim sumAX As Double, iPos%, temp#'约化过程For iStep = 1 To n - 1'列选主元iPos = 0For iRow = iStep + 1 To nIf Abs(A(iRow, iStep)) > Abs(A(iStep, iStep)) TheniPos = iRowEnd IfNext iRowIf iPos > iStep Then '需要换主元For iCol = iStep To ntemp = A(iStep, iCol)A(iStep, iCol) = A(iPos, iCol)A(iPos, iCol) = tempNext iColtemp = b(iStep)b(iStep) = b(iPos)b(iPos) = tempEnd If'约化过程For iRow = iStep + 1 To nL(iRow) = A(iRow, iStep) / A(iStep, iStep)For iCol = iStep To nA(iRow, iCol) = A(iRow, iCol) - L(iRow) * A(iStep, iCol)Next iColb(iRow) = b(iRow) - L(iRow) * b(iStep)Next iRowShowMatrix ANext iStep'回代过程X(n) = b(n) / A(n, n)For iRow = n - 1 To 1 Step -1sumAX = 0For iCol = n To iRow + 1 Step -1sumAX = sumAX + A(iRow, iCol) * X(iCol)Next iColX(iRow) = (b(iRow) - sumAX) / A(iRow, iRow)Next iRowEnd Sub'Guass－Seidel迭代法求解线性方程组Private Function Seidel(A, b, X, eps#) As BooleanDim i%, j%Dim P#, Q#, s#, t#Dim Row%, Col%, n%Row = UBound(A, 1) - LBound(A, 1) + 1Col = UBound(A, 2) - LBound(A, 2) + 1n = UBound(b) - LBound(b) + 1If n <> Row ThenMsgBox "方程组的系数矩阵与常数项大小不符！"Exit FunctionEnd IfFor i = 1 To nP = 0#X(i) = 0#For j = 1 To nIf i <> j Then P = P + Abs(A(i, j))Next jIf P >= Abs(A(i, i)) ThenSeidel = FalseExit FunctionEnd IfNext iP = eps + 1#While P >= epsP = 0#For i = 1 To nt = X(i)s = 0#For j = 1 To nIf j <> i Then s = s + A(i, j) * X(j)Next jX(i) = (b(i) - s) / (A(i, i))Q = Abs(X(i) - t) '/ (1# + Abs(x(i)))If Q > P Then P = QNext iWendSeidel = TrueEnd FunctionPublic Sub ShowMatrix(tt)Dim i%, j%, n%, m%m = UBound(tt, 1) - LBound(tt, 1) + 1n = UBound(tt, 2) - LBound(tt, 2) + 1For i = 1 To mFor j = 1 To nDebug.Print tt(i, j),Next jDebug.PrintNext iEnd Sub'通用的间接平差解算过程：输入系数矩阵A、权矩阵P、常数向量L和解向量X，求出X，并通过参数传出去Public Sub InAdjust(A, P, L, X)Dim a1%, a2%, p1%, p2%, L1%, x1% '输入矩阵或向量的大小Dim At() As Double, AtP() As Double, Naa#(), W() As Double '几个中间矩阵'计算并检查输入矩阵或向量的大小On Error Resume Nexta1 = UBound(A, 1) - LBound(A, 1) + 1If Err ThenMsgBox "系数矩阵A大小错误！"Exit SubEnd IfOn Error Resume Nexta2 = UBound(A, 2) - LBound(A, 2) + 1If Err ThenMsgBox "系数矩阵A大小错误！"Exit SubEnd IfOn Error Resume NextL1 = UBound(L) - LBound(L) + 1If Err ThenMsgBox "常数向量L大小错误！"Exit SubEnd IfOn Error Resume Nextx1 = UBound(X) - LBound(X) + 1If Err ThenMsgBox "解向量X大小错误！"Exit SubEnd IfOn Error Resume Nextp1 = UBound(P, 1) - LBound(P, 1) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfOn Error Resume Nextp2 = UBound(P, 2) - LBound(P, 2) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfIf p1 <> p2 ThenMsgBox "权矩阵P不是方阵！"Exit SubEnd IfIf p1 <> a1 Or p2 <> a1 ThenMsgBox "权矩阵P与系数矩阵A大小不符！"Exit SubEnd IfIf a2 <> x1 ThenMsgBox "系数矩阵A大小与解向量X大小不符！" Exit SubEnd IfIf a1 <> L1 ThenMsgBox "系数矩阵A大小与常数向量L大小不符！" Exit SubEnd If'定义中间矩阵的大小ReDim At(1 To a2, 1 To a1), AtP(1 To a2, 1 To a1)ReDim Naa(1 To a2, 1 To a2), W(1 To a2)'组成法方程并计算Debug.Print "The A matrix is:"ShowMatrix AMatrixTrans A, At '求A的转置矩阵Debug.Print "The At matrix is:"ShowMatrix AtDebug.Print "The P matrix is:"ShowMatrix PMatrix_Multy AtP, At, P '求AtPDebug.Print "and The AtP matrix is:"ShowMatrix AtPMatrix_Multy Naa, AtP, A'法方程系数矩阵Debug.Print "the Naa matrix is:"ShowMatrix NaaDebug.Print "the L matrix is:"For x1 = LBound(L) To UBound(L)Debug.Print L(x1)Next x1Matrix_Multy W, AtP, L '法方程常数向量Debug.Print "the W matrix is:"For x1 = LBound(W) To UBound(W)Debug.Print W(x1)Next x1MajorInColGuass Naa, W, XDebug.Print "the X matrix is:"For x1 = LBound(X) To UBound(X)Debug.Print X(x1)Next x1'Seidel Naa, W, x, 0.000001End Sub'通用的条件平差解算过程：输入系数矩阵A、权矩阵P、常数向量L和解向量X，求出X，并通过参数传出去Public Sub CondiAdjust(b, P, W, V)Dim b1%, b2%, p1%, p2%, w1%, v1% '输入矩阵或向量的大小Dim Q#(), Bt#(), QBt#(), Nbb#(), K#(), i% '几个中间矩阵'计算并检查输入矩阵或向量的大小On Error Resume Nextb1 = UBound(b, 1) - LBound(b, 1) + 1If Err ThenMsgBox "系数矩阵B大小错误！"Exit SubEnd IfOn Error Resume Nextb2 = UBound(b, 2) - LBound(b, 2) + 1If Err ThenMsgBox "系数矩阵B大小错误！"Exit SubEnd IfOn Error Resume Nextw1 = UBound(W) - LBound(W) + 1If Err ThenMsgBox "常数向量W大小错误！"Exit SubEnd IfOn Error Resume Nextv1 = UBound(V) - LBound(V) + 1If Err ThenMsgBox "改正数向量V大小错误！"Exit SubEnd IfOn Error Resume Nextp1 = UBound(P, 1) - LBound(P, 1) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfOn Error Resume Nextp2 = UBound(P, 2) - LBound(P, 2) + 1If Err ThenMsgBox "权矩阵P大小错误！"Exit SubEnd IfIf p1 <> p2 ThenMsgBox "权矩阵P不是方阵！"Exit SubEnd IfIf p1 <> b2 ThenMsgBox "权矩阵P与系数矩阵A大小不符！"Exit SubEnd IfIf b2 <> v1 ThenMsgBox "系数矩阵B大小与解向量V大小不符！"Exit SubEnd IfIf b1 <> w1 ThenMsgBox "系数矩阵B大小与常数向量W大小不符！"Exit SubEnd If'定义中间矩阵的大小ReDim Bt(1 To b2, 1 To b1), QBt(1 To b2, 1 To b1)ReDim Nbb(1 To b1, 1 To b1), K(1 To b1), Q(1 To p1, 1 To p2)'组成法方程并计算For i = 1 To p1 '求Q矩阵Q(i, i) = 1 / P(i, i)Next iMatrixTrans b, BtMatrix_Multy QBt, Q, BtMatrix_Multy Nbb, b, QBt '法方程系数矩阵ShowMatrix NbbMajorInColGuass Nbb, W, K '解法方程'Seidel Nbb, W, K, 0.0000001Matrix_Multy V, QBt, K '求改正数End Sub。

水准网平差(VB代码)

VB测量平差程序设计讲稿

实验一matlab完成水准网平差

水准网平差(VB代码)

水准网平差(VB代码)

水准网的条件平差

水准网条件平差.

vb水准

四等水准测量VB 程序 代码

四等水准附和导线、闭合导线平差VB代码

基于VB的水准网结点平差及精度评定

基于 VB 的水准网经典平差系统的开发与应用

水准网平差、矩阵运算MFC代码

利用VB编程实现电子水准测量手簿的自动检查

GPS基线向量网平差VB程序设计

基于VB环境下水准网平差程序设计研究

VB开发水准测量平差软件的方法

平差程序核心代码(VB)

四等水准测量VB 程序代码