用(VB)实现测量坐标转换系统
VB在坐标转换软件开发中的应用
1 引言 测
在 测 量 领 域 存 在 多 种 坐 标 系 统 , 需 要 将 不 同坐 标 系 统 的 坐 常 标数 据 进 行 转 换 , 如大 地 坐 标 和 平 面坐 标 的正 反 换 算 、 标 的 换 代 坐 计算 、 四参 数 和 七参 数 的 计 算 。 手工 计 算 费 时 费 力 , 确性 不高 , 准 随 着计算机 软硬件的发展 , 方便编制应 用程序进 行轻松计算 , 可 方 便 、 捷 地 得 到 成 果 。 者 多 年 的从 事 测 量 工 作 , 用 V 快 笔 利 B语 言结 合 测 量 知 识 , 功 编 制 了坐 标 转 换 软 件 , 繁 琐 的 坐 标 计 算 变 得 简 成 使 单 , 实 际 工 作 中发 挥 了大 作 用 。 在
∞
’
m X 1 = 一 × i ’ × OO x s n口一 CS'
、
2 解决方案设计
大 地 坐 标 和 平 面 坐标 的正 反换 算 模 块 主 要 包 括 大 地 坐 标 向 平 面坐 标 的 转 换 和 平 面坐 标 向 大 地 坐 标 的 转 换 。 要 指 的是 同 椭 球 主 和 不 同 椭 球 间 经 纬度 和 平 面坐 标 的 正 反 算 , 球 包 括 北京 5 椭球 、 椭 4
西 安8 椭球 , S 4 球 和 C S 0 0 0 WG 8 椭 GC 2 0 椭球 。 坐 标 的 换 代 计 算 模块 包 括 同 椭 球 和 不 同椭 球 间 换 代 计 算 , 主 要指 的是 6 带 、 度带 、 . 度 带 和 任 意 度 带 的坐 标 相 互 转 换 。 度 3 15 四 参 数 和 七 参数 计 算 模 块 是 不 同 工 程 坐 标 系 间 的 常 用 转 换 , 当工 程 区 域 比 较 小 时 使 用 四 参 数 , 工 程 区 域 比 较 大 时 使 用 七 参 当 数 。 参 数 可进 行 平 面 坐 标 间 转 换 , 参 数 可 进 行 三维 坐 标 间转 四 七
用(VB)实现测量坐标转换系统
⽤(VB)实现测量坐标转换系统坐标转换系统(VB)东华理⼯⼤学Theory 北京54⾼斯坐标转换西安80⾼斯坐标转换系统1.0版多点处理结果核⼼源代码:'⾼斯坐标转换成⼤地坐标过程Public Sub GausReverse(a As Double, f As Double, x() As Double, y() As Double, RB() As Double, RL() As Double, k As Integer)Dim i As Integer, fxb As Double, fxbl As Double, fybl As Doublee = Sqr(2 *f - f ^ 2)C = a / Sqr(1 - e ^ 2)e2 = e / Sqr(1 - e ^ 2)beita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kB0 = x(i) / (C * beita0)Dofxb = 0fxbl = 0fybl = 0t = Tan(B0)yita = e2 * Cos(B0)n = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)a2 = (1 / 2) * n * Sin(B0) * Cos(B0)a3 = (1 / 6) * n * (Cos(B0)) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(B0) * (Cos(B0)) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4)a5 = (1 / 120) * n * (Cos(B0)) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2) a6 = (1 / 720) * n * Sin(B0) * (Cos(B0)) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = fxb + (C * beita6 + C * beita8 * (Cos(B0)) ^ 2) * (Cos(B0)) ^ 2fxb = (fxb + C * beita4) * (Cos(B0)) ^ 2fxb = (fxb + C * beita2) * Sin(B0) * Cos(B0)fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5RB(i) = (x(i) - fxb - fxbl) / (C * beita0)a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))RL(i) = (y(i) - fybl) / a1If Abs(RB(i) - B0) <= 0.0000000001 And Abs(RL(i) - l0) <= 0.0000000001 ThenRL(i) = zrl + l0Exit DoElseB0 = RB(i)l0 = RL(i)End IfLoopNext iEnd Sub'⼤地坐标B,L转换为⾼斯坐标x,y的过程Public Sub BLHGaus(RB() As Double, RL() As Double, GX() As Double, GY() As Double, a As Double, f As Double, k As Integer)Dim l0 As Double, fxb As Double, gxbl As Double, fybl As Doublebeita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kl0 = RL(i) - zrln = a / Sqr(1 - e ^ 2 * (Sin(RB(i))) ^ 2)t = Tan(RB(i))yita = e2 * Cos(RB(i))a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))a2 = (1 / 2) * n * Sin(RB(i)) * Cos(RB(i))a3 = (1 / 6) * n * (Cos(RB(i))) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4) a5 = (1 / 120) * n * (Cos(RB(i))) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2)a6 = (1 / 720) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = 0fxbl = 0fybl = 0fxb = fxb + (C * beita6 + C * beita8 * (Cos(RB(i))) ^ 2) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita4) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita2) * Sin(RB(i)) * Cos(RB(i))fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5GX(i) = C * beita0 * RB(i) + fxb + fxblGY(i) = a1 * l0 + fyblNext iEnd Sub'三维直⾓坐标XYZ转换成⼤地坐标BLH过程Public Sub BLHXYZ1(SX() As Double, SY() As Double, SZ() As Double, RB() As Double, RL() As Double, RH() As Double, k As Integer, a As Double, f As Double)Dim i As IntegerDim N0 As Double, H0 As Double, B0 As Double, sb As Double, Ni As Doublesb = a * Sqr(1 - e ^ 2)pi = 4 * Atn(1)For i = 1 To kRL(i) = Atn(Abs(SY(i) / SX(i)))If SY(i) > 0 And SX(i) < 0 ThenRL(i) = pi - RL(i)End IfN0 = aH0 = Sqr(SX(i) ^ 2 + SY(i) ^ 2 + SZ(i) ^ 2) - Sqr(a * sb)B0 = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * N0 / (N0 + H0))))DoNi = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)RH(i) = Sqr(SX(i) ^ 2 + SY(i) ^ 2) / Cos(B0) - NiRB(i) = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * Ni / (Ni + RH(i)))))If Abs(RB(i) - B0) < 0.0000000001 And Abs(RH(i) - H0) < 0.0000000001 ThenExit DoElseB0 = RB(i)H0 = RH(i)End IfLoopNext iEnd Sub'最⼩⼆乘法求解七参数布尔萨模型Public Sub SloveBuersa(XD() As Double, XG() As Double, R() As Double, k As Integer) Dim a0 As Double, a1 As Double, a2 As DoubleFor i = 1 To ka0 = XG(i, 1)a1 = XG(i, 2)a2 = XG(i, 3)Call Cjuzhen(a0, a1, a2, G())For j = 1 To 3Next sNext jNext iFor i = 1 To kFor j = 1 To 3LC(3 * (i - 1) + j) = XD(i, j) - XG(i, j) Next jNext iFor i = 1 To 3 * kFor j = 1 To 7ET(j, i) = EC(i, j)Next jNext iFor i = 1 To 7For j = 1 To 7CTC(i, j) = 0For s = 1 To 3 * kCTC(i, j) = CTC(i, j) + ET(i, s) * EC(s, j) Next sNext jNext iFor i = 1 To 7For j = 1 To 7CTC1(i, j) = CTC(i, j)Next jNext iCall Comm.Reverse(CTC(), 7)For i = 1 To 7CTL(i) = 0For j = 1 To 3 * kCTL(i) = CTL(i) + ET(i, j) * LC(j)Next jNext iFor j = 1 To 7R(i) = R(i) + CTC(i, j) * CTL(j)Next jNext iEnd Sub'布尔萨模型系数矩阵⼀部分Public Sub Cjuzhen(x As Double, y As Double, z As Double, D() As Double) For i = 1 To 3D(i, i) = 1Next iD(1, 4) = xD(1, 5) = 0D(1, 6) = -zD(1, 7) = yD(2, 4) = yD(2, 5) = zD(2, 6) = 0D(2, 7) = -xD(3, 4) = zD(3, 5) = -yD(3, 6) = xD(3, 7) = 0End Sub'使⽤七参数求解新坐标系下的坐标Public Sub UseBuersa(XD() As Double, XG() As Double, EC() As Double, R() As Double, k As Integer) Dim a1 As Double, a2 As Double, a3 As Double, CR(1000) As DoubleFor i = 1 To ka1 = XG(i, 1)a2 = XG(i, 2)a3 = XG(i, 3)Call Cjuzhen(a1, a2, a3, G())For j = 1 To 3For s = 1 To 7EC(3 * (i - 1) + j, s) = G(j, s)Next iFor i = 1 To 3 * kCR(i) = 0For j = 1 To 7CR(i) = CR(i) + EC(i, j) * R(j)Next jNext iFor i = 1 To kFor j = 1 To 3XD(i, j) = XG(i, j) + CR(3 * (i - 1) + j)Next jNext iEnd Sub'弧度化为度分秒'弧度化成⾓度Public Sub RuJiao(ByVal rudu As Double, jiaodu As Double) Dim ja As Integer, jb As Integer, jc As Double pi = 4 * Atn(1)jiaodu = rudu * 180 / pija = Fix(jiaodu)jb = Fix((jiaodu - ja) * 60)jc = ((jiaodu - ja) * 60 - jb) * 60jiaodu = ja + jb / 100 + jc / 10000End Sub'矩阵求逆Public Sub Reverse(Ba, n%)Dim k%, K1%, j%, i%Dim C As Double, Aa(100, 200)For i = 1 To nFor j = 1 To nAa(i, j) = Ba(i, j)Next jNext iFor i = 1 To nAa(i, j + n) = 0End IfNext jNext iFor k = 1 To nFor j = k To nIf Aa(j, k) <> 0 Then GoTo 200Next jMsgBox "逆矩阵不存在": Exit Sub 200: For i = 1 To 2 * n C = Aa(k, i)Aa(k, i) = Aa(j, i)Aa(j, i) = CNext iC = 1 / Aa(k, k)For j = 1 To 2 * nAa(k, j) = C * Aa(k, j)Next jFor K1 = 1 To nIf K1 <> k ThenC = -Aa(K1, k)For j = 1 To 2 * nAa(K1, j) = Aa(K1, j) + C * Aa(k, j)Next jEnd IfNext K1Next kFor i = 1 To nFor j = n + 1 To 2 * nAa(i, j - n) = Aa(i, j)Next jNext iNext iEnd Sub'⾓度化成弧度Public Sub JiaoHu(ByVal jiaodu As Double, hudu As Double) Dim ja As Double, jb As Double, jc As Double pi = 4 * Atn(1)ja = Fix(jiaodu)jb = Fix((jiaodu - ja) * 100)jc = ((jiaodu - ja) * 100 - jb) * 100jiaodu = ja + jb / 60 + jc / 3600hudu = jiaodu * pi / 180End Sub。
基于VB的测量坐标系统转换程序设计与实现
第 14 卷第 12 期
吕翠华等 :基于 VB 的测量坐标系统转换程序设计与实现
·95·
个转换参数,至少需要 2 个公共点。通常,为减小转
对于莫洛金斯基模型,将旋转缩放中心 P(XP,
换误差,参与求解参数的公共点数量要多于最少公共 YP,Zp)的坐标取值为公共点坐标平均值 :
点数,按最小二乘原理 , 由误差方程列出法方程,通过 严密平差,解算出转换参数的最或然值 [3]。
XP
=
1 n
(XA1 + XA2 + g + XAn)
对于布尔莎模型,列出误差方程如下 :
YP
=
1 n
(YA1
+
YA2
+
g
+
YAn)
(5)
RSDX
V W
RSVXi
V W
RS1
S S
VYi
W W
=
SS0
TSVZi
W X
S0 T
0 1 0
0 0 1
XAi YAi ZAi
0 ZAi - YAi
- ZAi 0 XAi
布尔莎模型是以原坐标系原点为中心,对坐标进行旋
转、缩放和平移变换 ;莫洛金斯基模型是在测区范围
选择一参考点作为变换中心,对坐标进行旋转和缩放,
以原坐标系原点为中心进行平移变换 ;武测模型是以
原坐标系原点为中心,对坐标进行旋转和平移变换, 以测区某参考点为中心进行缩放变换 [1]。
1.1 布尔莎(Bursa)模型
RSVXi
V W
RS1
S S
VYi
W W
=
SS0
TSVZi
W X
推算坐标vb程序(带图)--测绘
Private Sub Command1_Click()Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double 'dc制作Dim a, a1, a2, a3x1 = V al(Text1.Text)y1 = Val(Text2.Text)x2 = V al(Text3.Text)y2 = Val(Text4.Text)Text5.Text = Pol(x1, y1, x2, y2)Const pi = 3.14159265358979a = 180 * Pol(x1, y1, x2, y2) / pia1 = Int(a)a2 = Int((a - a1) * 60)a3 = Int(((a - a1) * 60 - a2) * 60)Text13.Text = a1Text14.Text = a2Text15.Text = a3End SubFunction Pol(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double Dim pipi = 3.14159265359Dim dy As Doubledy = Abs(y2 - y1)If dy = 0 Thendy = 0.0000000001End IfPol = Atn((Abs(x2 - x1)) / dy)If x2 > x1 And y2 >= y1 Then '0-90ElseIf x2 < x1 And y2 <= y1 Then '180-270Pol = pi + PolElseIf x2 < x1 And y2 >= y1 Then '270-360Pol = 2 * pi - PolElseIf x2 >= x1 And y2 <= y1 Then '90-180Pol = pi - PolEnd IfEnd FunctionPrivate Sub Command2_Click()Dim fwj As DoubleDim hdj As DoubleDim b1, d1, juli As DoubleDim pipi = 3.14159265358979b1 = V al(Text3)d1 = V al(Text4)juli = Val(Text8)hdj = (V al(Text9.Text) + Val(Text10.Text) / 60 + V al(Text11.Text) / 60 / 60) * pi / 180 hdj = Format(hdj, "0.000000")fwj = (Text5.Text + pi - hdj)Text6.Text = Val(b1 + juli * Cos(fwj))Text7.Text = Val(d1 + juli * Sin(fwj))Text12.Text = fwja = Text12.Text * 180 / 3.14159265358979a1 = Int(a)a2 = Int((a - a1) * 60)a3 = Int(((a - a1) * 60 - a2) * 60)Text16.Text = a1Text17.Text = a2Text18.Text = a3Text7.Text = Format(Text7.Text, "0.00")Text6.Text = Format(Text6.Text, "0.00")End SubPrivate Sub Form_Load()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = ""Text6.Text = ""Text7.Text = ""Text8.Text = ""Text9.Text = ""Text10.Text = ""Text11.Text = ""Text12.Text = ""Text13.Text = "" Text14.Text = "" Text15.Text = "" Text16.Text = "" Text17.Text = "" Text18.Text = ""End Sub。
利用VB实现青海海东城市群网络RTK坐标转换
[ 1 2 ]张亚丽. 长期不同施肥对 高原农 田土壤质量和春小麦 品质 的影响 [ D] . 杨凌 : 西北农林科技大学 , 2 0 1 2 . [ 1 3 ]洪春来 , 魏幼璋 , 黄锦法 , 等. 秸秆全量直接 还 田对 土壤肥力及 农 田生态 环境 的影 响研究 [ J ] . 浙江大学学 报 : 农业与生 命科学版 ,
f i e l d e x p e r i me n t s [ J j . P l a n t a n d S o i l , 1 9 9 9, 2 1 6 : 1—1 4 .
[ 1 1 ]张亚丽 , 吕家珑 , 金继运 , 等. 施 肥和秸秆还 田对土壤肥力质量及 春小麦 品质 的影 响[ J ] . 植 物营养与肥 料学报 , 2 0 1 2, 1 8( 2) : 3 0 7—
<A h≤ 2 s的点 有 2个 , 占
总数的 5 %, 2 s<A h≤ s 的 点有 2个 , 占总数 的 5 %, A h>
92. 5% 。
的点有 1个 , 只 占总数 的 2 . 5 % 。如果
按 高程 差值 不大 于两 倍 中 误 差 计 算 , 及 A h≤ 2 s, 那 么 在 此 限差 范 围 内的 点 达 到 了 3 7个 , 占总 数 的 如 果高 程精 度 要 求 不 高 , 本软 件 不 但 可 以满 足 利用 网络 R T K测 量方 法 对 海东 地 区 1 : 5 0 0 0及 1 :
0.I 1 2 m。
计算 出 4 0个 点 的 检 查 中 误 差 为 s =±
s=4 - 0. 31 7 m。
=±
s = ±0. 1 5 8 m ,2 s=+ -0. 2 2 4 m,
基于VB的测量坐标系统的转换
GDGM-QR-03-077-A/0毕业论文Graduation Paper题目:基于VB的测量坐标系统的转换The Coordinate system Conversionbased on VB系别:测绘信息遥感工程系班级:08级(2)班学生姓名:学号:指导老师:完成日期:2011年5月14日目录目录 (3)第一章绪论 (1)第二章坐标系统 (3)2.1坐标系统简介 (3)2.1.1天球坐标系 (3)2.1.2 地球坐标系 (4)2.2参心系与地心系 (5)2.3常用的坐标系统 (6)2.3.1大地坐标系统 (6)2.3.2、WGS84坐标系 (6)2.3.3、ITRF框架 (7)2.3.4、BJ54坐标系 (8)2.3.5.XIAN80坐标系 (9)2.3.6、新BJ54坐标系 (9)2.3.7、CGCS2000坐标系统 (10)2.4地方独立坐标系 (10)第三章坐标转换的理论基础 (12)3.1大地坐标系统与空间直角坐标系统的转换原理 (12)3.2空间直角坐标系统的相互转换原理 (13)第四章基于VB的坐标转换 (15)4.1VB简介 (15)4.2系统开发语言的选择——VB6.0 (15)4.3利用VB实现空间直角坐标系统的相互转换 (17)第五章结论 (25)5.1大地坐标(BLH)对平面直角坐标(XYZ) (25)5.2北京54全国80及WGS84坐标系的相互转换 (25)5.3任意两空间坐标系的转换 (26)参考文献 (27)致谢 (28)摘要测量学是一门古老而富有生命力的学科,其应用范围很广,在国民经济和国防建设中发挥着十分重要的作用。
随着现代科技的发展,测量学也得到了迅猛的发展。
特别是计算机科学技术、航空航天科学技术、激光技术、遥感技术、图像处理技术及模式识别等的发展,对测绘科学的发展产生了巨大的推动作用。
坐标系统是测量非常重要的,测量坐标系统的种类繁多。
正是因为坐标系统的繁多,对测量工作造成了很大的影响。
利用VB实现手持GPS成果坐标系转换的方法
+ 划 ]
线性数学模型 :
X =Ax0 + XmXc s o AБайду номын сангаас-Y4 8 ̄m ̄ s n  ̄ i t Za
、
要求 出两 个坐 标 系之 间 的转 换参 数 ,需 要进 行
大量而繁琐 的计算工作,如果利用手工的计算方法, 既 费时 又 费力 , 而且 计 算 精度 也 相对 较 低 。要实 现
其余 各 点进 行 转 换 。研 究 不 同坐 标 系 统 的坐 标转 换
采 用 间接 平 差 的原理 。
N a Ar A a = P F : ATp c w V N~a F = a c
注 :A为系 数矩 阵 、A 为 A的转 置 矩 阵 ,P为 T 问题 ,主 要 是研 究 不 同 的空 间直 角 坐 标 系 的坐 标 转 权 矩 阵 ( 例 中 为 单 位 权 ) 本 ,W为 闭 合 差 矩 阵 ,V 换 问题 ,合理 确 定 两种 坐 标 系 的转 换 参数 是 非 常关 为改 正数 矩 阵 。 键 。一 般 的 是根 据 已知 的一 部分 同名 点 ( 称 公共 也 3 主要部分原代码 点 )在 两 个坐 标 系 中的坐 标 ,选 择 一 定 的计 算 方法 3 1 系数 矩阵 A和 闭合 差矩 阵 W的组 成 . 进行 解算 。 目前常 用 的 有 三点 法 、 多 点法 和严 密 平 差 法 等 多种 方 法 。在 实 际 工作 中根 据不 同的 精度 要 求 可选 假 设有 N个 同名 点, : 则
A(事 o , ) O (幸 o 2 - 2 R w 1= :A 2 R )- i
Nex Ro t w
维普资讯
l 学术研 究 0
F rR w l o N o o = T
vb坐标正算程序
VB坐标正算程序简介VB坐标正算程序是一种用于计算地理坐标的计算机程序,使用VB语言编写。
本文将深入探讨VB坐标正算程序的原理、功能以及使用方法。
原理VB坐标正算程序基于数学和地理学的原理,通过输入已知的地理坐标和相关参数,计算出目标点的地理坐标。
其原理主要包括以下几个步骤:1. 坐标系统转换VB坐标正算程序支持不同的坐标系统,如经纬度坐标、UTM坐标等。
在进行计算之前,需要将输入的坐标转换为程序所使用的统一坐标系统。
2. 大地测量模型大地测量模型是VB坐标正算程序中的核心算法,用于计算地球上两点之间的距离和方位角。
常用的大地测量模型有球面模型和椭球模型,根据实际需求选择合适的模型进行计算。
3. 参数输入在进行坐标正算之前,需要输入已知的地理坐标和相关参数。
已知的地理坐标可以是已知点的经纬度或UTM坐标,相关参数包括大地测量模型的参数、椭球模型的参数等。
4. 坐标计算根据已知的地理坐标和相关参数,通过大地测量模型进行计算,得出目标点的地理坐标。
功能VB坐标正算程序具有以下主要功能:1. 坐标系统转换VB坐标正算程序可以实现不同坐标系统之间的转换,如经纬度坐标转换为UTM坐标,UTM坐标转换为经纬度坐标等。
通过这个功能,用户可以方便地在不同坐标系统之间进行转换。
2. 大地测量计算VB坐标正算程序可以根据已知的地理坐标和相关参数,通过大地测量模型计算目标点的地理坐标。
用户只需输入已知点的坐标和相关参数,程序即可自动计算出目标点的坐标。
3. 参数设置VB坐标正算程序提供了参数设置功能,用户可以根据实际需求设置大地测量模型的参数、椭球模型的参数等。
通过参数设置,用户可以根据实际需求进行精确的坐标计算。
4. 结果输出VB坐标正算程序可以将计算结果以文本形式输出,用户可以方便地查看计算结果。
输出结果包括目标点的经纬度坐标、UTM坐标等。
使用方法以下是VB坐标正算程序的使用方法:1. 安装程序首先,用户需要将VB坐标正算程序安装到计算机上。
基于 VB 的坐标转换程序的开发
基于 VB 的坐标转换程序的开发田继成【摘要】网上免费的坐标转换软件很多,功能各异,其中COORD功能强大、使用广泛,是坐标转换软件中的杰出代表。
尽管如此,COORD在有些情况下仍不能实现一步转换。
因此,有必要开发一种能够实现一步转换的坐标转换程序。
本文以VB 6.0为开发环境,重点阐述了开发坐标转换程序的思路和算法。
程序投入运行以来,极大地提高了坐标转换工作的效率,也有利于坐标转换成果的标准化。
%There's lots of free coordinate transformation software with different functions .As an outstanding repre-sentative of the software ,COORD is powerful and widely used .But ,in some cases ,COORD still can not achieve one-step conversion .Therefore ,it is necessary to develop a coordinate transformation program to achieve one -step conversion . Based on VB 6.0,this paper focusing on the thought and algorithms of development coordinate transformation programs . It greatly improves the work efficiency of the coordinate transformation since put into operation , and conducive to the standardization of coordinate transformation results .【期刊名称】《城市勘测》【年(卷),期】2013(000)004【总页数】4页(P71-74)【关键词】坐标转换;程序设计;模块化;VB 6.0【作者】田继成【作者单位】大同市勘察测绘院,山西大同 037000【正文语种】中文【中图分类】P226+.3坐标转换问题在测量中经常遇到,计算过程较复杂,一般使用软件计算。
vb坐标正算程序
vb坐标正算程序
VB坐标正算程序是一种非常实用的工具,它可以帮助我们快速计算出某个点的坐标。
在实际工作中,我们经常需要用到这种工具,比如在地图制作、测量、建筑设计等领域。
VB坐标正算程序的实现原理是利用数学公式来计算出目标点的坐标。
具体来说,我们需要知道已知点的坐标、距离和方位角,然后根据三角函数公式来计算出目标点的坐标。
这个过程需要用到VB 语言的数学函数和逻辑运算符,因此需要一定的编程基础。
在编写VB坐标正算程序时,我们需要注意以下几点:
1. 确定计算公式:根据已知点的坐标、距离和方位角,确定计算目标点坐标的公式。
这个公式需要考虑到坐标系的不同,比如笛卡尔坐标系和极坐标系的计算公式是不同的。
2. 输入数据的格式:在编写程序时,需要考虑输入数据的格式,比如坐标的单位、距离的单位、方位角的单位等。
这些单位需要在程序中进行转换,以保证计算的准确性。
3. 界面设计:为了方便用户使用,我们需要设计一个简洁明了的界面,让用户能够方便地输入数据和查看计算结果。
界面设计需要考虑到用户的使用习惯和操作流程,以提高用户的体验。
4. 错误处理:在编写程序时,需要考虑到可能出现的错误情况,比
如输入数据错误、计算公式错误等。
我们需要在程序中加入相应的错误处理机制,以避免程序崩溃或计算结果错误。
VB坐标正算程序是一种非常实用的工具,它可以帮助我们快速计算出目标点的坐标。
在编写程序时,我们需要考虑到计算公式、输入数据的格式、界面设计和错误处理等方面,以保证程序的准确性和易用性。
VB在测量数据处理中的应用
VB在测量数据处理中的应用摘要本文主要探讨利用VB编制程序处理数据,方便数据交换和生成一些数据成果关键词VB程序设计文件类型数据格式一、引言随着计算机程序设计语言的不断发展,面向对象编程是当今程序设计的一个趋势,VB语言是一种简单易学的面向对象编程语言,本人运用它编制一些程序, 通过改变文件类型或数据格式等方式,对测量中些数据进行处理,达到转换成我们需要数据的目的,方便我们的测量工作。
我单位现在拥有Leica GPS530卫星定位系统,全站仪以及清华山维绘图及线路软件等,在工程测量中,通常需要将不同设备和软件中的数据进行相互转换,成为我们所需要的文件类型或数据格式,同时为了工作方便,还要对不同数据进行编辑修改。
如将GPS-RTK动态测量的点转入电子平板或线路软件,利用全站仪内存记录的测量点传入绘图软件等,以及在线路测量工作中将线路软件中输出的中线成果编制成中线成果表,在CAD中如何实现高程系统加减常数等问题,都可以通过VB编制一些小程序,实现数据处理的目的。
现就以下几例结合我单位的设备及工程实例,运用编制的程序处理数据,谈谈在实际中工作的体会。
二、全站仪外业数据存入内存,内业数据处理1、现势性在野外测量工作中,通常是全站仪测量数据,同时传输到绘图软件中,这样可现场成图,但是需要笔记本等设备。
有时,外业作业条件恶劣,或是笔记本等设备不能工作时,可将外业测量数据传输到仪器内存。
这样,可尽可能的缩短外业的作业时间,也可克服设备不足的弱点。
现在各种不同的绘图软件也应用于工作中,文件中,有记录操作步骤的文件,因此,有必要将全站仪内存中的数据格式转换成绘图软件中的文件的数据格式,实现数据交换,然后利用绘图软件编辑处理,完成图形。
现以全站仪TC307和清华山维EPSW98绘图软件为例说明。
2、数据处理过程将全站仪中数据传输到清华山维的软件中1)在全站仪中建工作,设置工作项目,将测量数据传输到内存中2)利用与仪器配套的数据传输软件,将数据*.gsi格式文件下载到计算机中,传输过程中注意数据格式,通常传输测量点的水平角、垂直角(天顶距)、斜距、仪器高等3)将数据传输到绘图软件中(1)文件类型转换全站仪TC307的数据格式数GSI 8位格式,文件类型为*.gsi类型,我单位采用的是清华山维EPSW98软件,记录操作步骤的数据格式文件类型为*.fld类型。
用EXCEL批量计算坐标转换
用EXCEL批量计算坐标转换在Excel中进行坐标转换,可以通过使用VBA(Visual Basic for Applications)编写宏来实现批量计算。
下面是一个示例,可以将经纬度转换为高斯投影坐标:1. 在Excel中创建一个新的工作表。
2.在第一列中输入经度值,例如A1单元格输入:经度。
3.在第二列中输入纬度值,例如B1单元格输入:纬度。
4.在第三列中输入转换后的X坐标的标题,例如C1单元格输入:高斯X坐标。
5.在第四列中输入转换后的Y坐标的标题,例如D1单元格输入:高斯Y坐标。
8.在模块中输入以下VBA代码:```vbaOption ExplicitSub ConvertCoordinatesDim ws As WorksheetDim lng As Double, lat As Double '经纬度Dim x As Double, y As Double '高斯坐标Dim i As Long'指定要处理的工作表Set ws = ThisWorkbook.Sheets("Sheet1")'从第二行开始遍历每一行For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row'读取经纬度值lng = ws.Cells(i, 1).Valuelat = ws.Cells(i, 2).Value'进行坐标转换,可以使用适当的转换算法'以下是一个示例,将经度值转换为高斯X坐标,纬度值转换为高斯Y坐标x = lng * 200y = lat * 100'将转换后的坐标值写入对应的单元格ws.Cells(i, 3).Value = xws.Cells(i, 4).Value = yNext iEnd Sub```10. 返回Excel界面,并在工作表上运行宏。
选择开发选项卡中的宏,找到ConvertCoordinates并点击运行。
基于VB的2000国家大地坐标系坐标转换程序的实现
第4 4卷 第 6期
2 01 6年 1 2月 d o i : 1 0 . 3 9 6 9 / j . i s s n . 1 0 01—3 5 8 X. 2 0 1 6 . 0 6. 0 2 0
矿 山 测 量
MI NE SURVEYI NG
Vo1 . 4 4 N0 . 6 De c . 2 01 6
S y s t e m 2 0 0 0,t h e p a pe r ,ba s e d o n VB 6. 0 p l a t ,d e v e l o p s c o mp u t i n g c o o r d i n a t e c o n v e r s i o n p r o g r a m o f Ch i n a Ge o d e t —
i c Co o r d i na t e S y s t e m 2 0 00 i n c l u d i n g p o s i t i v e Ga us s i a n c a l c u l a t i o n, i n v e r s e Ga u s s i a n c a l c u l a t i o n a n d c a l c u l a t i o n t o
t i o n a n d t h e c a l c u l a t i o n t o c o n v e r t p r o j e c t i o n z o n e a r e r e a l i z e d w i t h i n m i l l i me t e r p r e c i s i o n .A n d t h e d i r e c t m e t h o d i s
vb坐标方位角算法流程
vb坐标方位角算法流程
计算两个地点之间的方位角(或方向角)可以使用以下算法流程:
1. 获取两个地点的经纬度坐标。
假设地点A的经纬度坐标为(lonA,latA),地点B的经纬度坐标为(lonB,latB)。
2. 将经纬度坐标转换为弧度表示。
使用以下公式:
radLonA = lonA * (PI / 180)
radLatA = latA * (PI / 180)
radLonB = lonB * (PI / 180)
radLatB = latB * (PI / 180)
3. 计算方位角。
使用以下公式:
dLon = radLonB - radLonA
y = sin(dLon) * cos(radLatB)
x = cos(radLatA) * sin(radLatB) - sin(radLatA) * cos(radLatB) * cos(dLon)
angle = atan2(y, x)
4. 将方位角转换为度数表示。
使用以下公式:
angleDegrees = angle * (180 / PI) + 360 (取模 360)
注意:以上算法中,PI代表圆周率,atan2函数返回的角度范围是[-PI, PI],需转换为[0, 360]的度数表示。
这个算法可以计算地球上两个地点之间的方位角。
请注意,这只是一个简单的算法,不考虑地球的形状和其他因素,可能在极端情况下存在一定的误差。
对于更精确的计算,需要考虑使用更复杂的模型和算法。
数字摄影测量坐标转换(vb代码)
实验报告1 摄影测量坐标变换目的实现摄影测量常用坐标系之间的变换要求用VB进行编程,主要实现像空间坐标系与像辅助坐标系之间的变换方法与详细步骤界面所入空间坐标输入三个角度旋转(度分秒形式)计算旋转变换矩阵得到该点在像空间辅助坐标系中的坐标实验成果1.VB/VC原始代码Const PI As Double = 3.14159265Private Sub Command1_Click()Rem 定义数据类型Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double, z1 As Double, z2 As DoubleDim ω As Single, κ As Single, φ As SingleDim a1 As Single, a2 As Single, a3 As SingleDim b1 As Single, b2 As Single, b3 As SingleDim c1 As Single, c2 As Single, c3 As SingleRem 从text中读取数据x1 = Val(txtx1.Text): y1 = Val(txty1.Text): z1 = Val(txtz1.Text)ω= deg(Val(Txtω.Text)): κ = deg(Val(Txtκ.Text)): φ = deg(Val(Txtφ.Text)) Debug.Print φ, κ, ωRem 求解a1, a2, a3 ,b1, b2, b3,c1, c2, c3a1 = Cos(φ * PI / 180) * Cos(κ * PI / 180) - Sin(ω * PI / 180) * Sin(κ * PI / 180) * Sin(φ * PI / 180)a2 = -Cos(φ * PI / 180) * Sin(κ * PI / 180) - Sin(φ * PI / 180) * Sin(ω * PI / 180) * Cos(κ * PI / 180)a3 = -Sin(φ * PI / 180) * Cos(ω * PI / 180)b1 = Cos(ω * PI / 180) * Sin(κ * PI / 180)b2 = Cos(ω * PI / 180) * Cos(κ * PI / 180)b3 = -Sin(ω * PI / 180)c1 = Sin(φ * PI / 180) * Cos(κ * PI / 180) + Sin(ω * PI / 180) * Cos(φ * PI / 180) * Sin(κ * PI / 180)c2 = -Sin(φ * PI / 180) * Sin(κ * PI / 180) + Sin(ω * PI / 180) * Cos(φ * PI / 180) * Cos(κ * PI / 180)c3 = Cos(ω * PI / 180) * Cos(φ * PI / 180)Debug.Print a1, a2, a3Debug.Print b1, b2, b3Debug.Print b1, b1, b3Rem 定义数组Dim a(3, 3) As Singlea(1, 1) = a1: a(1, 2) = a2: a(1, 3) = a3a(2, 1) = b1: a(2, 2) = b2: a(2, 3) = b3a(3, 1) = c1: a(3, 2) = c2: a(3, 3) = c3Dim x(3, 1) As Doublex(1, 1) = x1x(2, 1) = y1x(3, 1) = z1Rem 求解Dim y(3, 1) As DoubleFor i = 1 To 3y(i, 1) = a(i, 1) * x(1, 1) + a(i, 2) * x(2, 1) + a(i, 3) * x(3, 1)Next ix2 = y(1, 1)y2 = y(2, 1)z2 = y(3, 1)Debug.Print x2, y2, z2Txtx2.Text = Format(x2, "0.000")Txty2.Text = Format(y2, "0.000")Txtz2.Text = Format(z2, "0.000")End SubRem 定义deg函数,即度分秒转换为度Private Function deg(a As Double)sign = Sgn(a)a = Abs(a) + 0.0000000001b = Int(a)c = Int((a - b) * 100)d = a - b - c / 100deg = sign * (b + c / 60 + d / 0.36)End Function➢ 2.程序运行结果图。
利用VB实现青海海东城市群网络RTK坐标转换
利用VB实现青海海东城市群网络RTK坐标转换
王永菊;赵得录
【期刊名称】《青海大学学报(自然科学版)》
【年(卷),期】2013(031)006
【摘要】本文根据大地坐标正算模型和似大地水准面模型,针对网络RTK观测的数据,利用Visual Basic 6.0程序语言工具编写了一个坐标转换程序,可以快速、精确地实现2000国家大地坐标系下平面坐标和正常高的计算.文中介绍了大地坐标到平面坐标的高斯投影正算和利用似大地水准面模型计算正常高的原理,分析了程序设计的主要流程,最后用实际算例对程序的转换效果进行了定性分析.
【总页数】8页(P78-85)
【作者】王永菊;赵得录
【作者单位】青海省第一测绘院,青海西宁810001;青海省第一测绘院,青海西宁810001
【正文语种】中文
【中图分类】TP31
【相关文献】
1.青海省东部城市群建设对海东市林业建设的新要求 [J], 贺梅年
2.青海东部城市群一次沙尘天气中PM10的模拟 [J], 谢启玉;何永晴;沈晓燕;朱宝文
3.欠发达省域城市群建设路径分析——以青海东部城市群为例 [J], 虞敏;王小梅
4.利用实现数据库字段值坐标转换 [J], 张慎平;张苏杭;施颢
5.青海东部城市群大气氨排放清单研究 [J], 张津建;李广英;张元勋;何跃君
因版权原因,仅展示原文概要,查看原文内容请购买。
vb坐标正算程序
vb坐标正算程序
VB坐标正算程序是一种用于计算点位坐标的工具,通常用于工程测量、地理信息系统等领域。
通过输入已知点的坐标和距离、方位角等数据,程序可以准确计算出目标点的坐标。
下面将详细介绍VB 坐标正算程序的使用方法和注意事项。
打开VB坐标正算程序,通常程序界面会包括输入框和计算按钮。
在输入框中,需要输入已知点的坐标、距离和方位角等数据。
确保输入的数据准确无误,否则会影响计算结果的准确性。
接下来,点击计算按钮,程序会根据输入的数据进行计算,最终显示目标点的坐标。
在计算过程中,程序会考虑各种因素,如坐标系、单位制等,确保计算结果符合实际需求。
在使用VB坐标正算程序时,需要注意以下几点:
1. 确保输入的数据准确无误,包括坐标、距离、方位角等信息。
2. 注意选择合适的坐标系和单位制,以保证计算结果的准确性。
3. 在计算过程中,及时保存已知点和目标点的数据,方便后续查阅和使用。
4. 如遇到计算结果不符合预期的情况,及时检查输入数据和计算方法,找出错误并进行修正。
总的来说,VB坐标正算程序是一种方便快捷的工具,可以帮助工程师、测量员等专业人士准确计算点位坐标。
通过正确使用该程序,
可以提高工作效率,减少人为误差,确保测量数据的准确性和可靠性。
希望以上介绍能帮助大家更好地理解和应用VB坐标正算程序。
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
坐标转换系统(VB)东华理工大学Theory 北京54高斯坐标转换西安80高斯坐标转换系统1.0版多点处理结果核心源代码:'高斯坐标转换成大地坐标过程Public Sub GausReverse(a As Double, f As Double, x() As Double, y() As Double, RB() As Double, RL() As Double, k As Integer)Dim i As Integer, fxb As Double, fxbl As Double, fybl As Doublee = Sqr(2 *f - f ^ 2)C = a / Sqr(1 - e ^ 2)e2 = e / Sqr(1 - e ^ 2)beita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kB0 = x(i) / (C * beita0)a1 = a * Cos(B0) / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)l0 = y(i) / a1Dofxb = 0fxbl = 0fybl = 0t = Tan(B0)yita = e2 * Cos(B0)n = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)a2 = (1 / 2) * n * Sin(B0) * Cos(B0)a3 = (1 / 6) * n * (Cos(B0)) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(B0) * (Cos(B0)) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4)a5 = (1 / 120) * n * (Cos(B0)) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2) a6 = (1 / 720) * n * Sin(B0) * (Cos(B0)) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = fxb + (C * beita6 + C * beita8 * (Cos(B0)) ^ 2) * (Cos(B0)) ^ 2fxb = (fxb + C * beita4) * (Cos(B0)) ^ 2fxb = (fxb + C * beita2) * Sin(B0) * Cos(B0)fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5RB(i) = (x(i) - fxb - fxbl) / (C * beita0)a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))RL(i) = (y(i) - fybl) / a1If Abs(RB(i) - B0) <= 0.0000000001 And Abs(RL(i) - l0) <= 0.0000000001 ThenRL(i) = zrl + l0Exit DoElseB0 = RB(i)l0 = RL(i)End IfLoopNext iEnd Sub'大地坐标B,L转换为高斯坐标x,y的过程Public Sub BLHGaus(RB() As Double, RL() As Double, GX() As Double, GY() As Double, a As Double, f As Double, k As Integer)Dim l0 As Double, fxb As Double, gxbl As Double, fybl As Doublee = Sqr(2 *f - f ^ 2)C = a / Sqr(1 - e ^ 2)e2 = e / Sqr(1 - e ^ 2)beita0 = 1 - (3 / 4) * e2 ^ 2 + (45 / 64) * e2 ^ 4 - (175 / 256) * e2 ^ 6 + (11025 / 16384) * e2 ^ 8 beita2 = beita0 - 1beita4 = (15 / 32) * e2 ^ 4 - (175 / 384) * e2 ^ 6 + (3675 / 8192) * e2 ^ 8beita6 = (-35 / 96) * e2 ^ 6 + (735 / 2048) * e2 ^ 8beita8 = (315 / 1024) * e2 ^ 8For i = 1 To kl0 = RL(i) - zrln = a / Sqr(1 - e ^ 2 * (Sin(RB(i))) ^ 2)t = Tan(RB(i))yita = e2 * Cos(RB(i))a1 = (a * Cos(RB(i))) / Sqr(1 - e ^ 2 * (Sin(RB(i)) ^ 2))a2 = (1 / 2) * n * Sin(RB(i)) * Cos(RB(i))a3 = (1 / 6) * n * (Cos(RB(i))) ^ 3 * (1 - t ^ 2 + yita ^ 2)a4 = (1 / 24) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 3 * (5 - t ^ 2 + 9 * yita ^ 2 + 4 * yita ^ 4) a5 = (1 / 120) * n * (Cos(RB(i))) ^ 5 * (5 - 18 * t ^ 2 + t ^ 4 + 14 * yita ^ 2 - 58 * yita ^ 2 * t ^ 2)a6 = (1 / 720) * n * Sin(RB(i)) * (Cos(RB(i))) ^ 5 * (61 - 58 * t ^ 2 + t ^ 4)fxb = 0fxbl = 0fybl = 0fxb = fxb + (C * beita6 + C * beita8 * (Cos(RB(i))) ^ 2) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita4) * (Cos(RB(i))) ^ 2fxb = (fxb + C * beita2) * Sin(RB(i)) * Cos(RB(i))fxbl = a2 * l0 ^ 2 + a4 * l0 ^ 4 + a6 * l0 ^ 6fybl = a3 * l0 ^ 3 + a5 * l0 ^ 5GX(i) = C * beita0 * RB(i) + fxb + fxblGY(i) = a1 * l0 + fyblNext iEnd Sub'三维直角坐标XYZ转换成大地坐标BLH过程Public Sub BLHXYZ1(SX() As Double, SY() As Double, SZ() As Double, RB() As Double, RL() As Double, RH() As Double, k As Integer, a As Double, f As Double)Dim i As IntegerDim N0 As Double, H0 As Double, B0 As Double, sb As Double, Ni As Doublee = Sqr(2 *f - f ^ 2)C = a / Sqr(1 - e ^ 2)e2 = e / Sqr(1 - e ^ 2)sb = a * Sqr(1 - e ^ 2)pi = 4 * Atn(1)For i = 1 To kRL(i) = Atn(Abs(SY(i) / SX(i)))If SY(i) > 0 And SX(i) < 0 ThenRL(i) = pi - RL(i)End IfN0 = aH0 = Sqr(SX(i) ^ 2 + SY(i) ^ 2 + SZ(i) ^ 2) - Sqr(a * sb)B0 = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * N0 / (N0 + H0))))DoNi = a / Sqr(1 - e ^ 2 * (Sin(B0)) ^ 2)RH(i) = Sqr(SX(i) ^ 2 + SY(i) ^ 2) / Cos(B0) - NiRB(i) = Atn(SZ(i) / ((Sqr(SX(i) ^ 2 + SY(i) ^ 2)) * (1 - e ^ 2 * Ni / (Ni + RH(i)))))If Abs(RB(i) - B0) < 0.0000000001 And Abs(RH(i) - H0) < 0.0000000001 ThenExit DoElseB0 = RB(i)H0 = RH(i)End IfLoopNext iEnd Sub'最小二乘法求解七参数布尔萨模型Public Sub SloveBuersa(XD() As Double, XG() As Double, R() As Double, k As Integer) Dim a0 As Double, a1 As Double, a2 As DoubleFor i = 1 To ka0 = XG(i, 1)a1 = XG(i, 2)a2 = XG(i, 3)Call Cjuzhen(a0, a1, a2, G())For j = 1 To 3For s = 1 To 7EC(3 * (i - 1) + j, s) = G(j, s)Next sNext jNext iFor i = 1 To kFor j = 1 To 3LC(3 * (i - 1) + j) = XD(i, j) - XG(i, j)Next jNext iFor i = 1 To 3 * kFor j = 1 To 7ET(j, i) = EC(i, j)Next jNext iFor i = 1 To 7For j = 1 To 7CTC(i, j) = 0For s = 1 To 3 * kCTC(i, j) = CTC(i, j) + ET(i, s) * EC(s, j)Next sNext jNext iFor i = 1 To 7For j = 1 To 7CTC1(i, j) = CTC(i, j)Next jNext iCall Comm.Reverse(CTC(), 7)For i = 1 To 7CTL(i) = 0For j = 1 To 3 * kCTL(i) = CTL(i) + ET(i, j) * LC(j)Next jNext iFor i = 1 To 7R(i) = 0For j = 1 To 7R(i) = R(i) + CTC(i, j) * CTL(j)Next jNext iEnd Sub'布尔萨模型系数矩阵一部分Public Sub Cjuzhen(x As Double, y As Double, z As Double, D() As Double) For i = 1 To 3D(i, i) = 1Next iD(1, 4) = xD(1, 5) = 0D(1, 6) = -zD(1, 7) = yD(2, 4) = yD(2, 5) = zD(2, 6) = 0D(2, 7) = -xD(3, 4) = zD(3, 5) = -yD(3, 6) = xD(3, 7) = 0End Sub'使用七参数求解新坐标系下的坐标Public Sub UseBuersa(XD() As Double, XG() As Double, EC() As Double, R() As Double, k As Integer)Dim a1 As Double, a2 As Double, a3 As Double, CR(1000) As DoubleFor i = 1 To ka1 = XG(i, 1)a2 = XG(i, 2)a3 = XG(i, 3)Call Cjuzhen(a1, a2, a3, G())For j = 1 To 3For s = 1 To 7EC(3 * (i - 1) + j, s) = G(j, s)Next sNext jNext iFor i = 1 To 3 * kCR(i) = 0For j = 1 To 7CR(i) = CR(i) + EC(i, j) * R(j)Next jNext iFor i = 1 To kFor j = 1 To 3XD(i, j) = XG(i, j) + CR(3 * (i - 1) + j)Next jNext iEnd Sub'弧度化为度分秒'弧度化成角度Public Sub RuJiao(ByVal rudu As Double, jiaodu As Double) Dim ja As Integer, jb As Integer, jc As Doublepi = 4 * Atn(1)jiaodu = rudu * 180 / pija = Fix(jiaodu)jb = Fix((jiaodu - ja) * 60)jc = ((jiaodu - ja) * 60 - jb) * 60jiaodu = ja + jb / 100 + jc / 10000End Sub'矩阵求逆Public Sub Reverse(Ba, n%)Dim k%, K1%, j%, i%Dim C As Double, Aa(100, 200)For i = 1 To nFor j = 1 To nAa(i, j) = Ba(i, j)Next jNext iFor i = 1 To nFor j = 1 To nIf i = j ThenAa(i, j + n) = 1ElseAa(i, j + n) = 0End IfNext jNext iFor k = 1 To nFor j = k To nIf Aa(j, k) <> 0 Then GoTo 200Next jMsgBox "逆矩阵不存在": Exit Sub 200: For i = 1 To 2 * nC = Aa(k, i)Aa(k, i) = Aa(j, i)Aa(j, i) = CNext iC = 1 / Aa(k, k)For j = 1 To 2 * nAa(k, j) = C * Aa(k, j)Next jFor K1 = 1 To nIf K1 <> k ThenC = -Aa(K1, k)For j = 1 To 2 * nAa(K1, j) = Aa(K1, j) + C * Aa(k, j)Next jEnd IfNext K1Next kFor i = 1 To nFor j = n + 1 To 2 * nAa(i, j - n) = Aa(i, j)Next jNext iFor i = 1 To nFor j = 1 To nBa(i, j) = Aa(i, j)Next jNext iEnd Sub'角度化成弧度Public Sub JiaoHu(ByVal jiaodu As Double, hudu As Double) Dim ja As Double, jb As Double, jc As Doublepi = 4 * Atn(1)ja = Fix(jiaodu)jb = Fix((jiaodu - ja) * 100)jc = ((jiaodu - ja) * 100 - jb) * 100jiaodu = ja + jb / 60 + jc / 3600hudu = jiaodu * pi / 180End Sub。