AnsweredAssumed Answered

Programming 3458A

Question asked by ravenn on Sep 28, 2010
hi,
first, this is the first time i'm working with all of this...
i am trying to read measured values from a 3458a multimeter. I'm working with excell and VBA and i managed to get readings into excell sheets, however i can't figure out how to get one reading at a time along with the time at which it was taken. Currently i can get one set of reading at once from device memory or rerun the program for each reading. This messes up timing.
I need a set of reading, for example 1, 10 or 60 seconds apart, with the moment of each reading, and to run either for a predefined time or until it is stopped by the user.  I figure if i can get one value at a time and not at the end of the program i can insert the time using excell, like i'm doing now, but without the delays of rerunning the entire thing...
any advice would help, sorry if my text is tangled upXD

this is the code for now:

Option Explicit

Dim io_mgr As VisaComLib.ResourceManager ' to be used for the resource manager
Dim DMM As VisaComLib.FormattedIO488 ' to create a formatted I/O reference

Dim vals As String * 9

'variables for sheet placing
Dim row As Long
Dim place As Integer

'variables for measurement intervals
Dim interv As Integer
Dim xtimes As Integer
Dim freqM As Integer

'variables for time
Dim startTime As Date

Dim connected As Boolean   ' Sets flag to determine if instrument is connected or not


Sub RunProgram()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub sets the 3458A to a pre-defined state, makes measurements, and
' returns the measurements.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

List1.Clear

' Call the sub that opens communication with instrument
If connected = False Then
    If Not OpenPort Then
        Exit Sub
    End If
End If

' Setup the 3458A
Setup

'get time at start of measurement
startTime = Now()

' Make measurements and return readings
GetReadings

End Sub

Sub Setup()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub performs the instrument setup.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim Cmds As String

' Setup the 3458A
Cmds = "PRESET DIG;"              ' Preset to the designated state (Digitizing)
Cmds = Cmds + "MFORMAT DINT;"     ' Set the memory storage format (double integer)
Cmds = Cmds + "OFORMAT ASCII;"    ' Set the output format (ASCI)
Cmds = Cmds + "MEM FIFO;"         ' Clear memory and set memory storage type
Cmds = Cmds + "NPLC 100;"

'option button controled if functions, chose between two and four wire input
If twowire.Value = True Then
Cmds = Cmds + "FUNC OHM, AUTO;"
End If
If fourwire.Value = True Then
Cmds = Cmds + "FUNC OHMF, AUTO;"
End If

Cmds = Cmds + "TRIG AUTO;"        ' Set the trigger source (Auto)
Cmds = Cmds + "NRDGS 1,AUTO;"
Cmds = Cmds + "TIMER 1;"

Cmds = Cmds + "END ON;"           ' Enable EOI function
Cmds = Cmds + "TARM HOLD"         ' Hold the trigger until triggered

' Execute the commands
DMM.WriteString Cmds

' Check for errors
Check_Error "Setup"

End Sub

Sub GetReadings()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This sub triggers the instrument and returns the readings from memory.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim rdgs As Variant
Dim rdcnt As Integer
Dim I As Integer

' Trigger the 3458A
DMM.WriteString "TARM SGL"

' Read status byte to determine when measurements are complete
Do
    rdcnt = DMM.IO.ReadSTB
    rdcnt = rdcnt And 128
Loop Until rdcnt = 128

' Get number of readings taken
With DMM
    .WriteString "MCOUNT?"
    rdcnt = .ReadNumber
End With


List1.AddItem "Number readings taken:" + Str$(rdcnt)
List1.AddItem "Returning readings; takes some time."
List1.AddItem ""
List1.AddItem "Rdg#" + Chr$(9) + "Readings"
List1.AddItem "---------" + Chr$(9) + "------------------------------"

' Return the readings
With DMM
    .WriteString "RMEM 1," + Str$(rdcnt)
    rdgs = .ReadList(ASCIIType_BSTR, ",")
End With

Dim Lastplace As Integer 'end possition of each cycle
Lastplace = place + 1
Range(Cells(place, 1), Cells(Lastplace, 1)).Select
Range(Cells(place, 1), Cells(Lastplace, 1)).Name = "rangeL"
row = 1

' Enter readings into list box and sheet
For I = 1 To rdcnt
    vals = Str$(rdgs(I - 1)) 'values are put into fixed length string
    List1.AddItem Str$(I) + Chr$(9) + vals
    Range("rangeL").Cells(row, 2).Value = rdgs(I - 1) / 1000000000 'write value to column B
    Range("rangeL").Cells(row, 1).Value = Now() 'write time
    row = row + 1
