📄 嵌套系数法.frm
字号:
Caption = "分"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 3120
TabIndex = 58
Top = 1680
Width = 285
End
Begin VB.Label Label31
Caption = "分"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 3120
TabIndex = 57
Top = 2160
Width = 285
End
Begin VB.Label Label30
Caption = "度"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2160
TabIndex = 55
Top = 960
Width = 285
End
Begin VB.Label Label29
Caption = "度"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2160
TabIndex = 54
Top = 1680
Width = 285
End
Begin VB.Label Label28
Caption = "度"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2160
TabIndex = 53
Top = 2160
Width = 285
End
Begin VB.Label Label27
Caption = "秒"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 5040
TabIndex = 52
Top = 480
Width = 285
End
Begin VB.Label Label26
Caption = "分"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 3120
TabIndex = 50
Top = 480
Width = 285
End
Begin VB.Label Label25
Caption = "度"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 405
Left = 2160
TabIndex = 48
Top = 480
Width = 285
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "P2："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 8
Top = 2040
Width = 480
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "经度L2＝"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 600
TabIndex = 7
Top = 2280
Width = 960
End
Begin VB.Label Label11
Caption = "纬度B2＝"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 600
TabIndex = 6
Top = 1800
Width = 1095
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "P1："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 120
TabIndex = 5
Top = 840
Width = 480
End
Begin VB.Label Label9
Caption = "纬度B1＝"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 600
TabIndex = 4
Top = 600
Width = 1095
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "经度L1＝"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 600
TabIndex = 3
Top = 1080
Width = 960
End
End
Begin VB.Label Label58
Caption = "椭球基准：克拉索夫椭球 参考坐标系：北京54"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 3000
TabIndex = 105
Top = 1320
Width = 5775
End
Begin VB.Label Label53
AutoSize = -1 'True
Caption = "大地主题解算"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 315
Left = 4680
TabIndex = 90
Top = 600
Width = 1980
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Function arcsin(x As Double) As Double
arcsin = Atn(x / Sqr(-x * x + 1))
End Function
Public Function arccos(x As Double) As Double
arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function
Public Function M(B4 As Double) As Double
Dim W As Double, e As Double, a As Double
a = 6378245
e = 0.08181333401693
W = Sqr(1 - e * e * Sin(B4) * Sin(B4))
M = a * (1 - e * e) / (W * W * W)
End Function
Public Function N(B4 As Double) As Double
Dim W As Double, a As Double, e As Double
a = 6378245
e = 0.08181333401693
W = Sqr(1 - e * e * Sin(B4) * Sin(B4))
N = a / W
End Function
Private Sub Command1_Click()
Dim a As Double, b As Double, c As Double
Dim e1 As Double, A1 As Double, e As Double
Dim i As Integer, L1 As Double, A2 As Double
Dim B1 As Double, B2 As Double, L2 As Double
Dim l As Double, x4 As Double, x5 As Double
Dim x1 As Double, x2 As Double, x3 As Double
Dim u As Double, v As Double, f As Double
Dim A21 As Double, B21 As Double
Dim Am As Double, tm As Double, Bm As Double
Dim vm As Double, Cm As Double, Nm As Double
Dim L21 As Double, tgA2 As Double, q4 As Double
Dim k11 As Double, ym As Double, k1 As Double
Dim q1 As Double, q2 As Double, q3 As Double
Dim sdd As Double, u1 As Double, c1 As Double
Dim Bf(1 To 10) As Double, Af(1 To 10) As Double
Dim lf(1 To 10) As Double, dtc(0 To 5) As Double
Dim sinA0 As Double, k3 As Double, c2o1 As Double
Dim m1 As Double, n1 As Double, mm As Double
Dim un As Double, t As Double, k2 As Double
Dim w1 As Double, dtw1 As Double, tgw1 As Double
Dim sinA1 As Double, cosA02 As Double, coto1 As Double
Dim da As Double, db As Double, dc As Double
Dim ar As Double, bt As Double, k12 As Double
Dim s2r As Double, c2r As Double, ot As Double
Dim o0 As Double, cosu1 As Double, sinu1 As Double
Dim cnc As Double, sinu2 As Double, wdd2 As Double
Dim wdf2 As Double, wdm2 As Double, s2o1 As Double
Const p = 206264.806247
Const pi = 3.1415926535897
a = 6378245
b = 6356863.01877305
e = 0.08181333401693
e1 = 0.08208852182055
If Option1.Value = True Then
B1 = (Val(Text1.Text) + Val(Text15.Text) / 60 + Val(Text16.Text) / 3600) / 180 * pi
L1 = (Val(Text2.Text) + Val(Text17.Text) / 60 + Val(Text18.Text) / 3600) / 180 * pi
A1 = (Val(Text4.Text) + Val(Text35.Text) / 60 + Val(Text38.Text) / 3600) / 180 * pi
sdd = Val(Text3.Text)
dtc(0) = 0
For i = 0 To 5
f = (a - b) / a
u1 = Atn((1 - f) * Tan(B1))
c1 = Atn(Tan(u1) / Cos(A1))
un = arccos(Cos(u1) * Sin(A1))
t = 1 / 4 * e1 * e1 * Sin(un) * Sin(un)
v = 1 / 4 * f * Sin(un) * Sin(un)
k11 = 3 - t * (5 - 11 * t)
k1 = 1 + t * (1 - t / 4 * k11)
k2 = t * (1 - t * (2 - t / 8 * (37 - 94 * t)))
k3 = v + f * v - 3 * v * v
c = sdd / (k1 * b) + dtc(i)
Cm = (2 * c1 + c) / 2
dtc(i + 1) = k2 * Sin(c) * (Cos(2 * Cm) + k2 / 4 * (Cos(c) * Cos(4 * Cm) - k2 / 6 * Cos(2 * Cm) * (-3 + 4 * Sin(c) * Sin(c)) * (-3 + 4 * Cos(2 * Cm) * Cos(2 * Cm))))
If Abs(dtc(i + 1) - dtc(i)) < 0.000000000001 Then
B2 = Atn((Sin(u1) * Cos(c) + Cos(u1) * Sin(c) * Cos(A1)) / Sqr(1 - Sin(un) * Sin(un) * Sin(c1 ⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -