高斯投影坐标正反算VB程序

高斯投影坐标正反算

院: 级:

口

号: 名:

课程名称: 指导老师:

实验目的：

1.了解高斯投影坐标正反算的基本思想；

2.学会编写高斯正反算程序，加深了解。

实验原理：

高斯投影正算公式中应满足的三个条件：

1.中央子午线投影后为直线；

2.中央子午线投影后长度不变；

3.投影具有正形性质，即正形投影条件。

高斯投影反算公式中应满足的三个条件：

1. x 坐标轴投影成中央子午线，是投影的对称轴；

2. x 轴上的长度投影保持不变；

3.正形投影条件，即高斯面上的角度投影到椭球面上后角度没

有变形，仍然相等。

操作工具：

计算机中的VB6.0

代码：

Dim a As Double, b As Double, x As Double, y As Double, y_#

Dim l_ As Double, b_ As Double, a0#, a2#, a4#, a6#, a8#, m2#, m4#, m6#, m8#, m0#, l0#, e#, e1#

Dim deg1 As Double, min1 As Double, sec1 As Double, deg2 As Double, min2 As Double, sec2 As Double

Private Sub Command1_Click()

Dim x_ As Double, t#, eta#, N#, W#, k1#, k2#, ik1%, ik2%, dh% deg1 = Val(Text1.Text) min1 = Val(Text2.Text) sec1 = Val(Text3.Text)

deg2 = Val(Text4.Text) min2 = Val(Text5.Text) sec2 =

Val(Text6.Text) l_ = (deg1 * 3600 + min1 * 60 + sec1) / 206265 b_ = (deg2 * 3600 + min2 * 60 + sec2) / 206265 dh = Val(Text9.Text) k1 = ((l_ * 180 / 3.14159 + 3) / 6) k2 = (l_ * 180 / 3.14159 / 3) ik1 = Round(k1, 0) ik2 = Round(k2, 0)

If dh = 6 Then l0 = 6 * ik1 - 3 Else

If dh = 3 Then

l0 = 3 * ik2

Else

MsgBox "error", 48, "error": Exit Sub

End If

End If l = l_ - l0 * 3.14159 / 180 e = Sqr(a * a - b * b) / a

m0 = a * (1 - e * e) a0 = m0 + m2 / 2 + m4 * 3 / 8 + m6 * 5 / 16 + m8 * 35 / 128 a2 = m2 / 2 + m4 / 2 + m6 * 15 / 32 + m8 * 7 / 16 a4 = m4 / 8 + m6 * 3 / 16 + m8 * 7 / 32 a6 = m6 / 32 + m8 / 16 a8 = m8 / 128 x_ = a0 * b_ - a2 * Sin(2 * b_) / 2 + a4 * Sin(4 * b_) / 4 - Sin(6 * b_) * a6 / 6 + Sin(8 * b_) * a8 / 8 t = Tan(b_) e1 = Sqr((a * a - b * b) / (b * b)) eta = Sqr(e1 * e1 * Cos(b) * Cos(b))

m2 = e * e * m0

m4 = e * e * m2

m6 = m4 * e * e

m8 = e * e * m6

W = Sqr(1 - e * e * Sin(b_) * Sin(b_)) x = x_ + N * Sin (b_) *

Cos(b_) * l * l / 2 + N * Sin(b_) * Cos(b_)八 3 * (5 - t * t + 9 * eta * eta + 4 * eta 八4) * l 八 4 / 24 + N * Sin(b_) * Cos(b_)

八 5 * (61 - 58 * t * t + t 八4) * l 八 6 / 720 y = N * Cos(b_) * l + N * Cos(b_)八 3 * (1 - t * t + eta * eta) * l * l * l / 6 + N * Cos(b_)八 5 * (5 - 18 * t * t + t 八 4 + 14 * eta * eta - 58 * eta * eta * t * t) * l 八 5 / 120

Text7 = x

If dh = 6 Then y_ = y + 500000 + 1000000 * ik1

Else

If dh = 3 Then y_ = y + 500000 + 1000000 * ik2

Else

MsgBox "error", 48, "error": Exit Sub End If

End If

Text8 = y_

End Sub

Private Sub Command2_Click()

Dim bf#, j%, Wf#, Vf#, Nf#, Mf#, c#, tf#, etaf#, dh%, ik% x =

Val(Text7.Text) y_ = Val(Text8.Text) e = Sqr((a * a - b * b) / (a * a))

m0 = a * (1 - e * e)

m2 = e * e * m0

m4 = e * e * m2

m6 = m4 *

m8 = e * e * m6

a0 = m0 + m2 / 2 + m4 * 3 / 8 + m6 * 5 / 16 + m8 * 35 / 128

a2 = m2 / 2 + m4 / 2 + m6 * 15 / 32 + m8 * 7 / 16

a4 = m4 / 8 + m6 * 3 / 16 + m8 * 7 / 32

a6 = m6 / 32 + m8 / 16

a8 = m8 / 128

bf = x / a0

For j = 1 To 10

bf = (x + a2 / 2 * Sin(2 * bf) - a4 * Sin(4 * bf) / 4 + a6 *

Sin(6 * bf) / 6 - a8 * Sin(8 * bf) / 8) / a0

Next j

e1 = Sqr(a * a - b * b) / b

Vf = Sqr(1 + e1 * e1 * Cos(bf) * Cos(bf))

Wf = Sqr(1 - e * e * Sin(bf) * Sin(bf))

Nf = a / Wf

Mf = c / Vf 八 3