代码拉取完成,页面将自动刷新
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "AgilentIO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'agilent demo
Private Rm As VisaComLib.ResourceManager
Private Instrument As VisaComLib.FormattedIO488
Private InitFlag As Boolean
'init agilent io
Function IOInit(addr) As Boolean
On Error GoTo myErr
Set Rm = New VisaComLib.ResourceManager
Set Instrument = New VisaComLib.FormattedIO488
Set Instrument.IO = Rm.Open(addr)
Instrument.IO.Timeout = 300000
Instrument.IO.TerminationCharacterEnabled = True
InitFlag = True
IOInit = True
Exit Function
myErr:
InitFlag = False
IOInit = False
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有能够初始化IO!"
Exit Function
End If
End Function
'write string agilent io
Sub IOSendStr(Command As String)
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有初始化IO!"
Exit Sub
End If
Call Instrument.WriteString(Command)
End Sub
Sub WriteString(Command As String)
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有初始化IO!"
Exit Sub
End If
Instrument.WriteString Command
End Sub
'read string agilent io
Function IOReadStr() As String
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有初始化IO!"
Exit Function
End If
IOReadStr = Instrument.ReadString()
End Function
Function ReadString() As String
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有初始化IO!"
Exit Function
End If
ReadString = Instrument.ReadString()
End Function
'read number agilent io
Function IOReadNumber() As Variant
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有初始化IO!"
Exit Function
End If
IOReadNumber = Instrument.ReadNumber
End Function
'io opc
Sub IOOPC()
Dim IOReadStr As String
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有初始化IO!"
Exit Sub
End If
Call Instrument.WriteString("*OPC?")
IOReadStr = Instrument.ReadNumber()
While CInt(IOReadStr) <> 1
DoEvents
IOReadStr = CInt(Instrument.ReadNumber())
Wend
End Sub
'io idn
Function IOidn() As String
Dim IOReadStr As String
If InitFlag = False Then
On Error Resume Next
Err.Raise 1000, "AgilentIO.cls", "没有初始化IO!"
Exit Function
End If
Call Instrument.WriteString("*IDN?")
IOidn = Instrument.ReadString()
End Function
Sub ResetIO()
Instrument.WriteString "*RST"
Instrument.WriteString "*WAI"
End Sub
Sub DropIO()
Set Rm = Nothing
Set Instrument = Nothing
InitFlag = False
End Sub
Function readImgFile(fileName As String)
Dim tmp
tmp = "MMEM:STOR:IMAG " + """" + fileName + """"
Instrument.WriteString "MMEM:STOR:IMAG " + """" + fileName + """"
tmp = "MMEM:TRAN? " + """" + fileName + """"
Instrument.WriteString "MMEM:TRAN? " + """" + fileName + """" '仪器中数据到表格
readImgFile = Instrument.ReadIEEEBlock(BinaryType_UI1)
End Function
Function readCsvFile(fileName As String)
Dim tmp
tmp = "MMEM:STOR:CSV " + """" + fileName + """"
Instrument.WriteString "MMEM:STOR:FDAT " + """" + fileName + """"
tmp = "MMEM:TRAN? " + """" + fileName + """"
Instrument.WriteString "MMEM:TRAN? " + """" + fileName + """" '仪器中数据到表格
readCsvFile = Instrument.ReadIEEEBlock(BinaryType_UI1)
End Function
此处可能存在不合适展示的内容,页面不予展示。您可通过相关编辑功能自查并修改。
如您确认内容无涉及 不当用语 / 纯广告导流 / 暴力 / 低俗色情 / 侵权 / 盗版 / 虚假 / 无价值内容或违法国家有关法律法规的内容,可点击提交进行申诉,我们将尽快为您处理。