下面这段程序的对错请大神帮忙看一下,并且想让仪器的不同通道显示在不同的text中,而且存在连接问题,需要什么驱动
Option Explicit
Dim videfaultRM As Long ' Resource manager session returned by viOpenDefaultRM(videfaultRM)
Dim vi As Long ' Session identifier of devices
Dim errorStatus As Long ' VISA function status return code
Dim connected As Boolean ' Sets flag to determine if instrument is connected or not
Dim addr As String ' Used for the instrument address
Dim addrtype As String ' Used for the I/O type
Dim TotTime As Double ' Used to calculate total measurement time
Dim ReturnedData As String ' Used to read returned data
Dim NumRdgs As Long ' Used for the number of readings taken
Dim TrigCount As Integer ' Used to determine number of scans
Dim NumChan As Long ' Used to determine the number of channels scanned
Private Sub Form_Load()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub loads the form.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Enable form and list box
VISAExample.Enabled = True
VISAExample.Visible = True
List1.Enabled = True
List1.Visible = True
List1.AddItem ("Enter/select instrument address, if needed,")
List1.AddItem ("click on " + Chr(34) + "Select I/O" + Chr(34) + " to select the adress,")
List1.AddItem ("and click on " + Chr(34) + "Get Readings" + Chr(34) + " to trigger instrument.")
List1.AddItem ("Measurements will take some time.")
connected = False
End Sub
Sub RunProgram()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This program sets the 34970A to a pre-defined state, makes measurements, and
' returns the measurements.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Call the function that opens communication with instrument
If connected = False Then
If Not OpenPort Then
Exit Sub
End If
End If
' Abort a scan, if one is in progress
SendCmd "ABORt"
' Call sub to setup the 34970A
Setup
List1.Clear
List1.AddItem "Scanning and making measurements; please wait."
List1.AddItem "The instrument will scan through the channels once,"
List1.AddItem "then wait a pre-determined time, and scan again."
List1.AddItem "Measurement time is about: " + LTrim$(Str$(TotTime)) + " seconds."
List1.Refresh
' Call sub to trigger the 34970A, make measurements, and return the readings
Readings
' Enable Exit button
Exit_Prog.SetFocus
End Sub
Private Sub Setup()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub performs the instrument setup.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim DelayVal As Double
Dim TrigTime As Double
' Reset instrument to turn-on condition
SendCmd "*RST"
' Configure for temperature measurements
' Select channels 101 to 110
' Type J thermocouple measurement
' 3 digit (selected by *RST)
SendCmd "CONFigure:TEMPerature TCouple, J, (@101:110)"
' Select the temperature unit (C = Celcius)
SendCmd "UNIT:TEMPerature C, (@101:110)"
' Set the reference temperature type (internal)
SendCmd "SENSe:TEMPerature:TRANSducer:TCouple:RJUNction:TYPE INTernal, (@101:110)"
' Configure for voltage readings:
' Select channels 111 to 120
' DC volts
' 10 V range
' 5.5 digit (selected by *RST)
SendCmd "CONFigure:VOLTage:DC 10, (@111:120)"
' Set the number of power line cycles for all channels to 1
SendCmd "SENSe:VOLTage:NPLC 1,(@111:120)"
' Select the scan list for channels 101 to 120 (all configured channels)
SendCmd "ROUTe:SCAN (@101:120)"
' Set the same measurement delay between the channels
SendCmd "ROUTe:CHANnel:DELay 0.25, (@101:120)"
' Set number of sweeps to 2; use your own value
SendCmd "TRIGger:COUNt 2"
' Set the trigger mode to TIMER (timed trigger); use your own type
SendCmd "TRIGger:SOURce TIMer"
' Set the trigger time to 10 seconds (i.e., time between scans); use your own value
SendCmd "TRIGger:TIMer 10"
' Format the reading time to show the time value from the start of the scan
SendCmd "FORMat:READing:TIME:TYPE RELative"
' Add time stamp to reading using the selected time format
SendCmd "FORMat:READing:TIME ON"
' Add the channel number to the returned readings
SendCmd "FORMat:READing:CHANnel ON"
' Wait for instrument to setup
SendCmd "*OPC?"
ReturnedData = GetData()
' Gets the number of channels to be scanned; used to determine the number of readings
SendCmd "ROUTe:SCAN:SIZE?"
NumChan = Val(GetData())
' Gets the number of triggers; used to determine the number of scans
SendCmd "TRIGger:COUNt?"
TrigCount = Val(GetData())
' Get the delay; for future use
SendCmd "ROUTe:CHANnel:DELay? (@101)"
DelayVal = Val(GetData())
' Get the trigger time
SendCmd "TRIGger:TIMer?"
TrigTime = Val(GetData())
' Calculate total number of readings
NumRdgs = NumChan * TrigCount
' Calculate total time
TotTime = (TrigTime * TrigCount) - TrigTime + (NumChan * DelayVal)
'Check for errors
Call Check_Error("Setup")
End Sub
Sub Readings()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub triggers the instrument, makes the measurements, and returns the readings.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim rdgs As String
Dim readval As String
Dim timerdg As String
Dim chrdg As String
Dim Dateval As String
Dim timeval As String
Dim temp As Long
Dim I As Long
' Trigger the insreument
SendCmd "INITiate"
' Get the date at which the scan was started
SendCmd "SYSTem:DATE?"
Dateval = GetData()
' Get the time at which the scan was started
SendCmd "SYSTem:TIME?"
timeval = GetData()
' Wait until instrument is finished taken readings.
Do
SendCmd "DATA:POINTS?"
ReturnedData = GetData()
temp = Val(ReturnedData)
Loop Until temp = NumRdgs
List1.Clear
List1.AddItem "Enter/select instrument address, if needed;"
List1.AddItem "then click on " + Chr$(34) + "Get Readings" + Chr$(34) + " to trigger instrument."
List1.AddItem "Measurements will take some time."
List1.AddItem ""
List1.AddItem "Start Date (yyyy,mm,dd): " + Left$(Dateval, Len(Dateval) - 1)
List1.AddItem "Start Time (hh,mm,ss): " + Left$(timeval, Len(timeval) - 1)
List1.AddItem "Rdng#" + Chr$(9) + "Channel" + Chr$(9) + "Value" + Chr$(9) + Chr$(9) + "Time"
List1.Refresh
' Check for errors
Call Check_Error("Readings")
' Take readings out of memory one reading at a time. The "FETCh?" can also be used.
' It reads all readings in memory, but leaves the readings in memory. The
' "DATA:REMove?" command removes and erases the readings in memory.
For I = 1 To NumRdgs
' Get reading value
SendCmd "DATA:REMove? 1 "
rdgs = GetData()
readval = Mid$(rdgs, 1, InStr(rdgs, ",") - 1)
rdgs = Mid$(rdgs, InStr(rdgs, ",") + 1, Len(rdgs))
' Get time stamp and channel number
timerdg = Mid$(rdgs, 1, InStr(rdgs, ",") - 1)
rdgs = Mid$(rdgs, InStr(rdgs, ",") + 1, Len(rdgs))
' Get channel number
chrdg = rdgs
rdgs = LTrim$(Str$(I)) + Chr$(9) + chrdg + Chr$(9) + readval + Chr$(9) + timerdg
List1.AddItem rdgs
Next I
End Sub
Function OpenPort() As Boolean
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This function opens a port (the communication between the instrument and computer).
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim addr As String
' If port is open, close it
If connected Then
errorStatus = viClose(vi)
End If
' Get I/O Address
addr = UCase(ioType.Text)
' Open the Visa session
errorStatus = viOpenDefaultRM(videfaultRM)
' Open communication to the instrument
errorStatus = viOpen(videfaultRM, addr & "::INSTR", 0, 0, vi)
' Set timeout in milliseconds; set the timeout for your requirements
errorStatus = viSetAttribute(vi, VI_ATTR_TMO_VALUE, 2000)
' Set the RS-232 parameters; refer to the 34970A and VISA documentation
' to change the settings. Make sure the instrument and the following
' settings agree.
errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_BAUD, 115200)
errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_DATA_BITS, 8)
errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_PARITY, VI_ASRL_PAR_NONE)
errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_STOP_BITS, VI_ASRL_STOP_ONE)
errorStatus = viSetAttribute(vi, VI_ATTR_ASRL_FLOW_CNTRL, VI_ASRL_FLOW_XON_XOFF)
' Set the instrument to remote
SendCmd "SYSTem:REMote"
' Check and make sure the correct instrument is addressed
SendCmd "*IDN?"
ReturnedData = GetData()
If (InStr(ReturnedData, "34970A") = 0) Then
MsgBox "Incorrect instrument addressed; use the correct address."
ioType.Text = "::INSTR"
ioType.Refresh
connected = False
OpenPort = False
' Close instrument session
errorStatus = viClose(vi)
' Close the session
errorStatus = viClose(videfaultRM)
Exit Function
End If
' Clear list box
List1.Clear
List1.AddItem "Instrument ID is:"
List1.AddItem ReturnedData
' Check and make sure the 34901A Module is installed in slot 100;
' Exit program if not correct
SendCmd ("SYSTem:CTYPe? 100")
ReturnedData = GetData()
If InStr(ReturnedData, "34901A") = 0 Then
MsgBox "Incorrect Module Installed in slot 100!"
End_Prog
End If
' Check if the DMM is installed
SendCmd ("INSTrument:DMM:INSTalled?")
ReturnedData = GetData()
'If not installed, stop programming the 34970A
If Val(ReturnedData) = 0 Then
MsgBox "DMM not installed; unable to make measurements."
End_Prog
End If
' Check if the DMM is enabled; enable if not enabled
SendCmd ("INSTrument:DMM?")
ReturnedData = GetData()
If Val(ReturnedData) = 0 Then
SendCmd ("INSTrument:DMM ON")
End If
connected = True
OpenPort = True
End Function
Private Sub SendCmd(SCPICmd As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This routine will send a SCPI command string to the instrument. If the
' command contains a question mark (i.e., is a query command), you must
' read the response with the 'GetData' function.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim commandstr As String ' Command passed to instrument
Dim actual As Long ' Number of characters sent/returned
' Set up an error handler within subroutine to be called if an error occurs.
'On Error GoTo VIerrorHandler
' Write the command to the instrument (terminated by a linefeed)
commandstr = SCPICmd & Chr$(10)
errorStatus = viWrite(vi, ByVal commandstr, Len(commandstr), actual)
Exit Sub
End Sub
Function GetData() As String
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This function reads the string returned by the instrument
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim readbuf As String * 2048 ' Buffer used for returned string
Dim replyString As String ' Store the string returned
Dim valpos As Integer ' Location of any null's and line feed in readbuf
Dim actual As Long ' Number of characters sent/returned
' Read the response string
errorStatus = viRead(vi, ByVal readbuf, 2048, actual)
replyString = readbuf
If actual = 0 Then
GoTo VIerrorHandler
End If
' Strip out the line feed, if any
If InStr(replyString, Chr$(10)) Then
replyString = Left(replyString, InStr(replyString, Chr$(10)) - 1)
End If
' Strip out the carriage returnfeed, if any
If InStr(replyString, Chr$(13)) Then
replyString = Left(replyString, InStr(replyString, Chr$(13)) - 1)
End If
' return data
GetData = replyString
Exit Function
VIerrorHandler:
' Display the error message
MsgBox " I/O Error"
' Close the device session
errorStatus = viClose(vi)
' Close the session
errorStatus = viClose(videfaultRM)
End
End Function
Sub Check_Error(msg As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Checks for syntax and other errors.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Dim err_code As Integer
Dim err_msg As String
Dim TempCheck As Integer
Dim valpos As Integer
' check for initial error
SendCmd "SYSTem:ERRor?"
err_msg = GetData()
' If error found, check for more errors and exit program
err_code = Val(err_msg)
TempCheck = 0
While err_code <> 0
TempCheck = 1
msg = "Error in: " + msg + Chr$(10)
msg = msg + "Error Number: " + Str$(err_code) + Chr$(10) + "Error Message: " + err_msg
MsgBox msg
' check for more errors
SendCmd "SYSTem:ERRor?"
err_msg = GetData()
err_code = Val(err_msg)
Wend
If TempCheck <> 0 Then
' Send a device clear
SendCmd "*CLS"
' Close instrument session
errorStatus = viClose(vi)
' Close the session
errorStatus = viClose(videfaultRM)
' end the program
End
End If
End Sub
Private Sub GetReadings_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Call sub routine to trigger instrument and get readings.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Call the Readings sub
RunProgram
End Sub
Private Sub Exit_Prog_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Calls sub to close the session and end program.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Calls the sub
End_Prog
End Sub
Sub End_Prog()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Closes the session and program.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
If connected Then
' Abort a scan
SendCmd "ABORt"
' Send a device clear
SendCmd "*CLS"
' Close instrument session
errorStatus = viClose(vi)
' Close the session
errorStatus = viClose(videfaultRM)
End If
End
End Sub
Private Sub SelectIO_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Button that selects the I/O and creates an instrument session.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Establish communications
OpenPort
End Sub