Next I

place = Lastplace

Range(Cells(2, 1), Cells(40, 1)).NumberFormat = "dd.mm.yyyy hh:mm:ss"

' Check for errors
Check_Error "GetReadings"

End Sub

Function OpenPort() As Boolean
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This function opens a port (the communication between the instrument and computer).
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim addr As String ' to be used for the instrument address
Dim retval As String

' Exit if error occurs
On Error GoTo MyError

' If port is open, close it
If connected Then
    DMM.IO.Close
End If

' Set the resource manager session
Set io_mgr = New AgilentRMLib.SRMCls

' Create the VISA Com object
Set DMM = New VisaComLib.FormattedIO488

' Get the instrument address form the text box
addr = UCase$(addrSelect.Text)

' Set the VISA Com resource session
Set DMM.IO = io_mgr.Open(addr, True, True, "")

' Set timeout to 5 seconds
DMM.IO.Timeout = 50000

' Set the termination character to carriage return (i.e., 13);
' the 3458A uses this character
DMM.IO.TerminationCharacter = 13

' Set the flag to terminate when receiving a termination character
DMM.IO.TerminationCharacterEnabled = True

' Query instrument ID string
With DMM
    .WriteString "ID?"
    retval = .ReadString
End With

' Check if correct instrument is addressed
If InStr(retval, "3458A") = 0 Then
    MsgBox "Wrong instrument addressed!"
    addrSelect.Text = "GPIB0::22"
   ' addrSelect.Refresh
    connected = False
    OpenPort = False

    ' Close the session
    DMM.IO.Close

    Exit Function
End If

' Remove carriage return
retval = Left$(retval, InStr(retval, Chr$(13)) - 1)

' Reset the 3458A to it's power on state
DMM.WriteString "RESET"

' Check for errors
Check_Error "OpenPort"

connected = True
OpenPort = True

Exit Function

MyError:
   
    MsgBox Err.Description
    End

End Function

Sub ClosePort()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' This club closes the communication with the instrument.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

If connected Then
    ' Close the port
    DMM.IO.Close
End If

End Sub

Sub Check_Error(msg As String)
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Checks for syntax and other errors.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

Dim ErrMsg As String * 80

' Check for error
With DMM
    .WriteString "ERRSTR?"
    ErrMsg = .ReadString
End With

' If error is found, show the errorrmem

If val(ErrMsg) Then
    ' Strip out the carriage return
    ErrMsg = Left(ErrMsg, InStr(ErrMsg, Chr$(13)) - 1)
    ' Get error message
    MsgBox "Error is: " + RTrim$(ErrMsg) + Chr$(10) + "In sub/function: " + msg
   
    ' Close sessions
    ClosePort
   
    ' Close program
    End
   
End If

End Sub

Private Sub ClearB_Click()
    'Clear previous readings from the sheet
    Range(Cells(2, 2), Cells(40, 2)).Clear
    Range(Cells(2, 1), Cells(40, 1)).Clear

End Sub

Private Sub esc_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Closes the session and exits the program.
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Reset the 3458A to it's power on state
DMM.WriteString "RESET"

' Close sessions
ClosePort

' Close program
End

End Sub
'close connection and set device to ohm or ohmf mesurement


Private Sub SelectAddr_Click()
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' Selects address and opens session
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""

' Open port
If Not OpenPort Then
    Exit Sub
Else
    connected = True
End If

End Sub

Private Sub startb_Click()

Dim tmr As Variant          'current time during measurment
Dim tmr2 As Variant         'starting time

    place = 2               'starting possition
    Cells(1, 6).Value = intsec.Value * 0.00001 'time interval - to be send to sheet
    'stopb.Value = False     'reset stop button
    tmr2 = Time()           'starting time
    Cells(1, 5).Value = Time()    'send time to sheet
    tmr2 = Cells(1, 7)      'get time with added interval
    List1.Clear
    Do
        tmr = Time()
        RunProgram
    Loop While tmr < tmr2
    
   startb.Value = False
End Sub


'Increase measuring interval -> will give a no of values
'from which one set of min max and avg if computed
Private Sub dectime_Click()
If intsec.Value >= 20 Then
intsec.Value = intsec.Value - 10
End If
End Sub
'Decrease measuring interval -> will give a no of values
'from which one set of min max and avg if computed
Private Sub inctime_Click()
intsec.Value = intsec.Value + 10
End Sub


Outcomes