水准网平差(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。
- 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点击“文件→退出”命令，退出程序。