📄 form2.frm
字号:
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 2
Left = 1080
TabIndex = 3
Top = 960
Width = 1335
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Times New Roman"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 1
Left = 1080
TabIndex = 2
Top = 600
Width = 1335
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Times New Roman"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Index = 0
Left = 1080
TabIndex = 1
Top = 240
Width = 1335
End
Begin VB.Label Label1
Caption = "起始桩号"
Height = 200
Index = 0
Left = 120
TabIndex = 16
Top = 360
Width = 735
End
Begin VB.Label Label1
Caption = "起点北坐标"
Height = 200
Index = 1
Left = 120
TabIndex = 15
Top = 721
Width = 950
End
Begin VB.Label Label1
Caption = "起点东坐标"
Height = 200
Index = 2
Left = 120
TabIndex = 14
Top = 1082
Width = 950
End
Begin VB.Label Label1
Caption = "截止桩号"
Height = 195
Index = 3
Left = 120
TabIndex = 13
Top = 1443
Width = 735
End
Begin VB.Label Label1
Caption = "转点北坐标"
Height = 200
Index = 4
Left = 120
TabIndex = 12
Top = 1799
Width = 950
End
Begin VB.Label Label1
Caption = "转点东坐标"
Height = 200
Index = 5
Left = 120
TabIndex = 11
Top = 2160
Width = 950
End
End
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 255
Left = 3000
TabIndex = 30
Top = 4200
Visible = 0 'False
Width = 4935
_ExtentX = 8705
_ExtentY = 450
_Version = 393216
Appearance = 0
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Check1_Click() '单击“边桩计算”复选框相应的操作
If Check1.Value = 1 Then
Text3.Enabled = True
SSTab1.TabEnabled(1) = True
MSHFlexGrid2.Enabled = True
MSHFlexGrid2.Row = 0
MSHFlexGrid2.Col = 0
MSHFlexGrid2.Text = "序号"
MSHFlexGrid2.Row = 0
MSHFlexGrid2.Col = 1
MSHFlexGrid2.Text = "边桩号"
MSHFlexGrid2.Row = 0
MSHFlexGrid2.Col = 2
MSHFlexGrid2.Text = "北坐标(X)"
MSHFlexGrid2.Row = 0
MSHFlexGrid2.Col = 3
MSHFlexGrid2.Text = "东坐标(Y)"
Else
Text3.Enabled = False
SSTab1.TabEnabled(1) = False
MSHFlexGrid2.Enabled = False
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Me
Load Form1
Form1.Show
End Sub
Private Sub Text1_GotFocus(Index As Integer)
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub
'保存计算结果
Private Sub Command2_Click()
If Dir$(File_Path & "\中桩坐标-直线.txt") <> "" Then
If MsgBox("该文件已经存在，覆盖吗？", vbYesNo + vbQuestion + vbDefaultButton2, "警告") <> vbYes Then
Exit Sub
End If
End If
Label3.Caption = "保存数据中… …"
Call Tools.Save_Text(ROW_OUT)
Label3.Caption = "计算结果成功保存于："
Label2.Caption = File_Path & "\中桩坐标-直线.txt"
End Sub
Private Sub Command3_Click() '单击“清除”按钮
MSHFlexGrid1.Clear
MSHFlexGrid2.Clear
MSHFlexGrid1.Rows = 6
MSHFlexGrid1.Cols = 5
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 0
MSHFlexGrid1.Text = "序号"
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Text = "桩号(里程)"
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 2
MSHFlexGrid1.Text = "北坐标(X)"
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 3
MSHFlexGrid1.Text = "东坐标(Y)"
Command2.Enabled = False '清除计算结果后不能保存数据
Label3.Caption = "表格已清空"
Label2.Caption = "要继续计算，请仔细输入"
End Sub
Private Sub Command4_Click()
Unload Me
Load Form1
Form1.Show
End Sub
Private Sub Form_Load()
Label2.Caption = "输入角度的格式：度.分秒。" + Chr(13) + "如 36°12'23.3" & "输入为 36.12233 "
Picture1.Cls
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 0
MSHFlexGrid1.ColWidth(0) = 520
MSHFlexGrid1.ColWidth(1) = 1250
MSHFlexGrid1.ColWidth(2) = 1500
MSHFlexGrid1.ColWidth(3) = 1500
MSHFlexGrid2.ColWidth(0) = 520
MSHFlexGrid2.ColWidth(1) = 1260
MSHFlexGrid2.ColWidth(2) = 1500
MSHFlexGrid2.ColWidth(3) = 1500
MSHFlexGrid1.Text = "序号"
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Text = "桩号(里程)"
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 2
MSHFlexGrid1.Text = "北坐标(X)"
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 3
MSHFlexGrid1.Text = "东坐标(Y)"
SSTab1.TabEnabled(1) = False '确定边桩计算
Check1.Value = 0
End Sub
Private Sub Option3_Click(Index As Integer)
If Index = 1 Then
Label1(4).Caption = "起始方位角"
Label1(5).Enabled = False
Text1(5).Text = "角度至少6位数"
Text1(5).Enabled = False
Else
Label1(4).Caption = "转点北坐标"
Label1(5).Enabled = True
Text1(5).Text = ""
Text1(5).Enabled = True
End If
End Sub
Private Sub Option2_Click(Index As Integer)
If Index = 2 Then
Text2.Enabled = True
Else
Text2.Enabled = False
End If
End Sub
'中线坐标计算——直线
Private Sub Command1_Click()
'添加表格头
'声明变量
Dim Cac_A As Double '计算得到的起始方位角
Dim InPutX_1 As Double
Dim InPutY_1 As Double
Dim InPutX_2 As Double
Dim InPutY_2 As Double
Dim Distant As Double '起点与计算点之间的距离
Dim Start_NO As Double '起始桩号（一般为 ZD 或 HZ）
Dim NO_Point As Double '初步计算需要计算的点数
ProgressBar1.Visible = True
'提取已知坐标
InPutX_1 = Val(Text1(1).Text)
InPutY_1 = Val(Text1(2).Text)
InPutX_2 = Val(Text1(4).Text)
InPutY_2 = Val(Text1(5).Text)
'判断输入数据的合理性
If Option3(0).Value = True Then
Select Case True
Case InPutX_1 = InPutX_2 And InPutY_1 = InPutY_2
MsgBox "输入的起始点坐标为同一值", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
Case Text1(0).Text = Text1(3).Text
MsgBox "输入数据中距离为零", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
Case Val(Text1(0).Text) > Val(Text1(3).Text)
MsgBox "输入数据中距离为负值", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
End Select
ElseIf Option3(1).Value = True Then
Select Case True
Case Text1(0).Text = Text1(3).Text
MsgBox "输入数据中距离为零", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
Case Val(Text1(0).Text) > Val(Text1(3).Text)
MsgBox "输入数据中距离为负值", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
Case Val(Text1(4).Text) < 0
MsgBox "输入的起始方位角为负值", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
Case Val(Text1(4).Text) > 360
MsgBox "输入的起始方位角大于360", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
End Select
End If
If Check1.Value = 1 And Text3.Text = "" Then
MsgBox "输入边桩的距离", vbOKOnly + vbDefaultButton1 + vbExclamation, "警告"
GoTo Line1
End If
ROW_NO = 0
ROW_OUT = 0
'提取计算桩号的距离/m
If Option2(0).Value = True Then
Cac_D = 20
ElseIf Option2(1).Value = True Then
Cac_D = 25
ElseIf Option2(2).Value = True Then
Cac_D = Val(Text2.Text)
End If
'确定计算样式
Select Case True
Case Option1(0).Value
Start_NO = Tools.Distiguish(Int(Val(Text1(0).Text)), Cac_D)
NO_Point = Tools.Distiguish(Int(Val(Text1(3).Text)), Cac_D)
Case Option1(1).Value
Start_NO = Val(Text1(0).Text)
NO_Point = Val(Text1(3).Text)
End Select
'########################## 开始计算——坐标 ########################
'在已知条件为“两点”的情况下计算坐标
Select Case True
Case Option3(0).Value
' 计算起始方位角
Cac_A = Tools.CaculateAzimuth(InPutX_1, InPutY_1, InPutX_2, InPutY_2)
'计算坐标
For i = 1 To (NO_Point - Start_NO) / Cac_D
ProgressBar1.Max = (NO_Point - Start_NO) / Cac_D
Distant = (Start_NO + Cac_D * i) - Val(Text1(0).Text)
Call CoordCaculate.CoordLine(InPutX_1, InPutY_1, Cac_A, Distant)
ProgressBar1.Value = i
Next
'在已知条件为“一点及方位角”的情况下计算坐标
Case Option3(1).Value
'将角度化为弧度
Cac_A = Tools.DegreeToH(Text1(4).Text)
'计算坐标
For i = 1 To (NO_Point - Start_NO) / Cac_D
ProgressBar1.Max = (NO_Point - Start_NO) / Cac_D
Distant = (Start_NO + Cac_D * i) - Val(Text1(0).Text)
Call CoordCaculate.CoordLine(InPutX_1, InPutY_1, Cac_A, Distant)
ProgressBar1.Value = i
Next
End Select
If Distant + Val(Text1(0).Text) <> Val(Text1(3).Text) Then
Distant = Val(Text1(3).Text) - Val(Text1(0).Text)
Call CoordCaculate.CoordLine(InPutX_1, InPutY_1, Cac_A, Distant)
End If
ProgressBar1.Visible = False
Command2.Enabled = True
Command3.Enabled = True
' Check1.Enabled = True
' Check1.Value = 0
'输出边桩坐标
If Check1.Value = 1 Then Call CoordCaculate.Line_BZ(Cac_A)
Label3.Caption = "计算成功"
Label2.Caption = "请检查并保存！"
Line1:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -