按间接平差原理写的代码,.docVIP

按间接平差原理写的代码, 按间接平差原理写的代码，绝对有用，真实可靠 Dim strFileName As String Dim nn%, un%, tn%, hn% 已知点个数，未知点个数，总点数，观测值个数 Dim Pname() As String 点名数组 Dim Hknown() As Double 已知高程数组，存放已知点高程和高程近似值 Dim be%(), en%() 观测值的起点和终点编号数组，存储的是点序号 Dim h#(), s#() 高差观测值数组和距离观测值数组 Dim A#(), X#(), P#(), L#() 间接平差的系数阵、解向量、权阵和常数向量 平差计算 Private Sub mnuAdj_Click() Dim i%, j% ReDim X(1 To un) InAdjust A, P, L, X 调用间接平差的通用过程求解 计算并显示高程平差结果 txtShow.Text = txtShow.Text 平差计算结果： vbCrLf txtShow.Text = txtShow.Text 点号 初始高程(m) 高程改正数(m) 平差后高程(m) vbCrLf For i = 1 To un txtShow.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) vbCrLf Next i txtShow.Text = txtShow.Text vbCrLf 计算并显示单位权中误差---------精度评定部分应该也包含在间接平差模块里，一起来调用 Dim dblT As Double dblT = 0 For i = 1 To un Next i End Sub 列立误差方程：给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 hn If 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 列立的误差方程： vbCrLf For i = 1 To hn For j = 1 To un txtShow.Text = txtShow.Text A(i, j) Next j txtShow.Text = txtShow.Text Format(L(i), 0.0000) vbCrLf Next i txtShow.Text = txtShow.Text 权矩阵： vbCrLf For i = 1 To hn For j = 1 To hn txtShow.Text = txtShow.Text P(i, j) Next j txtShow.Text = txtShow.Text vbCrLf Next i End Sub 计算近似高程 Private Sub mnuHeight_Click() Dim i%, j% For i = 1 To un For j = 1 To hn If be(j) = nn + i And en(j) nn + i Then 找到一个起点相同且终点已知的观测值 Hknown(nn + i) = Hknown(en(j)) - h(j) Exit For End If If en(j) = nn + i And be(j) nn + i Then 找到一个终点相同且起点已知的观测值 Hknown(nn + i) = Hknown(be(j)) + h(j) Exit For End If Next j Next i 显示近似高程计算结果 txtShow.Text = txtShow.Text 近似高程计算结果： vbC