平面和高程控制測量VB程序設(shè)計報告

1、題目：習(xí)題7.1平面和高程控制網(wǎng)平差蒲浡軒測繪c101班106684余數(shù)7一、 設(shè)計思路題目為：平面控制網(wǎng)和高程控制網(wǎng)的平差1、 流程圖2、界面設(shè)計 上面為開始主程序，在該頁面進行高程控制網(wǎng)平差，點擊平面控制啟動下面的程序頁面進行平面控制網(wǎng)平差。2、 功能設(shè)計通過菜單實現(xiàn)程序的各個功能，通過菜單啟動common dialog control控件輸入txt文檔，讀取txt里面的高程或平面控制網(wǎng)數(shù)據(jù)，然后點擊各個計算菜單進行平差計算二、算法及代碼實現(xiàn)1、form1代碼：dim strfilename as stringdim nn%, un%, tn%, hn% 已知點個數(shù)，未知點個數(shù)，總點數(shù)，觀

2、測值個數(shù)dim pname() as string 點名數(shù)組dim hknown() as double 已知高程數(shù)組，存放已知點高程和高程近似值dim be%(), en%() 觀測值的起點和終點編號數(shù)組，存儲的是點序號dim h#(), s#() 高差觀測值數(shù)組和距離觀測值數(shù)組dim a#(), x#(), p#(), l#() 間接平差的系數(shù)陣、解向量、權(quán)陣和常數(shù)向量高程平差計算private sub mnuadj_click() dim i%, j% redim x(1 to un) inadjust a, p, l, x 調(diào)用間接平差的通用過程求解 計算并顯示高程平差結(jié)果 txtsh

3、ow.text = txtshow.text & 平差計算結(jié)果： & vbcrlf txtshow.text = txtshow.text & 點號 初始高程(m) 高程改正數(shù)(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) & &

4、 format(hknown(nn + i), 0.0000) & vbcrlf next i txtshow.text = txtshow.text & vbcrlf 計算并顯示單位權(quán)中誤差-精度評定部分應(yīng)該也包含在間接平差模塊里，一起來調(diào)用 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_clic

5、k() 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 若終點未知，則給終點對應(yīng)的系數(shù)矩陣元素賦值 if be(i) nn then a(i, be(i) - nn) = -1 若起點未知，則給起點對應(yīng)的系數(shù)矩陣元素賦值 l(i) = -(hknown(en(i) - hknown(be(i) - h(i) 根據(jù)起終點計算常數(shù)項 p(i, i) = 1 / s(i) 以距離

6、的倒數(shù)為權(quán) 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 & 權(quán)矩陣： & vbcrlf for i = 1 to hn for j = 1 to hn txtshow.

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

8、 be(j) nn + i then 找到一個終點相同且起點已知的觀測值 hknown(nn + i) = hknown(be(j) + h(j) exit for end if next j next i 顯示近似高程計算結(jié)果 txtshow.text = txtshow.text & 近似高程計算結(jié)果： & 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

9、mnuhopen_click() dim i as integer 循環(huán)變量 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 讀入已知點個數(shù)，未知點個數(shù)，觀測值個數(shù) tn = nn + un redim pname(1 to tn), hkno

10、wn(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) 給起終點數(shù)組排序 next i 顯示讀入的數(shù)據(jù) txtshow.tex

11、t = txtshow.text & 讀入的水準(zhǔn)網(wǎng)數(shù)據(jù)： & vbcrlf txtshow.text = txtshow.text & 已知點 & nn & 個，未知點 & un & 個，觀測值 & hn & 個。 & vbcrlf txtshow.text = txtshow.text & 網(wǎng)中涉及的點名有： for i = 1 to tn txtshow.text = txtshow.text & pname(i) & ， next i txtshow.text = txtshow.text & vbcrlf txtshow.text = txtshow.text & 已知點高程為： &

12、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(

13、i), 0.000) & & format(s(i), 0.000) & vbcrlf next i close #1 不要忘記關(guān)閉文件end sub點名序號轉(zhuǎn)換函數(shù)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程序退出時檢查是否已保存結(jié)果private sub form_unload(cancel as integer) if txtshow.text then d

14、im imsg% imsg = msgbox(是否保存計算結(jié)果？, vbyesnocancel, 注意保存！) if imsg = vbyes then mnusave_click if imsg = vbcancel then cancel = true end ifend sub保存計算結(jié)果private sub mnusave_click() dim imsg%resave: cdg1.filename = : cdg1.filter = text files(*.txt)|*.txt cdg1.action = 2 strfilename = cdg1.filename if strf

15、ilename = 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

16、 dim net%, nn%, un%, tn% 網(wǎng)的類型，已知點個數(shù)，未知點個數(shù)，總點數(shù) dim pname() as string 點名數(shù)組，大小為tn dim x0#(), y0#() 已知點坐標(biāo)及未知點近似坐標(biāo)，大小為tn dim x#(), y#() 已知點坐標(biāo)及未知點平差坐標(biāo)，大小為tn dim n500% 記錄y坐標(biāo)的帶號，讀入數(shù)據(jù)時減該常數(shù)，輸出數(shù)據(jù)時加 dim ne%, nd% 邊長觀測值個數(shù)，方向觀測值個數(shù) dim mm#, pp# 邊長觀測值的固定誤差和比例誤差，單位為mm和ppm dim be%(), ee%(), s#() 邊長觀測值的起點、終點、邊長 dim md#

17、, dir0#(), dir#() 方向中誤差，原始方向數(shù)組和排序后的方向數(shù)組 dim bd0%(), ed0%(), bd%(), ed%() 方向起終點原始數(shù)組和排序后的數(shù)組 dim si%(), ni%() 統(tǒng)計總的方向數(shù)和每個測站的方向數(shù) dim aa%(), bb%(), cc%() 近似坐標(biāo)的計算路線，個數(shù)與未知點個數(shù)相同 dim pa#(700, 9), pa3#(200, 40), w#(400) 誤差方程系數(shù)（壓縮方式存放）和常數(shù)向量 dim ql#(700), qls#(200) 誤差方程權(quán)和虛擬誤差方程的權(quán) dim q(100, 100) as double 協(xié)方差陣，q

18、=n(-1) dim uw0# 單位權(quán)中誤差 dim strfilename as string檢查數(shù)據(jù)并將點名轉(zhuǎn)換為序號第一個參數(shù)是要檢查的點名，第二個參數(shù)是得到的序號；返回值是錯誤號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

19、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 - 1

20、030 txtshow.left = 120 txtshow.top = 120end sub退出程序private sub mnuexit_click() endend sub計算近似坐標(biāo)private sub mnucalccoor_click() screen.mousepointer = 13 dim i%, j%, k% 循環(huán)變量 if net = 1 then 按邊長計算近似坐標(biāo)：使用前方交會方法 dim sa#, sb#, sc#, al#, bl#, cl# 三角形邊長和三個內(nèi)角 for i = 1 to un sc = distab(x0(aa(i), y0(aa(i), x

21、0(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) 求三角形三個內(nèi)角 調(diào)用前方交會程序計算待定點坐標(biāo) forintersec x0(a

22、a(i), y0(aa(i), x0(bb(i), y0(bb(i), al, bl, x0(cc(i), y0(cc(i) next i 顯示計算結(jié)果 open app.path & 按邊長計算近似坐標(biāo).txt for output as #1 print #1, 按邊長計算近似坐標(biāo)： txtshow.text = txtshow.text & 按邊長計算近似坐標(biāo)： & vbcrlf for i = nn + 1 to tn print #1, pname(i), format(x0(i), 0.0000), format(y0(i), 0.0000) txtshow.text = txts

23、how.text & pname(i) & , & format(x0(i), 0.0000) & , & format(y0(i), 0.0000) & vbcrlf next i close #1 end if if net = 2 then 根據(jù)方向觀測值計算近似坐標(biāo)：使用前方交會方法 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 調(diào)用前方交會程序計算待定點坐標(biāo) forintersec x0(aa

24、(i), y0(aa(i), x0(bb(i), y0(bb(i), ta, tb, x0(cc(i), y0(cc(i) next i open app.path & 按方向計算近似坐標(biāo).txt for output as #1 print #1, 按方向計算近似坐標(biāo)： txtshow.text = txtshow.text & 按方向計算近似坐標(biāo)： & 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

25、 & pname(i) & , & format(x0(i), 0.0000) & , & format(y0(i), 0.0000) & vbcrlf next i close #1 end if if net 2 then 根據(jù)邊角條件計算近似坐標(biāo)：使用極坐標(biāo)方法 dim dbls#, dbla#, dbld# 極坐標(biāo)方法中的邊長、夾角、方位角 dim dir1#, dir2#, bf as boolean 兩個臨時的方向，一個邏輯開關(guān) for i = nn + 1 to tn for j = si(i) to si(i) + ni(i) - 1 if ed(j) i then 如果搜索要

26、用到的邊長和方向值，則根據(jù)極坐標(biāo)法計算待丁點坐標(biāo) 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 調(diào)用極坐標(biāo)方法求點的坐標(biāo) polarpositioning x0(ed(k), y0(ed(k), x0(ed(j),

27、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 & 按全邊角網(wǎng)計算近似坐標(biāo)(m): & vbcrlf open app.path & 按全邊角網(wǎng)計算近似坐標(biāo).txt for output as #1 print #1, 按全邊角網(wǎng)計算近似坐標(biāo)(m)： for i = nn + 1 to tn print #1, pname(i), format(x0(i), 0.0000),

28、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% 循環(huán)變量 foundsid = false for k = 1 to ne if

29、 (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% 循環(huán)變量 founddir1 = false for k = si(benode) to si(benode) + ni(benod

30、e) - 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% 循環(huán)變量 founddir2 = false for k = si(benode) to si(benode) + ni(benode) - 1 if ed(k) 0 then 如果有邊長觀測值，那么讀入邊長觀測值 inpu

31、t #1, mm, pp 輸入邊長精度：固定誤差和比例誤差 txtshow.text = txtshow.text & 邊長固定誤差 & format(mm, 0.00) & mm,比例誤差 & str(pp) & ppm。 & vbcrlf redim be(ne), ee(ne), s(ne) 聲明邊數(shù)組大小 for i = 1 to ne 輸入邊長有關(guān)信息 input #1, strt1, strt2, s(i) err1 = chkdata(strt1, be(i) 檢查起點并計算起點序號 err2 = chkdata(strt2, ee(i) 檢查終點并計算終點序號 txtshow

32、= txtshow & be( & i & )= & pname(be(i) & , & ee( & i & )= & pname(ee(i) & , & s( & i & )= & str(s(i) & , & vbcrlf next i 讀入的邊長數(shù)據(jù)寫入文件，并做檢查 open app.path & 邊長觀測值數(shù)據(jù).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

33、 & )=; 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 msgb

34、ox 邊長輸入錯誤, 1, 出錯 end if if nd 0 then 如果有方向觀測值，那么讀入方向觀測值 dim ii%, ik% 輔助循環(huán)變量 input #1, md 讀入方向中誤差 txtshow.text = txtshow.text & 方向中誤差： & str(md) & vbcrlf redim bd(1 to nd), ed(1 to nd), dir(nd) 聲明方向數(shù)組大小 redim si(nd), ni(nd) 聲明測站測回數(shù)數(shù)組的大小 redim bd0(nd), ed0(nd), dir0(nd) 聲明輔助方向數(shù)組大小 for i = 1 to nd inpu

35、t #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 讀入的方向數(shù)據(jù)寫入文件并檢查 open app.path & 方向觀測值數(shù)據(jù).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) = dotoh