mditest.frm

这个程序包的主要功能是对多台5101b进行功能化测试

       initialize
       wait 5
       If q = 1 Then
          order = msacvH(p) & "V60H,N"
       ElseIf q = 2 Then
          order = msacvH(p) & "V5E2H,N"
       Else
          order = msacvH(p) & "V1E3H,N"
       End If
       send_order "MEM LIFO", 0
       initialize
       send_order "C", t
       send_order order, t
       wait 15
       initialize
       If q = 1 Then
          receive_data msacv51(t, p), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacv51(t, p), 16) & "V"
       ElseIf q = 2 Then
          receive_data msacv51(t, p + 3), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacv51(t, p + 3), 16) & "V"
       Else
          receive_data msacv51(t, p + 6), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacv51(t, p + 6), 16) & "V"
       End If
       initialize
       wait 1
       If keyflag = 1 Then
          picstatue.Cls
          picstatue.Print "中断程序运行!"
          keyflag = 0
          send_order "*", t
          send_order "RESET", 0
          Exit Sub
       End If
     Next t
   Next p
   Next q
   For t = 1 To Number
      send_order "*", t
      send_order "C", t
   Next t
   initialize
   send_order "00", 11
   initialize
   
   Response = MsgBox("请正确连接5700A与3458A之间ACV测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Voltage Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
   
   initialize
   send_order "*cls", 20
   send_order "*rst", 20
   send_order "RESET", 0
   initialize
   
   send_order "NPLC 80;NDIG 7", 0
   initialize
   send_order "FUNC ACV 1000;SETACV SYNC;LFILTER ON", 0
   wait 3
   initialize
   fomcheck.lstchdata.AddItem "TEST ACV - 5700A:"
   
   '5700A------------------ACV--------------
   For q = 1 To 3
     If q = 1 Then
        fomcheck.lstchdata.AddItem "- 60 Hz"
     ElseIf q = 2 Then
        fomcheck.lstchdata.AddItem "- 500 Hz"
     Else
        fomcheck.lstchdata.AddItem "- 1 kHz"
     End If
   For p = 1 To 3
       initialize
       If q = 1 Then
          order = "*cls;out " & msacvH(p) & "V,60Hz;oper"
       ElseIf q = 2 Then
          order = "*cls;out " & msacvH(p) & "V,500Hz;oper"
       Else
          order = "*cls;out " & msacvH(p) & "V,1kHz;oper"
       End If
       send_order "MEM LIFO", 0
       wait 2
       initialize
       send_order order, 20
       wait 15
       If q = 1 Then
          receive_data msacv57(p), 0
          fomcheck.lstchdata.AddItem Left(msacv57(p), 16) & "V"
       ElseIf q = 2 Then
          receive_data msacv57(p + 3), 0
          fomcheck.lstchdata.AddItem Left(msacv57(p + 3), 16) & "V"
       Else
          receive_data msacv57(p + 6), 0
          fomcheck.lstchdata.AddItem Left(msacv57(p + 6), 16) & "V"
       End If
       initialize
       wait 1
       If keyflag = 1 Then
          picstatue.Cls
          picstatue.Print "中断程序运行!"
          keyflag = 0
          send_order "*rst", 20
          send_order "RESET", 0
          Exit Sub
       End If
   Next p
   Next q
   send_order "*cls", 20
   send_order "*rst", 20
   send_order "RESET", 0
   initialize

   
   picstatue.Cls
   picstatue.Print "测试完毕！"
   
   Saveflag = 1
      
   mdifomtest.mnusave.Enabled = True
   mdifomtest.imgsave1.Enabled = True
   mdifomtest.imgsave2.Enabled = True
End Sub

Private Sub mnumsacvL_Click()
   Dim p, q, t As Integer
   Dim Response As Integer
       
   Response = MsgBox("请正确连接ACV测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Voltage Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
   
   picstatue.Cls
   picstatue.Print "现在进行ACV的功能检查！(按Shift + F2键可中断程序运行)"
   
   fomcheck.Show
   fomcheck.Caption = "Test"
   
   'msacv = Array( 0.19, 0.1, 1.9, 1, 0.2, 19, 10, 2, 100, 20)
   initialize                      'test interface IEEE488
   receive_data temp, 0
   If IEEnoteflag = vbOK Then
      Exit Sub
   End If
   
   initialize
   For t = 1 To Number
     send_order "*", t
     'send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   initialize
   send_order "NPLC 80;NDIG 7", 0
   fomcheck.lstchdata.AddItem "TEST ACV:"
   '------------------ACV--------------
   For q = 1 To 5
     If q = 1 Then
        fomcheck.lstchdata.AddItem "- 60 Hz"
     ElseIf q = 2 Then
        fomcheck.lstchdata.AddItem "- 500 Hz"
     ElseIf q = 3 Then
        fomcheck.lstchdata.AddItem "- 1 kHz"
     ElseIf q = 4 Then
        fomcheck.lstchdata.AddItem "- 5 kHz"
     Else
        fomcheck.lstchdata.AddItem "- 10 kHz"
     End If
   For p = 1 To 10
     For t = 1 To Number
       initialize
       send_order "*", t                 '防止ERROR - 触发太快
       send_order "0" & t, 11
       initialize
       send_order "C", t
       initialize
       send_order "0V,N", t
       initialize
       wait 10

       If msacv(p) <= 0.1 Then
          send_order "FUNC ACV 0.1;SETACV SYNC;RES .002;LFILTER ON", 0
       ElseIf msacv(p) <= 1 Then
          send_order "FUNC ACV 1;SETACV SYNC;RES .002;LFILTER ON", 0
       ElseIf msacv(p) <= 10 Then
          send_order "FUNC ACV 10;SETACV SYNC;RES .002;LFILTER ON", 0
       Else
          send_order "FUNC ACV 100;SETACV SYNC;RES .002;LFILTER ON", 0
       End If
       wait 3
       initialize
       'send_order "01", 10
       If q = 1 Then
          order = msacv(p) & "V60H,N"
       ElseIf q = 2 Then
          order = msacv(p) & "V5E2H,N"
       ElseIf q = 3 Then
          order = msacv(p) & "V1E3H,N"
       ElseIf q = 4 Then
          order = msacv(p) & "V5E3H,N"
       Else
          order = msacv(p) & "V10E3H,N"
       End If
       send_order "C", t
       send_order order, t
       wait 30
       If q = 1 Then
          receive_data msacvTP(t, p), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacvTP(t, p), 16) & "V"
       ElseIf q = 2 Then
          receive_data msacvTP(t, p + 10), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacvTP(t, p + 10), 16) & "V"
       ElseIf q = 3 Then
          receive_data msacvTP(t, p + 20), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacvTP(t, p + 20), 16) & "V"
       ElseIf q = 4 Then
          receive_data msacvTP(t, p + 30), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacvTP(t, p + 30), 16) & "V"
       Else
          receive_data msacvTP(t, p + 40), 0
          fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msacvTP(t, p + 40), 16) & "V"
       End If
       initialize
       wait 1
    
     If keyflag = 1 Then
        picstatue.Cls
        picstatue.Print "中断程序运行!"
        keyflag = 0
        send_order "*", t
        send_order "RESET", 0
        Exit Sub
     End If
     Next t
   Next p
   Next q
   For t = 1 To Number
     send_order "*", t
     send_order "C", t
   Next t
   initialize
   send_order "00", 11

   picstatue.Cls
   picstatue.Print "检查完毕！"
   
   Saveflag = 1
      
   mdifomtest.mnusave.Enabled = True
   mdifomtest.imgsave1.Enabled = True
   mdifomtest.imgsave2.Enabled = True
   
   mnumsohm_Click

End Sub


Private Sub mnumsdci_Click()
   Dim p, t As Integer
   Dim Response As Integer
       
   Response = MsgBox("请正确连接DCI测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Current Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If
  
   picstatue.Cls
   picstatue.Print "现在进行DCI的功能测试！(按Shift + F2键可中断程序运行)"

   fomcheck.Show
   fomcheck.Caption = "Test"
   
   'msdci = Array(0.00019, 0.0001, 0.00002, 0.0019, 0.001, 0.0002, 0.019, 0.01, 0.002, 0.19, 0.1, 0.02, 1, 0.2)
   
   initialize                      'test interface IEEE488
   receive_data temp, 0
   If IEEnoteflag = vbOK Then
      Exit Sub
   End If
   
   initialize
   For t = 1 To Number
   initialize
   send_order "*", t
   send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   For t = 1 To Number
   initialize
   send_order "S", t
   Next t
   
   initialize
   send_order "NPLC 80;NDIG 6", 0
   fomcheck.lstchdata.AddItem "Test DCI:"

   '------------------------------DCI---------------------------
For p = 12 To 14
     initialize
 
     If p = 2 Or p = 5 Or p = 8 Or p = 11 Then
        For t = 1 To Number
        send_order "S", t
        Next t
        initialize
     End If
     
     If msdci(p) <= 0.0001 Then
       send_order "FUNC DCI,1E-4", 0
     ElseIf msdci(p) <= 0.001 Then
       send_order "FUNC DCI,1E-3", 0
     ElseIf msdci(p) <= 0.01 Then
       send_order "FUNC DCI,1E-2", 0
     ElseIf msdci(p) <= 0.1 Then
       send_order "FUNC DCI,1E-1", 0
     Else
       send_order "FUNC DCI,1", 0
     End If
  
     initialize
     If p = 1 Or p = 2 Or p = 4 Or p = 5 Or p = 7 Or p = 8 Or p = 10 Or p = 11 Or p = 13 Then
        For t = 1 To Number
        initialize
        send_order "*", t
        Next t
        wait 7
        send_order "MATH NULL", 0
        wait 5
        initialize
     End If
     For t = 1 To Number
     send_order "C", t
     Next t
     For t = 1 To Number
        order = "+" & msdci(p) & "A,N"
        send_order "0" & t, 11
        initialize
        send_order order, t
        wait 12
        receive_data msdciTP(t, p), 0
        fomcheck.lstchdata.AddItem "(" & t & ")" & Left(msdciTP(t, p), 16) & "A"
        initialize
        send_order "S", t
        initialize
        send_order "MEM LIFO", 0
        initialize
     Next t
     wait 1
     If keyflag = 1 Then
        picstatue.Cls
        picstatue.Print "中断程序运行!"
        keyflag = 0
        send_order "*", 1
        send_order "RESET", 0
        Exit Sub
     End If

Next p
   For t = 1 To Number
   send_order "*", t
   send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   
   picstatue.Cls
   picstatue.Print "测试完毕！"
   
   Saveflag = 1
   
   mdifomtest.mnusave.Enabled = True
   mdifomtest.imgsave1.Enabled = True
   mdifomtest.imgsave2.Enabled = True

   mnumsdcv_Click

End Sub


Private Sub mnumsdcv_Click()
   Dim p, q, t As Integer
   Dim Response As Integer
       
   Response = MsgBox("请正确连接DCV测试线！", vbOKCancel + vbInformation + vbDefaultButton1, "Voltage Test Connect")
   If Response = vbCancel Then
       Exit Sub
   End If

   picstatue.Cls
   picstatue.Print "现在进行DCV的功能测试！(按Shift + F2键可中断程序运行)"
   
   fomcheck.Show
   fomcheck.Caption = "Test"
   
   'msdcv = Array(0.019, 0.01, 0.002, 0, 0.19, 0.1, 0.02, 1.9, 1, 0.2, 19, 10, 2, 190, 100, 20, 1000, 500, 200)
   
   initialize                      'test interface IEEE488
   receive_data temp, 0
   If IEEnoteflag = vbOK Then
      Exit Sub
   End If
   
   initialize
   send_order "*", 1
   send_order "RESET", 0
   
   initialize
   For t = 1 To Number
   send_order "*", t
   send_order "C", t
   Next t
   send_order "RESET", 0
   initialize
   send_order "00", 11
   
   initialize
   send_order "NPLC 80;NDIG 7", 0
   fomcheck.lstchdata.AddItem "Test DCV:"
   initialize
   For t = 1 To Number
     send_order "+0V,N", t
   Next t
   initialize
   send_order "01", 11

   '----------------------------DCV-----------------------------
   For q = 1 To 2
   For p = 1 To 19
     For t = 1 To Number
       initialize
       If p = 6 Or p = 9 Or p = 12 Or p = 15 Then  '防止换量程时 显示过载
          send_order "0" & t, 11
          initialize
          send_order "0V,N", t
          wait 2
       End If
       
       If msdcv(p) <= 0.1 Then
          send_order "FUNC DCV,0.1", 0
       ElseIf msdcv(p) <= 1 Then
          send_order "FUNC DCV,1", 0
       ElseIf msdcv(p) <= 10 Then
          send_order "FUNC DCV,10", 0
       ElseIf msdcv(p) <= 100 Then