📄 form1
字号:
b1 = (x / 6367558.4969)
c = Cos(b1) * Cos(b1)
bf = b1 + (50221746 + (293622 + (2350 + 22 * c) * c) * c) * Sin(b1) * Cos(b1) / 10 ^ (10)
bf1 = bf
bf2 = Cos(bf1) * Cos(bf1)
bf3 = bf * 206264.806247096
nf = 6399698.902 - (21562.267 - (108.973 - 0.612 * bf2) * bf2) * bf2
z = y / (nf * Cos(bf1))
b2 = (0.5 + 0.003369 * bf2) * Sin(bf1) * Cos(bf1)
b3 = 0.333333 - (0.166667 - 0.001123 * bf2) * bf2
b4 = 0.25 + (0.16161 + 0.00562 * bf2) * bf2
b5 = 0.2 - (0.1667 - 0.0088 * bf2) * bf2
b = bf3 - (1 - (b4 - 0.12 * z * z) * z * z) * z * z * b2 * 206264.806247096
'Debug.Print b
L = (1 - (b3 - b5 * z * z) * z * z) * z * 206264.806247096
'Debug.Print L
l1 = L0 * 3600 + L
'坐标反算
lm = l1 / 206264.806247096
bm = b / 206264.806247096
rm = a * Sqr(1 - e2) / (1 - e2 * Sin(bm) * Sin(bm))
u = Atn(Sqr(1 - e2) * Tan(bm))
yn = Sqr(e2 * Cos(bm) * Cos(bm))
Debug.Print yn
tm = Atn(bm)
'椭球参数
xm = x
ym = y
'Debug.Print xm
'Debug.Print ym
fm = 206264.806247096 / (2 * rm * rm)
iia = ym * ym * ym / (3 * rm * rm)
oa = ym - (y2 - y1) / 6 - iia
ob = ym + (y2 - y1) / 6 - iia
'Debug.Print yn
'Debug.Print tm
'Debug.Print ym
'Debug.Print ob
'Debug.Print rm
'Debug.Print (y2 - y1)
e = yn * yn * tm * (y2 - y1) * ym * ym * 206264.806247096 / (rm * rm * rm)
fab = fm * (x1 - x2) * oa - e
fba = fm * (x2 - x1) * ob - e
'方向改化
Text7.Text = fab
Text8.Text = fba
f1 = u / (2 * rm * rm) * 10 ^ 8
i = (y2 - y1) * (y2 - y1) / 12
ii = ym * ym * ym * ym / (6 * rm * rm)
aa = 1 / (6 * rm * rm)
k = ym * ym / (2 * rm * rm)
s = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
sab = s * (1 + 3 * aa * (ym * ym + i + 0.5 * ii))
Text5.Text = sab
End Sub
Private Sub Command2_Click()
Dim f1, i, ii, aa, k, d, u, rm, bm, lm, yy, tm, yn As Double
Dim x1, x2, y1, y2, xm, ym As Double
Dim fab, fba, sab, s As Double
Dim x, y, bf, b1, z, nf, b2, b3, b4, b5, a1, a2, a3, bf1, bf2, e, f, l1, L, b, oa, ob, iia As Double
If Option1.Value = True Then
a = 6378245#
b = 6356863.01877305
cc = 63399698.9017827
e2 = 0.006693421633966
ei2 = 0.006738525414638
End If
If Option2.Value = True Then
a = 6378140
b = 6356755.28815753
cc = 6399596.65198801
e2 = 0.006694384999588
ei2 = 0.006739501819473
End If
If Option3.Value = True Then
a = 6378137#
b = 6356752.3142
cc = 6399593.6258
e2 = 0.0066943799013
ei2 = 0.00673949674227
End If
x1 = Text1.Text
y1 = Text2.Text
x2 = Text3.Text
y2 = Text4.Text
x = (Val(Text1.Text) + Val(Text3.Text)) / 2
y = (Val(Text2.Text) + Val(Text4.Text)) / 2
L0 = Val(Text6.Text)
b1 = (x / 6367558.4969)
c = Cos(b1) * Cos(b1)
bf = b1 + (50221746 + (293622 + (2350 + 22 * c) * c) * c) * Sin(b1) * Cos(b1) / 10 ^ (10)
bf1 = bf
bf2 = Cos(bf1) * Cos(bf1)
bf3 = bf * 206264.806247096
nf = 6399698.902 - (21562.267 - (108.973 - 0.612 * bf2) * bf2) * bf2
z = y / (nf * Cos(bf1))
b2 = (0.5 + 0.003369 * bf2) * Sin(bf1) * Cos(bf1)
b3 = 0.333333 - (0.166667 - 0.001123 * bf2) * bf2
b4 = 0.25 + (0.16161 + 0.00562 * bf2) * bf2
b5 = 0.2 - (0.1667 - 0.0088 * bf2) * bf2
b = bf3 - (1 - (b4 - 0.12 * z * z) * z * z) * z * z * b2 * 206264.806247096
'Debug.Print b
L = (1 - (b3 - b5 * z * z) * z * z) * z * 206264.806247096
'Debug.Print L
l1 = L0 * 3600 + L
'坐标反算
lm = l1 / 206264.806247096
bm = b / 206264.806247096
rm = a * Sqr(1 - e2) / (1 - e2 * Sin(bm) * Sin(bm))
u = Atn(Sqr(1 - e2) * Tan(bm))
yn = Sqr(e2 * Cos(bm) * Cos(bm))
Debug.Print yn
tm = Atn(bm)
'椭球参数
xm = x
ym = y
'Debug.Print xm
'Debug.Print ym
fm = 206264.806247096 / (2 * rm * rm)
iia = ym * ym * ym / (3 * rm * rm)
oa = ym - (y2 - y1) / 6 - iia
ob = ym + (y2 - y1) / 6 - iia
'Debug.Print yn
'Debug.Print tm
'Debug.Print ym
'Debug.Print ob
'Debug.Print rm
'Debug.Print (y2 - y1)
e = yn * yn * tm * (y2 - y1) * ym * ym * 206264.806247096 / (rm * rm * rm)
fab = fm / 3 * (x1 - x2) * (2 * y1 + y2)
fba = fm / 3 * (x2 - x1) * (2 * y2 + y1)
'方向改化
Text7.Text = fab
Text8.Text = fba
f1 = u / (2 * rm * rm) * 10 ^ 8
i = (y2 - y1) * (y2 - y1) / 12
ii = ym * ym * ym * ym / (6 * rm * rm)
aa = 1 / (6 * rm * rm)
k = ym * ym / (2 * rm * rm)
s = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
sab = s * (1 + 3 * aa * (ym * ym + i))
Text5.Text = sab
End Sub
Private Sub Command3_Click()
Dim f1, i, ii, aa, k, d, u, rm, bm, lm, yy, tm, yn As Double
Dim x1, x2, y1, y2, xm, ym As Double
Dim fab, fba, sab, s As Double
Dim x, y, bf, b1, z, nf, b2, b3, b4, b5, a1, a2, a3, bf1, bf2, e, f, l1, L, b, oa, ob, iia As Double
If Option1.Value = True Then
a = 6378245#
b = 6356863.01877305
cc = 63399698.9017827
e2 = 0.006693421633966
ei2 = 0.006738525414638
End If
If Option2.Value = True Then
a = 6378140
b = 6356755.28815753
cc = 6399596.65198801
e2 = 0.006694384999588
ei2 = 0.006739501819473
End If
If Option3.Value = True Then
a = 6378137#
b = 6356752.3142
cc = 6399593.6258
e2 = 0.0066943799013
ei2 = 0.00673949674227
End If
x1 = Text1.Text
y1 = Text2.Text
x2 = Text3.Text
y2 = Text4.Text
x = (Val(Text1.Text) + Val(Text3.Text)) / 2
y = (Val(Text2.Text) + Val(Text4.Text)) / 2
L0 = Val(Text6.Text)
b1 = (x / 6367558.4969)
c = Cos(b1) * Cos(b1)
bf = b1 + (50221746 + (293622 + (2350 + 22 * c) * c) * c) * Sin(b1) * Cos(b1) / 10 ^ (10)
bf1 = bf
bf2 = Cos(bf1) * Cos(bf1)
bf3 = bf * 206264.806247096
nf = 6399698.902 - (21562.267 - (108.973 - 0.612 * bf2) * bf2) * bf2
z = y / (nf * Cos(bf1))
b2 = (0.5 + 0.003369 * bf2) * Sin(bf1) * Cos(bf1)
b3 = 0.333333 - (0.166667 - 0.001123 * bf2) * bf2
b4 = 0.25 + (0.16161 + 0.00562 * bf2) * bf2
b5 = 0.2 - (0.1667 - 0.0088 * bf2) * bf2
b = bf3 - (1 - (b4 - 0.12 * z * z) * z * z) * z * z * b2 * 206264.806247096
'Debug.Print b
L = (1 - (b3 - b5 * z * z) * z * z) * z * 206264.806247096
'Debug.Print L
l1 = L0 * 3600 + L
'坐标反算
lm = l1 / 206264.806247096
bm = b / 206264.806247096
rm = a * Sqr(1 - e2) / (1 - e2 * Sin(bm) * Sin(bm))
u = Atn(Sqr(1 - e2) * Tan(bm))
yn = Sqr(e2 * Cos(bm) * Cos(bm))
Debug.Print yn
tm = Atn(bm)
'椭球参数
xm = x
ym = y
'Debug.Print xm
'Debug.Print ym
fm = 206264.806247096 / (2 * rm * rm)
iia = ym * ym * ym / (3 * rm * rm)
oa = ym - (y2 - y1) / 6 - iia
ob = ym + (y2 - y1) / 6 - iia
'Debug.Print yn
'Debug.Print tm
'Debug.Print ym
'Debug.Print ob
'Debug.Print rm
'Debug.Print (y2 - y1)
e = yn * yn * tm * (y2 - y1) * ym * ym * 206264.806247096 / (rm * rm * rm)
fab = fm * (x1 - x2) * ym
fba = fm * (x2 - x1) * ym
'方向改化
Text7.Text = fab
Text8.Text = fba
f1 = u / (2 * rm * rm) * 10 ^ 8
i = (y2 - y1) * (y2 - y1) / 12
ii = ym * ym * ym * ym / (6 * rm * rm)
aa = 1 / (6 * rm * rm)
k = ym * ym / (2 * rm * rm)
s = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
sab = s * (1 + k)
Text5.Text = sab
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text6.Text = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -