frm_auto.frm

全站仪学习测量与自动测量程序,测量数据excel导出.

      End
      Begin VB.Label Label5 
         Caption         =   "测站选择："
         Height          =   345
         Left            =   180
         TabIndex        =   16
         Top             =   270
         Width           =   1095
      End
   End
End
Attribute VB_Name = "frm_auto"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Combo1_Click()
 '(3)初始化数据
 p_sitename = Combo1.Text
connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\pyppeo.mdb;Persist Security Info=False"
Adodc1.ConnectionString = connstr
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select 站点,测点,水平角,竖直角,斜距,零方向 from cl_data_study where 站点='" & p_sitename & "' order by 水平角"
Adodc1.Refresh
 
End Sub

Private Sub Command1_Click() '自动测量
'(1) 保存测回数,根据零点计算自动测量顺序.
  Dim x_chs As Integer  '测回数
  x_chs = Val(Text6.Text)
  If x_chs < 1 Or x_chs > 20 Then
    MsgBox "输入的测回数有错误!请重新输入."
    Exit Sub
  End If
  Text1.Text = "设定的测回数为:" & Str(x_chs) & " ......"
  '处理测序
  Dim mrc As ADODB.Recordset
  Dim msgtxt As String
  Dim x_cdnum As Long
  Dim x_zero_v As Double
  Dim x_cur_v As Double
  msgtxt = ""
  sqltxt = "select * from cl_data_study where 站点='" & Combo1.Text & "' and 零方向=true"
  Set mrc = ExecuteSQL(sqltxt, msgtxt)
  If mrc.RecordCount < 1 Then
     MsgBox "没有定义零方向!"
     Exit Sub
  End If
  x_zero_v = mrc("水平角").Value
  Set mrc = Nothing
  
  sqltxt = "select * from cl_data_study where 站点='" & Combo1.Text & "' order by 零方向"
  Set mrc = ExecuteSQL(sqltxt, msgtxt)
  x_cdnum = mrc.RecordCount
  If x_cdnum = 0 Then
    MsgBox "没有测点!"
    Exit Sub
  End If
  mrc.MoveFirst
  Do While Not mrc.EOF
   x_cur_v = mrc("水平角").Value
   If x_cur_v - x_zero_v >= 0 Then
    mrc("测序").Value = x_cur_v - x_zero_v
   Else
    mrc("测序").Value = x_cur_v - x_zero_v + 360
   End If
   mrc.MoveNext
  Loop
  Set mrc = Nothing
  '取测序
  Dim x_cl_number As String
  x_cl_number = ""
  sqltxt = "select * from cl_data_study where 站点='" & Combo1.Text & "' order by 测序"
  Set mrc = ExecuteSQL(sqltxt, msgtxt)
  mrc.MoveFirst
  Do While Not mrc.EOF
   If x_cl_number = "" Then
     x_cl_number = mrc("测点").Value
     Else
     x_cl_number = x_cl_number & "-" & mrc("测点").Value
   End If
   mrc.MoveNext
  Loop
   mrc.MoveFirst
  Text1.Text = Text1.Text & vbCrLf & "测量点顺序为：" & x_cl_number & "   ............"
'(2)连接全站仪
  Text1.Text = Text1.Text & vbCrLf & "正在进行全站仪连接   ............"
If Not bApplRunning Then
    Result = VB_COM_Init()
    If Result = RC_OK Then
      Text1.Text = Text1.Text & vbCrLf & "全站仪初始化成功   ............"
      Result = VB_COM_OpenConnection(ComPort, COM_BAUD_9600, 1)
      If Result = RC_OK Then
         bApplRunning = True
         Text1.Text = Text1.Text & vbCrLf & "全站仪连接成功   ............"
      Else
         Text1.Text = Text1.Text & vbCrLf & "全站仪连接失败。"
         Call VB_COM_End
         Exit Sub
      End If
    Else
      Text1.Text = Text1.Text & vbCrLf & "全站仪初始化失败。"
      Exit Sub
    End If
 Else
  Text1.Text = Text1.Text & vbCrLf & "全站仪已为连接状态   ............"
 End If

'(3)根据测序,循环测量各点,并写入数据库
Dim c_hz As Double
Dim c_v As Double
Dim c_d As Double
Dim c_cd As String
Dim retag As Boolean
Dim coordinate As TMC_COORDINATE
For i = 1 To x_chs  '分多个测回进行测量
Text1.Text = Text1.Text & vbCrLf & "正在进行第" & i & "个测回   ............"
  mrc.MoveFirst
  Do While Not mrc.EOF  '顺测
    '(1)取得学习测量点的数据
    c_cd = mrc("测点").Value
    c_hz = mrc("水平角").Value
    c_v = mrc("竖直角").Value
    c_d = mrc("斜距").Value
    '(2)照准指定方向
     retag = p_MakPosition(c_hz, c_v)
     If Not retag Then
      MsgBox "点" & c_cd & "照准失败"
      Exit Sub
     End If
    '(3)精瞄
     retag = p_Fineadjust()
     If Not retag Then
      MsgBox "点" & c_cd & "精瞄失败"
      Exit Sub
     End If
    '(4)执行测距
    retag = LoopMeasure(coordinate)
    If Not retag Then
      MsgBox "点" & c_cd & "测距失败"
      Exit Sub
    End If
    '(5)获取数据
    c_hz = coordinate.dE
    c_v = coordinate.dN
    c_d = coordinate.dH
    Text2.Text = c_cd
    Text3.Text = c_hz
    Text4.Text = c_v
    Text5.Text = c_d
    Text1.Text = Text1.Text & vbCrLf & "点号：" & c_cd & "--- 水平角---" & c_hz & " 竖直角---" & c_v & " 斜距---" & c_d
    '(6)下一个点
    mrc.MoveNext
  Loop
  '零方向要多测一次
  mrc.MoveFirst
  c_cd = mrc("测点").Value
  c_hz = mrc("水平角").Value
  c_v = mrc("竖直角").Value
  c_d = mrc("斜距").Value
  retag = MeasureOneDot(c_cd, c_hz, c_v, coordinate)
  If retag Then
    c_hz = coordinate.dE
    c_v = coordinate.dN
    c_d = coordinate.dH
    Text2.Text = c_cd
    Text3.Text = c_hz
    Text4.Text = c_v
    Text5.Text = c_d
    Text1.Text = Text1.Text & vbCrLf & "点号：" & c_cd & "--- 水平角---" & c_hz & " 竖直角---" & c_v & " 斜距---" & c_d
  Else
    MsgBox "点" & c_cd & "测量失败(MeasureOnedot)"
    Exit Sub
  End If
  '---------------------------------------
  '倒镜，反过来测
   retag = ChangeFace()
   If Not retag Then
     MsgBox "倒镜失败"
     Exit Sub
   End If
  
  '零方向先测一次
  mrc.MoveFirst
  c_cd = mrc("测点").Value
  c_hz = mrc("水平角").Value
  c_v = mrc("竖直角").Value
  c_d = mrc("斜距").Value
  retag = MeasureOneDot(c_cd, c_hz, c_v, coordinate)
  If retag Then
    c_hz = coordinate.dE
    c_v = coordinate.dN
    c_d = coordinate.dH
    Text2.Text = c_cd
    Text3.Text = c_hz
    Text4.Text = c_v
    Text5.Text = c_d
    Text1.Text = Text1.Text & vbCrLf & "点号：" & c_cd & "--- 水平角---" & c_hz & " 竖直角---" & c_v & " 斜距---" & c_d
  Else
    MsgBox "点" & c_cd & "测量失败(MeasureOnedot)"
    Exit Sub
  End If
  
  '反测
  mrc.MoveLast
  Do While Not mrc.BOF
     '(1)取得学习测量点的数据
    c_cd = mrc("测点").Value
    c_hz = mrc("水平角").Value
    c_v = mrc("竖直角").Value
    c_d = mrc("斜距").Value
    '(2)照准指定方向
    '(3)精瞄
    '(4)执行测距
     retag = MeasureOneDot(c_cd, c_hz, c_v, coordinate)
    '(5)获取数据
  If retag Then
    c_hz = coordinate.dE
    c_v = coordinate.dN
    c_d = coordinate.dH
    Text2.Text = c_cd
    Text3.Text = c_hz
    Text4.Text = c_v
    Text5.Text = c_d
    Text1.Text = Text1.Text & vbCrLf & "点号：" & c_cd & "--- 水平角---" & c_hz & " 竖直角---" & c_v & " 斜距---" & c_d
  Else
    MsgBox "点" & c_cd & "测量失败(MeasureOnedot)"
    Exit Sub
  End If
    '(6)下一个点
    mrc.MovePrevious
  Loop
  '倒镜
  retag = ChangeFace()
   If Not retag Then
     MsgBox "倒镜失败"
     Exit Sub
   End If
Text1.Text = Text1.Text & vbCrLf & "第" & i & "个测回完成   ............"
Next i
'(4)断开全站仪连接
  Set mrc = Nothing
If bApplRunning Then
  bApplRunning = False
  Call VB_TMC_DoMeasure(TMC_CLEAR, TMC_AUTO_INC)
  Result = VB_COM_CloseConnection()
  If Result <> RC_OK Then
    Call VB_COM_ViewError(Result, "Error")
  End If
  Call VB_COM_End
End If
Text1.Text = Text1.Text & vbCrLf & "全站仪连接已断开,测量完成。"
End Sub

Private Sub Command3_Click()
  If bApplRunning Then
    bApplRunning = False
    Call VB_TMC_DoMeasure(TMC_CLEAR, TMC_AUTO_INC)
    Result = VB_COM_CloseConnection()
    If Result <> RC_OK Then
     Call VB_COM_ViewError(Result, "Error")
    End If
    Call VB_COM_End
  End If
  Unload Me
End Sub

Private Sub Form_Load()
'（1）添写测站选择列表
 Dim mrc As ADODB.Recordset
 Dim msgtxt As String
 sqltxt = "select 站名 from site_data order by 创建时间 desc"
 msgtxt = ""
 Set mrc = ExecuteSQL(sqltxt, msgtxt)
 Combo1.Clear
 For i = 1 To mrc.RecordCount
   Combo1.AddItem mrc("站名").Value
   mrc.MoveNext
 Next i
 If mrc.RecordCount > 0 Then
   Combo1.ListIndex = 0
 End If
 
'（2）初始化控件
 Text6.Text = ""
 Text1.Text = ""
 Text2.Text = ""
 Text3.Text = ""
 Text4.Text = ""
 Text5.Text = ""

End Sub