form4.frm

VB编写的施工放样方法研究及其综合程序

      Begin VB.TextBox Text1 
         Height          =   375
         Left            =   2400
         TabIndex        =   15
         Top             =   360
         Width           =   1455
      End
      Begin VB.Label Label4 
         Caption         =   "y(m)"
         Height          =   255
         Index           =   5
         Left            =   4320
         TabIndex        =   11
         Top             =   480
         Width           =   735
      End
      Begin VB.Label Label4 
         Caption         =   "y(m)"
         Height          =   255
         Index           =   4
         Left            =   4320
         TabIndex        =   10
         Top             =   1080
         Width           =   735
      End
      Begin VB.Label Label4 
         Caption         =   "y(m)"
         Height          =   255
         Index           =   3
         Left            =   4320
         TabIndex        =   9
         Top             =   1680
         Width           =   735
      End
      Begin VB.Label Label4 
         Caption         =   "x(m)"
         Height          =   255
         Index           =   2
         Left            =   1920
         TabIndex        =   8
         Top             =   1080
         Width           =   735
      End
      Begin VB.Label Label4 
         Caption         =   "x(m)"
         Height          =   255
         Index           =   1
         Left            =   1920
         TabIndex        =   7
         Top             =   1680
         Width           =   735
      End
      Begin VB.Label Label4 
         Caption         =   "x(m)"
         Height          =   255
         Index           =   0
         Left            =   1920
         TabIndex        =   6
         Top             =   480
         Width           =   735
      End
      Begin VB.Label Label3 
         Caption         =   "控制点B坐标："
         Height          =   375
         Index           =   2
         Left            =   480
         TabIndex        =   5
         Top             =   1080
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "放样点S坐标："
         Height          =   375
         Index           =   1
         Left            =   480
         TabIndex        =   4
         Top             =   1680
         Width           =   1215
      End
      Begin VB.Label Label3 
         Caption         =   "控制点A坐标："
         Height          =   375
         Index           =   0
         Left            =   480
         TabIndex        =   3
         Top             =   480
         Width           =   1215
      End
   End
   Begin VB.Label Label5 
      Caption         =   "Label5"
      Height          =   375
      Index           =   1
      Left            =   4320
      TabIndex        =   13
      Top             =   4080
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "前方交会法放样数据计算"
      Height          =   615
      Left            =   1800
      TabIndex        =   0
      Top             =   360
      Width           =   4335
   End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim x1!, y1!, x2!, y2!, x3!, y3!, j1!, j2!, jAB!, jAC!, jBA!, jBC!, s1!, s2!, d%, f%, m!, z1!, z2!, zfh%
x1 = Val(Text1.Text)
y1 = Val(Text2.Text)
x2 = Val(Text3.Text)
y2 = Val(Text4.Text)
x3 = Val(Text5.Text)
y3 = Val(Text6.Text)
If x1 < x2 Then
If y1 <= y2 Then
jAB = Atn((y1 - y2) / (x1 - x2))
Else
jAB = 3.14159 * 2 + Atn((y1 - y2) / (x1 - x2))
End If
ElseIf x1 = x2 Then
If y1 < y2 Then
jAB = 3.14159 / 2
ElseIf y1 = y2 Then
MsgBox "注意：两控制点重合", 48, "错误提示"
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text1.SetFocus
Else
jAB = 3.14159 * 1.5
End If
Else
If y1 < y2 Then
jAB = 3.14159 + Atn((y1 - y2) / (x1 - x2))
ElseIf y1 = y2 Then
jAB = 3.14159
Else
jAB = 3.14159 + Atn((y1 - y2) / (x1 - x2))
End If
End If      '以上是讨论角AB在各象限的情况然后各象限的角AB值
If x1 < x3 Then
If y1 <= y3 Then
jAC = Atn((y1 - y3) / (x1 - x3))
Else
jAC = 3.14159 * 2 + Atn((y1 - y3) / (x1 - x3))
End If
ElseIf x1 = x3 Then
If y1 < y3 Then
jAC = 3.14159 / 2
ElseIf y1 = y3 Then
MsgBox "注意：控制点与放样点重合", 48, "错误提示"
Else
jAC = 3.14159 * 1.5
End If
Else
If y1 < y3 Then
jAC = 3.14159 + Atn((y1 - y3) / (x1 - x3))
ElseIf y1 = y3 Then
jAC = 3.14159
Else
jAC = 3.14159 + Atn((y1 - y3) / (x1 - x3))
End If
End If    '以上是讨论角AC在各象限的情况然后各象限的角AC值
j1 = jAC - jAB
d = Fix((j1 / 3.14159) * 180)
zfh = Sgn(d)
d = Abs(d)
z1 = Abs((j1 / 3.14159) * 180) - d
f = Fix(z1 * 60)
m = (z1 * 60 - f) * 60
m = CInt(m)
If m = 60 Then
f = f + 1
m = 0
End If
If f = 60 Then
d = d + 1
f = 0
End If
If zfh < 0 Then
Text7.Text = "-" & Str$(d) & "度" & Str$(f) & "分" & Str$(m) & "秒"
Else
Text7.Text = Str$(d) & "度" & Str$(f) & "分" & Str$(m) & "秒"
End If
s1 = Sqr((x1 - x3) * (x1 - x3) + (y1 - y3) * (y1 - y3))
Text9.Text = Str$(s1)
If jAB < 3.14159 Then
jBA = jAB + 3.14159
Else
jBA = jAB - 3.14159
End If
If x2 < x3 Then
If y2 <= y3 Then
jBC = Atn((y2 - y3) / (x2 - x3))
Else
jBC = 3.14159 * 2 + Atn((y2 - y3) / (x2 - x3))
End If
ElseIf x2 = x3 Then
If y2 < y3 Then
jBC = 3.14159 / 2
ElseIf y2 = y3 Then
MsgBox "注意：控制点与放样点重合", 48, "错误提示"
Else
jBC = 3.14159 * 1.5
End If
Else
If y2 < y3 Then
jBC = 3.14159 + Atn((y2 - y3) / (x2 - x3))
ElseIf y2 = y3 Then
jBC = 3.14159
Else
jBC = 3.14159 + Atn((y2 - y3) / (x2 - x3))
End If
End If    '以上是讨论角BC在各象限的情况然后各象限的角BC值
j2 = jBC - jBA
d = Fix((j2 / 3.14159) * 180)
zfh = Sgn(d)
d = Abs(d)
z1 = Abs((j2 / 3.14159) * 180) - d
f = Fix(z1 * 60)
m = (z1 * 60 - f) * 60
m = CInt(m)
If m = 60 Then
f = f + 1
m = 0
End If
If f = 60 Then
d = d + 1
f = 0
End If
If zfh < 0 Then
Text8.Text = "-" & Str$(d) & "度" & Str$(f) & "分" & Str$(m) & "秒"
Else
Text8.Text = Str$(d) & "度" & Str$(f) & "分" & Str$(m) & "秒"
End If
s2 = Sqr((x2 - x3) * (x2 - x3) + (y2 - y3) * (y2 - y3))
Text10.Text = Str$(s2)

End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""

End Sub

'Private Sub Form_Load()
'Command1.Enabled = False
'Command2.Enabled = False
'End Sub

'Private Sub Text1_Change()
'If Text1.Text <> "" Then
'Command1.Enabled = True
'Command2.Enabled = True
'End If
'End Sub