VB坐标转换程序设计

1、option explicitdim k2#, e2#, dx2#, dy2# dim x2#, xx2#, y2#, yy2# dim k3#, ex#, ey#, ez#, dx3#, dy3#, dz3# dim x3#, y3#, z3#, xx3#, yy3#, zz3# const pi = 3.14159265358979private sub check1_click() if check1.value = 1 then frmcoortrans.height = 5175 elseif check1.value = 0 then frmcoortrans.height = 4

2、440 end ifend subprivate sub cmdbrowfile_click() cdg1.filter = 控制点文件 (*.gcp)|*.gcp|所有文件 (*.*)|*.* cdg1.action = 1 txtfilename.text = cdg1.filenameend subprivate sub cmdcalc_click() dim s as string, ipos%, i%, icent! dim n%, x1#(), y1#(), x2#(), y2#() dim a() as double, l() as double, x(1 to 4) as do

3、uble dim at#(), naa#(), w#() open txtfilename.text for input as #1 line input #1, s n = val(s) redim x1#(n), y1#(n), x2#(n), y2#(n) for i = 1 to n line input #1, s ipos = instr(s, ,) x1(i) = val(left(s, ipos - 1) s = mid(s, ipos + 1) ipos = instr(s, ,) y1(i) = val(left(s, ipos - 1) s = mid(s, ipos +

4、 1) ipos = instr(s, ,) x2(i) = val(left(s, ipos - 1) s = mid(s, ipos + 1) y2(i) = val(s) next i close #1 计算转换参数 redim a(1 to 2 * n, 1 to 4) as double, l(1 to 2 * n) as double redim at(1 to 4, 1 to 2 * n), naa(1 to 4, 1 to 4), w(1 to 4) debug.print 系数矩阵a：for i = 1 to n a(2 * i - 1, 1) = 1: a(2 * i -

5、1, 2) = 0: a(2 * i - 1, 3) = x1(i): a(2 * i - 1, 4) = y1(i) debug.print a(2 * i - 1, 1), a(2 * i - 1, 2), a(2 * i - 1, 3), a(2 * i - 1, 4) a(2 * i, 1) = 0: a(2 * i, 2) = 1: a(2 * i, 3) = y1(i): a(2 * i, 4) = -x1(i) debug.print a(2 * i, 1), a(2 * i, 2), a(2 * i, 3), a(2 * i, 4) l(2 * i - 1) = x2(i):

6、l(2 * i) = y2(i) next i debug.print 常数向量l： for i = 1 to 2 * n debug.print l(i) next i matrixtrans a, at debug.print a的转置矩阵： showmatrix at matrix_multy naa, at, a debug.print naa： showmatrix naa matrix_multy w, at, l debug.print w： for i = 1 to 4 debug.print w(i) next i majorincolguass naa, w, x debu

7、g.print x for i = 1 to 4 debug.print x(i) next i 分离旋转和尺度参数 if abs(x(3) 0 then e2 = pi / 2 else e2 = pi * 3 / 2 end if else e2 = atn(x(4) / x(3) 得到的是弧度 if x(3) 0 then e2 = pi - e2 elseif x(3) 0 and x(4) 0 and x(4) 0 then e2 = pi * 2 + e2 end if end if k2 = x(3) / cos(e2) 将转换参数写入相应文本框 txtk2 = str(k2 -

8、 1) e2 = e2 * 180 / pi dim du%, fen% du = int(e2): e2 = (e2 - du) * 60 fen = int(e2): e2 = (e2 - fen) * 60 e2 = val(format(e2, 0.00) e2 = du + fen / 100# + e2 / 10000 txte2 = str(e2) txtdx2.text = str(x(1) txtdy2.text = str(x(2)end subprivate sub cmdcalc2_click() k2 = val(txtk2.text) e2 = val(txte2.

9、text) e2 = dotohu(e2) dx2 = val(txtdx2.text) dy2 = val(txtdy2.text) x2 = val(txtx2.text) y2 = val(txty2.text) xx2 = (k2 + 1) * (x2 * cos(e2) + y2 * sin(e2) + dx2 yy2 = (k2 + 1) * (y2 * cos(e2) - x2 * sin(e2) + dy2 txtxx2.text = format(xx2, 0.0000) txtyy2.text = format(yy2, 0.0000)end subprivate sub

10、cmdcalc3_click() k3 = val(txtk3.text) ex = val(txtex.text) ex = dotohu(ex) ey = val(txtey.text) ey = dotohu(ey) ez = val(txtez.text) ez = dotohu(ez) dx3 = val(txtdx3.text) dy3 = val(txtdy3.text) dz3 = val(txtdz3.text) x3 = val(txtx3.text) y3 = val(txty3.text) z3 = val(txtz3.text) xx3 = (k3 + 1) * (x

11、3 * cos(ey) * cos(ez) + y3 * cos(ey) * sin(ez) - z3 * sin(ey) + dx3 yy3 = (k3 + 1) * (x3 * (-cos(ex) * sin(ez) + sin(ex) * sin(ey) * cos(ez) + y3 * (cos(ex) * cos(ez) + sin(ex) * sin(ey) * sin(ez) + z3 * (sin(ex) * cos(ey) + dy3 zz3 = (k3 + 1) * (x3 * (sin(ex) * sin(ez) + cos(ex) * sin(ey) * cos(ez)

12、 + y3 * (-sin(ex) * cos(ez) + cos(ex) * sin(ey) * sin(ez) + z3 * (cos(ex) * cos(ey) + dz3 txtxx3.text = format(xx3, 0.0000) txtyy3.text = format(yy3, 0.0000) txtzz3.text = format(zz3, 0.0000)end subprivate sub cmdclear2_click() txtx2.text = txty2.text = txtxx2.text = txtyy2.text = end subprivate sub

13、 cmdclear3_click() txtx3.text = txty3.text = txtz3.text = txtxx3.text = txtyy3.text = txtzz3.text = end subprivate sub cmdconcalc2_click() k2 = val(txtk2.text) e2 = val(txte2.text) e2 = dotohu(e2) dx2 = val(txtdx2.text) dy2 = val(txtdy2.text) xx2 = val(txtxx2.text) yy2 = val(txtyy2.text) x2 = (xx2 -

14、 dx2) * cos(e2) - (yy2 - dy2) * sin(e2) / (k2 + 1) y2 = (yy2 - dy2) * cos(e2) + (xx2 - dx2) * sin(e2) / (k2 + 1) txtx2.text = format(x2, 0.0000) txty2.text = format(y2, 0.0000)end subprivate sub cmdconcalc3_click() k3 = val(txtk3.text) ex = val(txtex.text) ex = dotohu(ex) ey = val(txtey.text) ey = d

15、otohu(ey) ez = val(txtez.text) ez = dotohu(ez) dx3 = val(txtdx3.text) dy3 = val(txtdy3.text) dz3 = val(txtdz3.text) xx3 = val(txtxx3.text) yy3 = val(txtyy3.text) zz3 = val(txtzz3.text) x3 = (xx3 - dx3) * cos(ey) * cos(ez) + (yy3 - dy3) * (-cos(ex) * sin(ez) + sin(ex) * sin(ey) * cos(ez) + (zz3 - dz3

16、) * (sin(ex) * sin(ez) + cos(ex) * sin(ey) * cos(ez) / (k3 + 1) y3 = (xx3 - dx3) * cos(ey) * sin(ez) + (yy3 - dy3) * (sin(ex) * sin(ey) * sin(ez) + cos(ex) * cos(ez) + (zz3 - dz3) * (-sin(ex) * cos(ez) + cos(ex) * sin(ey) * sin(ez) / (k3 + 1) z3 = (xx3 - dx3) * (-sin(ey) + (yy3 - dy3) * sin(ex) * co

17、s(ey) + (zz3 - dz3) * (cos(ex) * cos(ey) / (k3 + 1) txtx3.text = format(x3, 0.0000) txty3.text = format(y3, 0.0000) txtz3.text = format(z3, 0.0000)end subprivate sub cmdexit_click() endend subprivate sub form_load() frmcoortrans.height = 4440end sub弧度化为度.分秒的形式：输入弧度值，输出度.分秒（各占两位）public function hutod

18、o(byval hu as double) as single dim du%, fen%, miao% hu = hu * 180 / pi du = fix(hu) hu = (hu - du) * 60 fen = fix(hu) hu = (hu - fen) * 60 miao = fix(hu + 0.5) if miao = 60 then fen = fen + 1 miao = 0 end if hutodo = du + fen / 100 + miao / 10000end function将度.分秒形式化为弧度：输入为度.分秒形式，输出为弧度public functio

19、n dotohu(byval dofenmiao as double) as single dim du%, fen%, miao%, angle# du = fix(dofenmiao) dofenmiao = (dofenmiao - du) * 100 fen = fix(dofenmiao) miao = (dofenmiao - fen) * 100 angle = du + fen / 60 + miao / 3600 dotohu = angle * pi / 180end function矩阵转置的通用过程public sub matrixtrans(a, at) dim i%

20、, j% dim r1%, c1% on error resume next c1 = ubound(a, 2) - lbound(a, 2) + 1 if err then msgbox 输入的矩阵维数不对！ exit sub end if r1 = ubound(a, 1) - lbound(a, 1) + 1 redim c(1 to c1, 1 to r1) for i = 1 to r1 for j = 1 to c1 at(j, i) = a(i, j) next j next iend sub矩阵相乘：输入矩阵或数qa、qb，自动识别它们的维数，并输出它们的乘积qnpublic

21、sub matrix_multy(qn, qa, qb) dim ia%, ib%, ic% dim ai%, bi%, ci% dim e1 as boolean, e2 as boolean, e3 as boolean, e4 as boolean, e5 as boolean, e6 as boolean, e7 as boolean on error resume next 看qa是不是一维数组 ic = ubound(qa, 2) - lbound(qa, 2) if err then e1 = true on error resume next 看qa是不是一维数组 ib = u

22、bound(qb, 2) - lbound(qb, 2) if err then e2 = true if e1 = false and e2 = false then 二维矩阵相乘 for ai = lbound(qa, 1) to ubound(qa, 1) for bi = lbound(qb, 2) to ubound(qb, 2) for ci = lbound(qa, 2) to ubound(qa, 2) qn(ai, bi) = qn(ai, bi) + qa(ai, ci) * qb(ci, bi) next ci next bi next ai elseif e1 = tr

23、ue and e2 = false then on error resume next ia = ubound(qa) - lbound(qa) if err then e6 = true if e6 then 数乘以二维矩阵 for ai = lbound(qb, 1) to ubound(qb, 1) for bi = lbound(qb, 2) to ubound(qb, 2) qn(ai, bi) = qa * qb(ai, bi) next bi next ai else 一维矩阵乘以二维矩阵 for ci = lbound(qb, 2) to ubound(qb, 2) for a

24、i = lbound(qa, 1) to ubound(qa, 1) qn(ci) = qn(ci) + qa(ai) * qb(ai, ci) next ai next ci end if elseif e1 = false and e2 = true then on error resume next ic = ubound(qb) - lbound(qb) if err then e7 = true if e7 then 二维矩阵乘以数 for ai = lbound(qa, 1) to ubound(qa, 1) for bi = lbound(qa, 2) to ubound(qa,

25、 2) qn(ai, bi) = qa(ai, bi) * qb next bi next ai else 二维矩阵乘以一维矩阵 for ai = lbound(qa, 1) to ubound(qa, 1) for bi = lbound(qa, 2) to ubound(qa, 2) qn(ai) = qn(ai) + qa(ai, bi) * qb(bi) next bi next ai end if else dim errt as integer on error resume next 结果是否是一个数 errt = ubound(qn) if err then e3 = true

26、 if e3 then 一维矩阵乘以一维矩阵得一个数 for ai = lbound(qa, 1) to ubound(qa, 1) for bi = lbound(qa, 2) to ubound(qa, 2) qn = qn + qa(ai) * qb(bi) next bi next ai exit sub end if on error resume next 是否是数乘一维矩阵 ia = ubound(qa) - lbound(qa) if err then e4 = true if e4 then for bi = lbound(qa, 2) to ubound(qa, 2) qn

27、(bi) = qa * qb(bi) next bi exit sub end if on error resume next 是否是一维矩阵乘数 ib = ubound(qb) - lbound(qb) if err then e5 = true if e5 then for ai = lbound(qa, 1) to ubound(qa, 1) qn(ai) = qa(ai) * qb next ai exit sub end if 一维矩阵相乘结果是二维矩阵 for ai = lbound(qa, 1) to ubound(qa, 1) for bi = lbound(qa, 2) to

28、 ubound(qa, 2) qn(ai, bi) = qa(ai) * qb(bi) next bi next ai end ifend subpublic sub showmatrix(tt) dim i%, j%, n%, m% m = ubound(tt, 1) - lbound(tt, 1) + 1 n = ubound(tt, 2) - lbound(tt, 2) + 1 for i = 1 to m for j = 1 to n debug.print tt(i, j), next j debug.print next iend sub列选主元法guass约化求解线性方程组pub

29、lic sub majorincolguass(a, b, x) dim row%, col%, n% 矩阵大小 dim istep%, irow%, icol% 循环变量 dim l() as double 各行的约化系数 计算并检查矩阵的大小 row = ubound(a, 1) - lbound(a, 1) + 1 col = ubound(a, 2) - lbound(a, 2) + 1 if row col then msgbox 方程组的系数矩阵有误！ exit sub end if 准备约化过程的变量和数组 n = ubound(b) - lbound(b) + 1 if n r

30、ow then msgbox 方程组的系数矩阵与常数项大小不符！ exit sub end if redim l(2 to row) as double dim sumax as double, ipos%, temp# 约化过程 for istep = 1 to n - 1 列选主元 ipos = 0 for irow = istep + 1 to n if abs(a(irow, istep) abs(a(istep, istep) then ipos = irow end if next irow if ipos istep then 需要换主元 for icol = istep to

31、n temp = a(istep, icol) a(istep, icol) = a(ipos, icol) a(ipos, icol) = temp next icol temp = b(istep) b(istep) = b(ipos) b(ipos) = temp end if 约化过程 for irow = istep + 1 to n l(irow) = a(irow, istep) / a(istep, istep) for icol = istep to n a(irow, icol) = a(irow, icol) - l(irow) * a(istep, icol) next

32、 icol b(irow) = b(irow) - l(irow) * b(istep) next irow next istep 回代过程 x(n) = b(n) / a(n, n) for irow = n - 1 to 1 step -1 sumax = 0 for icol = n to irow + 1 step -1 sumax = sumax + a(irow, icol) * x(icol) next icol x(irow) = (b(irow) - sumax) / a(irow, irow) next irowend suboption explicitdim imark

33、% 测站计数器dim dist!, dh!private sub cmdcancel_click() 清除已经传给主窗体的数据 dim i% for i = 1 to imark dis(i) = 0 deth(i) = 0 next i 清除主窗体的显示 frmmain.txtshowresult.text = 水准计算结果: 卸载输入窗体 unload meend subprivate sub cmdok_click() dist = val(txtdist.text) dh = val(txtdeth.text) call adddata(imark, dist, dh) 在主窗体显示本

34、站数据 frmmain.txtshowresult = frmmain.txtshowresult & 第 & str(imark) & 站： & vbcrlf frmmain.txtshowresult = frmmain.txtshowresult & 距离： & dis(imark) & 高差中数： & deth(imark) & vbcrlf if imark = nmarks then 如果已经输入完所有的测站观测值 frminput.hide else 若还没有输完，初始化输入界面输入下一个测站 txtdist.text = txtdeth.text = txtdist.setfo

35、cus end if frminput.caption = 观测数据输入：第 & trim(str(imark) & 站 imark = imark + 1 测站数加1end subprivate sub form_load() imark = 1end suboption explicitdim imark% 测站计数器dim dist!, dh!private sub cmdcancel_click() 清除已经传给主窗体的数据 dim i% for i = 1 to imark dis(i) = 0 deth(i) = 0 next i 清除主窗体的显示 frmmain.txtshowr

36、esult.text = 水准计算结果: 卸载输入窗体 unload meend subprivate sub cmdok_click() dist = val(txtdist.text) dh = val(txtdeth.text) call adddata(imark, dist, dh) 在主窗体显示本站数据 frmmain.txtshowresult = frmmain.txtshowresult & 第 & str(imark) & 站： & vbcrlf frmmain.txtshowresult = frmmain.txtshowresult & 距离： & dis(imark)

37、 & 高差中数： & deth(imark) & vbcrlf if imark = nmarks then 如果已经输入完所有的测站观测值 frminput.hide else 若还没有输完，初始化输入界面输入下一个测站 txtdist.text = txtdeth.text = txtdist.setfocus end if frminput.caption = 观测数据输入：第 & trim(str(imark) & 站 imark = imark + 1 测站数加1end subprivate sub form_load() imark = 1end suboption explici

38、toption base 1 dim sangle() as double, sdangle() as double, sedge() as double dim detx() as double, dety() as double, rex() as double, rey() as double dim strfilename as string dim itype%, xa#, ya#, xb#, yb#, xc#, yc#, xd#, yd# dim istation as integer dim deta as double 角度闭合差 dim dettx#, detty#, det

39、tt#, tedge# x坐标闭合差、y坐标闭合差、总体闭合差、路线长 const pi = 3.141592653 private sub mnuabout_click() form2.show 1end subprivate sub mnucalc_click() 计算坐标方位角 dim aab#, adc# dim i% aab = directab(xa, ya, xb, yb) txtshow.text = txtshow.text & vbcrlf & 起始坐标方位角 & format(hutodo(aab), 0.0000) if itype = 1 then adc = dir

40、ectab(xc, yc, xd, yd) txtshow.text = txtshow.text & vbcrlf & 终止坐标方位角 & format(hutodo(adc), 0.0000) else txtshow.text = txtshow.text & vbcrlf & 终止坐标方位角 & format(hutodo(aab), 0.0000) end if 推算坐标方位角，把推算得到的方位角初值给sdangle数组 sdangle(1) = aab txtshow.text = txtshow.text & vbcrlf & 方位角初值： & vbcrlf for i = 1

41、to istation sdangle(i + 1) = sdangle(i) + pi - sangle(i) txtshow.text = txtshow.text & format(hutodo(sdangle(i), 0.0000) & , next i txtshow.text = txtshow.text & format(hutodo(sdangle(i), 0.0000) & vbcrlf 计算角度闭合差 if itype = 1 then deta = sdangle(i) - adc else deta = sdangle(i) - aab end if txtshow.t

42、ext = txtshow.text & format(hutodo(deta), 0.0000) & vbcrlf 判断是否附合限差要求 if deta int(40 * sqr(istation) then msgbox 角度闭合差超限！, , 计算终止 txtshow.text = txtshow.text & vbcrlf & 角度闭合差超限，计算终止！ exit sub end if 若没有超限，则分配角度闭合差，重新计算角度值和推算坐标方位角 deta = deta / istation 简单地平均分配角度值了，后面对秒进行四舍五入处理 txtshow.text = txtshow

43、.text & 改正后的角度： & vbcrlf for i = 1 to istation sangle(i) = sangle(i) + deta txtshow.text = txtshow.text & format(hutodo(sangle(i), 0.0000) & , sdangle(i) = sdangle(i) + deta * (i - 1) next i txtshow.text = txtshow.text & vbcrlf & 改正后的方位角： & vbcrlf for i = 1 to istation txtshow.text = txtshow.text &

44、format(hutodo(sdangle(i), 0.0000) & , next i txtshow.text = txtshow.text & vbcrlf 计算初始坐标增量 txtshow.text = txtshow.text & 坐标增量初值： & vbcrlf for i = 2 to istation detx(i - 1) = sedge(i - 1) * cos(sdangle(i) txtshow.text = txtshow.text & format(detx(i - 1), 0.000) & , dety(i - 1) = sedge(i - 1) * sin(sdangle(i) txtshow.text = txtshow.text & format(dety(i - 1), 0.000) & ; next i txtshow.text = txtshow.text & vbcrlf 计算坐标闭合差 rex(1) = xb: rey(1) = yb: tedge = 0 for i = 2 to ist