水准网平差(VB代码)

1、本文档如对你有帮助，请帮忙下载支持！（误差理论与测量平差础）课程设计报告系（部）：土木工程系实习单位：山东交通学院班 级：测绘084学生姓名：田忠星学号 0带队教师：夏小裕、周宝兴时间： 10 年12 月13日 到10年 12月19日山东交通学院目录：1摘要P32概述P33 .水准网间接平差程序设计思路 P3-P44 .平差程序流程图P4 P65 .程序源代码及说明P7-P236 .计算结果P23P267 .总结P26P27一：摘要在测量工作中，为了能及时发现错误和提高测量成果的精度，常作多余观测，这就产生了平差问题。在一个平差问题中，当所选的独立参数 "的个数等于必要观测数 t时，

2、可将每个观 测值表达成这t个参数的函数，组成观测方程， 这种以观测方程 为函数模型的平差方法，就是间接平差。二：概述：该课程设计的主要目是对水准网进行间接平差，在输入数据后依次计算高程近似值、误差方程和平差计算。三：水准网间接平差程序设计思路1根据平差问题的性质，选择 t 个独立量（既未知点的高程）作为参数 X?2. 将每一个观测量的平差值（既观测的高程差值）分别表达成3由误差方程系数B 和自由项组成法方程，法方程个数等于参数的个数 t ；4. 解算法方程，求出参数X? ,计算参数（高程）的平差值X? =X0 +x? ；5由误差方程计算V ，求出观测量（高差 ）平差值 L L V6.评定精度单

3、位权中误差平差值函数的中误差四：平差程序流程图1 已知数据的输入需要输入的数据包括水准网中已知点数、未知点数以及这些点的点号，已知高程和高差观测值、距离观测值。程序采用文件方式进行输入，约定文件输入的格式如下：第一行：已知点数、未知点数、观测值个数第二行：点号（已知点在前，未知点在后）第三行：已知高程（顺序与上一行的点号对应）第四行：高差观测值，按“起点点号，终点点号。高差观测值，距离观测值”的顺序输入。本节中使用的算例的数据格式如下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,

4、0.657,2.43,5,0.238,1.45,2,-0.595,2.62 .平差计算过程（ 1 ）近似高程的计算。用一个数组来存储高程近似值，已知点的高程放在这个数组的开头， 然后按照点号输入顺序依次搜索涉及该店的高差观测值， 看该高差涉及的另一点是否已知， 若未知，则检查下一个高差观测值， 若已知， 则可以计算出当前未知点的高差近似值， 并放入高程近似值数组， 依次类推， 直到所有未知点的高程近似值都被求出为止。（ 2 ）列立观测值的误差方程。根据各观测值的起止点信息及高本文档如对你有帮助，请帮忙下载支持!差、距离值和误差方程的系数矩阵、权矩阵和常数项的各个元素赋值。(3)平差计算。通过间

5、接平差通用过程进行平差计算，该过程将系数矩阵数组 A、权矩阵数组P和常数向量数组L以参数的方式传入，通过计算，把平差结果存放在解向量数组X中，以参数的形式传出。3 .计算结果的输出计算的中间结果和最后结果都实时在文本框中显示，最后还可以把文本框中的内容保存在文本文件中。4 .界面设计根据以上分析，本程序采用菜单组织程序， 用文本框显示数据的 输入、计算和输出情况。由于涉及到打开和保存文件的操作，所以还需要一个通用对话框。(1) 菜单设计。本程序的菜单结构如表所示。标题名称快捷键文件(&File )mnuFile一打开数据mnuOpen一保存结果mnuSave一aa一退出mnuExitC

6、trl+E计算mnuCalc一(&Calc )近似高程mnuHeight一误差方程mnuEqu一平差计算mnuAdj一(2) 窗体、文本框和通用对话框。在主窗体上绘制1个文本框控件和一个通用对话框控件，弁按照下图设置属性(文本框的Name属性改为txtShow )对象属性值Text1TextText1MultiLineTrueForm1Caption水准网间接平差CommonDialog1NameCDg1Textl设计好属性后，调整控件和窗体的大小和位置，以方便美 观为好。五：程序源代码及说明程序中涉及的公共变量及其说明如下:已知点个数，未知点点名数组'已知高程数组，存放Dim

7、 strFileName As StringDim nn%, un%, tn%, hn%个数，总点数，观测值个数Dim Pname() As StringDim Hknown() As Double已知点高程和高程近似值本文档如对你有帮助，请帮忙下载支持！Dim be%(), en%()编号数组，存储的是点序号Dim h#(), s#()观测值数组Dim A#(), X#(), P#(), L#()量、权阵和常数向量' 观测值的起点和终点' 高差观测值数组和距离' 间接平差的系数阵、解向1. 数据输入单击“文件一打开文件”命令，弹出打开对话框，待用户选取了文件以后，程序

8、开始读取已知数据，具体代码如下Private Sub mnuOpen_Click()Dim i As Integer'循环变量Dim strT1 As String, strT2 As StringCDgl.Filter ="文本文件(*txt) |*txt|所有文件(* ) |*"CDg1.ShowOpen'打开对话框strFileName = CDg1.FileName '获得选中的文件名和路径Open strFileName For Input As #1'打开文件Input #1, nn, un, hn 读入已知点个数，未知点个数，观

