basicpro.bas

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

Attribute VB_Name = "basicpro"
Global p_sitename As String
Global conn_status As String
Global ComPort As Long
Global bApplRunning As Boolean
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public Function ConnectString() As String
ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\pyppeo.mdb;Persist Security Info=False"
End Function

Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset
   Dim cnn As ADODB.Connection
   Dim rst As ADODB.Recordset
   Dim sTokens() As String
   On Error GoTo ExecuteSQL_Error
   sTokens = Split(SQL)
   Set cnn = New ADODB.Connection
   cnn.Open ConnectString
   If InStr("INSERT,DELETE,UPDATE,EXECUTE", UCase$(sTokens(0))) Then
      cnn.Execute (SQL)
          MsgString = sTokens(0) & " query successful"
   Else
        Set rst = New ADODB.Recordset
      rst.Open Trim$(SQL), cnn, adOpenKeyset, adLockOptimistic
      Set ExecuteSQL = rst
      MsgString = "查询到" & rst.RecordCount & " 条记录 "
    End If
ExecuteSQL_Exit:
   Set rst = Nothing
   Set cnn = Nothing
   Exit Function
ExecuteSQL_Error:
   MsgString = "查询错误: " & Err.Description
   Resume ExecuteSQL_Exit
End Function

'全站仪函数--------------------------------
'粗瞄函数
Public Function p_MakPosition(ByVal c_hz, ByVal c_v) As Boolean
  Dim grc As Long
  grc = RC_IVRESULT
  Dim tryagain As Boolean
  tryagain = True
  p_MakPosition = False
  Do While grc <> RC_OK And tryagain
    grc = VB_AUT_MakePositioning4(c_hz, c_v, AUT_NORMAL, AUT_POSITION, False)
    Call Sleep(2000)
    If grc = RC_OK Then
      p_MakPosition = True
      tryagain = False
    Else
     If (grc = 8704 Or grc = 3077 Or grc = 8706) Then
       '再瞄
     Else
       tryagain = False
       p_MakPosition = False
     End If
    End If
  Loop

End Function
'精瞄函数
Public Function p_Fineadjust() As Boolean
  Dim onoff As Long
  Dim onoff_result As Long
  Dim grc As Long
  grc = RC_IVRESULT
  Dim tryagain As Boolean
  tryagain = True
  p_Fineadjust = False
  Do While grc <> RC_OK And tryagain
    grc = VB_AUT_FineAdjust3(0.08, 0.08, False)
    Call Sleep(3500)
    If grc = RC_OK Then
      p_Fineadjust = True
      tryagain = False
    ElseIf grc = 8714 Then
       '设置模式
       onoff_result = VB_AUT_GetATRStatus(onoff)
       If onoff = 0 Then
         onoff_result = VB_AUT_SetATRStatus(1)
       End If
    ElseIf grc = 3077 Or grc = 8704 Then
       '再瞄
       
    Else
       tryagain = False
       p_Fineadjust = False
    End If
  Loop

End Function
'循环测量
Public Function LoopMeasure(ByRef coordinate As TMC_COORDINATE) As Boolean
  Dim flag As Long
  Dim coordinate1 As TMC_COORDINATE
  LoopMeasure = False
  For i = 1 To 4
    flag = VB_TMC_DoMeasure(TMC_DEF_DIST, TMC_AUTO_INC)
    Call Sleep(10000)
    If flag = RC_OK Then
      Exit For
    End If
  Next i
  If flag = RC_OK Then
    flag = VB_TMC_GetCoordinate1(2000, coordinate1, TMC_AUTO_INC)
    coordinate = coordinate1
    LoopMeasure = True
  End If
  
End Function
'一个点的测量
Public Function MeasureOneDot(ByVal c_cd As String, ByVal c_hz As Double, ByVal c_v As Double, ByRef coordinate As TMC_COORDINATE) As Boolean
  Dim retag As Long
 '(2)照准指定方向
     retag = p_MakPosition(c_hz, c_v)
     If Not retag Then
      MeasureOneDot = False
      Exit Function
     End If
    '(3)精瞄
     retag = p_Fineadjust()
     If Not retag Then
      MeasureOneDot = False
      Exit Function
     End If
    '(4)执行测距
    retag = LoopMeasure(coordinate)
    If Not retag Then
      MeasureOneDot = False
      Exit Function
    End If
    MeasureOneDot = True
End Function
'全站仪倒镜
Public Function ChangeFace() As Boolean
   Dim retag As Long
   Dim tryagain As Boolean
   tryagain = True
   retag = RC_IVRESULT
   ChangeFace = False
   Do While retag <> RC_OK And tryagain
     retag = VB_AUT_ChangeFace4(AUT_PRECISE, AUT_POSITION, False)
     Call Sleep(2000)
     If retag = RC_OK Then
        tryagain = False
        ChangeFace = True
     ElseIf retag = 8706 Then
        Call VB_TMC_SetInclineSwitch(OFF)
     Else
        tryagain = False
     End If
   Loop
End Function