平面和高程控制测量VB程序设计报告.doc

测绘程序编制实习报告题目：习题7.1平面和高程控制网平差蒲浡轩测绘c101班106684余数7一、 设计思路题目为：平面控制网和高程控制网的平差1、 流程图2、界面设计 上面为开始主程序，在该页面进行高程控制网平差，点击平面控制启动下面的程序页面进行平面控制网平差。2、 功能设计通过菜单实现程序的各个功能，通过菜单启动common dialog control控件输入txt文档，读取txt里面的高程或平面控制网数据，然后点击各个计算菜单进行平差计算二、算法及代码实现1、form1代码：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#() 间接平差的系数阵、解向量、权阵和常数向量高程平差计算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 iend subprivate sub mnucalc_click(index as integer)form1.visible = falsefrmmain.visible = trueend sub误差方程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 iend subprivate 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 & 近似高程计算结果： & vbcrlf for i = 1 to un txtshow.text = txtshow.text & pname(i + nn) & ： & format(hknown(i + nn), 0.000) & vbcrlf next iend sub打开高程文件private sub mnuhopen_click() dim i as integer 循环变量 dim strt1 as string, strt2 as string cdg1.filter = 文本文件（*.txt）|*.txt|所有文件（*.*）|*.* cdg1.showopen 打开对话框 strfilename = cdg1.filename 获得选中的文件名和路径 open strfilename for input as #1 打开文件 input #1, nn, un, hn 读入已知点个数，未知点个数，观测值个数 tn = nn + un redim 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 i for i = 1 to nn 读入已知高程 input #1, hknown(i) next i for 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 & 读入的水准网数据： & vbcrlf txtshow.text = txtshow.text & 已知点 & nn & 个，未知点 & un & 个，观测值 & hn & 个。 & vbcrlf txtshow.text = txtshow.text & 网中涉及的点名有： for i = 1 to tn txtshow.text = txtshow.text & pname(i) & ， next i txtshow.text = txtshow.text & vbcrlf txtshow.text = txtshow.text & 已知点高程为： & vbcrlf for i = 1 to nn txtshow.text = txtshow.text & pname(i) & 的高程为： & hknown(i) & vbcrlf next i txtshow.text = txtshow.text & 各观测值分别为： & vbcrlf txtshow.text = txtshow.text & 起点 & & 终点 & & 高差观测值 & 距离观测值 & vbcrlf for i = 1 to hn txtshow.text = txtshow.text & pname(be(i) & & pname(en(i) & & format(h(i), 0.000) & & format(s(i), 0.000) & vbcrlf next i close #1 不要忘记关闭文件end sub点名序号转换函数public function order(str as string) as integer dim i% for i = 1 to tn if str = pname(i) then order = i exit for end if next iend function程序退出时检查是否已保存结果private sub form_unload(cancel as integer) if txtshow.text then dim imsg% imsg = msgbox(是否保存计算结果？, vbyesnocancel, 注意保存！) if imsg = vbyes then mnusave_click if imsg = vbcancel then cancel = true end ifend sub保存计算结果private sub mnusave_click() dim imsg%resave: cdg1.filename = : cdg1.filter = text files(*.txt)|*.txt cdg1.action = 2 strfilename = cdg1.filename if strfilename = then imsg = msgbox(请选择文件名！, vbyesnocancel, 注意！) if imsg = vbyes then goto resave: else txtshow.text = exit sub end if end if open strfilename for output as #1 print #1, txtshow.text close #1 txtshow.text = end sub3、 frmmain代码： option explicit const pi = 3.14159265358979 const ru = 206264.8 dim net%, nn%, un%, tn% 网的类型，已知点个数，未知点个数，总点数 dim pname() as string 点名数组，大小为tn dim x0#(), y0#() 已知点坐标及未知点近似坐标，大小为tn dim x#(), y#() 已知点坐标及未知点平差坐标，大小为tn dim n500% 记录y坐标的带号，读入数据时减该常数，输出数据时加 dim ne%, nd% 边长观测值个数，方向观测值个数 dim mm#, pp# 边长观测值的固定误差和比例误差，单位为mm和ppm dim be%(), ee%(), s#() 边长观测值的起点、终点、边长 dim md#, dir0#(), dir#() 方向中误差，原始方向数组和排序后的方向数组 dim bd0%(), ed0%(), bd%(), ed%() 方向起终点原始数组和排序后的数组 dim si%(), ni%() 统计总的方向数和每个测站的方向数 dim aa%(), bb%(), cc%() 近似坐标的计算路线，个数与未知点个数相同 dim pa#(700, 9), pa3#(200, 40), w#(400) 误差方程系数（压缩方式存放）和常数向量 dim ql#(700), qls#(200) 误差方程权和虚拟误差方程的权 dim q(100, 100) as double 协方差阵，q=n(-1) dim uw0# 单位权中误差 dim strfilename as string检查数据并将点名转换为序号第一个参数是要检查的点名，第二个参数是得到的序号；返回值是错误号public function chkdata(strp as string, order%) as integer dim i%, bfound as boolean order = 0 bfound = false for i = 1 to tn if strp = pname(i) then bfound = true order = i chkdata = 0 exit for end if next i if not bfound then open app.path & err.log for output as #1 print #1, 未找到的点号： & strp & vbcrlf close #1 chkdata = 1 msgbox 有未找到的点号, 1, 输入错误 end ifend function文本框大小随窗口大小的改变而改变private sub form_resize() txtshow.width = frmmain.width - 330 if frmmain.height 1030 then txtshow.height = frmmain.height - 1030 txtshow.left = 120 txtshow.top = 120end sub退出程序private sub mnuexit_click() endend sub计算近似坐标private sub mnucalccoor_click() screen.mousepointer = 13 dim i%, j%, k% 循环变量 if net = 1 then 按边长计算近似坐标：使用前方交会方法 dim sa#, sb#, sc#, al#, bl#, cl# 三角形边长和三个内角 for i = 1 to un sc = distab(x0(aa(i), y0(aa(i), x0(bb(i), y0(bb(i) for j = 1 to ne if (be(j) = bb(i) and ee(j) = cc(i) or (be(j) = cc(i) and ee(j) = bb(i) then sa = s(j) if (be(j) = aa(i) and ee(j) = cc(i) or (be(j) = cc(i) and ee(j) = aa(i) then sb = s(j) next j call getinnerangles(sa, sb, sc, al, bl, cl) 求三角形三个内角 调用前方交会程序计算待定点坐标 forintersec x0(aa(i), y0(aa(i), x0(bb(i), y0(bb(i), al, bl, x0(cc(i), y0(cc(i) next i 显示计算结果 open app.path & 按边长计算近似坐标.txt for output as #1 print #1, 按边长计算近似坐标： txtshow.text = txtshow.text & 按边长计算近似坐标： & vbcrlf for i = nn + 1 to tn print #1, pname(i), format(x0(i), 0.0000), format(y0(i), 0.0000) txtshow.text = txtshow.text & pname(i) & , & format(x0(i), 0.0000) & , & format(y0(i), 0.0000) & vbcrlf next i close #1 end if if net = 2 then 根据方向观测值计算近似坐标：使用前方交会方法 dim ta#, tb# 用于交会的两个角 for i = 1 to un ta = getbeta(bb(i), aa(i), cc(i), j) 求角a tb = getbeta(aa(i), bb(i), cc(i), j) 求角b 调用前方交会程序计算待定点坐标 forintersec x0(aa(i), y0(aa(i), x0(bb(i), y0(bb(i), ta, tb, x0(cc(i), y0(cc(i) next i open app.path & 按方向计算近似坐标.txt for output as #1 print #1, 按方向计算近似坐标： txtshow.text = txtshow.text & 按方向计算近似坐标： & vbcrlf for i = nn + 1 to tn print #1, pname(i), format(x0(i), 0.0000), format(y0(i), 0.0000) txtshow.text = txtshow.text & pname(i) & , & format(x0(i), 0.0000) & , & format(y0(i), 0.0000) & vbcrlf next i close #1 end if if net 2 then 根据边角条件计算近似坐标：使用极坐标方法 dim dbls#, dbla#, dbld# 极坐标方法中的边长、夹角、方位角 dim dir1#, dir2#, bf as boolean 两个临时的方向，一个逻辑开关 for i = nn + 1 to tn for j = si(i) to si(i) + ni(i) - 1 if ed(j) i then 如果搜索要用到的边长和方向值，则根据极坐标法计算待丁点坐标 if foundsid(ed(j), i, dbls) and founddir1(ed(j), i, dir1) then bf = false for k = si(ed(j) to si(ed(j) + ni(ed(j) - 1 if ed(k) i then dir2 = dir(k): bf = true dbla = dir1 - dir2: if dbla 0 then dbla = dbla + 2 * pi 调用极坐标方法求点的坐标 polarpositioning x0(ed(k), y0(ed(k), x0(ed(j), y0(ed(j), dbls, dbla, x0(i), y0(i) exit for end if next k if bf then exit for end if end if next j next i txtshow.text = txtshow.text & 按全边角网计算近似坐标(m): & vbcrlf open app.path & 按全边角网计算近似坐标.txt for output as #1 print #1, 按全边角网计算近似坐标(m)： for i = nn + 1 to tn print #1, pname(i), format(x0(i), 0.0000), format(y0(i), 0.0000) txtshow.text = txtshow.text & str(pname(i) & & format(x0(i), 0.0000) & , & format(y0(i), 0.0000) & vbcrlf next i close #1 end if screen.mousepointer = 0end sub搜索已知起点和终点的边public function foundsid(benode%, ennode%, dbls#) as boolean dim k% 循环变量 foundsid = false for k = 1 to ne if (be(k) = benode and ee(k) = ennode) or (be(k) = ennode and ee(k) = benode) then dbls = s(k) foundsid = true exit function end if next kend function搜索已知起点和终点的起始方向值public function founddir1(benode%, ennode%, dbldir#) as boolean dim k% 循环变量 founddir1 = false for k = si(benode) to si(benode) + ni(benode) - 1 if ed(k) = ennode then dbldir = dir(k) founddir1 = true exit function end if next kend function搜索已知起点和终点的终止方向值public function founddir2(benode%, ennode%, dbldir#) as boolean dim k% 循环变量 founddir2 = false for k = si(benode) to si(benode) + ni(benode) - 1 if ed(k) 0 then 如果有边长观测值，那么读入边长观测值 input #1, mm, pp 输入边长精度：固定误差和比例误差 txtshow.text = txtshow.text & 边长固定误差 & format(mm, 0.00) & mm,比例误差 & str(pp) & ppm。 & vbcrlf redim be(ne), ee(ne), s(ne) 声明边数组大小 for i = 1 to ne 输入边长有关信息 input #1, strt1, strt2, s(i) err1 = chkdata(strt1, be(i) 检查起点并计算起点序号 err2 = chkdata(strt2, ee(i) 检查终点并计算终点序号 txtshow = txtshow & be( & i & )= & pname(be(i) & , & ee( & i & )= & pname(ee(i) & , & s( & i & )= & str(s(i) & , & vbcrlf next i 读入的边长数据写入文件，并做检查 open app.path & 边长观测值数据.txt for output as #2 print #2, 边长观测值： print #2, mm= & mm print #2, pp= & pp for i = 1 to ne print #2, be( & i & )=; pname(be(i); , ee( & i & )=; pname(ee(i); , s( & i & )=; s(i) next i close #2 检查边的起点与终点是否相同 err3 = 0 for i = 1 to ne if be(i) = ee(i) then err3 = 1 open app.path & err.log for output as #2 print #2, s( & i & ), be( & i & )= & pname(be(i), ee( & i & )= & pname(ee(i) close #2 end if next i if err1 + err2 + err3 0 then msgbox 边长输入错误, 1, 出错 end if if nd 0 then 如果有方向观测值，那么读入方向观测值 dim ii%, ik% 辅助循环变量 input #1, md 读入方向中误差 txtshow.text = txtshow.text & 方向中误差： & str(md) & vbcrlf redim bd(1 to nd), ed(1 to nd), dir(nd) 声明方向数组大小 redim si(nd), ni(nd) 声明测站测回数数组的大小 redim bd0(nd), ed0(nd), dir0(nd) 声明辅助方向数组大小 for i = 1 to nd input #1, strt1, strt2, dir(i) err1 = chkdata(strt1, bd(i) 检查起点并计算起点序号 err2 = chkdata(strt2, ed(i) 检查终点并计算终点序号 txtshow = txtshow & bd( & i & )= & pname(bd(i) & ； ed( & i & )= & pname(ed(i) & ； dir( & i & )= & dir(i) & vbcrlf next i 读入的方向数据写入文件并检查 open app.path & 方向观测值数据.txt for output as #2 print #2, 方向观测值中误差md= & md for i = 1 to nd bd0(i) = bd(i): ed0(i) = ed(i): dir0(i) = dir(i): dir(i) = dot