（误差理论与测量平差础）课程设计报告系（部）：土木工程系实习单位：山东交通学院班级：测绘084学生姓名：田忠星学号080712420 带队教师：夏小裕﹑周宝兴时间：10 年12 月13日到10 年12 月19日山东交通学院目录：1.摘要P32.概述P33.水准网间接平差程序设计思路P3—P44. 平差程序流程图P4—P65. 程序源代码及说明P7—P236. 计算结果P23—P267. 总结P26—P27一：摘要在测量工作中，为了能及时发现错误和提高测量成果的精度，常作多余观测，这就产生了平差问题。
在一个平差问题中，当所选的独立参数Xˆ的个数等于必要观测数t时，可将每个观测值表达成这t个参数的函数，组成观测方程，这种以观测方程为函数模型的平差方法，就是间接平差。
二：概述：该课程设计的主要目是对水准网进行间接平差，在输入数据后依次计算高程近似值﹑误差方程和平差计算。
三：水准网间接平差程序设计思路1．根据平差问题的性质，选择t个独立量（既未知点的高程）作为参数Xˆ2. 将每一个观测量的平差值（既观测的高程差值）分别表达成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）近似高程的计算。
用一个数组来存储高程近似值，已知点的高程放在这个数组的开头，然后按照点号输入顺序依次搜索涉及该店的高差观测值，看该高差涉及的另一点是否已知，若未知，则检查下一个高差观测值，若已知，则可以计算出当前未知点的高差近似值，并放入高程近似值数组，依次类推，直到所有未知点的高程近似值都被求出为止。
（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）" & vbCrLf txtShow.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）" & vbCrLf For 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点击“文件→退出”命令，退出程序。