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 '读到的是文件第一行。

ma = tr(1): ms = tr(2): mk = tr(3): p = 1 '提取观测方向,边先验精度值，并使该句以后不能再执行。

ElseIf m(1) = 0 Then j = j + 1: ReDim Preserve dm(j): ReDim Preserve nl(j): ReDim Preserve ns(j): dm(j) = B: nl(j) = nl(j - 1): ns(j) = ns(j - 1) '该行中没有逗号,但又不是结束符，则一定是测站点名。

将读出的字符串赋值到点名数组变量dm(j)，资料.Next jIf p = 0 Then d = d + 1: ReDim Preserve ns(d): ns(d) = ns(d - 1): ReDim Preserve dm(d): dm(d) = lb(i) '如p=0，表明目标点未设过测站,将该点点名加入点名数组Next izds = d '将总点数存入模块级变量zdsReDim x(zds), y(zds) ' 重新定义坐标数组x(1) = 10000: y(1) = 10000 '为推算近似坐标,对第一个点赋假设坐标值k = 1For i = 1 To ydsIf lb(1) = ym(i) Then k = k + 1Next iss = sid(1, k) '调出第一点到未知点方向的边长，参数是测站点序号，照准方向号h = seqn(lb(k)) '查k方向照准点的计算序号x(h) = x(1) + ss * Cos(0): y(h) = y(1) + ss * Sin(0) '计算第一点上第k方向值的目标点假设坐标For i = 1 To nl(cds) '遍访所有方向值，将其由角度值转换为弧度值.If l(i) > 0.001 Then l(i) = radian(l(i)) '零方向值不参加转换Next in = 0Don = n + 1 'n是循环计数变量，控制循环次数，避免假定坐标计算不出时，进入死循环。

For i = 1 To cds '按测站循环If x(i) > 1 Then '在该测站假设坐标已计算出的前提下，求照准点假设坐标p1 = 0For j = nl(i - 1) + 1 To nl(i) '遍访i测站上所有方向值h = seqn(lb(j)) '查目标点对应的序号If x(h) > 1 Then '目标点坐标已解出资料.t2 = azimuth(xo(1), yo(1), xo(2), yo(2))dt = t2 - t1: x1 = x(m(1)): y1 = y(m(1))For i = 1 To zds '将假设坐标转换到实际坐标dx = x(i) - x1: dy = y(i) - y1x(i) = xo(1) + dx * Cos(dt) - dy * Sin(dt)y(i) = yo(1) + dx * Sin(dt) + dy * Cos(dt)Next iFor i = 1 To yds '置入已知点坐标x(m(i)) = xo(i): y(m(i)) = yo(i)Next iCase 2 '组法方程Text1.Visible = FalseDim l1 As Double, pp As Double, n2 As Long '定义过程级变量q = 206265: ll = 0n1 = 2 * (zds - yds) '未知数数目n2 = n1 * (n1 + 1) / 2 '一维存储法方程系数数组上限ReDim NX(n2), UX(n1) ' 重新定义法方程系数、常数数组Call order(m(), yds) '对保存已知点序号的m()数组排序For i = 1 To cds '按测站循环z = 0 '将按测站累积的变量清零'下面开始处理一个测站的方向观测值k1 = nl(i - 1) + 1: k2 = nl(i) '一测站上最小和最大方向号For j = k1 To k2 '在i测站上按方向循环，求定向角未知数h = seqn(lb(j))t = azimuth(x(i), y(i), x(h), y(h))f = t - l(j): If f < 0 Then f = f + 2 * pi 'f是解算的零方角方位角资料.pp = 1 '方向观测值的权为1Call equation(nb(), pp, l1) '组法方程，参数分别是误差方程系数数组、权、误差方程常数项Next jpp = -1 / (k2 - k1 + 1): l1 = ln 'pp是和方程的权Call equation(nc(), pp, l1) '和方程组法方程,nc()是一测站方向误差方程和方程数组'一个测站方向观测值误差方程处理完毕,下面开始处理该测站的边观测值If ns(i) - ns(i - 1) - 1 >= 0 Then 'i测站有观测边For j = ns(i - 1) + 1 To ns(i) '依次遍访i测站上各观测边ReDim nb(n1) ' 重新定义误差方程系数数组,并且每循环到一新边长前清零h = seqn(sb(j))t = azimuth(x(i), y(i), x(h), y(h))A = Cos(t):B = Sin(t)cha = charact(i, k) '自定义函数，查测站点i是否已知点，如不是,用k返回i前面有几个已知点If cha = "n" Then '测站点i不是已知点d = 2 * (i - k - 1) + 1 '计算测站i点x坐标未知数在未知数点集中的序号nb(d) = -A: nb(d + 1) = -BEnd Ifcha = charact(h, k)If cha = "n" Then '照准方向点h不是已知点d = 2 * (h - k - 1) + 1 '计算照准方向h点x坐标未知数在未知数点集中的序号nb(d) = A: nb(d + 1) = BEnd Ifdx = x(h) - x(i): dy = y(h) - y(i)ss = Sqr(dx ^ 2 + dy ^ 2) '反算边长，置于判断式外是因为两已知点之间不会测边pp = (ma / (0.1 * ms + mk * ss * 10 ^ -4)) ^ 2 '边长观测值定权l1 = (ss - s(j)) * 100 '求边误差方程常数(单位是厘米)资料.'并对该测站最大方向号，最大边长号数组变量nl(j)、ns(j)赋值累计起始值If m(1) <> 0 Then '不是第一行，并且该行中有逗号分割的多个字串tr(2) = LCase(tr(2))If tr(2) <> "l" And tr(2) <> "s" Then '这一行不是方向或边长观测值，而是已知点坐标值k = k + 1: ReDim Preserve ym(k): ReDim Preserve xo(k): ReDim Preserve yo(k):ym(k) = tr(1): xo(k) = Val(tr(2)): yo(k) = Val(tr(3)) '输入已知点坐标ElseIf tr(2) = "l" Then nl(j) = nl(j) + 1: ReDim Preserve lb(nl(j)): ReDim Preserve l(nl(j)): lb(nl(j)) = tr(1): l(nl(j)) = Val(tr(3)) '累计测站方向数、提取照准点、方向值If tr(2) = "s" Then ns(j) = ns(j) + 1: ReDim Preserve sb(ns(j)): ReDim Preserve s(ns(j)): sb(ns(j)) = tr(1): s(ns(j)) = Val(tr(3)) '提取边观测数、提取照准点、观测边End IfEnd IfEnd IfLoopts.Closecds = j: yds = k '用模块级变量cds 、yds保存测站点总数、已知点总数MsgBox "数据已成功读入", 0 + 64 + 0, "数据输入"End IfCase 1 '解算近似坐标d = cds 'd是测站数For i = 1 To nl(cds) '依次访问所有的方向值p = 0 '设识别变量For j = 1 To d '依次访问所有测站If dm(j) = lb(i) Then p = 1 ' 查看目标点是否设过测站，是则对识别变量p赋值1。