📄 中桩大地坐标.frm
字号:
Left = 1320
TabIndex = 7
Text = "Text7"
ToolTipText = "单位为米"
Top = 960
Width = 1215
End
Begin VB.TextBox Text6
Alignment = 2 'Center
Height = 270
Left = 1320
TabIndex = 6
Text = "Text6"
ToolTipText = "按度分秒输入，如 56°16′34″ 按 56.1634输入"
Top = 600
Width = 1215
End
Begin VB.TextBox Text5
Alignment = 2 'Center
Height = 270
Left = 1320
TabIndex = 5
Text = "Text5"
ToolTipText = "单位为米"
Top = 240
Width = 1215
End
Begin VB.Label Label22
Caption = "加桩间距Lj＝"
Height = 255
Left = 120
TabIndex = 57
Top = 2040
Width = 1095
End
Begin VB.Label Label18
Caption = "缓和曲线Ls2＝"
Height = 255
Left = 120
TabIndex = 50
Top = 1680
Width = 1215
End
Begin VB.Label Label8
Caption = "缓和曲线Ls1＝"
Height = 255
Left = 120
TabIndex = 30
Top = 1320
Width = 1215
End
Begin VB.Label Label7
Caption = "曲线半径R ＝"
Height = 255
Left = 120
TabIndex = 29
Top = 960
Width = 1215
End
Begin VB.Label Label6
Caption = "偏角角度α ＝"
Height = 255
Left = 120
TabIndex = 28
Top = 600
Width = 1215
End
Begin VB.Label Label5
Caption = "交点桩号JD ＝"
Height = 255
Left = 120
TabIndex = 27
Top = 240
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "初始坐标"
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1695
Left = 0
TabIndex = 0
Top = 80
Width = 2655
Begin VB.TextBox Text4
Alignment = 2 'Center
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1320
TabIndex = 4
Text = "Text4"
Top = 1320
Width = 1215
End
Begin VB.TextBox Text3
Alignment = 2 'Center
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1320
TabIndex = 3
Text = "Text3"
Top = 960
Width = 1215
End
Begin VB.TextBox Text2
Alignment = 2 'Center
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1320
TabIndex = 2
Text = "Text2"
Top = 600
Width = 1215
End
Begin VB.TextBox Text1
Alignment = 2 'Center
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 270
Left = 1320
TabIndex = 1
Text = "Text1"
Top = 240
Width = 1215
End
Begin VB.Label Label4
Caption = "本交点Y坐标＝"
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 25
Top = 1320
Width = 1215
End
Begin VB.Label Label3
Caption = "本交点X坐标＝"
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 24
Top = 960
Width = 1215
End
Begin VB.Label Label2
Caption = "前交点Y坐标＝"
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 23
Top = 600
Width = 1215
End
Begin VB.Label Label1
Caption = "前交点X坐标＝"
BeginProperty Font
Name = "新宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 22
Top = 240
Width = 1215
End
End
End
Attribute VB_Name = "frmzzddzb"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zh, hy, qz, yh, hz, jz As Double
Dim pm As Double
Dim p, q As Double
Dim x, y, x1, y1 As Double
Dim x11, x12, y11, y12, xbz1, xbz2, ybz1, ybz2, xb, yb, xbm, ybm As Double
Dim xzh, yzh, xm, ym, fw, ct, ia, ib, ic, id, alp As Double
Dim jd, r, ls, th, lh, ly, bt, d1, d2 As Double
Dim ls1, ls2, th1, th2, bt1, bt2, p1, p2, q1, q2 As Double
Dim cp As Integer
Private Sub Command1_Click()
'计算要素
On Error GoTo handlerror
For i = 1 To VSFlexGrid1.Rows - 1
VSFlexGrid1.TextMatrix(i, 0) = ""
VSFlexGrid1.TextMatrix(i, 1) = ""
VSFlexGrid1.TextMatrix(i, 2) = ""
VSFlexGrid1.TextMatrix(i, 3) = ""
VSFlexGrid1.TextMatrix(i, 4) = ""
VSFlexGrid1.TextMatrix(i, 5) = ""
VSFlexGrid1.TextMatrix(i, 6) = ""
VSFlexGrid1.TextMatrix(i, 7) = ""
VSFlexGrid1.TextMatrix(i, 8) = ""
VSFlexGrid1.TextMatrix(i, 9) = ""
VSFlexGrid1.TextMatrix(i, 10) = ""
VSFlexGrid1.TextMatrix(i, 11) = ""
VSFlexGrid1.TextMatrix(i, 12) = ""
Next i
VSFlexGrid1.Rows = 2
Text9.Visible = True
d1 = Val(Text10.Text)
d2 = Val(Text11.Text)
jd = Val(Text5.Text)
alp = Val(Text6.Text)
r = Val(Text7.Text)
ls1 = Val(Text8.Text)
ls2 = Val(Text18.Text)
LJ = Val(Text22.Text)
pj = alp
du = Int(pj)
fe = Int((pj - Int(pj)) * 100)
mi = (pj * 100 - Int(pj * 100)) * 100
pz = du + fe / 60 + mi / 3600
pm = pz * pi / 180
bt1 = ls1 / 2 / r
bt2 = ls2 / 2 / r
p1 = ls1 * ls1 / 24 / r - ls1 ^ 4 / 2688 / r ^ 3
p2 = ls2 * ls2 / 24 / r - ls2 ^ 4 / 2688 / r ^ 3
q1 = ls1 / 2 - ls1 ^ 3 / 240 / r / r
q2 = ls2 / 2 - ls2 ^ 3 / 240 / r / r
th1 = (r + p2) * Tan(pm / 2) + q1 + (p2 - p1) / Tan(pm)
th2 = (r + p1) * Tan(pm / 2) + q2 + (p1 - p2) / Tan(pm)
lh = ls1 + ls2 + (pm - bt1 - bt2) * r
If ls1 = ls2 Then
eh = (p1 + r) / Cos(pm / 2) - r
End If
ly = lh - ls1 - ls2
zh = jd - th1
hy = zh + ls1
u = (p2 - p1) / 2 / r / Sin(pm / 2)
qz = zh + ls1 + ly / 2
' qz = zh + ls1 + (pm / 2 - bt1) * r + r * Atn(u / (1 - u * u))
yh = zh + lh - ls2
hz = zh + lh
dbt = bt * 180 / pi
If Option1.Value = True Then cp = 1
If Option2.Value = True Then cp = 1
If pm < bt1 + bt2 Then
MsgBox "平曲线半径过短或缓和曲线长度过长，请重新拟定！", 64
Exit Sub
End If
xa = Val(Text1.Text) '大地坐标
ya = Val(Text2.Text)
xb = Val(Text3.Text)
yb = Val(Text4.Text)
dx = xb - xa
dy = yb - ya
S = Sqr(dx * dx + dy * dy)
If dx = 0 And dy > 0 Then fw = pi / 2
If dx = 0 And dy < 0 Then fw = 3 / 2 * pi
If dy = 0 And dx > 0 Then fw = 0
If dy = 0 And dx < 0 Then fw = pi
If dx <> 0 Then
rj = Abs(Atn(dy / dx))
If dx > 0 And dy > 0 Then fw = rj
If dx < 0 And dy > 0 Then fw = pi - rj
If dx < 0 And dy < 0 Then fw = pi + rj
If dx > 0 And dy < 0 Then fw = 2 * pi - rj
End If
xzh = xb - th1 * Cos(fw)
yzh = yb - th1 * Sin(fw)
Text12.Text = Str(Int(th1 * 1000 + 0.5) / 1000)
Text19.Text = Str(Int(th2 * 1000 + 0.5) / 1000)
Text13.Text = Str(Int(lh * 1000 + 0.5) / 1000)
Text14.Text = Str(Int(eh * 1000 + 0.5) / 1000)
If Val(Text14.Text) = 0 Then Text14.Text = ""
Text15.Text = Str(Int(ly * 1000 + 0.5) / 1000)
Text16.Text = Str(Int(p1 * 1000 + 0.5) / 1000)
Text20.Text = Str(Int(p2 * 1000 + 0.5) / 1000)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -