Other topics about Sample Programs
This sample program demonstrates on how to obtain the measurement data for calculating the calibration and compensation coefficients.
The sample program begins by configuring the measurement point setup table and calibration kit and configuring the instrument accordingly. After measuring the necessary data, it then calculates the calibration coefficients and turns ON the calibration function. It lets the user select a test fixture and configure the compensation kit. Finally, it measures the data for calculating the compensation coefficients.
In this program, the measurement point setup table in configured as below:
|
Point number |
Measuring frequency |
Averaging factor |
Signal source level |
|
1 |
1 MHz |
4 |
0 dBm |
|
2 |
10 MHz |
4 |
0 dBm |
|
3 |
100 MHz |
4 |
0 dBm |
See these topics for this programming:
Selecting a Test Fixture (Port Extension Compensation)
Running the Compensation Process
Sub Calibration()
'*** The variables of the resource manager and the instrument I/O are declared
Dim ioMgr As VisaComLib.ResourceManager
Dim age4982x As VisaComLib.FormattedIO488
Dim ReadData() As Double
Dim i As Integer
'*** The memory area of the resource manager and the instrument I/O are acquired
Set ioMgr = New VisaComLib.ResourceManager
Set age4982x = New VisaComLib.FormattedIO488
'*** Open the instrument. Sets the GPIB address.
Set age4982x.IO = ioMgr.Open("GPIB0::17::INSTR")
age4982x.IO.Timeout = 30000 ' TimeOut time should be greater than the measurement time.
'*** Variable declaration
Dim Buff As String, File As String, Inp_char As String, Ofile As String
Dim Cal_coef_a1() As Double, Cal_coef_a2() As Double
Dim Cal_coef_b1() As Double, Cal_coef_b2() As Double
Dim Cal_coef_c1() As Double, Cal_coef_c2() As Double
Dim Cal_coef_dc(3) As Double
Dim Open_l_lim As Double, Short_u_lim As Double, Load_l_lim As Double, Load_u_lim As Double
Dim Scode As Integer, Result As Integer, Nop As Integer
'*** Clear old data
ActiveSheet.Range("C10:E10").Clear
ActiveSheet.Range("H11:S221").Clear
ActiveSheet.Cells(1, 1).Select
'*** Resets the instrument.
age4982x.WriteString ":SYST:PRES", True
'*** Sets the data transfer format to ASCII.
age4982x.WriteString ":FORM ASC", True
'*** Configures the measurement point setup table as follows.
age4982x.WriteString ":SOUR:LIST:TABL 1", True
age4982x.WriteString ":SOUR:UNIT DBM", True
age4982x.WriteString ":SOUR:LIST 3,", False
age4982x.WriteString "10E6, 4, 0,", False
age4982x.WriteString "100E6, 4, 0,", False
age4982x.WriteString "1E9, 4, 0", True
'*** Passes control to a subprogram named Set_cal_kit to configure the calibration kit.
MsgBox "## Calibration Kit Setting ##", vbOKOnly
Call Set_cal_kit(age4982x)
'*** Passes control to a subprogram named Inp_data, which prompts the user to enter the limit values for each standard. Then the program
'*** stores the Rdc measurement lower limit for the OPEN standard into the Open_l_lim variable, the Rdc measurement upper limit for the SHORT
'*** standard into the Short_u_lim variable, and the Rdc measurement lower and upper limits for the LOAD standard into the Load_l_lim and
'*** Load_u_lim variables, respectively.
MsgBox "## Rdc Limit Setting ##", vbOKOnly
Call Inp_data("Open Lower Limit", Open_l_lim)
Call Inp_data("Short Upper Limit", Short_u_lim)
Call Inp_data("Load Lower Limit", Load_l_lim)
Call Inp_data("Load Upper Limit", Load_u_lim)
'*** Passes control to a subprogram named FNCal, which measures the data for OPEN, SHORT, and LOAD standard.
MsgBox "## Measurement ##", vbOKOnly
Result = FNCal(age4982x, "Open", Open_l_lim, 1000000000#)
If Result <> 0 Then Exit Sub
Result = FNCal(age4982x, "Short", -1000000000#, Short_u_lim)
If Result <> 0 Then Exit Sub
Result = FNCal(age4982x, "Load", Load_l_lim, Load_u_lim)
If Result <> 0 Then Exit Sub
'*** Prompts the user to confirm whether to measure a low-loss capacitor and waits until the user presses the y or n key.
Inp_char = Val(InputBox("Low Loss Capacitor is valid ONLY for 16195B. Do you want to measure Low Loss Capacitor? [Y]es/[N]o", "LLC", "y"))
'*** If the user presses the y key in response to the above line, the program passes control to the FNCal subprogram to obtain the measurement
'*** data for the low-loss capacitor.
' If Inp_char = "Y" Or Inp_char= "YES" Then
If UCase(Inp_char) = "Y" Or UCase(Inp_char) = "YES" Then
Result = FNCal(age4982x, "Low Loss C", -1000000000#, 1000000000#)
If Result <> 0 Then Exit Sub
End If
'*** Calculates the calibration coefficients and turns on the calibration function.
age4982x.WriteString ":CORR1:COLL:SAVE", True
age4982x.WriteString "*OPC?", True
Buff = age4982x.ReadNumber
'*** Calibration Coefficient Array Reading.
'*** Retrieves the number of measurement points and resizes the arrays accordingly.
age4982x.WriteString ":SOUR:LIST:SIZE?", True
Nop = age4982x.ReadNumber
'Nop = Nop - 1
'*** Retrieves the calibration coefficients for impedance measurement, A1, B1, C1, A2, B2, and C2
'*** and then stores them into the excel sheet.
age4982x.WriteString ":DATA:CCO1?", True
ReadData() = age4982x.ReadList(ASCIIType_R8, ",")
For i = 0 To Nop - 1
ActiveSheet.Cells(i + 11, 8).value = ReadData(i * 2)
ActiveSheet.Cells(i + 11, 9).value = ReadData(i * 2 + 1)
Next i
age4982x.WriteString ":DATA:CCO2?", True
ReadData() = age4982x.ReadList(ASCIIType_R8, ",")
For i = 0 To Nop - 1
ActiveSheet.Cells(i + 11, 10).value = ReadData(i * 2)
ActiveSheet.Cells(i + 11, 11).value = ReadData(i * 2 + 1)
Next i
age4982x.WriteString ":DATA:CCO3?", True
ReadData() = age4982x.ReadList(ASCIIType_R8, ",")
For i = 0 To Nop - 1
ActiveSheet.Cells(i + 11, 12).value = ReadData(i * 2)
ActiveSheet.Cells(i + 11, 13).value = ReadData(i * 2 + 1)
Next i
age4982x.WriteString ":DATA:CCO4?", True
ReadData() = age4982x.ReadList(ASCIIType_R8, ",")
For i = 0 To Nop - 1
ActiveSheet.Cells(i + 11, 14).value = ReadData(i * 2)
ActiveSheet.Cells(i + 11, 15).value = ReadData(i * 2 + 1)
Next i
age4982x.WriteString ":DATA:CCO5?", True
ReadData() = age4982x.ReadList(ASCIIType_R8, ",")
For i = 0 To Nop - 1
ActiveSheet.Cells(i + 11, 16).value = ReadData(i * 2)
ActiveSheet.Cells(i + 11, 17).value = ReadData(i * 2 + 1)
Next i
age4982x.WriteString ":DATA:CCO6?", True
ReadData() = age4982x.ReadList(ASCIIType_R8, ",")
For i = 0 To Nop - 1
ActiveSheet.Cells(i + 11, 18).value = ReadData(i * 2)
ActiveSheet.Cells(i + 11, 19).value = ReadData(i * 2 + 1)
Next i
'*** Retrieves the calibration coefficients for Rdc measurement, A, B, and C, and then stores them in the excel sheet
'*** retaining the original order.
age4982x.WriteString ":DATA:RCCO1?", True
ActiveSheet.Cells(10, 3).value = age4982x.ReadNumber
age4982x.WriteString ":DATA:RCCO2?", True
ActiveSheet.Cells(10, 4).value = age4982x.ReadNumber
age4982x.WriteString ":DATA:RCCO3?", True
ActiveSheet.Cells(10, 5).value = age4982x.ReadNumber
'*** Call Compensation Function
Call Compensation(age4982x)
End Sub
'*** Calibration Data Measurement Function
'*** The FNCal subprogram measures the data for calculating the calibration coefficients.
Function FNCal(LCRMeter As VisaComLib.FormattedIO488, Standard As String, L_lim As Double, U_lim As Double) As Integer
Dim Inp_char As String, Trig_sour As String
Dim Buff As Integer, BitWaitingForTrigger As Integer, CondReg As Integer
Dim Rdc As Double
Dim Meas_data As Double
Dim Err_flag As Integer
'*** Retrieves the current trigger source setting and stores the setting into the Trig_sour variable.
LCRMeter.WriteString ":TRIG:SOUR?", True
Trig_sour = LCRMeter.ReadString
'*** After measurement is stopped (the trigger system is stopped), the program sets the trigger source to GPIB/LAN trigger and
'*** turns ON the continuous activation of the trigger system.
LCRMeter.WriteString ":ABOR", True
LCRMeter.WriteString ":TRIG:SOUR BUS", True
LCRMeter.WriteString ":INIT:CONT ON", True
Cal_meas:
'*** Prompts the user to set up the connection for measuring the standard identified by Standard and
'*** waits until the user presses the y key followed by the return key.
Inp_char = InputBox("Set " & Standard & "-Connection. OK? [Y/N]", "Calibration Execution", "y")
If UCase(Inp_char) = "Y" Or UCase(Inp_char) = "YES" Then
'*** Clears the status byte register and operation status event register.
LCRMeter.WriteString "*CLS", True
LCRMeter.WriteString "*OPC?", True
Buff = LCRMeter.ReadNumber
'*** Sends the commands to measure the standard identified by Standard.
Select Case Standard
Case "Open"
LCRMeter.WriteString ":CORR1:COLL STAN1", True
Case "Short"
LCRMeter.WriteString ":CORR1:COLL STAN2", True
Case "Load"
LCRMeter.WriteString ":CORR1:COLL STAN3", True
Case "Low Loss C"
LCRMeter.WriteString ":CORR1:COLL STAN4", True
End Select
'*** Triggers the instrument.
LCRMeter.WriteString ":TRIG", True
Do
LCRMeter.WriteString ":STAT:OPER:COND?", True
CondReg = LCRMeter.ReadNumber
BitWaitingForTrigger = CondReg And 32
Loop While BitWaitingForTrigger = 0
Meas_end:
'*** Sets the Err_flag variable to 0.
Err_flag = 0
'*** When the standard is OPEN, SHORT, or LOAD, the subprogram checks whether the Rdc value falls within the limit range.
'*** If the limit range is exceeded, it sets the Err_flag variable to 1.
Select Case Standard
Case "Open"
LCRMeter.WriteString ":DATA:RCAD1?", True
Rdc = LCRMeter.ReadNumber
MsgBox "Rdc= " & Rdc
If Abs(Rdc) < L_lim Then Err_flag = 1
Case "Short"
LCRMeter.WriteString ":DATA:RCAD2?", True
Rdc = LCRMeter.ReadNumber
MsgBox "Rdc= " & Rdc
If Abs(Rdc) > U_lim Then Err_flag = 1
Case "Load"
LCRMeter.WriteString ":DATA:RCAD3?", True
Rdc = LCRMeter.ReadNumber
MsgBox "Rdc= " & Rdc
If Abs(Rdc) < L_lim Or Abs(Rdc) > U_lim Then Err_flag = 1
End Select
'*** If Err_flag is 0, which means that the Rdc value is within the limit range, the subprogram notifies the user of successful measurement.
'*** If Err_flag is 1, which means that the Rdc value is not within the limit range, the subprogram notifies the user of failed measurement and
'*** returns to the line where it starts measuring the standard.
If Err_flag = 0 Then
MsgBox Standard & " Data Measurement Complete", vbOKOnly
Else
MsgBox "Error: RDC is out of Range", vbOKOnly
End If
'*** Finally, the subprogram returns 0 after restoring the original trigger source by changing the trigger source to Trig_sour.
LCRMeter.WriteString ":TRIG:SOUR " & Trig_sour, True
Else
'*** If the key the user pressed for "Set Standard Connection. OK?" is not the y key, this statement
'*** block is executed and the subprogram returns -1.
LCRMeter.WriteString ":TRIG:SOUR " & Trig_sour, True
MsgBox "Program Interruption", vbOKOnly
End If
FNCal = Err_flag
End Function
'*** The Set_cal_kit subprogram configures the calibration kit.
Sub Set_cal_kit(LCRMeter As VisaComLib.FormattedIO488)
Dim Para1 As String, Para2 As String, Kit As Integer
Dim Inp_char As String, Def As Integer, Nop As Integer, Load_para As Integer, Point As Integer
Dim Open1 As Double, Open2 As Double, Open_dc As Double, Open_del As Double
Dim Shor1 As Double, Shor2 As Double, Shor_dc As Double, Shor_del As Double
Dim Load1 As Double, Load2 As Double, Load_dc As Double, Load_del As Double
Kit_select:
'*** Displays the list of supported calibration kits and prompts the user to choose one of the items by typing in the appropriate number.
Kit = Val(InputBox("Select Calibration Kit, 1: 16195B; 2: User Defined ", "Calibration Kit Selection", 1))
'*** If Kit is neither 1 nor 2, the program returns to the entry start line.
If Kit < 1 Or Kit > 2 Then GoTo Kit_select
If Kit = 1 Then
'*** If Kit is 1, the program configures the instrument to use the 7 mm calibration kit.
LCRMeter.WriteString ":CORR1:CKIT DEF", True
Else
'*** If Kit is 2, the program configures the instrument to use a user-defined calibration kit.
'*** The description below assumes that Kit is 2.
LCRMeter.WriteString ":CORR1:CKIT USER", True
'
'*** Displays the list of modes for defining the calibration kit and prompts the user to choose one of the items
'*** by typing in the appropriate number. Then the program converts the entered value into an integer
'*** and stores it into the Def variable.
Def_select:
Def = Val(InputBox("Select Definition Type, 1: Fixed; 2: Not Fixed ", "Definition Type Selection", 1))
If Def < 1 Or Def > 2 Then GoTo Def_select
Select Case Def
'*** If Def is 1, the program configures the instrument so that the user can define the calibration kit in fixed mode
'*** and stores “1” into the Nop variable, which indicates the number of measurement points that require definitions.
Case 1
LCRMeter.WriteString ":CORR1:CKIT:LIST OFF", True
Nop = 1
'*** If Def is 2, the program configures the instrument so that the user can define the calibration kit in point-by-point mode,
'*** and then retrieves the number of points and stores the number into the Nop variable.
Case 2
LCRMeter.WriteString ":CORR1:CKIT:LIST ON", True
LCRMeter.WriteString ":SOUR:LIST:SIZE?", True
Nop = LCRMeter.ReadNumber
End Select
'*** Displays the list of parameter types that can be used to define the LOAD standard and prompts the user to choose one of the items by
'*** typing in the appropriate number. Then the program converts the entered value into an integer and stores it into the Load_para variable.
Load_select:
Load_para = Val(InputBox("Select Load Definition Parameters, 1: Rs and Ls; 2: Ls and Q, 3: Cp and D", "Load Definition Parameter Selection", 1))
If Load_para < 1 Or Load_para > 3 Then GoTo Load_select
'*** Sets the parameter type for defining the LOAD standard based on Load_para and stores the parameter names into
'*** the Para1 andPara2 variables.
Select Case Load_para
Case 1
LCRMeter.WriteString ":CORR1:CKIT:STAN3:FORM RL", True
Para1 = "Rs"
Para2 = "Ls"
Case 2
LCRMeter.WriteString ":CORR1:CKIT:STAN3:FORM LQF", True
Para1 = "Ls"
Para2 = "Q"
Case 3
LCRMeter.WriteString ":CORR1:CKIT:STAN3:FORM CDFRL", True
Para1 = "Cp"
Para2 = "D"
End Select
'*** Iterates the following steps Nop times:
'*** If Nop is 2 or greater, the program displays each measurement point that requires a definition.
'*** Passes control to the Inp_data subprogram to acquire the OPEN, SHORT, or LOAD standard values from user input.
'*** Configures each standard with the entered values.
For Point = 1 To Nop
If Nop > 1 Then
MsgBox "[Point No. " & Val(Point) & "]", vbOKOnly
End If
Call Inp_data("Open(G) Value", Open1)
Call Inp_data("Open(Cp) Value", Open2)
Call Inp_data("Open(Rs) Value", Shor1)
Call Inp_data("Open(Ls) Value", Shor2)
Call Inp_data("Load (" & Para1 & ") value", Load1)
Call Inp_data("Load (" & Para2 & ") value", Load2)
LCRMeter.WriteString ":CORR1:CKIT:STAN1:LIST " & Point & "," & Open1 & "," & Open2, True
LCRMeter.WriteString ":CORR1:CKIT:STAN2:LIST " & Point & "," & Shor1 & "," & Shor2, True
LCRMeter.WriteString ":CORR1:CKIT:STAN3:LIST " & Point & "," & Load1 & "," & Load2, True
Next Point
'*** Prompts the user to confirm whether to define the standards for Rdc measurement and waits until the user presses the y or n key.
Inp_char = InputBox("Do you want to define standard values for Rdc measurement? [Y]es/[N]o", "Confirmation", "y")
'*** If the user presses the y key in response to line 2540, the program acquires the definitions for Rdc measurement from user input and
'*** configures the standards accordingly.
If UCase(Inp_char) = "Y" Or UCase(Inp_char) = "YES" Then
Call Inp_data("Open(G) Value for Rdc Measurement", Open_dc)
Call Inp_data("Short(R)) Value for Rdc Measurement", Shor_dc)
Call Inp_data("Load(G) Value for Rdc Measurement", Load_dc)
LCRMeter.WriteString ":CORR1:CKIT:STAN1:DC " & Open_dc, True
LCRMeter.WriteString ":CORR1:CKIT:STAN2:DC " & Shor_dc, True
LCRMeter.WriteString ":CORR1:CKIT:STAN3:DC " & Load_dc, True
End If
'*** Prompts the user to confirm whether to define the delay time and waits until the user presses the y or n key.
Inp_char = InputBox("Do you want to define standard delay values? [Y]es/[N]o", "Confirmation", "y")
'*** If the user presses the y key in response, the program acquires the delay time from user input and
'*** configures the standards accordingly.
If UCase(Inp_char) = "Y" Or UCase(Inp_char) = "YES" Then
Call Inp_data("Open Delay Time", Open_del)
Call Inp_data("Short Delay Time", Shor_del)
Call Inp_data("Load Delay Time", Load_del)
LCRMeter.WriteString ":CORR1:CKIT:STAN1:EDEL " & Open_del, True
LCRMeter.WriteString ":CORR1:CKIT:STAN2:EDEL " & Shor_del, True
LCRMeter.WriteString ":CORR1:CKIT:STAN3:EDEL " & Load_del, True
End If
End If
End Sub
'*** The Inp_data subprogram lets the user enter the necessary data.
Sub Inp_data(Mes As String, Inp_val As Double)
Dim Inp_char As String
'*** Returns to the start line of input if an error occurs due to an invalid entry or similar reason.
'*** This allows the user to make an entry again.
On Error GoTo Inp_start
Inp_start:
'*** Prompts the user to enter a data value specified by Mes and waits until the user actually enters the value.
Inp_val = Val(InputBox("Input " & Mes, "Value Input", 0))
'*** Displays the value entered and waits until the user confirms the entry by pressing the y or n key.
Inp_char = InputBox("Input Value: " & Inp_val & " : Correct? (Y or N)", "Confirmation", "y")
'*** Returns to the entry start line if the key the user pressed for the above line is not the y key.
If UCase(Inp_char) <> "Y" Then GoTo Inp_start
End Sub
'******************************************************************************************************************
'*** COMPENSATION ***
Sub Compensation(age4982x As VisaComLib.FormattedIO488)
Dim Buff As String
Dim Open_l_lim_compen As Double, Short_u_lim_compen As Double
Dim ResultComp As Integer, NopComp As Integer
Open_l_lim_compen = 100
Short_u_lim_compen = 25
'*** Passes control to a subprogram named Set_fixture, which configures the test fixture.
MsgBox "## Test Fixture Setting ##", vbOKOnly
Call Set_Fixture(age4982x)
'*** Passes control to a subprogram named Set_comp_kit to configure the compensation kit.
MsgBox "## Compensation Kit Setup ##", vbOKOnly
Call Set_comp_kit(age4982x)
'*** Passes control to a subprogram named FNCompen, which measures the OPEN and SHORT data.
MsgBox "## Measurement ##", vbOKOnly
ResultComp = FNCompen(age4982x, "Open", Open_l_lim_compen) ' YH Open_l_lim_compen is not specified.
If ResultComp <> 0 Then Exit Sub
ResultComp = FNCompen(age4982x, "Short", Short_u_lim_compen) ' YH Short Short_l_lim_compen is not specified.
If ResultComp <> 0 Then Exit Sub
'*** Calculates the compensation ccoefficients and turns on the compensation function.
age4982x.WriteString ":CORR2:COLL:SAVE", True
age4982x.WriteString "*OPC?", True
Buff = age4982x.ReadNumber
'*** Displays a closing message.
MsgBox "### Done ###", vbOKOnly
Exit Sub
End Sub
'*** Compensation Data Measurement Function
'*** The FNCompen subprogram measures the data for calculating the compensation coefficients.
Function FNCompen(LCRMeter As VisaComLib.FormattedIO488, Standard As String, Limit As Double) As Integer
Dim Inp_char As String, Trig_sour As String
Dim Buff As Integer, BitWaitingForTrigger As Integer, CondReg As Integer
Dim Rdc As Double
Dim Err_flag As Integer
'*** After measurement is stopped (the trigger system is stopped), the program sets the trigger source to GPIB/LAN trigger and
'*** turns ON the continuous activation of the trigger system.
LCRMeter.WriteString ":ABOR", True
LCRMeter.WriteString ":TRIG:SOUR BUS", True
LCRMeter.WriteString ":INIT:CONT ON", True
Compen_meas:
'*** Prompts the user to set up the connection for measuring the standard identified by Standard and
'*** waits until the user presses the y key followed by th return key.
Inp_char = InputBox("Set " & Standard & "-Connection. OK? [Y/N]", "Compensation Execution", "y")
If UCase(Inp_char) = "Y" Or UCase(Inp_char) = "YES" Then
'*** Clears the status byte register and operation status event register.
LCRMeter.WriteString "*CLS", True
LCRMeter.WriteString "*OPC?", True
Buff = LCRMeter.ReadNumber
'*** Sends the commands to measure the standard identified by Standard.
Select Case Standard
Case "Open"
LCRMeter.WriteString ":CORR2:COLL STAN1", True
Case "Short"
LCRMeter.WriteString ":CORR2:COLL STAN2", True
End Select
'*** Triggers the instrument.
LCRMeter.WriteString ":TRIG", True
Do
LCRMeter.WriteString ":STAT:OPER:COND?", True
CondReg = LCRMeter.ReadNumber
BitWaitingForTrigger = CondReg And 32
Loop While BitWaitingForTrigger = 0
Meas_end:
'*** Sets the Err_flag variable to 0.
Err_flag = 0
'*** Checks whether the Rdc value falls within the limit range. If the limit range is exceeded, it set the Err_flag variable to 1 again.
Select Case Standard
Case "Open"
LCRMeter.WriteString ":DATA:RCMD1?", True
Rdc = LCRMeter.ReadNumber
MsgBox "Rdc= " & Rdc
If Abs(Rdc) < Limit Then Err_flag = 1
Case "Short"
LCRMeter.WriteString ":DATA:RCMD2?", True
Rdc = LCRMeter.ReadNumber
MsgBox "Rdc= " & Rdc
If Abs(Rdc) > Limit Then Err_flag = 1
End Select
'*** If Err_flag is 0, which means that the Rdc value is within the limit range, the subprogram notifies the user of successful measurement.
'*** If Err_flag is 1, which means that the Rdc value is not within the limit range, the subprogram notifies the user of failed measurement and
'*** returns to the line where it starts measuring the standard.
If Err_flag = 0 Then
MsgBox Standard & " Data Measurement Complete", vbOKOnly
Else
MsgBox "Error: RDC is out of Range", vbOKOnly
End If
Else
End If
FNCompen = Err_flag
End Function
'*** The Set_comp_kit subprogram configures the compensation kit.
Sub Set_comp_kit(LCRMeter As VisaComLib.FormattedIO488)
Dim Para1 As String, Para2 As String, Kit As Integer
Dim Inp_char As String, Def As Integer, Nop As Integer, Load_para As Integer, Point As Integer
Dim Open1 As Double, Open2 As Double, Open_dc As Double, Open_del As Double
Dim Shor1 As Double, Shor2 As Double, Shor_dc As Double, Shor_del As Double
Kit_select:
'*** Displays the list of compensation kit definitions and prompts the user to choose one of the items by typing in the appropriate number.
Kit = Val(InputBox("Select Calibration Kit, 1: Default; 2: User Defined ", "Compensation Kit Selection", 1))
'*** If Kit is neither 1 nor 2, the program returns to the entry start line.
If Kit < 1 Or Kit > 2 Then GoTo Kit_select
If Kit = 1 Then
'*** If Kit is 1, the subprogram configures the instrument to use its built-in definition for the compensation kit values.
LCRMeter.WriteString ":CORR2:CKIT DEF", True
Else
'*** If Kit is 2, the program configures the instrument to use a user-defined compensation kit.
'*** The description below assumes that Kit is 2.
LCRMeter.WriteString ":CORR2:CKIT USER", True
'
'*** Displays the list of modes for defining the compensation kit and prompts the user to choose one of the items
'*** by typing in the appropriate number. Then the program converts the entered value into an integer
'*** and stores it into the Def variable.
On Error GoTo Def_select
Def_select:
Def = Val(InputBox("Select Definition Type, 1: Fixed; 2: Not Fixed ", "Definition Type Selection", 1))
If Def < 1 Or Def > 2 Then GoTo Def_select
Select Case Def
'*** If Def is 1, the program configures the instrument so that the user can define the compensation kit in fixed mode
'*** and stores “1” into the Nop variable, which indicates the number of measurement points that require definitions.
Case 1
LCRMeter.WriteString ":CORR2:CKIT:LIST OFF", True
Nop = 1
'*** If Def is 2, the program configures the instrument so that the user can define the compensation kit in point-by-point mode,
'*** and then retrieves the number of points and stores the number into the Nop variable.
Case 2
LCRMeter.WriteString ":CORR2:CKIT:LIST ON", True
LCRMeter.WriteString ":SOUR:LIST:SIZE?", True
Nop = LCRMeter.ReadNumber
End Select
'*** Iterates the following steps Nop times:
'*** If Nop is 2 or greater, the program displays each measurement point that requires a definition.
'*** Passes control to the Inp_data subprogram to acquire the OPEN and LOAD standard values from user input.
'*** Configures each standard with the entered values.
For Point = 1 To Nop
If Nop > 1 Then
MsgBox "[Point No. " & Val(Point) & "]", vbOKOnly
End If
Call Inp_data("Open(G) Value", Open1)
Call Inp_data("Open(Cp) Value", Open2)
Call Inp_data("Open(Rs) Value", Shor1)
Call Inp_data("Open(Ls) Value", Shor2)
LCRMeter.WriteString ":CORR2:CKIT:STAN1:LIST " & Point & "," & Open1 & "," & Open2, True
LCRMeter.WriteString ":CORR2:CKIT:STAN2:LIST " & Point & "," & Shor1 & "," & Shor2, True
Next Point
'*** Prompts the user to confirm whether to define the standards for Rdc measurement and waits until the user presses the y or n key.
Inp_char = InputBox("Do you want to define standard values for Rdc measurement? [Y]es/[N]o", "Confirmation", "y")
'*** If the user presses the y key in response, the program acquires the definitions for Rdc measurement from user input and
'*** configures the standards accordingly.
If UCase(Inp_char) = "Y" Or UCase(Inp_char) = "YES" Then
Call Inp_data("Open(G) Value for Rdc Measurement", Open_dc)
Call Inp_data("Short(R)) Value for Rdc Measurement", Shor_dc)
LCRMeter.WriteString ":CORR2:CKIT:STAN1:DC " & Open_dc, True
LCRMeter.WriteString ":CORR2:CKIT:STAN2:DC " & Shor_dc, True
End If
End If
End Sub
'*** The Set_Fixture configures the test fixture.
Sub Set_Fixture(LCR As VisaComLib.FormattedIO488)
Dim Inp_char As String
Dim Fixture As Integer
Dim E_len As Double
On Error GoTo Fixture_select
'*** Allows the user to return to the entry start line and re-enter the data if an error (such as an invalid entry) occurs while
'*** entering the number that identifies the test fixture.
Fixture_select:
Fixture = Val(InputBox("1:None, 2:16191A, 3:16192A, 4:16193A, 5:16194A, 6:16196A, 7:16196B, 8:16196C, 9:USER. Input 1 to 9:", "Select Test Fixture", "1"))
'*** If Fixture is not an integer between 1 and 9, the program returns to the entry start line.
If Fixture < 1 Or Fixture > 9 Then GoTo Fixture_select
'*** Configures the test fixture based on Fixture. If Fixture is 9, which means that the user opted to use a user-defined fixture,
'*** the subprogram acquires the delay compensation value (electrical length) from the user input and configures the test fixture accordingly.
Select Case Fixture
Case 1
LCR.WriteString ":CORR2:FIXT NONE", True
Case 2
LCR.WriteString ":CORR2:FIXT FXT16191A", True
Case 3
LCR.WriteString ":CORR2:FIXT FXT16192A", True
Case 4
LCR.WriteString ":CORR2:FIXT FXT16193A", True
Case 5
LCR.WriteString ":CORR2:FIXT FXT16194A", True
Case 6
LCR.WriteString ":CORR2:FIXT FXT16196A", True
Case 7
LCR.WriteString ":CORR2:FIXT FXT16196B", True
Case 8
LCR.WriteString ":CORR2:FIXT FXT16196C", True
Case 9
LCR.WriteString ":CORR2:FIXT USER", True
Call Inp_data("Electrical Length of the User Fixture", E_len)
LCR.WriteString ":CORR2:FIXT:EDEL:DIST " & E_len, True
End Select
End Sub