水准网平差(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是目前在研究机构广泛应用的一种数值计算及图形工具软件，它的特点是语法结构简明、数值计算高效、图形功能完备，特别适合非专业编程员完成数值计算、科学试验处理等任务。
以往的测量数据处理方法需要编制特定的处理矩阵运算程序，而且程度复杂，难度大。
本文介绍一种基于MATLAB的水准网和测边网的程序设计方法，与其它算法语言相比，具有编程简单，运算速度快的特点。
文中分别阐述了水准网和测边网程序的理论基础、实现步骤和运行结果。
通过实例的分析，总结出利用MATLAB对测量数据处理有很大的应用价值，它缩短了编程的时间，提高工作效率。
关键词：MATLAB；水准网；测边网；程序设计ABSTRAC TMATLAB is one species of numerical-values calculation and graphic tools software which is widely used to apply at research institutions at present. The particularities are: concise grammar-structure、highly efficient in numerical values calculating、complete function of graphs、especially it is adapted to evildoing professional programmer to accomplish the tasks that are numerical-values calculating and scientific experiments treating. The ancient methods of measured data-processing need establishing special proceedings of treating matrices operation, moreover, it is complex and greatly difficult.This article introduces one programming method dealing with leveling and measuring edge network based on MATLAB. Compared with other algorithm language, it has particularities which are simply programming and quickly operating. The article separately expatiate the theories basics、realizing steps and running results at leveling and measuring edge network. With the analysis of examples, it has prodigious application value in measured data-processing by use of MATLAB. Moreover, it shortens programming time and improves working effectiveness.Key words：MATLAB；leveling network；measuring edge network；programming目录绪论 (4)1. MATLAB软件简介 (5)2．MATLAB 在测量平差中的应用 (6)2.1测量平差原理的概述 (6)2.2平差程序总体方案 (7)3.1程序的功能 (8)3.2水准模型网的间接平差 (8)3.2.1 “权”值的确定 (8)3.2.2 水准路线的平差计算 (9)3.2.3 精度评定 (11)3.3水准网间接平差程序信息设计 (11)3.4 水准网程序与使用说明 (12)3.4.1 水准网程序流程图 (12)3.4.2 水准网程序的使用 (12)3.5案例 (13)4. 测边网平差程序设计 (15)4.1数学模型 (15)4.1.1 误差方程和法方程的组成 (15)4.1.2 边长观测的权 (15)4.1.3 解算法方程 (16)4.1.4 精度评定 (19)4.2 测边网平差信息设计 (20)4.2.1 主要的技术要求 (21)4．3利用MATLAB的绘图语句绘制网图 (21)4.4测边网程序和使用说明 (22)4.5 程序代码说明： (23)4.6程序的使用算例 (25)结论 (29)致谢 (30)参考文献 (31)附录一 (32)附录二 (36)附录三 (46)绪论作为一名测量技术人员，如果不掌握一门PC机编程语言与便携计算工具，要想提高测量工作的效率几乎寸步难行。
水准网平差(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）近似高程的计算。
利用MATLAB实现水准网条件平差
Ｐ ２ ｈ ６
（ ） Ｋ代入法方程式 ， 出 Ｖ值 ， ４将 求 并求出平差 值 ＝ Ｖ Ｌ＋ 。 （） ５ 为了验证平差计算的正确性 ， 用平差值 重新列出平差值条件方程式 ， 看是否满足方程。
Ａ
ｈ ７
２ 水准 网
Ｐ１
铜
业
工
程
２０ Ｎ４ ０ ８ ０
是 ＝ ， ＝ Ｑ
＝５。 因各观测高差不相关故
协 因数 阵为对 角 阵 ， ： 即
１７ ． ２． ３
Ｑ ＝Ｐ ＝ ～
２． ７
２４ ．
１４ ．
１６ ．
由此 组成 法方程 为 ：
ｒ ． ５ ２ ２４ ． ２４ ． ０ １７ ．
强 的绘图功能。Ｍ Ｔ Ａ Ａ Ｌ Ｂ集科学计算 、 图像处理 、 声
音处理 于一身 ， 一个高 度 的集成 系统 ， 良好 的用 是 有 户 界面 ， 并有 良好 的帮 助功 能 。利 用 ＭＡ Ｌ Ｂ的矩 ＴＡ
水准网中 ， 必要观测的个数等 于网中所有未知点个
数 减 ｌ 。 以图 １中水准 网为例 详 细说 明水准 网平 差方 程 的列 立 和计算 的具 体过 程 ，Ａ，Ｂ是 已知 高 程 的水 准点 ，图 中 Ｐ ，Ｐ ，Ｐ ｌ ２ ３点 是 待 定 点 。Ａ，Ｂ是 已
摘
要： 水准网条件 平差 中矩阵运算 占很 大一 部分 ， 计算 工作浪 费时 间较 多。ＭＡ Ｌ Ｂ具 有强 大的矩 阵运 算 ＴＡ
和创建 图形厨户界面的功能。用 ＭＡ Ｌ Ｂ编制 水准网条件平差程序 可以去掉 矩阵计算这 个沉重的包袱 ， 而提 高 ＴＡ 从
计算工作效率。
关键词 ： 测量平 ； 阵运算 ； Ｔ Ａ ； ＭＡ Ｌ Ｂ 水准网
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]。
基于VB6.0的水准网抗差估计程序设计与开发
基于VB6.0的水准网抗差估计程序设计与开发
俞礼彬;岳东杰
【期刊名称】《测绘与空间地理信息》
【年(卷),期】2015(000)002
【摘要】针对当前水准网平差软件不能满足用户粗差探测需求的现状,基于VB6.0编写了水准网抗差估计程序,本程序可以在固定基准、秩亏基准、拟稳基准下对水准网平差,并利用7种不同的选权迭代法进行抗差估计,达到抗粗差干扰的目的.本文选用IGG-Ⅲ法在3种不同基准下进行抗差估计,结果验证了程序的正确性和可靠性.【总页数】3页(P196-197,201)
【作者】俞礼彬;岳东杰
【作者单位】河海大学地球科学与工程学院,江苏南京210098;河海大学地球科学与工程学院,江苏南京210098
【正文语种】中文
【中图分类】P224.1
【相关文献】
1.基于MATLAB的水准网平差程序设计与实现 [J], 陈永星;王蕾
2.水准网抗差估计程序设计 [J], 潘申运
3.基于VB6.0的水准网数据处理程序的实现 [J], 陈帅;王鹏
4.基于 MATLAB 的水准网平差程序设计 [J], 王鹏磊;刘长星
5.一种基于MATLAB的改进的水准网平差程序设计与实现 [J], 李亮亮;郭恒林;王利华
因版权原因，仅展示原文概要，查看原文内容请购买。
四等水准测量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)
原文地址：平差程序核心代码（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代码
程序说明:数据录入文件的存储格式为:按每一测站的距离、高差形式存储,平差之前需要输入测站总数,依次点击“平差计算”、“成果分析”、“成果输出“。
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水准测量是建立高程控制的一种常规方法，也是高精度沉降监测的主要手段之一。
基于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)的参数文件，通过编写程序代码实现直接读取数据。
windows绘图和水准网平差c++代码
Windows绘图#include "stdafx.h"#include "cbs.h"#include "cbsDoc.h"#include "cbsView.h"#ifdef _DEBUG#define new DEBUG_NEW#undef THIS_FILEstatic char THIS_FILE[] = __FILE__;#endif/////////////////////////////////////////// //////////////////////////////////// CCbsViewIMPLEMENT_DYNCREATE(CCbsView, CView)BEGIN_MESSAGE_MAP(CCbsView, CView)//{{AFX_MSG_MAP(CCbsView)ON_WM_MOUSEMOVE()ON_WM_LBUTTONDOWN()ON_WM_LBUTTONUP()//}}AFX_MSG_MAP// Standard printing commandsON_COMMAND(ID_FILE_PRINT,CView::OnFilePrint)ON_COMMAND(ID_FILE_PRINT_DIRECT, CView::OnFilePrint)ON_COMMAND(ID_FILE_PRINT_PREVIEW, CView::OnFilePrintPreview)END_MESSAGE_MAP()/////////////////////////////////////////// //////////////////////////////////// CCbsView construction/destruction CCbsView::CCbsView(){// TODO: add construction code herethis->m_bDragging=false;}CCbsView::~CCbsView(){}BOOL CCbsView::PreCreateWindow(CREATESTRUCT& cs){// TODO: Modify the Window class or styles here by modifying// the CREATESTRUCT csreturn CView::PreCreateWindow(cs);}/////////////////////////////////////////// //////////////////////////////////// CCbsView drawingvoid CCbsView::OnDraw(CDC* pDC){CCbsDoc* pDoc = GetDocument();ASSERT_VALID(pDoc);// TODO: add draw code for native data here /* pDC->SetMapMode(MM_TEXT);pDC->Rectangle(CRect(50, 50, 100, 100));// 直接基于屏幕绘制pDC->SetMapMode(MM_TEXT);//pDC->SetWindowOrg(50, 50); //屏幕左上角的坐标设置为(50, 50)pDC->Rectangle(CRect(50, 50, 100, 100));pDC->SetMapMode(MM_TEXT);pDC->SetViewportOrg(50,50);//当前原点位置移动到(50, 50)的位置pDC->Rectangle(CRect(50, 50, 100, 100));pDC->SetMapMode(MM_TEXT);pDC->SetViewportOrg(100,100); // 当前原点位置移动到(50, 50)的位置pDC->SetWindowOrg(50, 50); // 当前的原点坐标设置为(50, 50)pDC->Rectangle(CRect(100, 100, 100, 100));pDC->SetWindowOrg(100,100);*/pDC->SetViewportOrg(150,150); // 当前原点位置移动到(50, 50)的位置COLORREF rgbBkClr = RGB(192,192,192);// 定义灰色pDC->SetBkColor(rgbBkClr);// 背景色为灰色pDC->SetTextColor(RGB(0,0,128));// 文本颜色为兰色pDC->TextOut(250,10,"我*****的*****绘*****图*****板！");CPen *pPenOld, PenNew;int nPenStyle[]= { PS_SOLID, // 实线PS_DOT,// 点线PS_DASH,// 虚线PS_DASHDOT,// 点划线PS_DASHDOTDOT, // 双点划线PS_NULL,// 空的边框PS_INSIDEFRAME,// 边框实线};char *strStyle[]={"Solid", "Dot", "Dash", "DashDot","DashDotDot", "Null", "InsideFrame"};pDC->TextOut(50, 65, "用不同样式的画笔绘图"); pDC->TextOut(400, 40, "***制作者***陈斌生***");for(int i=0; i<7; i++){ // 用不同样式的画笔绘图if(PenNew.CreatePen(nPenStyle[i],1,RGB(0,0, 0))){ //创建画笔pPenOld=pDC->SelectObject(&PenNew);// 选择画笔pDC->TextOut(45,90+20*i,strStyle[i]);pDC->MoveTo(150,100+20*i);pDC->LineTo(200,100+20*i);pDC->SelectObject(pPenOld);// 恢复原来的画笔PenNew.DeleteObject();// 删除底层的GDI对象}else {MessageBox("不能创建画笔！"); } }char *strWidth[]={"1", "2", "3", "4", "5", "6", "7"};pDC->TextOut(260, 65, "用不同宽度的画笔绘图");for(i=0; i<7; i++){ // 用不同宽度的画笔绘图if(PenNew.CreatePen(PS_SOLID,i+1,RGB(0, 0,0))){ // 创建画笔pPenOld=pDC->SelectObject(&PenNew); // 选择画笔pDC->TextOut(260,90+20*i,strWidth[i]);pDC->MoveTo(300, 100+20*i);pDC->LineTo(400, 100+20*i);pDC->SelectObject(pPenOld);// 恢复原来的画笔PenNew.DeleteObject();// 删除底层的GDI对象}else { MessageBox("不能创建画笔！"); }}char *strColor[]={"红","绿","蓝","黄","紫","青","灰"};COLORREF rgbPenClr[]={RGB(255,0,0), RGB(0,255,0),RGB(0,0,255), RGB(255,255,0), RGB(255,0,255),RGB(0,255,255),RGB(192,192,192)};pDC->TextOut(460,65,"用不同颜色的画笔绘图");for(i=0; i<7; i++){ // 用不同颜色的画笔绘图CPen *pPenNew=new CPen(PS_INSIDEFRAME,10,rgbPenClr[i]);// 创建画笔的另一种方法pPenOld=pDC->SelectObject(pPenNew);// 选择创建的画笔pDC->TextOut(460,90+20*i, strColor[i]);pDC->MoveTo(500,100+20*i);pDC->LineTo(600,100+20*i);pDC->SelectObject(pPenOld); // 恢复原来的画笔delete pPenNew; // 自动删除底层的GDI对象}}/////////////////////////////////////////// //////////////////////////////////// CCbsView printingBOOL CCbsView::OnPreparePrinting(CPrintInfo* pInfo){// default preparationreturn DoPreparePrinting(pInfo);} void CCbsView::OnBeginPrinting(CDC* /*pDC*/, CPrintInfo* /*pInfo*/){// TODO: add extra initialization before printing}void CCbsView::OnEndPrinting(CDC* /*pDC*/, CPrintInfo* /*pInfo*/){// TODO: add cleanup after printing}/////////////////////////////////////////// //////////////////////////////////// CCbsView diagnostics#ifdef _DEBUGvoid CCbsView::AssertValid() const{CView::AssertValid();}void CCbsView::Dump(CDumpContext& dc) const {CView::Dump(dc);}CCbsDoc* CCbsView::GetDocument() // non-debug version is inline{ASSERT(m_pDocument->IsKindOf(RUNTIME_CL ASS(CCbsDoc)));return (CCbsDoc*)m_pDocument;}#endif //_DEBUG/////////////////////////////////////////// //////////////////////////////////// CCbsView message handlersvoid CCbsView::OnMouseMove(UINT nFlags, CPoint point)// TODO: Add your message handler code here and/or call defaultif(m_bDragging){CClientDC dc(this);OnPrepareDC(&dc);dc.DPtoLP(&point);dc.MoveTo(this->m_ptOrigin);dc.LineTo(point);m_ptOrigin = point;}CView::OnMouseMove(nFlags, point);}void CCbsView::OnLButtonDown(UINT nFlags, CPoint point){// TODO: Add your message handler code here and/or call defaultCClientDC dc(this);OnPrepareDC(&dc); // 调整设备环境的属性dc.DPtoLP(&point); // 将设备坐标转换为逻辑坐标SetCapture(); // 捕捉鼠标//::SetCursor(m_hCross); // 设置十字光标m_ptOrigin=point;m_bDragging=TRUE; // 设置拖拽标记CView::OnLButtonDown(nFlags, point);}void CCbsView::OnLButtonUp(UINT nFlags, CPoint point){// TODO: Add your message handler code here and/or call defaultm_bDragging = false;ReleaseCapture();CView::OnLButtonUp(nFlags, point);}结果水准网平差结果#include<iostream.h>#include<stdlib.h>#include<iomanip.h>#include<math.h>#define max 50class CMatrix{public:CMatrix(){row=0; column=0;}; // 默认构造函数CMatrix(int i, int j){row=i;column=j;} // 构造函数一CMatrix(const CMatrix& m); // 复制构造函数~CMatrix(void){/*cout<<"谢谢使用，矩阵所占空间以释放！"<<endl;*/} // 默认析构函数CMatrix& operator=(const CMatrix& m); // 赋值运算符bool operator==(const CMatrix& m); // 比括较运算符bool operator!=(const CMatrix& m); // 比括较运算符CMatrix operator+(const CMatrix& m); // 加运算符CMatrix operator-(const CMatrix& m); // 减运算符CMatrix& operator+=(const CMatrix& m); // 自加运算符CMatrix& operator-=(const CMatrix& m); // 自减运算符CMatrix operator-();// 取负数CMatrix& operator*(const CMatrix& m); // 乘法运算符void input(); //输入矩阵void outputMatrix(); // 输出该矩阵void setValue(int row, int column, double value) { A[row-1][column-1] = value; }// 设置(i,j)的值double getValue(int row, int column) const { return A[row-1][column-1]; }// 设置行、列的值void setRow(const int i) { row = i; }int getRow() const { return row; }void setColunm(const int i) { column = i; }int getColumn() const { return column; }CMatrix& change(int i, int j);//交换矩阵的行CMatrix& transpose(); // 矩阵转置CMatrix& inverse(); // 矩阵求逆void find(int& f)const;// 判断该矩阵是否可用于迭代求解friend void jocabi(const CMatrix& a) ; //迭代求解void lzys(); //列主元素法求解void solve(); //可逆线性矩阵求解void qxnh(); //曲线拟合private:// 成员变量double A[max][max];int row;// 行int column;// 列};void CMatrix::input() //输入{ cout<<"开始输入矩阵值："<<endl;int i, j;double z;for(i=0;i<row;i++){ cout<<"请输入第"<<i+1<<"行的值："<<endl;for(j=0;j<column;j++){ cin>>z;A[i][j]=z;}}cout<<endl;};CMatrix::CMatrix(const CMatrix& m) // 复制构造函数{ int i, j;for(i=0;i<m.row;i++)for(j=0;j<m.column;j++)this->A[i][j]=m.A[i][j];};CMatrix& CMatrix::operator=(const CMatrix& m) // 赋值运算符{int i,j;for(i=0;i<row;i++){for(j=0;j<column;j++)A[i][j]=m.A[i][j];}return *this;};bool CMatrix::operator ==(const CMatrix& m) // 比括较运算符{ int i,j,k;for(i=0;i<m.row;i++){ for(j=0;j<m.column;j++)if(this->A[i][j]=m.A[i][j])k=1;else k=0;}if(k=1) return true;else return false;};bool CMatrix::operator !=(const CMatrix& m) // 比括较运算符{ int i,j,k;for(i=0;i<m.row;i++){ for(j=0;j<m.column;j++)if(this->A[i][j]=m.A[i][j])k=1;else k=0;}if(k=0) return true;else return false;};CMatrix CMatrix::operator+(const CMatrix& m)// 加运算符{ int i,j;if((this->row==m.row)&&(this->column==m .column)){ for(i=0;i<m.row;i++)for(j=0;j<m.column;j++)this->A[i][j]+=m.A[i][j];}else { cout<<"此两矩阵不能相加，请检查！"<<endl; }return *this;};CMatrix CMatrix::operator-(const CMatrix& m)// 减运算符{ int i,j;if((this->row==m.row)&&(this->column==m.column)){ for(i=0;i<m.row;i++)for(j=0;j<m.column;j++)this->A[i][j]-=m.A[i][j];}else { cout<<"此两矩阵不能相加，请检查！"<<endl; }return *this;};CMatrix& CMatrix::operator+=(const CMatrix& m) //自加运算符{ int i,j;for(i=0;i<m.row;i++)for(j=0;j<m.column;j++)this->A[i][j]=2*m.A[i][j];return *this;};CMatrix& CMatrix::operator-=(const CMatrix& m) //自减运算符{ int i,j;for(i=0;i<m.row;i++)for(j=0;j<m.column;j++)this->A[i][j]=m.A[i][j]-m.A[i][j];return *this;};void CMatrix::find(int& f)const{ int i;for(i=0;i<this->row;i++) if(this->A[i][i]!=0) f=1;else f=0;};CMatrix CMatrix::operator-() // 取负数{ int i,j;for(i=0;i<this->row;i++)for(j=0;j<this->column;j++)this->A[i][j]=-this->A[i][j];return *this;};CMatrix& CMatrix::operator*(const CMatrix& m) // 乘法运算符{ int i,j,t;CMatrix n;if(this->column==m.row){for(i=0;i<this->row;i++)for(j=0;j<m.column;j++){ double sum=0.0;for(t=0;t<m.row;t++)sum+=this->A[i][t]*m.A[t][j];n.A[i][j]=sum;}}else {cerr<<"此两矩阵不能相乘，请检查！"<<endl; exit(1);}return n;};void CMatrix::outputMatrix()// 输出该矩阵{ int i,j;for(i=1;i<=row;i++){ for(j=1;j<=column;j++)cout<<A[i-1][j-1]<<" ";cout<<endl;}};CMatrix& CMatrix::transpose()// 矩阵转置{ int i,j;CMatrix m(this->column,this->row);for(i=0;i<this->row;i++)for(j=0;j<this->column;j++){ m.A[j][i]=this->A[i][j];}return m;};void jocabi(const CMatrix& a) //高斯迭代求解{ int f=1;a.find(f);if(f==0) {cerr<<"该矩阵不满足迭代求解条件！"<<endl; exit(1); }else{CMatrix x,w;x.setColunm(1);x.setRow(a.getColumn());w.setColunm(1);w.setRow(a.getColumn());int i;double z;for(i=1;i<=x.row;i++){ cout<<"请输入等式右侧的第"<<i<<"个值：";cin>>z;w.A[i-1][0]=z;}for(i=1;i<=x.row;i++){ cout<<"请输入X"<<i<<"的近似值：";cin>>z;x.setValue(i, 1, z);}i=1;while(i<=20){ int j, k;for(j=1;j<=x.row;j++){ double sum=0.0;for(k=1;k<j;k++){sum=sum-(a.A[j-1][k-1])*(x.A[k-1][0]);}for(k=j+1;k<=x.row;k++){sum=sum-(a.A[j-1][k-1])*(x.A[k-1][0]); }sum+=w.A[j-1][0];x.A[j-1][0]=sum/a.A[j-1][j-1];}i++;}for(i=1;i<=x.row;i++)cout<<"X"<<i<<" = "<<x.A[i-1][0]<<endl; }};double jdz(double a) //绝对值{ if(a>0.0) return a;else return -a;};CMatrix& CMatrix::change(int i, int j)//交换矩阵的行{ int k;double z;for(k=1;k<=this->column;k++){ z=A[i-1][k-1];A[i-1][k-1]=A[j-1][k-1];A[j-1][k-1]=z;}return *this;};void CMatrix::lzys() //列主元素法求解{ CMatrix x,w;x.setColunm(1);x.setRow(getColumn());w.setColunm(1);w.setRow(getColumn());int i;double z;for(i=0;i<row;i++){for(int j=0;j<row; j++)w.A[i][j]=0.0;}for(i=1;i<=x.row;i++)x.setValue(i, 1, 0.0);for(i=1;i<=x.row;i++){ cout<<"请输入等式右侧的第"<<i<<"个值：";cin>>z;w.A[i-1][0]=z;}i=0;while(i<x.row-1){ int j,t,h=i;for(j=i;j<x.row-1;j++){ if(jdz(A[j][i])<jdz(A[j+1][i]))h=j+1; }this->change(i+1,h+1);w.change(i+1,1);for(j=i+1;j<row;j++){ double k;k=A[j][i]/A[i][i];for(t=i;t<column;t++){A[j][t]=A[j][t]-k*A[i][t];}w.A[j][0]=w.A[j][0]-k*w.A[i][0];}i++;}if(this->A[row-1][column-1]==0){cerr<<"此矩阵对应的方程组有无穷解！"<<endl; exit(1);}i=column-1;while(i>0){ int j, t;for(j=i-1;j>=0;j--){ double k;k=A[j][i]/A[i][i];for(t=i;t>j;t--){ A[j][t]=A[j][t]-k*A[i][t]; }w.A[j][0]=w.A[j][0]-k*w.A[i][0];}i--;}int j;for(j=0;j<x.row;j++){x.A[j][0]=w.A[j][0]/this->A[j][j];}for(i=1;i<=x.row;i++)cout<<"X"<<i<<" = "<<x.A[i-1][0]<<endl; };CMatrix& CMatrix::inverse() //矩阵求逆{ if(this->row!=this->column) {cerr<<"该矩阵不符合求逆条件！"<<endl; exit(1);}else{CMatrix w;w.setColunm(this->getRow());w.setRow(getColumn());int i;for(i=0;i<row;i++){for(int j=0;j<row; j++){w.A[i][j]=0.0;}w.A[i][i]=1;}i=0;while(i<column-1){ int j,t,h=i;for(j=i;j<row-1;j++){if(jdz(A[j][i])<jdz(A[j+1][i]))h=j+1;}this->change(i+1,h+1);w.change(i+1,h+1);for(j=i+1;j<row;j++){ double k;k=A[j][i]/A[i][i];for(t=i;t<column;t++){A[j][t]=A[j][t]-k*A[i][t];w.A[j][t]=w.A[j][t]-k*w.A[i][t];}}i++;}if(this->A[row-1][column-1]==0){cerr<<"此矩阵求逆不成功，其所对应的方程组有无穷解！"<<endl; exit(1);} i=column-1;while(i>0){ int j, t;for(j=i-1;j>=0;j--){ double k;k=A[j][i]/A[i][i];for(t=i;t>j;t--){ A[j][t]=A[j][t]-k*A[i][t]; }for(t=column-1;t>=0;t--){w.A[j][t]=w.A[j][t]-k*w.A[i][t];}}i--;}int j,k;for(j=0;j<row;j++){ for(k=0;k<w.column;k++) {w.A[j][k]=w.A[j][k]/this->A[j][j];}this->A[j][j]=this->A[j][j]/this->A[j][j];}return w;}};void CMatrix::solve() //可逆线性矩阵求解{CMatrix x,w,c;x.setColunm(1);x.setRow(getColumn());w.setColunm(1);w.setRow(getColumn());c.setColunm(getColumn());c.setRow(getRow());int i;double z;for(i=1;i<=x.row;i++){ cout<<"请输入等式右侧的第"<<i<<"个值：";cin>>z;w.A[i-1][0]=z;}c.operator =(this->inverse());x.operator =(c.operator *(w));cout<<"求解结果："<<endl;for(i=1;i<=x.row;i++)cout<<"X"<<i<<" = "<<x.A[i-1][0]<<endl; };void CMatrix::qxnh() //曲线拟合{cout<<"用矩阵曲线拟合："<<endl;int i, j,k,t;double x, y;cout<<"请输入已知坐标点的个数：";cin>>i;CMatrix a(i,1), g(i,i) , w(i,1),c(i,i),q(i,i),p(i,i);for(j=1;j<=i;j++){ cout<<"请输入第"<<j<<"个已知点坐标(先横坐标后纵坐标)：";cin>>x>>y;w.A[j-1][0]=y;g.A[j-1][0]=1.0;for(k=1;k<i;k++){ g.setValue(j,k+1,1.0);for(t=1;t<=k;t++)g.A[j-1][k]*=x;}}c=g.transpose();q=c*g;p=q.inverse();w=c*w;a=p*w;cout<<"Y="<<a.A[0][0];for(j=1;j<i;j++){ cout<<'+'<<'('<<a.A[j][0]<<')';for(k=0;k<j;k++)cout<<"*x";}cout<<endl;cout<<" 1 .求取其它点坐标 0. 退出 "<<endl; while(1){ cout<<"请选择：";cin>>k;switch(k){ case 1:{ double x, y,sum;cout<<"请输入待求点的横坐标（x）：";cin>>x;y=a.A[0][0];for(j=1;j<i;j++){ sum=a.A[j][0];for(k=0;k<j;k++){sum*=x;}y+=sum;}cout<<"纵坐标：y="<<y<<endl; break;}case 0:{cerr<<"谢谢使用！"<<endl; exit(1);break;}default: cout<<"选择有误，请检查！"<<endl; break;}}};struct CElvDif{double value; // 观测值double weight; // 权重long startPoint; // 起始点编号long endPoint; // 终点编号};//水准点类的设计struct CLevelPoint{ // 高程平差值=高程值+高程值改正数long index; // 水准点编号double eleValue; // 高程值double dv; // 高程值改正数（初始化为0）bool isKnown; // 是否为已知点};class CElevationNet{public: // 成员函数CElevationNet(){numElvDif=0;numPoints=0 ;numKnPoint=0;}; // 构造函数~CElevationNet(){}; // 析构函数 void input();void output();void jsgc();int getgz(){return numElvDif;} //返回观测值数目int getzs(){return numPoints;} //返回总点数int getys(){return numKnPoint;} //返回已知点数int getws(){return numPoints-numKnPoint;} //返回未知点数 double geteleValue(int i){return this->lpVec[i-1].eleValue;} //获得高程值 long getindex(int i){return lpVec[i-1].index;} //返回高程点编号void seteleValue(int i, double value){lpVec[i-1].eleValue+=value;} //修改高程值void setdv(int i,double value){this->lpVec[i-1].dv=value;} //修改改正数double getdv(int i){return lpVec[i-1].dv;} //返回改正数friend void xishu(CMatrix& B, CMatrix& X,CElevationNet A); //求取系数矩阵和未知点高程矩阵friend void quanzhen(CMatrix& Q, CElevationNet A); //求取权阵friend void l_zhen( CMatrix& l ,CMatrix& L, CElevationNet A); //求取观测值L矩阵和l阵private: // 成员变量int numElvDif; // 高差总数int numPoints; // 控制网中点的总数目int numKnPoint; //控制网中已知点的数目CElvDif edVec[max]; // 观测值数组CLevelPoint lpVec[max]; // 高程值数组};void CElevationNet::input(){ int a,b,c,i;double z,l,g;cout<<"请对已知点和未知点进行编号，注意已知点的编号应小于未知点的编号！"<<endl<<endl; cout<<"请输入控制网中水准点总数和已知点数：";cin>>a>>b;numPoints=a;numKnPoint=b;for(i=0;i<numPoints;i++){ lpVec[i].index=i+1;lpVec[i].eleValue=0.0;lpVec[i].dv=0.0;lpVec[i].isKnown=0;}for(i=0;i<numKnPoint;i++){ cout<<"请输入第"<<i+1<<"个已知点高程值：";cin>>z;lpVec[i].eleValue=z;lpVec[i].isKnown=1;}cout<<"请输入观测值个数：";cin>>c;numElvDif=c;for(i=0;i<numElvDif;i++){ cout<<"请输入第"<<i+1<<"段观测段的高差值(单位米)、长度(单位千米)、起始点编号和终点编号："<<endl;cin>>g>>l>>a>>b;edVec[i].value=g;edVec[i].weight=l;edVec[i].startPoint=a;edVec[i].endPoint=b;}};void CElevationNet::output(){int i;for(i=0;i<this->numPoints;i++)cout<<"编号为"<<this->lpVec[i].index<<"的点的高程值为："<<this->lpVec[i].eleValue<<endl;for(i=0;i<this->numElvDif;i++)cout<<"观测段"<<i+1<<"的平差后的值为："<<this->edVec[i].value<<endl;};void CElevationNet::jsgc(){ int i,j;for(i=0;i<this->numElvDif;i++){ if((lpVec[edVec[i].startPoint-1].eleValu e!=0.0)&&(lpVec[edVec[i].endPoint-1].eleVal ue==0.0)){lpVec[edVec[i].endPoint-1].eleValue=(l pVec[edVec[i].startPoint-1].eleValue)+(edVe c[i].value);}elseif(lpVec[edVec[i].startPoint-1].eleValue==0 .0&&lpVec[edVec[i].endPoint-1].eleValue!=0.0){lpVec[edVec[i].startPoint-1].eleValue= (lpVec[edVec[i].endPoint-1].eleValue)-(edVe c[i].value);}}for(j=numKnPoint;j<this->numPoints;j++) {if(this->lpVec[j].eleValue==0.0){for(i=0;i<this->numElvDif;i++){ if(this->edVec[i].startPoint==lpVec[ j].index&&this->lpVec[this->edVec[i].endPoi nt-1].eleValue!=0.0)this->lpVec[j].eleValue=this->lpVec[thi s->edVec[i].endPoint-1].eleValue-this->edVe c[i].value;elseif(this->edVec[i].endPoint==lpVec[j].index& &this->lpVec[this->edVec[i].startPoint-1].e leValue!=0.0){this->lpVec[j].eleValue=this->lpVec[this-> edVec[i].startPoint-1].eleValue+this->edVec [i].value;}}}//cout<<"第"<<this->lpVec[j].index<<"个点的高程近似值："<<this->lpVec[j].eleValue<<endl;}};void xishu(CMatrix& B, CMatrix& X,CElevationNet A){int i,j;for(i=1;i<=B.getRow();i++)for(j=1;j<=B.getColumn();j++){ B.setValue(i,j,0);}for(i=0;i<A.numElvDif;i++) { if(A.lpVec[A.edVec[i].startPoint-1].isKn own==1&&A.lpVec[A.edVec[i].endPoint-1].isKn own==0){B.setValue(i+1,A.edVec[i].endPoint-A.numKn Point,1);}elseif(A.lpVec[A.edVec[i].startPoint-1].isKnown ==0&&A.lpVec[A.edVec[i].endPoint-1].isKnown ==1){ B.setValue(i+1,A.edVec[i].startPoint -A.numKnPoint,-1);}elseif(A.lpVec[A.edVec[i].startPoint-1].isKnown ==0&&A.lpVec[A.edVec[i].endPoint-1].isKnown ==0){ B.setValue(i+1,A.edVec[i].endPoint-A. numKnPoint,1);B.setValue(i+1,A.edVec[i].startPoint-A. numKnPoint,-1);}}for(i=0;i<X.getRow();i++)X.setValue(i+1,1,A.lpVec[A.numKnPoint+i ].eleValue);};void quanzhen(CMatrix& Q, CElevationNet A) {int i,j;double sum=0.0;for(i=0;i<A.numElvDif;i++)sum+=A.edVec[i].weight;sum=sum/A.numElvDif;for(i=1;i<=Q.getRow();i++)for(j=1;j<=Q.getColumn();j++){ Q.setValue(i,j,0);}for(i=1;i<=Q.getRow();i++)Q.setValue(i,i,sum/A.edVec[i-1].weight) ;};void l_zhen( CMatrix& l ,CMatrix& L, CElevationNet A){int i;double m;for(i=0;i<A.numElvDif;i++)L.setValue(i+1,1,A.edVec[i].value);for(i=0;i<l.getRow();i++){m=(A.lpVec[A.edVec[i].startPoint-1].ele Value+A.edVec[i].value-A.lpVec[A.edVec[i].e ndPoint-1].eleValue)*1000;l.setValue(i+1,1,m);}};void main(){CElevationNet A;A.input();A.jsgc();CMatrixB(A.getgz(),A.getws()),Q(A.getgz(),A.getgz( )),X(A.getws(),1),l(A.getgz(),1),b(A.getws( ),A.getgz()),V(A.getgz(),1);CMatrixNBB(A.getws(),A.getws()),x(A.getws(),1) ,N(A.getws(),A.getws()),L(A.getgz(),1),M(A. getws(),A.getgz()),R(A.getws(),A.getgz()),W (A.getws(),A.getgz());CMatrixvz(1,A.getgz()),vp(1,A.getgz()),p(1,1);xishu(B,X,A);quanzhen(Q,A);l_zhen(l,L,A);b.operator =(B.transpose());M.operator =(b.operator *(Q));NBB.operator =(M.operator *(B));N.operator =(NBB.inverse());R.operator =(N.operator *(b));W.operator =(R.operator *(Q));x.operator =(W.operator *(l));int i,j;for(i=A.getys()+1;i<=A.getzs();i++){A.setdv(i,(x.getValue(i-A.getys(),1)/1000));A.seteleValue(i,A.getdv(i));cout<<"平差后编号为"<<A.getindex(i)<<"的点高程值："<<A.geteleValue(i)<<"米"<<endl;}V.operator =(B.operator *(x));V.operator -(l);for(j=0;j<V.getRow();j++)cout<<"第"<<j+1<<"段观测高差平差值为："<<(L.getValue(j+1,1)+V.getValue(j+1,1)/100 0)<<"米"<<endl;vz.operator =(V.transpose());vp=(vz.operator *(Q));p=(vp.operator *(V));cout<<"平差后单位权中误差为："<<"+_"<<sqrt(p.getValue(1,1)/A.getws())<<"毫米"<<endl;}。
三四等水准测量vba编程计算
测站数： 测站数：
测自 观测者： 观测者： 测站 编号 后尺 上丝 下丝 后距 视距差d 视距差 至 上丝 下丝 前距 Σd 天气： 天气： 记录者： 记录者： 标尺读数 方向 及 尺 号 黑面读数 红面读数 后尺 前尺 后- 前 后尺 前尺 后- 前 后尺 前尺 后- 前 后尺 前尺 后- 前 后尺 前尺 后- 前 后尺 前尺 后- 前 后尺 前尺 后- 前 后尺 前尺 后- 前 黑+K-红 红
日期： 日期：
仪器型号： 仪器型号：
前尺
K值
平均高程
Hale Waihona Puke 备注
测绘程序设计—实验八 水准网平差程序设计报告
《测绘程序设计()》上机实验报告（Visual C++.Net）班级：测绘0901班学号： 0405090204姓名：代娅琴2012年4月29日实验八平差程序设计基础一、实验目的•巩固过程的定义与调用•巩固类的创建与使用•巩固间接平差模型及平差计算•掌握平差程序设计的基本技巧与步骤二、实验内容水准网平差程序设计。
设计一个水准网平差的程序，要求数据从文件中读取，计算部分与界面无关。
1.水准网间接平差模型：2.计算示例：近似高程计算：3.水准网平差计算一般步骤(1)读取观测数据和已知数据；(2)计算未知点高程近似值；(3)列高差观测值误差方程；(4)根据水准路线长度计算高差观测值的权；(5)组成法方程；(6)解法方程，求得未知点高程改正数及平差后高程值；(7)求高差观测值残差及平差后高差观测值；(8)精度评定；(9)输出平差结果。
4.水准网高程近似值计算算法5.输入数据格式示例实验代码：#pragma onceclass LevelControlPoint{public:LevelControlPoint(void);~LevelControlPoint(void);public:CString strName;//点名CString strID;//点号float H;bool flag;//标记是否已经计算出近似高程值，若计算出则为，否则为};class CDhObs{public:CDhObs(void);~CDhObs(void);public:LevelControlPoint* cpBackObj;//后视点LevelControlPoint* cpFrontObj;//前视点double ObsValue;//高差值double Dist;//测站的距离};#include"StdAfx.h"#include"LevelControlPoint.h"LevelControlPoint::LevelControlPoint(void){strName=_T("");strID=_T("");H=0;flag=0;}LevelControlPoint::~LevelControlPoint(void){}CDhObs::CDhObs(void){}CDhObs::~CDhObs(void){}#pragma once#include"LevelControlPoint.h"#include"Matrix.h"class AdjustLevel{public:AdjustLevel(void);~AdjustLevel(void);public:LevelControlPoint* m_pKnownPoint;//已知点数组int m_iKnownPointCount;//已知点个数LevelControlPoint* m_pUnknownPoint;//未知点数组int m_iUnknownPointCount;//未知点个数CDhObs* m_pDhObs;//高差观测值数组int m_iDhObsCount;//高差观测值个数public:void SetKnownPointSize(int size);//创建大小为size的已知点数组void SetUnkonwnPointSize(int size);//创建大小为size的未知点数组void SetDhObsSize(int size);//创建大小为size的观测值数组bool LoadObsData(const CString& strFile);//读入观测文件CString* SplitString(CString str, char split, int& iSubStrs);void ApproHeignt(void);//计算近似值private:LevelControlPoint* SearchKnownPointUsingID(CString ID);LevelControlPoint* SearchUnknownPointUsingID(CString ID);LevelControlPoint* SearchPointUsingID(CString ID);CMatrix LevleWeight(void);//计算权矩阵public:void FormErrorEquation(CMatrix &B, CMatrix &L);//组成误差方程void EquationCompute(CMatrix &x);//计算法方程void Accuracy_Assessment(double &r0,CMatrix &Qxx);//精度评定void CompAdjust(double &r0,CMatrix Qx[]);};#include"StdAfx.h"#include"AdjustLevel.h"#include<locale.h>#include"LevelControlPoint.h"#include"math.h"AdjustLevel::AdjustLevel(void){m_pKnownPoint=NULL;//已知点数组m_iKnownPointCount=0;//已知点个数m_pUnknownPoint=NULL;//未知点数组m_iUnknownPointCount=0;//未知点个数m_pDhObs=NULL;//高差观测值数组m_iDhObsCount=0;//高差观测值个数}AdjustLevel::~AdjustLevel(void){if(m_pKnownPoint!=NULL){delete[] m_pKnownPoint;m_pKnownPoint=NULL;}if(m_pUnknownPoint!=NULL){delete[] m_pUnknownPoint;m_pUnknownPoint=NULL;}if(m_pDhObs!=NULL){delete[] m_pDhObs;m_pDhObs=NULL;}}void AdjustLevel::SetKnownPointSize(int size){m_pKnownPoint=new LevelControlPoint[size];//创建动态指针m_iKnownPointCount=size;}void AdjustLevel::SetUnkonwnPointSize(int size){m_pUnknownPoint=new LevelControlPoint[size];m_iUnknownPointCount=size;}void AdjustLevel::SetDhObsSize(int size){m_pDhObs=new CDhObs[size];m_iDhObsCount=size;//高差观测值个数}bool AdjustLevel::LoadObsData(const CString& strFile){CStdioFile sf;if(!sf.Open(strFile,CFile::modeRead)) return false;//创建并打开文件对象CString strLine;bool bEOF=sf.ReadString(strLine);//读取第一行，即已知点的数目SetKnownPointSize(_ttoi(strLine));//根据已知点的数目，创建已知点数组；int n=0;for(int i=0;i<m_iKnownPointCount;i++)//读取已知点的点名和高程值{sf.ReadString(strLine);CString *pstrData=SplitString(strLine,',',n);m_pKnownPoint[i].strName=pstrData[0];m_pKnownPoint[i].strID=pstrData[0];m_pKnownPoint[i].H=_tstof(pstrData[1]);m_pKnownPoint[i].flag=1;//已知点不用平差，故将其的flag设置为delete[] pstrData;pstrData=NULL;}sf.ReadString(strLine);//读取未知点的个数SetUnkonwnPointSize(_ttoi(strLine));//根据未知点的个数创建未知点数组sf.ReadString(strLine);//读取未知点的点名CString *pstrData=SplitString(strLine,',',n);for(int i=0;i<m_iUnknownPointCount;i++)//将未知点的点名放入未知点数组{m_pUnknownPoint[i].strName=pstrData[i];m_pUnknownPoint[i].strID=pstrData[i];m_pUnknownPoint[i].H=0;//未知点的高程值设置为m_pUnknownPoint[i].flag=0;//还没有求得近似高程，故其flag设置为}if(pstrData!=NULL){delete[] pstrData;pstrData=NULL;}sf.ReadString(strLine);//读取观测值的个数SetDhObsSize(_ttoi(strLine));//按照观测值的大小，创建观测值数组for(int i=0;i<m_iDhObsCount;i++)//分行读取观测值的数据，将其存入观测值数组{sf.ReadString(strLine);CString *pstrData=SplitString(strLine,',',n);m_pDhObs[i].cpBackObj=SearchPointUsingID(pstrData[0]);//后视点m_pDhObs[i].cpFrontObj=SearchPointUsingID(pstrData[1]);//前视点m_pDhObs[i].HObsValue=_tstof(pstrData[2]);//高差观测值m_pDhObs[i].Dist=_tstof(pstrData[3]);//距离观测值delete[] pstrData;pstrData=NULL;}sf.Close();return 1;}CString* AdjustLevel::SplitString(CString str, char split, int& iSubStrs) {int iPos = 0; //分割符位置int iNums = 0; //分割符的总数CString strTemp = str;CString strRight;//先计算子字符串的数量while (iPos != -1){iPos = strTemp.Find(split);if (iPos == -1){break;}strRight = strTemp.Mid(iPos + 1, str.GetLength());strTemp = strRight;iNums++;}if (iNums == 0) //没有找到分割符{//子字符串数就是字符串本身iSubStrs = 1;return NULL;}//子字符串数组iSubStrs = iNums + 1; //子串的数量= 分割符数量+ 1CString* pStrSplit;pStrSplit = new CString[iSubStrs];strTemp = str;CString strLeft;for (int i = 0; i < iNums; i++){iPos = strTemp.Find(split);//左子串strLeft = strTemp.Left(iPos);//右子串strRight = strTemp.Mid(iPos + 1, strTemp.GetLength());strTemp = strRight;pStrSplit[i] = strLeft;}pStrSplit[iNums] = strTemp;return pStrSplit;}//LevelControlPoint* AdjustLevel::SearchKnownPointUsingID(CString ID){for(int i=0;i<m_iKnownPointCount;i++){if(m_pKnownPoint[i].strID==ID){return &m_pKnownPoint[i];}}return NULL;}//LevelControlPoint* AdjustLevel::SearchUnknownPointUsingID(CString ID){for(int i=0;i<m_iUnknownPointCount;i++){if(m_pUnknownPoint[i].strID==ID){return &m_pUnknownPoint[i];}}return NULL;}LevelControlPoint* AdjustLevel::SearchPointUsingID(CString ID){LevelControlPoint* cp;cp=SearchKnownPointUsingID(ID);if(cp==NULL)cp=SearchUnknownPointUsingID(ID);return cp;}void AdjustLevel::ApproHeignt(void)//用于计算高程近似值的函数{for(int i=0;i<m_iUnknownPointCount;i++)//计算未知点高程值{if(m_pUnknownPoint[i].flag!=1){//先在未知点作为观测值的前视点的情况for(int j=0;j<m_iDhObsCount;j++)//从观测数组里找与未知点有关联的点{//如果观测值的前视点是未知点且其后视点已经有高程值if((m_pDhObs[j].cpFrontObj->strID==m_pUnknownPoint[i].strID)&& m_pDhObs[j].cpBackObj->flag==1 ){ //前视点=后视点-高差/*m_pUnknownPoint[i].H=m_pDhObs[i].cpBackObj->H -m_pDhObs[i].ObsValue;*/m_pUnknownPoint[i].H=m_pDhObs[j].cpBackObj->H + m_pDhObs[j].HObsValue;m_pUnknownPoint[i].flag=1;break;}}if(m_pUnknownPoint[i].flag!=1)//如果经过上一步骤未知点仍没有计算出近似值{for(int j=0;j<m_iDhObsCount;j++)//从观测数组里找与未知点有关联的点 {//如果观测值的后视点是未知点且其前视点已经有高程值if((m_pDhObs[j].cpBackObj->strID==m_pUnknownPoint[i].strID)&& m_pDhObs[j].cpFrontObj->flag==1 ){ //后视点=前视点+高差m_pUnknownPoint[i].H=m_pDhObs[j].cpFrontObj->H-m_pDhObs[j].HObsValue;/*m_pUnknownPoint[i].H=m_pDhObs[i].cpFrontObj->H+m_pDhObs[i].ObsValue;*/m_pUnknownPoint[i].flag=1;break;}}}}if(i==m_iUnknownPointCount-1)//如果已经计算到最后一个未知点{for(int a=0;a<m_iUnknownPointCount;a++){if(m_pUnknownPoint[i].flag!=1)//只要有一个未知点的近似高程直没有计算{ //则要重新进行上面的步骤直到所有的未知点的近似高程值都计算出i=-1;break;}}}}}CMatrix AdjustLevel::LevleWeight(void){CMatrix p(m_iDhObsCount,m_iDhObsCount);p.Unit();double value;for(int i=0;i<m_iDhObsCount;i++){value=(1.0/m_pDhObs[i].Dist);p(i,i)=value;}return p;}void AdjustLevel::FormErrorEquation(CMatrix &B, CMatrix &L){B.SetSize(m_iDhObsCount,m_iUnknownPointCount);L.SetSize(m_iDhObsCount,1);for(int i=0;i<m_iDhObsCount;i++)//建立B系数阵{LevelControlPoint *tmpBack=NULL,*tmpFront=NULL;tmpBack=SearchPointUsingID(m_pDhObs[i].cpBackObj->strID);tmpFront=SearchPointUsingID(m_pDhObs[i].cpFrontObj->strID);//找到与第i个观测值有关的未知点tmpBack->strID;for(int j=0;j<m_iUnknownPointCount;j++){if(m_pUnknownPoint[j].strID==tmpBack->strID)//如果是后视点则前面的系数为-1{ B(i,j)=-1;continue;}if(m_pUnknownPoint[j].strID==tmpFront->strID)//如果是前视点则前面的系数为{B(i,j)=1;}}}//建立L矩阵CString tmp;for(int i=0;i<m_iDhObsCount;i++){//l=高差观测值-（后视近似值-前视近似值）/*L(i,0)=m_pDhObs[i].ObsValue-(m_pDhObs[i].cpBackObj->H-m_pDhObs[i].cpFrontObj->H);*/ L(i,0)=m_pDhObs[i].HObsValue-(m_pDhObs[i].cpFrontObj->H - m_pDhObs[i].cpBackObj->H);tmp.Format(_T("%.3f"),L(i,0));L(i,0)=_tstof(tmp);L(i,0)=L(i,0)*1000;//将单位化为mm}}void AdjustLevel::EquationCompute(CMatrix &x)//计算法方程{CMatrix P,B,l;P=LevleWeight(); //P为权矩阵FormErrorEquation(B,l);ApproHeignt();CMatrix BT(m_iUnknownPointCount,m_iDhObsCount);BT=~B; //B的转置矩阵CMatrix NBB(m_iUnknownPointCount,m_iUnknownPointCount);NBB=BT*P*B;CMatrix NBBl=NBB.Inv();x=NBBl*BT*P*l;for(int i=0;i<m_iUnknownPointCount;i++){m_pUnknownPoint[i].H+=x(i,0);//未知点高程值=近似值+改正数}}void AdjustLevel::Accuracy_Assessment(double &r0,CMatrix &Qxx)//精度评定{CMatrix B,l,P,x;P=LevleWeight(); //P为权矩阵FormErrorEquation(B,l);EquationCompute(x);CMatrix v(m_iDhObsCount,1);v=B*x-l;CMatrix vT(1,m_iDhObsCount);vT=~v;CMatrix r/*(1,l)*/;r=vT*P*v;r0=sqrt(r(0,0)/(m_iDhObsCount-m_iUnknownPointCount));//单位权中误差Qxx.SetSize(m_iUnknownPointCount,m_iUnknownPointCount);CMatrix BT(m_iUnknownPointCount,m_iDhObsCount);BT=~B;CMatrix NBB(m_iUnknownPointCount,m_iUnknownPointCount);NBB=BT*P*B;Qxx=NBB.Inv();}void AdjustLevel::CompAdjust(double &r0,CMatrix Qx[]){ApproHeignt();//计算未知点的近似高程值并且存入数组CMatrix P(m_iDhObsCount,m_iDhObsCount);P=LevleWeight();//p为权矩阵CMatrix B,L;CMatrix x,Qxx;FormErrorEquation(B,L);//组成误差方程，B为系数矩阵，l为常数项EquationCompute(x);//计算法方程Accuracy_Assessment(r0,Qxx);//精度评定for(int i=0;i<m_iUnknownPointCount;i++)//未知点高程中误差{Qx[i]=sqrt(Qxx(i,i))*r0;}}#include"Matrix.h"#include"locale.h"#include"LevelControlPoint.h"#include"AdjustLevel.h"AdjustLevel LevelComput;CString* SplitString(CString str, char split, int& iSubStrs) {int iPos = 0; //分割符位置int iNums = 0; //分割符的总数CString strTemp = str;CString strRight;//先计算子字符串的数量while (iPos != -1){iPos = strTemp.Find(split);if (iPos == -1){break;}strRight = strTemp.Mid(iPos + 1, str.GetLength());strTemp = strRight;iNums++;}if (iNums == 0) //没有找到分割符{//子字符串数就是字符串本身iSubStrs = 1;return NULL;}//子字符串数组iSubStrs = iNums + 1; //子串的数量= 分割符数量+ 1CString* pStrSplit;pStrSplit = new CString[iSubStrs];strTemp = str;CString strLeft;for (int i = 0; i < iNums; i++){iPos = strTemp.Find(split);//左子串strLeft = strTemp.Left(iPos);//右子串strRight = strTemp.Mid(iPos + 1, strTemp.GetLength()); strTemp = strRight;pStrSplit[i] = strLeft;}pStrSplit[iNums] = strTemp;return pStrSplit;}void CIndircLelveDlg::OnBnClickedOpendatafile(){// TODO: 在此添加控件通知处理程序代码UpdateData(TRUE);CFileDialog dlgFile(TRUE,_T("txt"),NULL,OFN_ALLOWMULTISELECT|OFN_EXPLORER, _T("(文本文件)|*.txt"));//创建文件对话框if(dlgFile.DoModal()==IDCANCEL) return;//如果选择取消按钮则返回CString strFileName=dlgFile.GetPathName();//打开获取文件文件名setlocale(LC_ALL,""); //设置语言环境CStdioFile sf;if(!sf.Open(strFileName, CFile::modeRead)) return;InputContent.Empty();//清空字符串str_openContent中的内容CString strLine;BOOL bEOF=sf.ReadString(strLine);//读取第一行数据while(bEOF)//开始读取顶点数据{bEOF=sf.ReadString(strLine);if(bEOF)InputContent+=strLine+_T("\r\n");}sf.Close();UpdateData(FALSE);}void CIndircLelveDlg::OnBnClickedSavedata(){// TODO: 在此添加控件通知处理程序代码U pdateData(TRUE);CFileDialog dlgFile(FALSE,_T("txt"),NULL,OFN_EXPLORER,_T("(Level格式)|*.txt"));if(dlgFile.DoModal()==IDCANCEL) return;CString strFileName=dlgFile.GetPathName();setlocale(LC_ALL,"");CStdioFile sf;if(!sf.Open(strFileName, CFile::modeCreate|CFile::modeWrite)) return;sf.WriteString(LevleContent);sf.Close();UpdateData(FALSE);}void CIndircLelveDlg::OnBnClickedComputelevel(){// TODO: 在此添加控件通知处理程序代码UpdateData(TRUE);setlocale(LC_ALL,"");double *Qx=new double[LevelComput.m_iUnknownPointCount];double r0;pAdjust(r0,Qx);LevleContent.Format(_T("平差后高程值:\r\n"));CString Temp;for(int i=0;i<LevelComput.m_iUnknownPointCount;i++){Temp.Empty();Temp.Format(_T("%s,%.4f\r\n"),LevelComput.m_pUnknownPoint[i].strID,LevelComput.m_pUnknownPoint[i].H);LevleContent+=Temp;}Temp.Format(_T("单位权中误差：%.1f mm\r\n"),r0*1000);LevleContent+=Temp;LevleContent+=_T("未知点高程中误差(mm):\r\n");for(int i=0;i< LevelComput.m_iUnknownPointCount;i++){Temp.Empty();Temp.Format(_T("%s,%.1f\r\n"),LevelComput.m_pUnknownPoint[i].strName,Qx[i]*1000);LevleContent+=Temp;}UpdateData(false);}void CIndircLelveDlg::OnBnClickedSavelevleresult(){// TODO: 在此添加控件通知处理程序代码UpdateData(TRUE);CFileDialog dlgFile(FALSE,_T("txt"),NULL,OFN_EXPLORER,_T("(Level格式)|*.txt"));if(dlgFile.DoModal()==IDCANCEL) return;CString strFileName=dlgFile.GetPathName();setlocale(LC_ALL,"");CStdioFile sf;if(!sf.Open(strFileName, CFile::modeCreate|CFile::modeWrite)) return;sf.WriteString(LevleContent);sf.Close();UpdateData(FALSE);}三、实验结果打开文件数据：平差结果：四、实验心得这从实验是我们测绘程序设计的最后一次实验，虽然这个学期我们做了好几次相关的实验，但是我却发现自己学的东西也越来越模糊，感觉很多内容都不理解。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
（误差理论与测量平差础）课程设计报告系（部）：土木工程系实习单位：山东交通学院班级：测绘084学生姓名：田忠星学号0带队教师：夏小裕﹑周宝兴时间：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ˆ=X 0 +x ˆ ； 5．由误差方程计算V ，求出观测量(高差)平差值 6.评定精度单位权中误差 平差值函数的中误差四：平差程序流程图 1． 已知数据的输入需要输入的数据包括水准网中已知点数﹑未知点数以及这些点的点号，已知高程和高差观测值﹑距离观测值。
程序采用文件方式进行输入，约定文件输入的格式如下： 第一行：已知点数﹑未知点数﹑观测值个数 第二行：点号（已知点在前，未知点在后）V L L +=∧第三行：已知高程（顺序与上一行的点号对应）第四行：高差观测值，按“起点点号，终点点号。
高差观测值，距离观测值”的顺序输入。
本节中使用的算例的数据格式如下2,3,71,2,3,4,55.016,6.0161,3,1.359,1.11,4,2.009,1.72,3,0.363,2.32,4,1.012,2.73,4,0.657,2.43,5,0.238,1.45,2,-0.595,2.62.平差计算过程（1）近似高程的计算。
用一个数组来存储高程近似值，已知点的高程放在这个数组的开头，然后按照点号输入顺序依次搜索涉及该店的高差观测值，看该高差涉及的另一点是否已知，若未知，则检查下一个高差观测值，若已知，则可以计算出当前未知点的高差近似值，并放入高程近似值数组，依次类推，直到所有未知点的高程近似值都被求出为止。
（2）列立观测值的误差方程。
根据各观测值的起止点信息及高差﹑距离值和误差方程的系数矩阵﹑权矩阵和常数项的各个元素赋值。
（3）平差计算。
通过间接平差通用过程进行平差计算，该过程将系数矩阵数组A﹑权矩阵数组P和常数向量数组L以参数的方式传入，通过计算，把平差结果存放在解向量数组X中，以参数的形式传出。
3．计算结果的输出计算的中间结果和最后结果都实时在文本框中显示，最后还可以把文本框中的内容保存在文本文件中。
4．界面设计根据以上分析，本程序采用菜单组织程序，用文本框显示数据的输入﹑计算和输出情况。
由于涉及到打开和保存文件的操作，所以还需要一个通用对话框。
（1）菜单设计。
本程序的菜单结构如表所示。
（2）窗体﹑文本框和通用对话框。
在主窗体上绘制1个文本框控件和一个通用对话框控件，并按照下图设置属性（文本框的Name属性改为txtShow）Text1设计好属性后，调整控件和窗体的大小和位置，以方便美观为好。
五：程序源代码及说明程序中涉及的公共变量及其说明如下：Dim strFileName As StringDim nn%, un%, tn%, hn% '已知点个数，未知点个数，总点数，观测值个数Dim Pname() As String '点名数组Dim Hknown() As Double '已知高程数组，存放已知点高程和高程近似值Dim be%(), en%() '观测值的起点和终点编号数组，存储的是点序号Dim h#(), s#() '高差观测值数组和距离观测值数组Dim A#(), X#(), P#(), L#() '间接平差的系数阵、解向量、权阵和常数向量1.数据输入单击“文件→打开文件”命令，弹出打开对话框，待用户选取了文件以后，程序开始读取已知数据，具体代码如下Private Sub mnuOpen_Click()Dim i As Integer '循环变量Dim strT1 As String, strT2 As StringCDg1.Filter = "文本文件（*.txt）|*.txt|所有文件（*.*）|*.*"CDg1.ShowOpen '打开对话框strFileName = CDg1.FileName '获得选中的文件名和路径Open strFileName For Input As #1 '打开文件Input #1, nn, un, hn '读入已知点个数，未知点个数，观测值个数tn = nn + unReDim Pname(1 To tn), Hknown(1 To tn)ReDim h(1 To hn), s(1 To hn), be(1 To hn), en(1 To hn)For i = 1 To tn '读入点名Input #1, Pname(i)Next iFor i = 1 To nn '读入已知高程Input #1, Hknown(i)Next iFor i = 1 To hn '读入各观测值Input #1, strT1, strT2, h(i), s(i)be(i) = Order(strT1): en(i) = Order(strT2) '给起终点数组排序Next i'显示读入的数据txtShow.Text = txtShow.Text & "读入的水准网数据：" & vbCrLftxtShow.Text = txtShow.Text & " 已知点" & nn & "个，未知点" & un & "个，观测值" & hn & "个。
" & vbCrLftxtShow.Text = txtShow.Text & " 网中涉及的点名有："For i = 1 To tntxtShow.Text = txtShow.Text & Pname(i) & "，"Next itxtShow.Text = txtShow.Text & vbCrLftxtShow.Text = txtShow.Text & " 已知点高程为：" & vbCrLfFor i = 1 To nntxtShow.Text = txtShow.Text & Pname(i) & "的高程为：" & Hknown(i) & vbCrLfNext itxtShow.Text = txtShow.Text & " 各观测值分别为：" & vbCrLftxtShow.Text = txtShow.Text & "起点" & " " & "终点" & " " & "高差观测值" & " 距离观测值" & vbCrLfFor i = 1 To hntxtShow.Text = txtShow.Text & Pname(be(i)) & " " & Pname(en(i)) & " " & Format(h(i), "0.000") & " " & Format(s(i), "0.000") & vbCrLf Next iClose #1 '不要忘记关闭文件End Sub其中Order（）函数是根据点号（字符串）获得一个点的序号（数值）的自定义函数，之所以要进行这样的排序，是因为在输入和输出时需使用字符串类型的点号，而在程序计算时。
数组的下标元素需要整数型的点号。
该函数定义如下：'点名－序号转换函数Public Function Order(str As String) As IntegerDim i%For i = 1 To tnIf str = Pname(i) ThenOrder = iExit ForEnd IfNext iEnd Function2.高程近似值的计算输入数据后，点击“计算→近似高程”，程序根据已知数据计算未知点的高程近似值，并将计算的中间结果显示在文本框中，代码如下：'计算近似高程Private Sub mnuHeight_Click()Dim i%, j%For i = 1 To unFor j = 1 To hnIf be(j) = nn + i And en(j) < nn + i Then '找到一个起点相同且终点已知的观测值Hknown(nn + i) = Hknown(en(j)) - h(j)Exit ForEnd IfIf en(j) = nn + i And be(j) < nn + i Then '找到一个终点相同且起点已知的观测值Hknown(nn + i) = Hknown(be(j)) + h(j)Exit ForEnd IfNext jNext i'显示近似高程计算结果txtShow.Text = txtShow.Text & " 近似高程计算结果：" & vbCrLfFor i = 1 To untxtShow.Text = txtShow.Text & Pname(i + nn) & "：" & Format(Hknown(i + nn), "0.000") & vbCrLfNext iEnd Sub3.列立误差方程点击“计算→误差方程”命令，程序根据输入的数据给误差方程的系数矩阵﹑权矩阵和常数向量赋值，并将其结果显示在文本框中，代码如下：'列立误差方程：给A、P、L赋值Private Sub mnuEqu_Click()Dim i%, j%ReDim A(1 To hn, 1 To un), L(1 To hn), P(1 To hn, 1 To hn)'对每个观测值列误差方程For i = 1 To hnIf en(i) > nn Then A(i, en(i) - nn) = 1 '若终点未知，则给终点对应的系数矩阵元素赋值If be(i) > nn Then A(i, be(i) - nn) = -1 '若起点未知，则给起点对应的系数矩阵元素赋值L(i) = -(Hknown(en(i)) - Hknown(be(i)) - h(i)) '根据起终点计算常数项P(i, i) = 1 / s(i) '以距离的倒数为权Next i'显示误差方程txtShow.Text = txtShow.Text & " 列立的误差方程：" & vbCrLfFor i = 1 To hnFor j = 1 To untxtShow.Text = txtShow.Text & A(i, j) & " "Next jtxtShow.Text = txtShow.Text & " " & Format(L(i), "0.0000") & vbCrLfNext itxtShow.Text = txtShow.Text & "权矩阵：" & vbCrLfFor i = 1 To hnFor j = 1 To hntxtShow.Text = txtShow.Text & P(i, j) & " "Next jtxtShow.Text = txtShow.Text & vbCrLfNext iEnd Sub4.计算高程平差值和高程中误差和高差中误差点击“计算→平差计算”命令，程序调用间接平差通用过程求解误差方程，并求出高程平差值﹑高程中误差和高差中误差，显示在文本框中，代码如下：'平差计算Private Sub mnuAdj_Click()Dim i%, j%, VtP#(), VtPV#(), z#, AtP#(), AtPA#(), r(), Naan#(), b()Dim o() As DoubleReDim X(1 To un)ReDim o(1 To un, 1 To 1)ReDim s(1 To hn, 1 To 1)ReDim AX(1 To hn, 1 To 1)ReDim V(1 To hn, 1 To 1)ReDim VtP(1 To 1, 1 To hn)ReDim VtPV(1 To 1, 1 To 1)ReDim AtP(1 To un, 1 To hn)ReDim AtPA(1 To un, 1 To un)ReDim bAt(1 To un, 1 To hn)ReDim AbAt(1 To hn, 1 To hn)ReDim r(1 To un, 1 To un)ReDim b(1 To un, 1 To un)InAdjust A, P, L, X '调用间接平差的通用过程求解'计算并显示高程平差结果txtShow.Text = txtShow.Text & "平差计算结果：" & vbCrLftxtShow.Text = txtShow.Text & "点号初始高程(m) 高程改正数(m) 平差后高程(m)" & vbCrLfFor i = 1 To untxtShow.Text = txtShow.Text & Pname(nn + i) & " " & Format(Hknown(nn + i), "0.0000")Hknown(nn + i) = Hknown(nn + i) + X(i)txtShow.Text = txtShow.Text & " " & Format(X(i), "0.0000") & " " & Format(Hknown(nn + i), "0.0000") & vbCrLfNext itxtShow.Text = txtShow.Text & vbCrLf'计算改正数VFor i = 1 To unFor j = 1 To 1o(i, j) = X(i)Next jNext iMatrix_Multy AX, A, oFor i = 1 To unFor j = 1 To 1s(i, j) = L(i) * 1000Next jNext iMatrixMinus AX, s, VFor i = 1 To hnFor j = 1 To 1V(i, j) = AX(i, j) * 1000 - s(i, j)Next jNext i'计算并显示单位权中误差MatrixTrans V, VttxtShow.Text = txtShow.Text & vbCrLfMatrix_Multy VtP, Vt, PtxtShow.Text = txtShow.Text & vbCrLfMatrix_Multy VtPV, VtP, VFor i = 1 To 1For j = 1 To 1z = VtPV(i, j)Next jNext iσ0 = Sqr(z / (hn - nn))txtShow.Text = txtShow.Text & "单位权中误差：（mm）" & vbCrLftxtShow.Text = txtShow.Text & Format(σ0, "0.0000")txtShow.Text = txtShow.Text & vbCrLf'计算未知点的高程中误差MatrixTrans A, AtMatrix_Multy AtP, At, PMatrix_Multy AtPA, AtP, AFor i = 1 To unFor j = 1 To unr(i, j) = AtPA(i, j)Next jNext iCall jzqn(r(), b())txtShow.Text = txtShow.Text & "点号高程中误差：（mm）" & vbCrLfFor i = 1 To unz = b(i, i)zz = σ0 * Sqr(z)txtShow.Text = txtShow.Text & Pname(nn + i) & " "txtShow.Text = txtShow.Text & " " & Format(zz, "0.0000") & vbCrLfNext i'计算高差平差值的中误差MatrixTrans A, AtMatrix_Multy bAt, b, AtMatrix_Multy AbAt, A, bAttxtShow.Text = txtShow.Text & "起点" & " " & "终点" & " " & "高差平差值的中误差（mm）" & vbCrLfFor i = 1 To hny = AbAt(i, i)yy = σ0 * Sqr(y)txtShow.Text = txtShow.Text & Pname(be(i)) & " " & Pname(en(i)) & " " & Format(yy, "0.0000") & vbCrLfNext iEnd Sub在此程序中用到了过程jzqn（）代码如下：Public Sub jzqn(Qa(), na())Dim A()n = UBound(Qa, 1)ReDim na(n, n)ReDim A(n, 2 * n)For i = 1 To nFor j = 1 To nA(i, j) = Qa(i, j)Next jNext iFor i = 1 To nFor j = n + 1 To 2 * nIf j - i = n ThenA(i, j) = 1ElseA(i, j) = 0End IfNext jNext iFor i = 1 To nIf A(i, i) = 0 ThenFor Q = i To nIf A(Q, i) <> 0 ThenFor W = i To 2 * nzj = A(i, W)A(i, W) = A(Q, W)A(Q, W) = zjNext WExit ForEnd IfNext QIf Q > n Then MsgBox "此矩阵不可逆": Exit Sub End IfFor K = 2 * n To i Step -1A(i, K) = A(i, K) / A(i, i)Next KFor j = i + 1 To nIf A(j, i) <> 0 ThenFor K = 2 * n To i Step -1A(j, K) = A(j, K) / A(j, i) - A(i, K)Next KEnd IfNext jNext iFor i = n To 1 Step -1If A(i, i) = 0 ThenFor Q = i - 1 To 1 Step -1If A(Q, i) <> 0 ThenFor W = i To 2 * nzj = A(i, W)A(i, W) = A(Q, W)A(Q, W) = zjNext WExit ForEnd IfNext QEnd IfFor K = 2 * n To i Step -1A(i, K) = A(i, K) / A(i, i)Next KFor j = i - 1 To 1 Step -1If A(j, i) <> 0 Thenxxx = A(j, i)For K = 2 * n To 1 Step -1A(j, K) = A(j, K) / xxx - A(i, K)Next KEnd IfNext jNext iFor i = 1 To nFor j = 1 To nna(i, j) = A(i, j + n)Next jNext iEnd Sub5.保存﹑退出点击“文件→保存结果”命令，将文本框中的内容保存在指定的文件中，代码如下：'保存计算结果Private Sub mnuSave_Click()CDg1.Filter = "文本文件（*.txt）|*.txt|所有文件（*.*）|*.*"CDg1.ShowSavestrFileName = CDg1.FileNameOpen strFileName For Output As #1Print #1, txtShow.TextClose #1End Sub点击“文件→退出”命令，退出程序。