9、测值个数'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) =

10、 Order(strT2)'给起终点数组排序Next i'显示读入的数据txtShow.Text = txtShow.Text & "读入的水准网数据：" & vbCrLftxtShow.Text = txtShow.Text & " 已知点 " & nn & " 个，未知点 " & un& " 个，观测值" & hn & " 个。 " & vbCrLftxtShow.Text = txtShow.T

11、ext & " 网中涉及的点名有： "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) & "的高程为：

12、" & Hknown(i)& vbCrLfNext itxtShow.Text = txtShow.Text & " 各观测值分别为： " & vbCrLftxtShow.Text = txtShow.Text & "起点 " & "" & " 终点 " & "" & " 高差观测值 " & " 距离观测值" & vbCrLfFor i = 1 To hntx

13、tShow.Text = txtShow.Text & Pname(be(i) & "" & Pname(en(i)& "" & Format(h(i), "0.000") & "" & Format(s(i), "0.000") & vbCrLfNext iClose #1'不要忘记关闭文件End Sub其中 Order () 函数是根据点号 (字符串) 获得一个点的序号 (数值) 的自定义函数， 之所以要进行这样的排序，

14、 是因为在输入和输出时需使用字符串类型的点号， 而在程序计算时。 数组的下标元素需要整数型的点号。该函数定义如下：' 点名序号转换函数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 mn

15、uHeight_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

16、'显示近似高程计算结果txtShow.Text = txtShow.Text & " 近似高程计算结果： " & vbCrLfFor i = 1 To untxtShow.Text = txtShow.Text & Pname(i + nn) & "： " & Format(Hknown(i + nn), "0.000") & vbCrLfNext iEnd Sub3. 列立误差方程点击“计算-误差方程”命令，程序根据输入的数据给误差方程的系数矩阵、权矩阵和常数向量赋值，并将其结

17、果显示在文本框中，代码如下：' 列立误差方程：给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'若起点未知，则给起点对应的系数矩阵元素赋

18、值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

19、& "" & 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. 计算高程平差值和高

20、程中误差和高差中误差点击“计算-平差计算”命令，程序调用间接平差通用过程求解误差方程，并求出高程平差值、高程中误差和高差中误差，显示在文本框中，代码如下：'平差计算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

21、, 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.Tex

22、t & "平差计算结果：" & 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)txt

23、Show.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

24、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_Mul

25、ty VtPV , VtP, VFor i = 1 To 1For j = 1 To 1z = VtPV(i, j)Next jNext io- 0 = Sqr(z / (hn nn)txtShow.Text = txtShow.Text & "单位权中误差：( mm) " & vbCrLftxtShow.Text = txtShow.Text & Format( o- 0, "0.0000")txtShow.Text = txtShow.Text & vbCrLf'计算未知点的高程中误差MatrixTrans A

26、, 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 = o- 0 * Sqr(z)txtShow.Text = txtShow.Text & Pname(nn + i) &am

27、p; ""txtShow.Text = txtShow.Text & "" & Format(zz, "0.0000") &vbCrLfNext i'计算高差平差值的中误差MatrixTrans A, AtMatrix_Multy bAt, b, AtMatrix_Multy AbAt, A, bAttxtShow.Text = txtShow.Text & " 起点 " & "" & " 终点 " & &quo

28、t;" & " 高差平差值的中误差( mm) " & vbCrLfFor i = 1 To hny = AbAt(i, i)yy = o- 0 * Sqr(y)txtShow.Text = txtShow.Text & Pname(be(i) & "" & Pname(en(i)& "" & Format(yy, "0.0000") & vbCrLfNext iEnd Sub在此程序中用到了过程jzqn ()代码如下：Public Sub j

29、zqn(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

30、 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 SubEnd 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

31、(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 -1I

32、f 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()CDgl.Filter ="仪次文件(*txt)

33、 |*txt|所有文件(* ) |*"CDg1.ShowSavestrFileName = CDg1.FileNameOpen strFileName For Output As #1Print #1, txtShow.TextClose #1End Sub点击”文件一退出”命令，退出程序。代码如下:Private Sub mnuExit_Click()EndEnd Sub6此程序用到的通用过程mdlAdjust （）代码如下：'矩阵转置的通用过程Public Sub MatrixTrans(A, c)Dim i%, j%Dim R1%, C1%On Error Resume

34、 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

35、 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 <

36、> 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) - LB

37、ound(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 &qu

38、ot;输入的两个矩阵维数不等，不能相减！"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

39、, 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 el = False And e2 = False Then2!维矩阵相乘For ai = LBoun

40、d(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 '数乘以二维矩

41、阵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

42、 = 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(Q

43、a, 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)

44、 * 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 e

45、5 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%Di

46、m 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) - LB

47、ound(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)&#

48、39;矩阵大小'循环变量'各行的约化系数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 <

49、> 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) Then iPos = iRowEnd IfNext iRowIf iPos > iStep Then'需要换主

50、元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(iSte

51、p, 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 SubPublic

52、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

53、%, 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 Then

54、MsgBox "系数矩阵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) - LBou

55、nd(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与系数矩阵

56、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:"ShowMatri