VBA-fix-sim-01.txt

위로 E5071C VBA 프로그래밍

Private Sub UserForm_Click()
Dim FmtData As Variant, Freq As Variant
Dim BwData As Variant
Dim SaveData(99, 800)
Dim i, j, No As Integer

Dim Savefile, Calfile As String
Dim dmy As Long
Dim start, finish

pico = 0.000000000001
nano = 0.000000001
micro = 0.000001
mega = 1000000#
giga = 1000000000#


Savefile = "C:\Documents and Settings\All Users\Documents\2.txt"
Calfile = "D:\2PORT-500M-3G-TOGO.STA"
SCPI.MMEMory.Load.STATe = Calfile
mark1 = 1930 * mega
mark2 = 1960 * mega
mark3 = 1990 * mega

SCPI.SENSe(1).FREQuency.CENTer = 1960 * mega
SCPI.SENSe(1).FREQuency.SPAN = 100 * mega

SCPI.CALCulate(1).SELected.MARKer(1).X = mark1
SCPI.CALCulate(1).SELected.MARKer(3).X = mark3
SCPI.CALCulate(1).SELected.MARKer(2).X = mark2

SCPI.CALCulate(1).PARameter(1).Count = 3
SCPI.DISPlay.WINDow(1).Split = "D12_33"
SCPI.DISPlay.WINDow(1).TRACe(3).Y.SCALe.PDIVision = 1


Open Savefile For Output As #1
'Print #1, i, Peak, fc1, fc2, fc3, Bw1, Bw2, Bw3, Q, delta1, delta2, delta3, delta4
Print #1, ",No,C[pF],L[nH],Peak-amp,fc1,fc2,fc3,Bw1,Bw2,Bw3,Q3"

SCPI.SENSe(1).SWEep.POINts = 801
Nop = SCPI.SENSe(1).SWEep.POINts
SCPI.DISPlay.ENABle = True


ECHO "Nop=", Nop
ECHO "Measurement Cycle=100"

SCPI.TRIGger.SEQuence.Source = "BUS"

Freq = SCPI.SENSe(1).FREQuency.DATA
start = Timer


  'fixure simulator on
SCPI.CALCulate(1).FSIMulator.STATe = True
 'Port
SCPI.CALCulate(1).FSIMulator.SENDed.PMCircuit.STATe = True
 'NONE, SLPC, PCSL, PLSC, SCPL, PLPC, USER
 'SCPC, PCSC, SLPL, PLSL  v11.20
SCPI.CALCulate(1).FSIMulator.SENDed.PMCircuit.PORT(1).TYPE = "PCSL"
    
    
No = 0
For i = 1 To 21
    For j = 1 To 21
        No = No + 1
        C = (i - 1) * pico * 0.1
        L = (j - 1) * nano * 0.1 + nano
        SCPI.CALCulate(1).FSIMulator.SENDed.PMCircuit.PORT(1).PARameters.C = C
        SCPI.CALCulate(1).FSIMulator.SENDed.PMCircuit.PORT(1).PARameters.G = 0#
        SCPI.CALCulate(1).FSIMulator.SENDed.PMCircuit.PORT(1).PARameters.L = L
        SCPI.CALCulate(1).FSIMulator.SENDed.PMCircuit.PORT(1).PARameters.R = 0#

        SCPI.TRIGger.SEQuence.SINGle
        dmy = SCPI.IEEE4882.OPC
        SCPI.CALCulate(1).PARameter(3).SELect
        SCPI.CALCulate(1).SELected.MARKer(4).STATe = True
    
        SCPI.CALCulate(1).SELected.MARKer(4).FUNCtion.TYPE = "MAX"
        SCPI.CALCulate(1).SELected.MARKer(4).FUNCtion.EXECute
    
        SCPI.CALCulate(1).SELected.MARKer(4).BWIDth.THReshold = -1
        SCPI.CALCulate(1).SELected.MARKer(4).BWIDth.STATe = True
        BwData = SCPI.CALCulate(1).SELected.MARKer(4).BWIDth.DATA
        Bw1 = BwData(0) / mega
        fc1 = BwData(1) / mega
    
        SCPI.CALCulate(1).SELected.MARKer(4).BWIDth.THReshold = -2
        BwData = SCPI.CALCulate(1).SELected.MARKer(4).BWIDth.DATA
        Bw2 = BwData(0) / mega
        fc2 = BwData(1) / mega
    
        SCPI.CALCulate(1).SELected.MARKer(1).BWIDth.THReshold = -3
        BwData = SCPI.CALCulate(1).SELected.MARKer(4).BWIDth.DATA
        Bw3 = BwData(0) / mega
        fc3 = BwData(1) / mega
        Q3 = BwData(2)
        Peak = BwData(3)
    
        SCPI.CALCulate(1).SELected.MARKer(4).BWIDth.STATe = False
        SCPI.CALCulate(1).PARameter(1).SELect
    
        ECHO No
        Print #1, No, C / pico, L / nano, Peak, fc1, fc2, fc3, Bw1, Bw2, Bw3, Q3, delta1, delta2, delta3, delta4
    Next j
Next i
    
    

'For i = 0 To 99
'    SCPI.TRIGger.SEQuence.SINGle
'    dmy = SCPI.IEEE4882.OPC
'    FmtData = SCPI.CALCulate(1).SELected.DATA.FDATa
'    For j = 0 To Nop - 1
'        SaveData(i, j) = FmtData(2 * j)
'    Next j
'Next i

'finish = Timer
'ECHO "Elapsed Time=", finish - start

'For j = 0 To Nop - 1
'    Print #1, j + 1, Freq(j);
'    For i = 0 To 99
'        Print #1, SaveData(i, j);
'    Next i
'    Print #1,
'Next j
Close #1
SCPI.DISPlay.ENABle = True

MsgBox "Measurement Completion"
SCPI.SYSTem.BEEPer.COMPlete.IMMediate


End Sub