module1.bas

54坐标系高斯正反算及换带,54坐标系高斯正反算及换带.

Attribute VB_Name = "Module1"
Public lold0 As Double, lnew0 As Double, dold1 As Double, dnew1 As Double
Public b(100) As Double, l(100) As Double, bf As Double, pubx As Double
Public Const e12 = 0.0067385254147
Public Const c = 6399698.90178271
Public Sub gaoszh(w1 As Double, w2 As Double, w11 As Double, w21 As Double)
Dim t As Double, nn As Double, nf1 As Double, nf11 As Double
If pubx = 0 Then
pubx = 6367558.505 * w1 - (32005.7799 * Sin(w1) + 133.9238 * Sin(w1) ^ 3 + 0.6976 * Sin(w1) ^ 5 + 0.0039 * Sin(w1) ^ 7) * Cos(w1)
End If
l0 = w2 - lnew0
t = Tan(w1)
nf1 = e12 * Cos(w1) ^ 2
nf11 = c / Sqr(1 + nf1)
nn = nf11 / 2 * Sin(w1) * Cos(w1) * l0 ^ 2
w11 = pubx + nf11 / 2 * Sin(w1) * Cos(w1) * l0 ^ 2 + nf11 / 24 * Cos(w1) ^ 3 * Sin(w1) * (5 - t * t + 9 * nf1 + 4 * nf1 ^ 2) * l0 ^ 4 + nf11 / 720 * Cos(w1) ^ 5 * Sin(w1) * (61 - 58 * t * t + t ^ 4 + 270 * nf1 - 330 * nf1 * t * t) * l0 ^ 6
w21 = nf11 * Cos(w1) * l0 + nf11 / 6 * Cos(w1) ^ 3 * (1 - t ^ 2 + nf1) * l0 ^ 3 + nf11 / 120 * Cos(w1) ^ 5 * (5 - 18 * t * t + t ^ 4 + 14 * nf1 - 58 * t * t * nf1) * l0 ^ 5
End Sub
Public Sub gaosfa(z1 As Double, z2 As Double, z3 As Double, z4 As Double)
Dim b1 As Double, b2 As Double, nf1 As Double, nf11 As Double, b5 As Double
b1 = 50 * 3.14159265 / 180#
b2 = 50
1:
b5 = b2
b2 = ((z1 + 32005.7798 * Sin(b1) * Cos(b1) + 133.9238 * Sin(b1) ^ 3 * Cos(b1) + 0.6973 * Sin(b1) ^ 5 * Cos(b1) + 0.0039 * Sin(b1) ^ 7 * Cos(b1)) * 57.2957795131) / 6367558.4969
If Abs(b2 - b5) >= 0.0000000001 Then
b1 = b2 * 3.14159265 / 180#
GoTo 1
End If
bf = b1
nf1 = e12 * (Cos(bf) ^ 2)
tf = Tan(bf)
nf11 = c / Sqr(1 + nf1)
z4 = z2 / Cos(bf) / nf11 - z2 ^ 3 / 6# / (Cos(bf) * nf11 ^ 3) * (1 + 2 * tf ^ 2 + nf1) + z2 ^ 5 / 120# / (nf11 ^ 5 * Cos(bf)) * (5 + 28 * tf ^ 2 + 24 * tf ^ 4 + 6 * nf1 + 8 * nf1 * tf ^ 2)
z3 = b1 - z2 ^ 2 / (2# * nf11 ^ 2) * tf * (1 + nf1) + z2 ^ 4 / 24# / nf11 ^ 4 * tf * (5 + 3 * tf ^ 2 + 6 * nf1 - 6 * tf ^ 2 * nf1 - 3 * nf1 ^ 2 + 9 * nf1 ^ 2 * tf ^ 4) - z2 ^ 6 / 720# / nf11 ^ 6 * tf * (61 + 90 * tf ^ 2 + 45 * tf ^ 4 + 107 * nf1 + 162 * nf1 * tf ^ 2 + 45 * nf1 * tf ^ 4)
z4 = z4 + lold0
b1 = z3
b2 = b1 / 3.14159265 * 180#
pubx = 6367558.4969 * b2 / 57.2957795131 - 32005.7798 * Sin(b1) * Cos(b1) - 133.9238 * Sin(b1) ^ 3 * Cos(b1) - 0.6973 * Sin(b1) ^ 5 * Cos(b1) - 0.0039 * Sin(b1) ^ 7 * Cos(b1)
End Sub

Public Sub deg(dfm As Double)
Dim a1 As Double, a2 As Double, a3 As Double
a1 = Fix(dfm + 0.000000000001)
a2 = (dfm + 0.000000000001 - a1) * 100
a3 = (a2 - Fix(a2)) * 100
a2 = Fix(a2)
dfm = a1 + a2 / 60# + a3 / 3600#
End Sub
Public Sub dhh(sss As Double)
Dim a1 As Double, a2 As Double, a3 As Double
a1 = Fix(sss + 0.000000000001)
a2 = (sss + 0.000000000001 - a1) * 60
a3 = Fix(a2)
a2 = (a2 - a3) * 60
sss = a1 + a3 / 100# + a2 / 10000#
End Sub