Attribute VB_Name = "Module1" 'Option Explicit '#uses "X11MA_beamline.ipm" '#uses "X11MA_LEEM.ipm" '#uses "X11MA_LJ.ipm" '#uses "epics.ipm" '#uses "sls_log.ipm" '#uses "sls_plot.ipm" Rem global variables Rem for saving Global autopath As String Global autoname As String Global autonum As Integer Global configpath As String Global autoexpo(2) As Long Global autoaver(2) As Long Global autosave As Long Global autoenergy(2) As Double Global autocontrast As Single Global autoseq As Long Global sensi_image As String Global autoscale As Single Global autocycles As Long Rem for stack Global energym(20)As Double Global estepm(20) As Double Global stackfilepath As String Global estepmCheck(20) As Integer Rem for beamline Global setEnergy As Double Global rbkEnergy As Double Global avrbkenergy As Double Global Polarisation As Double Global Polarisationstring As String 'Global linearMode As Double Global activeID As Single Global opID As Single Global polswitchmode As Single Global polstring(5) As String Global linrotstring As String Global switchstring(3) As String Global linrotstringID1(19) As String Global linrotstringID2(19) As String Global linrotalphadegID1(19) As Single 'Global linrotID1 As Single 'Global linrotID2 As Single Global polID1 As Single Global polID2 As Single Global pol As Single Global ID1offset As Double Global ID2offset As Double Global IDswitching As String Global ID1rbkEnergy As Double Global ID2rbkEnergy As Double Global ID1alpha As Double Global ID2alpha As Double Global ID1harmonic As Double Global ID2harmonic As Double Rem for linear rot scan Global E1,E2,E3 As Double Global E4 As Double Global E5 As Double Global E6 As Double Global E7 As Double Global E8 As Double Global E9 As Double Global E10 As Double Global setRotstep As Single Global ID1_linrot_gap (631,19) As Double Global ID1_linrot_shift (631,19) As Double Global ID1_linrot_offset(90) As Double Global ID2_linrot_gap (631,19) As Double Global ID2_linrot_shift (631,19) As Double Global ID2_linrot_offset(90) As Double Rem for XMCD (small one) Global setXMCDMag As Double Global rbkXMCDMag As Double Rem for Strassbourg XMCD Global rbkTBTMag As Double Global setTBTMag As Double Global Const maxTBT = 7.0 Global TBTTemperature As Double Global timer0 As Double Global L2edge As Double Global L3edge As Double Global En1 As Double Global En2 As Double Global En3 As Double Global En4 As Double Global En5 As Double Global CE1 As Double Global CE2 As Double Global CE3 As Double Global CE4 As Double Global CE5 As Double Global Saturation_Field As Double Global Measurement_Field As Double Rem for measurment Global noint As Integer Global KeithleyMode As Integer Global KeithleyNo As Double Global VG10 As Integer Global do_checkbeamline As Integer Global do_checkring As Integer Global KeithleyDelay As Integer Global ScanDelay As Integer Global noADC As Integer Rem for LEEM200 Global startvoltage As Double Global objective As Double Global LEEMtemp As Double Rem for girder Global x_from As Double Global x_to As Double Global x_d As Double Rem for time_scan Global timespan As Single Global MCP_Delay As Double Global MCP_Delay_Fine As Double Global PulsePicker_Delay As Double Global PulsePicker_Delay_Fine As Double Global Laser_Initial_Delay As Double Rem for Phasebump Global Phstart As Double Global Phend As Double Global Phstep As Double Global Phset As Double Rem for calculating focus Global calcstartSV As Double Global calcstartOB As Double Global calcSV As Double Global calcOB As Double Sub mkdirs(path As String) Dim d As String Dim c As String On Error Resume Next d="" For i=1 To Len(path) c=Mid(path,i,1) If c = "\" And i <> 3 Then MkDir d End If d=d+c Next i MkDir d On Error GoTo 0 End Sub Sub init_def Polstring(1)="circ +" Polstring(2)="circ -" Polstring(3)="lin hor" Polstring(4)="lin vert" Polstring(5)="lin rot" linrotstringID1(0)="" ' for circ or ver or hor linrotstringID1(1)=" 0" linrotstringID1(2)=" 5" linrotstringID1(3)=" 10" linrotstringID1(4)=" 15" linrotstringID1(5)=" 20" linrotstringID1(6)=" 25" linrotstringID1(7)=" 30" linrotstringID1(8)=" 35" linrotstringID1(9)=" 40" linrotstringID1(10)=" 45" linrotstringID1(11)=" 50" linrotstringID1(12)=" 55" linrotstringID1(13)=" 60" linrotstringID1(14)=" 65" linrotstringID1(15)=" 70" linrotstringID1(16)=" 75" linrotstringID1(17)=" 80" linrotstringID1(18)=" 85" linrotstringID1(19)=" 90" linrotstringID2(0)="" ' for circ or ver or hor linrotstringID2(1)=" 0" linrotstringID2(2)=" 5" linrotstringID2(3)=" 10" linrotstringID2(4)=" 15" linrotstringID2(5)=" 20" linrotstringID2(6)=" 25" linrotstringID2(7)=" 30" linrotstringID2(8)=" 35" linrotstringID2(9)=" 40" linrotstringID2(10)=" 45" linrotstringID2(11)=" 50" linrotstringID2(12)=" 55" linrotstringID2(13)=" 60" linrotstringID2(14)=" 65" linrotstringID2(15)=" 70" linrotstringID2(16)=" 75" linrotstringID2(17)=" 80" linrotstringID2(18)=" 85" linrotstringID2(19)=" 90" ID1_linrot_offset(0)= 0 ID1_linrot_offset(5)= 1 ID1_linrot_offset(10)= 2 ID1_linrot_offset(15)= 2.5 ID1_linrot_offset(20)= 2.5 ID1_linrot_offset(25)= 2.5 ID1_linrot_offset(30)= 2.5 ID1_linrot_offset(35)= 2.5 ID1_linrot_offset(40)= 2.5 ID1_linrot_offset(45)= 2.5 ID1_linrot_offset(50)= 2.5 ID1_linrot_offset(55)= 2.5 ID1_linrot_offset(60)= 2.5 ID1_linrot_offset(65)= 2.5 ID1_linrot_offset(70)= 2.5 ID1_linrot_offset(75)= 2 ID1_linrot_offset(80)= 1 ID1_linrot_offset(85)= 0 ID1_linrot_offset(90)= 0 ID2_linrot_offset(0)= 0 ID2_linrot_offset(5)= 5 ID2_linrot_offset(10)= 8 ID2_linrot_offset(15)= 10 ID2_linrot_offset(20)= 11 ID2_linrot_offset(25)= 12 ID2_linrot_offset(30)= 12 ID2_linrot_offset(35)= 12 ID2_linrot_offset(40)= 12 ID2_linrot_offset(45)= 11 ID2_linrot_offset(50)= 10 ID2_linrot_offset(55)= 9 ID2_linrot_offset(60)= 8 ID2_linrot_offset(65)= 7 ID2_linrot_offset(70)= 6 ID2_linrot_offset(75)= 4 ID2_linrot_offset(80)= 3 ID2_linrot_offset(85)= 0 ID2_linrot_offset(90)= 0 switchstring(1)="normal" switchstring(2)="tune/detune" switchstring(3)="chopper" 'Rem default is measure Keithley1+2+Norm 'KeithleyNo=2 Current_job=0 Jobsrunning=False noint=1 noADC=100 End Sub Sub getbeamline rbkEnergy=getEnergy() Select Case opID Case 1 polID1=getPolID1() pol=polID1 If pol=5 Then linrotstring=CStr(ID1alpha) Else linrotstring="" 'ID1rbkEnergy=getID1rbkEnergy() Case 2 polID2=getPolID2() pol=polID2 If pol=5 Then linrotstring=CStr(ID2alpha) Else linrotstring="" 'ID2rbkEnergy=getID2rbkEnergy() Case 3 polID1=getPolID1() polID2=getPolID2() 'ID1rbkEnergy=getID1rbkEnergy() 'ID2rbkEnergy=getID2rbkEnergy() If activeID=1 Then pol=polID1 If activeID=2 Then pol=polID2 If activeID=3 Then pol=polID1 If pol=5 Then If activeID=1 Then linrotstring=CStr(ID1alpha) Else linrotstring="" If activeID=2 Then linrotstring=CStr(ID2alpha) Else linrotstring="" If activeID=3 Then linrotstring=CStr(ID1alpha) Else linrotstring="" End If Case Else polID1=getPolID1() polID2=getPolID2() 'ID1rbkEnergy=getID1rbkEnergy() 'ID2rbkEnergy=getID2rbkEnergy() pol=polID1 End Select End Sub Function checkRing() As Integer Rem 0 Ring ok Rem 1 Ring FB off Rem 2 Ring down Rem 3 cancel was pressed Dim ID1status As Integer Dim ID2status As Integer Dim Ringstatus As Integer Dim status As Boolean Dim oldRingstatus As Integer If do_checkring=1 Then ID1status=getID1control ID2status=getID2control Ringstatus=getRingstatus status=False oldRingstatus=Ringstatus checkRing=0 If Ringstatus=5 Then write_logfile(1,"FB off") addKeyVal "status","FB off" checkRing=1 End If If Ringstatus=0 Then write_logfile(1,"Machine down") addKeyVal "status","M down" checkRing=2 End If If checkRing>0 Then Do ID1status=getID1control ID2status=getID2control Ringstatus=getRingstatus If oldRingstatus<>Ringstatus Then Select Case Ringstatus Case 0 write_logfile(1,"Machine down") checkRing=2 addKeyVal "status","M down" oldRingstatus=Ringstatus Case 1 write_logfile(1,"Inj. Stopped") checkRing=2 oldRingstatus=Ringstatus Case 2 write_logfile(1,"Accumulating.") checkRing=2 oldRingstatus=Ringstatus Case 3 write_logfile(1,"Accumulating") checkRing=2 oldRingstatus=Ringstatus Case 4 write_logfile(1,"Top-up ready, Gap still open") checkRing=2 oldRingstatus=Ringstatus Case 5 write_logfile(1,"Light-Available, no OFB") checkRing=2 oldRingstatus=Ringstatus Case 6 write_logfile(1,"Light Available") checkRing=2 oldRingstatus=Ringstatus End Select End If If Ringstatus =6 And ID1status=1 And ID2status=1 Then status=True End If If cancelmacro() = 0 Then status=True checkRing=3 End If sleep(1) Loop While status=False Select Case checkRing Case 2 write_logfile(1,"wait 120 s") addKeyVal "status","waiting" sleep(120) write_logfile(0,"continue") Case 1 write_logfile(1,"wait 10 s") addKeyVal "status","waiting" sleep(10) write_logfile(0,"continue") End Select End If End If End Function Sub getLEEM startvoltage=getStartvoltage() objective=getObjective() LEEMtemp=getLEEMtemp() End Sub Sub getXMCD rbkXMCDMag=getXMCDMag() End Sub Sub getTBT rbkTBTMag=getTBTrdkField() End Sub Sub updatelog Rem updates the infos in the log window addKeyVal "Energy",Format(rbkEnergy,"0.000") addKeyVal "Polarization",Polstring(pol)+" "+linrotstring addKeyVal "activeID",Format(activeID) addKeyVal "IDswitching",switchstring(polswitchmode) addKeyVal "Objective", Format(objective,"0.0") addKeyVal "SV", Format(startvoltage,"0.00") End Sub Function write_logfile(a As Integer, message As String) addMessage a,message If FileExists(autopath) Then Open autopath+"logfile.log" For Append As #5 Else Open "C:\IpWin5\X11MAconfig\logfile.log" For Append As #5 End If Print #5, Format(Date())+" "+Format(Time())+" "+message Close #5 End Function Sub startMacro(n As String) Rem sets log window active Dim value As Double addMessage 0,"" ' otherwise program crashes when log window not open 'write on log write_logfile(0,"start macro "+n) 'addMessage 0,"start macro "+n addKeyVal "Status",n+" running" updatelog 'active log setRunning 1 End Sub Sub stopMacro Rem set log window passive Dim value As Double 'write on log write_logfile(0,"stop macro") 'addMessage 0,"stop macro" addKeyVal "Status","Macro done" addKeyVal "Energy","done" addKeyVal "Polarization","done" addKeyVal "activeID","done" addKeyVal "IDswitching","done" addKeyVal "Objective","done" addKeyVal "SV","done" 'active log setRunning 0 End Sub Function cancelmacro() As Integer Rem if macro stoped by canelbutton, writes macro stoped cancelmacro=isRunning() If cancelmacro =0 Then Begin Dialog UserDialog 10,10,130,63,"Message" ' %GRID:10,7,1,1 Text 20,7,90,14,"Macro stoped",.Text1 OKButton 10,28,90,21 End Dialog Dim scanstoped As UserDialog Dialog scanstoped 'MsgBox "Scan canceled" 'info on X11MA log window stopMacro End If End Function Function checkbeamline() As Integer Rem 0 beamline ok Rem 1 beamline error Rem 2 Rem 3 cancel was pressed Dim ID1status As Integer Dim ID2status As Integer Dim ID1error As Integer Dim ID2error As Integer Dim ID1error_old As Integer Dim ID2error_old As Integer Dim status As Boolean Dim message(5) As String If do_checkbeamline = 1 Then ID1error_old=0 ID2error_old=0 checkbeamline=0 message(5)= "Interlock" message(4)= "Moving timeout" message(3)= "Operator control" message(2)= "Feedforward error" message(1)= "Encoder error" message(0)= "PLC error" Do Select Case opID Case 1 ID1status=getID1status ID2status=0 If ID1status = 0 Then status = True Case 2 ID1status=0 ID2status=getID2status If ID2status = 0 Then status = True Case 3 ID1status=getID1status ID2status=getID2status If (ID1status = 0) And (ID2status = 0) Then status = True End Select If ID1status >= 1 Then ID1error=getID1error If ID1error<>ID1error_old Then checkbeamline=1 status = False ID1error_old=ID1error For bit=5 To 0 Step -1 ID1test=ID1error/(2^bit) If ID1test >= 1 Then write_logfile(1,"ID1 "+message(bit)) ID1error=ID1error-(2^bit) End If Next bit End If End If If ID2status >= 1 Then ID2error=getID2error If ID2error<>ID2error_old Then checkbeamline=1 status = False ID2error_old=ID2error For bit=5 To 0 Step -1 ID2test=ID2error/(2^bit) If ID2test >= 1 Then write_logfile(1,"ID2 "+message(bit)) ID2error=ID2error-(2^bit) End If Next bit End If End If If cancelmacro() = 0 Then status=True checkbeamline=3 End If sleep(1) Loop While status=False End If End Function Sub loadstackfile Rem load setting (energy and steps) for stack from *_stack.txt Dim Iname As String *255 Dim i As Integer Dim selectfile As Integer 'Selectfile = IpStGetName("Select file","C:\IpWin4\X11MAconfig","*stack.txt",Iname) Selectfile = IpStGetName("Select file",configpath,"*.scn",Iname) If Selectfile = 0 Then Exit Sub Open Iname For Input As#1 For i = 1 To 20 Input #1, energym(i) Input #1, estepm(i) Input #1, estepmCheck(i) If EOF(1) Then Close Exit Sub End If Next i Close #1 End Sub Sub savestackfile Rem save setting (energy and steps) for stack in *_stack.txt Dim Iname As String *200 Dim selectfile As Integer Dim i As Integer Selectfile = IpStGetName("save as *.scn",configpath,"*.scn",Iname) If Selectfile = 0 Then Exit Sub tt= InStrRev(Iname,".") If tt = 0 Then tt=InStr(Iname,vbNullChar) Iname=Left(Iname,tt-1)+".scn" Else Iname=Left(Iname,tt-1)+".scn" End If Open Iname For Output As#1 For i = 1 To 20 Write #1, energym(i) Write #1, estepm(i) Write #1, estepmCheck(i) Next i Close #1 End Sub Sub saveX11MAstack Rem saves actual settings of stack Dim i As Integer Open "C:\IPWin5\X11MAconfig\X11MA_stack.scn" For Output As#1 For i = 1 To 20 Write #1, energym(i) Write #1, estepm(i) Write #1, estepmCheck(i) Next i Close #1 End Sub Sub loadX11MAstack Rem load last settings of stack Dim i As Integer Open "C:\IPWin5\X11MAconfig\X11MA_stack.scn" For Input As#1 For i = 1 To 20 Input #1, energym(i) Input #1, estepm(i) Input #1, estepmCheck(i) If EOF(1) Then Close Exit Sub End If Next i Close #1 End Sub Sub saveX11MA_PEEMconfig Rem saves setting for automatic saving of images Open "C:\IPWin5\X11MAconfig\X11MA_PEEM.txt" For Output As#3 Write #3, autopath Write #3, autoname Write #3, autoexpo(1) Write #3, autoexpo(2) Write #3, autoaver(1) Write #3, autoaver(2) Write #3, autosave Write #3, autoenergy(1) Write #3, autoenergy(2) Write #3, autocontrast Write #3, configpath Write #3, sensi_image Write #3, opID Write #3, polswitchmode Write #3, ID1offset Write #3, ID2offset Write #3, noint Write #3, KeithleyMode Write #3, VG10 Write #3, L3edge Write #3, L2edge Write #3, E1 Write #3, E2 Write #3, E3 Write #3, E4 Write #3, E5 Write #3, E6 Write #3, E7 Write #3, E8 Write #3, E9 Write #3, E10 Write #3, setRotstep Write #3, do_checkbeamline Write #3, do_checkring Close #3 End Sub Sub loadX11MA_PEEMconfig Rem load settings for automatic saving of images Open "C:\IPWin5\X11MAconfig\X11MA_PEEM.txt" For Input As#3 Input #3, autopath Input #3, autoname Input #3, autoexpo(1) Input #3, autoexpo(2) Input #3, autoaver(1) Input #3, autoaver(2) Input #3, autosave Input #3, autoenergy(1) Input #3, autoenergy(2) Input #3, autocontrast Input #3, configpath Input #3, sensi_image Input #3, opID Input #3, polswitchmode Input #3, ID1offset Input #3, ID2offset Input #3, noint Input #3, KeithleyMode Input #3, VG10 Input #3, L3edge Input #3, L2edge Input #3, E1 Input #3, E2 Input #3, E3 Input #3, E4 Input #3, E5 Input #3, E6 Input #3, E7 Input #3, E8 Input #3, E9 Input #3, E10 Input #3, setRotstep Input #3, do_checkbeamline Input #3, do_checkring Close #3 End Sub Sub saveX11MA_XMCDconfig Rem saves setting for automatic saving of images Open "C:\IPWin5\X11MAconfig\X11MA_XMCD.txt" For Output As#3 Write #3, autopath Write #3, autoname 'Write #3, autoexpo(1) 'Write #3, autoexpo(2) 'Write #3, autoaver(1) 'Write #3, autoaver(2) Write #3, autosave 'Write #3, autoenergy(1) 'Write #3, autoenergy(2) 'Write #3, autocontrast Write #3, configpath 'Write #3, sensi_image Write #3, opID Write #3, polswitchmode Write #3, ID1offset Write #3, ID2offset Close #3 End Sub Sub loadX11MA_XMCDconfig Rem load settings for automatic saving of images Open "C:\IPWin5\X11MAconfig\X11MA_XMCD.txt" For Input As#3 Input #3, autopath Input #3, autoname 'Input #3, autoexpo(1) 'Input #3, autoexpo(2) 'Input #3, autoaver(1) 'Input #3, autoaver(2) Input #3, autosave 'Input #3, autoenergy(1) 'Input #3, autoenergy(2) 'Input #3, autocontrast Input #3, configpath 'Input #3, sensi_image Input #3, opID Input #3, polswitchmode Input #3, ID1offset Input #3, ID2offset Close #3 End Sub 'Function find_next_file_Backup(prefix As String, suffix As String) ' f = Dir$(prefix + "_*." + suffix) ' mx = 0 ' Do While f <> "" ' nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3)) ' If nb > mx Then mx = nb ' f = Dir$ ' Loop ' mx = mx + 1 ' t=Left(prefix,InStrRev(prefix,"\")) ' mkdirs("C:\cache"+Right(t,Len(t)-2)) ' f = Dir$("C:\cache"+Right(prefix,Len(prefix)-2) + "_*." + suffix) ' mx2 = 0 ' Do While f <> "" ' nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3)) ' If nb > mx2 Then mx2 = nb ' f = Dir$ ' Loop ' mx2 = mx2 + 1 ' If mx2 > mx Then mx=mx2 ' find_next_file = prefix + "_" + Format(mx, "000") + "." + suffix 'End Function Function find_next_file(prefix As String, suffix As String) f = Dir$(prefix + "_*." + suffix) mx = 0 Do While f <> "" 'nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3)) nb= CInt( Mid( Right ( f, Len(f) - InStr(f,"_") ), 1, 3 ) ) ' Changed by Loic in case of problem comment this line and uncomment the line up If nb > mx Then mx = nb f = Dir$ Loop mx = mx + 1 t=Left(prefix,InStrRev(prefix,"\")) mkdirs("C:\cache"+Right(t,Len(t)-2)) f = Dir$("C:\cache"+Right(prefix,Len(prefix)-2) + "_*." + suffix) mx2 = 0 Do While f <> "" 'nb = CInt(Mid(f, Len(f) - (Len(suffix) + 3), 3)) nb= CInt( Mid( Right ( f, Len(f) - InStr(f,"_") ), 1, 3 ) ) ' Changed by Loic in case of problem comment this line and uncomment the line up If nb > mx2 Then mx2 = nb f = Dir$ Loop mx2 = mx2 + 1 If mx2 > mx Then mx=mx2 autonum=CInt(mx) find_next_file = prefix + "_" + Format(mx, "000") + "." + suffix End Function Sub imageinfo(inftxt As String) Rem save infos of beamline in image Rem I:E photonenergy scan Rem I:S startvoltage scan (photoemission) Rem I:M "manual" scan Rem I:O objective scan Rem I:I single image Rem I:T time resovled IpWsChangeDescription(INF_TITLE,"E:"+Format(setEnergy,"0.000")+" P:"+Polstring(pol)+" "+linrotstring+" I:"+inftxt) IpWsChangeDescription(INF_DESCRIPTION,"Polarisation "+Polarisationstring) IpWsChangeDescription(INF_Artist,"SV:"+Format(startvoltage,"0.000")+" OB:"+Format(objective,"0.00")+" ST:"+Format(LEEMtemp,"0.0")) End Sub Function SelectImage_X11MA(message As String, Image1 As Integer) As Boolean Rem ask user to select one image with message, returns true if successful Dim pt As pointapi selectImage_X11MA = False Image1 = IpDocClick(message+" select",pt) If Image1 < 0 Then Exit Function selectImage_X11MA = True End Function Function Select2Images_X11MA(Image1 As Integer, Image2 As Integer) As Boolean Rem Asks user to select two images Rem Returns True if successful Dim pt As pointapi Select2Images_X11MA = False Image1 = IpDocClick("Select first image", pt) If Image1 < 0 Then Exit Function Image2 = IpDocClick("Select second image", pt) If Image2 < 0 Then Exit Function Select2Images_X11MA = True End Function Function Divide2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer Rem Divides Image1 / Image2 (*Gray), scales Image1 by Scale or autoscales if Scale = 0.0, Rem Enhances contrast by Enhance, flattens if DoFLatten = True Rem Returns ID Dim tmp As Integer Dim Gray As Single tmp = ScaleImage(Image1, Image2, Scale, True) Gray = (GetWhiteValue(Image2) + 1) / 2 ret = IpOpImageArithmetics(Image2, Gray, OPA_DIV, False) 'If DoFlatten Then ret = Flatten(tmp, False) ret = EnhanceImageContrast(tmp, Enhance, 0) Divide2Images = tmp End Function Function Add2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer Dim tmp As Integer Dim Gray As Single tmp = IpOpNumberArithmetics(1.0, OPA_MULT, 1) Gray = (GetWhiteValue(Image2) + 1) / 2 ret = IpOpImageArithmetics(Image2, 0, OPA_ADD, False) 'If DoFlatten Then ret = Flatten(tmp, False) ret = IpAppSelectDoc(tmp) Add2Images = tmp End Function Function Subtract2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer Rem Subtracts Image1 - Image2 (+Gray), scales Image1 by Scale or autoscales if Scale = 0.0, Rem Enhances contrast by Enhance Rem Returns ID Dim tmp As Integer Dim Gray As Single tmp = ScaleImage(Image1, Image2, Scale, True) Gray = (GetWhiteValue(Image2) + 1) / 2 ret = IpOpImageArithmetics(Image2, Gray, OPA_SUB, False) 'If DoFlatten Then ret = Flatten(tmp, False) ret = EnhanceImageContrast(tmp, Enhance, 0) Subtract2Images = tmp End Function Function Subtract2ImagesNoGray(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer Rem Subtracts Image1 - Image2 scales Image1 by Scale or autoscales if Scale = 0.0, Rem Enhances contrast by Enhance Rem Returns ID Dim tmp As Integer Dim Gray As Single tmp = ScaleImage(Image1, Image2, Scale, True) ret = IpOpImageArithmetics(Image2, 0, OPA_SUB, False) 'If DoFlatten Then ret = Flatten(tmp, False) ret = EnhanceImageContrast(tmp, Enhance, 0) Subtract2ImagesNoGray = tmp End Function Function ScaleImage(ByVal Image As Integer, ByVal Reference As Integer, ByVal Scale As Single, ByVal New_Image As Boolean) As Integer Rem Scales Image to same brightness as Reference if Scale < 0.01 and Reference >= 0, else uses fixed value Scale Rem Creates new image if New_Image = True Rem Returns ID ReDim stats(10) As Single If (Scale < 0.0001) And (Reference >= 0) Then ret = IpAppSelectDoc(Reference) ret = IpHstCreate() ret = IpHstGet(GETSTATS, 0, stats(0)) ret = IpHstDestroy() Scale = stats(2) / ((GetWhiteValue(Reference) + 1) / 2) ret = IpAppSelectDoc(Image) ret = IpHstCreate() ret = IpHstGet(GETSTATS, 0, stats(0)) ret = IpHstDestroy() Scale = Scale / (stats(2) / ((GetWhiteValue(Image) + 1) / 2)) Else ret = IpAppSelectDoc(Image) End If ScaleImage = IpOpNumberArithmetics(Scale, OPA_MULT, New_Image) End Function Function Asymmetry2Images(ByVal Image1 As Integer, ByVal Image2 As Integer, ByVal Scale As Single, ByVal Enhance As Single, ByVal DoFlatten As Boolean) As Integer Rem Calculates asymmetry (Image1-Image2+Gray)/(Image1+Image2-Gray), scales Image1 by Scale or autoscales if Scale = 0.0, Rem Enhances contrast by Enhance, flattens if DoFLatten = True Rem Returns ID Dim tmp1 As Integer Dim tmp2 As Integer Dim tmp3 As Integer Dim range(2) As Single Dim Info As IPDOCINFO ret = IpDocGet(GETDOCINFO, Image1, Info) tmp2 = ScaleImage(Image1, Image2, Scale, True) tmp1 = IpWsConvertImage(IMC_FLOAT, CONV_DIRECT, 0, 0, 0, 0) CloseImage(tmp2) ret = IpAppSelectDoc(Image2) tmp2 = IpWsConvertImage(IMC_FLOAT, CONV_DIRECT, 0, 0, 0, 0) tmp3 = IpOpImageArithmetics(tmp1, 0, OPA_ADD, True) ret = IpAppSelectDoc(tmp1) tmp1 = IpOpImageArithmetics(tmp2, 0, OPA_SUB, False) tmp1 = IpOpImageArithmetics(tmp3, 100*Enhance, OPA_DIV, False) CloseImage(tmp2) CloseImage(tmp3) range(0)=-100 range(1)=100 IpDrSet(DR_FRANGE, 1, range(0)) tmp2 = IpWsConvertImage(Info.Class, CONV_SCALE, 0, 0, 0, 0) If DoFlatten Then ret = Flatten(tmp2, False) CloseImage(tmp1) Asymmetry2Images = tmp2 End Function Function EnhanceImageContrast(ByVal Image As Integer, ByVal Factor As Single, ByVal New_Image As Boolean) As Integer Rem Enhances contrast of Image by Factor Rem Creates new image if New_Image = True Rem Returns ID Dim Gray As Single ReDim stats(10) As Single If (Factor > 0.01) And (Factor < 100) Then ret = IpAppSelectDoc(Image) Gray = (GetWhiteValue(Image) + 1) / 2 ret = IpHstGet(GETSTATS, 0, stats(0)) ret = IpHstDestroy() IpOpNumberArithmetics(Gray-stats(0), OPA_ADD, 0) If Factor >= 1.0 Then EnhanceImageContrast = IpOpNumberArithmetics(Gray * (1.0 - 1.0/Factor), OPA_SUB, New_Image) ret = IpOpNumberArithmetics(Factor, OPA_MULT, 0) Else ret = IpOpNumberArithmetics(Factor, OPA_MULT, 0) EnhanceImageContrast = IpOpNumberArithmetics(Gray * (1.0 - Factor), OPA_Add, New_Image) End If Else EnhanceImageContrast = -1 End If End Function Function GetWhiteValue(Image As Integer) As Single Rem Returns pixel value corresponding to White for Image Dim Info As IPDOCINFO ret = IpDocGet(GETDOCINFO, Image, Info) If Info.Class = IMC_GRAY16 Then GetWhiteValue = 65535.0 ElseIf Info.Class = IMC_GRAY12 Then GetWhiteValue = 4095.0 Else GetWhiteValue = 255.0 End If End Function Function definescan(lolimit As Integer, uplimit As Integer) As Boolean Rem ask user for the region of the scan, returns True when done Dim doneinput As Boolean definescan = True loadX11MAstack Do 'define scan Begin Dialog UserDialog 1000,100,390,320,"define spectrum" ' %GRID:10,8,1,1 Text 220,0,60,16,"Step",.Text3 TextBox 120,16,90,16,.energy1 TextBox 120,40,90,16,.energy2 TextBox 120,64,90,16,.energy3 TextBox 120,88,90,16,.energy4 TextBox 120,112,90,16,.energy5 TextBox 120,136,90,16,.energy6 TextBox 120,160,90,16,.energy7 TextBox 120,184,90,16,.energy8 TextBox 120,208,90,16,.energy9 TextBox 120,232,90,16,.energy10 TextBox 220,24,60,16,.Step1 TextBox 220,56,60,16,.Step2 TextBox 220,80,60,16,.Step3 TextBox 220,104,60,16,.Step4 TextBox 220,128,60,16,.Step5 TextBox 220,152,60,16,.Step6 TextBox 220,176,60,16,.Step7 TextBox 220,200,60,16,.Step8 TextBox 220,224,60,16,.Step9 CheckBox 290,24,90,16,CheckBox1,.CheckBox1 CheckBox 290,56,90,16,CheckBox2,.CheckBox2 CheckBox 290,80,90,16,CheckBox3,.CheckBox3 CheckBox 290,104,90,16,CheckBox4,.CheckBox4 CheckBox 290,128,90,16,CheckBox5,.CheckBox5 CheckBox 290,152,90,16,CheckBox6,.CheckBox6 CheckBox 290,176,90,16,CheckBox7,.CheckBox7 CheckBox 290,200,90,16,CheckBox8,.CheckBox8 CheckBox 290,224,90,16,CheckBox9,.CheckBox9 Text 290,0,80,16,"Click to use",.Text1 Text 130,0,80,16,"Energy",.Text2 PushButton 380,312,10,8,"enterkey",.PushButton1 OKButton 130,288,90,24 CancelButton 250,288,90,24 PushButton 90,256,100,24,"load setings",.PushButton2 PushButton 220,256,90,24,"save settings",.PushButton3 End Dialog Dim dlg As UserDialog dlg.energy1=Format(energym(1)) dlg.energy2=Format(energym(2)) dlg.energy3=Format(energym(3)) dlg.energy4=Format(energym(4)) dlg.energy5=Format(energym(5)) dlg.energy6=Format(energym(6)) dlg.energy7=Format(energym(7)) dlg.energy8=Format(energym(8)) dlg.energy9=Format(energym(9)) dlg.energy10=Format(energym(10)) dlg.step1=Format(estepm(1)) dlg.step2=Format(estepm(2)) dlg.step3=Format(estepm(3)) dlg.step4=Format(estepm(4)) dlg.step5=Format(estepm(5)) dlg.step6=Format(estepm(6)) dlg.step7=Format(estepm(7)) dlg.step8=Format(estepm(8)) dlg.step9=Format(estepm(9)) dlg.CheckBox1=Format(estepmCheck(1)) dlg.CheckBox2=Format(estepmCheck(2)) dlg.CheckBox3=Format(estepmCheck(3)) dlg.CheckBox4=Format(estepmCheck(4)) dlg.CheckBox5=Format(estepmCheck(5)) dlg.CheckBox6=Format(estepmCheck(6)) dlg.CheckBox7=Format(estepmCheck(7)) dlg.CheckBox8=Format(estepmCheck(8)) dlg.CheckBox9=Format(estepmCheck(9)) r=Dialog(dlg,1) doneinput=True If r = 0 Then definescan=False Exit Function End If If r=1 Then doneinput=False End If ' "internal save" input n=0 n=n+string2double(dlg.energy1,energym(1)) n=n+string2double(dlg.step1,estepm(1)) estepmCheck(1)=CInt(dlg.CheckBox1) n=n+string2double(dlg.energy2,energym(2)) n=n+string2double(dlg.step2,estepm(2)) estepmCheck(2)=CInt(dlg.CheckBox2) n=n+string2double(dlg.energy3,energym(3)) n=n+string2double(dlg.step3,estepm(3)) estepmCheck(3)=CInt(dlg.CheckBox3) n=n+string2double(dlg.energy4,energym(4)) n=n+string2double(dlg.step4,estepm(4)) estepmCheck(4)=CInt(dlg.CheckBox4) n=n+string2double(dlg.energy5,energym(5)) n=n+string2double(dlg.step5,estepm(5)) estepmCheck(5)=CInt(dlg.CheckBox5) n=n+string2double(dlg.energy6,energym(6)) n=n+string2double(dlg.step6,estepm(6)) estepmCheck(6)=CInt(dlg.CheckBox6) n=n+string2double(dlg.energy7,energym(7)) n=n+string2double(dlg.step7,estepm(7)) estepmCheck(7)=CInt(dlg.CheckBox7) n=n+string2double(dlg.energy8,energym(8)) n=n+string2double(dlg.step8,estepm(8)) estepmCheck(8)=CInt(dlg.CheckBox8) n=n+string2double(dlg.energy9,energym(9)) n=n+string2double(dlg.step9,estepm(9)) estepmCheck(9)=CInt(dlg.CheckBox9) n=n+string2double(dlg.energy10,energym(10)) If n<> 0 Then Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"type in numbers!",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror5 As UserDialog Dialog scanerror5 doneinput=False End If If r = 2 Then loadstackfile doneinput=False End If If r= 3 Then savestackfile doneinput=False End If noregion = 0 For i = 1 To 9 If estepmCheck(i) = 1 Then noregion=noregion+1 'If estepm(i)<=0 Then definescan=False If energym(i)uplimit Then definescan=False If energym(i+1)uplimit Then definescan=False End If Next i If noregion = 0 Then Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"No energy range selected",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror3 As UserDialog Dialog scanerror3 doneinput=False End If If definescan = False Then Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"wrong energy or step size",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror4 As UserDialog Dialog scanerror4 doneinput=False End If Loop While doneinput=False saveX11MAstack End Function Function definescan_otf(lolimit As Integer, uplimit As Integer) As Boolean Rem ask user for the region of the otf scan, returns True when done Dim doneinput As Boolean definescan_otf = True loadX11MAstack Do 'define scan Begin Dialog UserDialog 1000,100,390,112,"define spectrum" ' %GRID:10,8,1,1 Text 230,8,120,16,"Time (minutes)",.Text3 TextBox 30,24,90,16,.energy1 TextBox 130,24,90,16,.energy2 TextBox 240,24,60,16,.Step1 Text 30,8,80,16,"Start Energy",.Text2 Text 130,8,80,16,"End Energy",.Text4 PushButton 380,104,10,8,"enterkey",.PushButton1 OKButton 140,88,90,24 CancelButton 240,88,90,24 PushButton 90,56,100,24,"load setings",.PushButton2 PushButton 210,56,90,24,"save settings",.PushButton3 End Dialog Dim dlg As UserDialog dlg.energy1=Format(energym(1)) dlg.energy2=Format(energym(2)) dlg.step1=Format(estepm(1)) r=Dialog(dlg,1) doneinput=True If r = 0 Then definescan_otf=False Exit Function End If If r=1 Then doneinput=False End If ' "internal save" input n=0 n=n+string2double(dlg.energy1,energym(1)) n=n+string2double(dlg.step1,estepm(1)) n=n+string2double(dlg.energy2,energym(2)) If n<> 0 Then Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"type in numbers!",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror5 As UserDialog Dialog scanerror5 doneinput=False End If If r = 2 Then loadstackfile doneinput=False End If If r= 3 Then savestackfile doneinput=False End If noregion = 1 If estepm(1)<=0 Then definescan_otf=False If energym(1)uplimit Then definescan_otf=False If energym(2)uplimit Then definescan_otf=False If definescan_otf = False Then Begin Dialog UserDialog 260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"wrong energy or step size",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror4 As UserDialog Dialog scanerror4 doneinput=False End If Loop While doneinput=False saveX11MAstack End Function Function ExpandName(s As String, n As Integer, ext As String) As String Rem Expands filename s with number n and extension ext and adds ".TIF" Rem Returns new filename Dim t As String t = s If n<10 Then t = t + "00" Else If n<100 Then t = t + "0" End If ExpandName = t + Mid$(Str$(n),2) + ext + ".TIF" End Function Function FileExists(f As String) As Boolean Rem Tests whether filename f already exists Rem Returns True if f exists Dim p As String Dim n As String Dim x As Integer Dim Iname As String * 255 Dim i As Integer x = 0 i = InStrRev(f, "\") p = Left(f, i) n = Mid(f, i+1) FileExists = IpStSearchDir(p, n, x, Iname) End Function Sub ini_switchID ID1os=getID1offset ID2os=getID2offset If ID1os=ID1offset Then activeID=1 Else activeID=2 PHS_mode(3) End Sub Sub switchID If activeID = 1 Then Rem detuneID1 putID1offset(ID1offset-40) Rem tuneID2 putID2offset(ID2offset) activeID=2 Else Rem detuneID2 putID2offset(ID2offset-40) Rem tuneID1 putID1offset(ID1offset) activeID=1 End If End Sub Function nextpol As Single Select Case polswitchmode Case 1 'Normal If pol=1 Then nextpol=2 'circ+ -> circ- If pol=2 Then nextpol=1 'circ+ -> circ- If pol=3 Then nextpol=4 'lin hor -> lin vert If pol=4 Then nextpol=3 'lin vert -> lin hor If pol=5 Then nextpol=5 'lin rot -> lin rot Case 2 'tune/detuned If activeID=1 Then nextpol=polID2 If activeID=2 Then nextpol=polID1 End Select End Function Sub switchpol_new Dim newpol As Single Dim v As Double Dim chop As Double newpol=nextpol Select Case opID Case 1 'ID1 only putPolID1(newpol) Case 2 'ID2 only putPolID2(newpol) Case 3 'ID1+ID2 If polswitchmode=1 Then 'normal putPolID1(newpol) putPolID2(newpol) End If If polswitchmode = 2 Then 'tune/detuned If activeID = 1 Then Rem detuneID1 putID1offset(ID1offset-40) Rem tuneID2 putID2offset(ID2offset) activeID=2 Else Rem detuneID2 putID2offset(ID2offset-40) Rem tuneID1 putID1offset(ID1offset) activeID=1 End If End If If polswitchmode = 3 Then 'chopper If activeID = 1 Then chop=1 activeID = 2 putChopper(chop) Else chop=0 activeID = 1 putChopper(chop) End If End If Case Else 'Error Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"go to config beamline",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror5 As UserDialog Dialog scanerror5 End Select sleep_f(1) End Sub 'Set all the ID's in use in detuned mode Sub set_IDs_in_detune Select Case opID Case 1 'ID1 only putID1offset(ID1offset-40) Case 2 'ID2 only putID2offset(ID2offset-40) Case 3 'ID1+ID2 If polswitchmode=1 Then 'normal putID1shift(0) putID2shift(0) Else 'tune/detuned If activeID = 1 Then putID1offset(ID1offset-40) Else putID2offset(ID2offset-40) End If End If End Select sleep_f(1) End Sub Sub correct_sensi Dim image1 As Integer Dim image2 As Integer If selectImage_X11MA("select image",image1) Then IpWsLoad(sensi_image, "TIF") ret = IpDocGet(GETACTDOC, 0, Image2) ret=Divide2Images(image1,image2,0,1,False) ret=IpDocCloseEx(Image2) End If End Sub Sub config_beamline Dim ListopID(4) As String Dim Listswitchmode(3) As String Dim ListactiveID(3) As String Dim Listharmonic(5) As String Dim doneinput As Boolean ListopID(1)="ID1" ListopID(2)="ID2" ListopID(3)="ID1+ID2" ListopID(4)="open gap" Listswitchmode(1)="Normal" Listswitchmode(2)="tune/detune" Listswitchmode(3)="chopper" ListactiveID(1)="ID1" ListactiveID(2)="ID2" ListactiveID(3)="ID1+ID2" Listharmonic(1)="1" Listharmonic(3)="3" loadX11MA_PEEMconfig getbeamline Do Begin Dialog UserDialog 800,100,830,238,"config_beamline" ' %GRID:10,7,1,1 OKButton 80,203,90,21 CancelButton 190,203,90,21 Text 390,210,70,14,"offset ID1",.Text1 TextBox 470,203,90,21,.ID1offset Text 610,210,70,14,"offset ID2",.Text2 TextBox 690,203,90,21,.ID2offset ComboBox 80,21,90,70,ListopID(),.ListopID Text 30,21,50,14,"use ID:",.Text3 Text 220,21,70,14,"switching mode:",.Text4 ComboBox 290,21,90,70,Listswitchmode(),.Listswitchmode Text 430,21,50,14,"ID1:",.Text5 ComboBox 480,21,90,70,Polstring(),.PolID1 Text 650,21,30,14,"ID2:",.Text6 ComboBox 690,21,90,70,Polstring(),.PolID2 TextBox 480,91,90,21,.ID1alpha TextBox 690,91,90,21,.ID2alpha Text 410,91,70,14,"Alpha ID1",.Text7 Text 610,91,70,14,"Alpha ID2",.Text8 ComboBox 480,119,90,70,Listharmonic(),.harmonicID1 ComboBox 690,119,90,70,Listharmonic(),.harmonicID2 Text 380,126,90,14,"harmonic ID1",.Text9 Text 600,119,90,14,"harmonic ID2",.Text10 'ListBox 480,91,90,56,linrotstringID1(),.linrotID1 'ListBox 670,91,90,56,linrotstringID2(),.linrotID2 End Dialog Dim dlg As UserDialog dlg.ID1offset=Format(ID1offset) dlg.ID2offset=Format(ID2offset) dlg.ListopID=ListopID(opID) dlg.Listswitchmode=Listswitchmode(polswitchmode) dlg.PolID1=Polstring(polID1) dlg.PolID2=Polstring(polID2) dlg.ID1alpha=Format(ID1alpha) dlg.ID2alpha=Format(ID2alpha) dlg.harmonicID1=Format(getID1harmonic) dlg.harmonicID2=Format(getID2harmonic) If JobsRunning=False Then r=Dialog(dlg) Else r=-1 dlg.ListopID = Jobs(Current_job,2) dlg.Listswitchmode = Jobs(Current_job,3) dlg.PolID1 = Jobs(Current_job,4) dlg.PolID2 = Jobs(Current_job,5) dlg.ID1alpha = Jobs(Current_job,6) dlg.ID2alpha = Jobs(Current_job,7) dlg.ID1offset = Jobs(Current_job,8) dlg.ID2offset = Jobs(Current_job,9) dlg.harmonicID1 = Jobs(Current_job,10) dlg.harmonicID2 = Jobs(Current_job,11) End If If r=0 Then stopMacro Exit Sub End If ID1offset=CDbl(dlg.ID1offset) ID2offset=CDbl(dlg.ID2offset) ID1alpha=CDbl(dlg.ID1alpha) ID2alpha=CDbl(dlg.ID2alpha) Rem find new harmonic For i = 1 To 5 If dlg.harmonicID1=Listharmonic(i) Then ID1harmonic = i If dlg.harmonicID2=Listharmonic(i) Then ID2harmonic = i Next i Rem set harmonic putID1harmonic(ID1harmonic) putID2harmonic(ID2harmonic) If r=-1 Then doneinput=True End If ' putIDmotors(0) 'off For i=1 To 5 If dlg.PolID1=Polstring(i) Then putpolID1(i) sleep_f(1) If dlg.PolID2=Polstring(i) Then putpolID2(i) sleep_f(1) Next i 'sleep(2) Rem ID1 as active ID If dlg.ListopID=ListopID(1) Then PHS_mode(1) sleep_f(1) activeID=1 opID=1 polswitchmode=1 putID2offset(ID2offset) sleep_f(1) putID1offset(ID1offset) sleep(1) Rem set harmonic putID1harmonic(ID1harmonic) opengapID2 End If Rem ID2 as active ID If dlg.ListopID=ListopID(2) Then PHS_mode(2) sleep_f(1) activeID=2 opID=2 polswitchmode=1 putID2offset(ID2offset) sleep_f(1) putID1offset(ID1offset) sleep(1) Rem set harmonic putID2harmonic(ID2harmonic) opengapID1 End If Rem ID1+ID2 as active IDs If dlg.ListopID=ListopID(3) Then PHS_mode(3) sleep_f(1) activeID=3 opID=3 polswitchmode=1 putID2offset(ID2offset) sleep_f(1) putID1offset(ID1offset) sleep_f(1) Rem set harmonic putID1harmonic(ID1harmonic) putID2harmonic(ID2harmonic) End If Rem open gaps If dlg.ListopID=ListopID(4) Then ' putIDmotors(2) opengapID1 sleep_f(1) opengapID2 stopmacro write_logfile(0,"open gaps") Exit Sub End If 'sleep(5) Rem normal switching If dlg.Listswitchmode=Listswitchmode(1) Then polswitchmode=1 End If Rem tune/detune switching If dlg.Listswitchmode=Listswitchmode(2) Then polswitchmode=2 activeID = 1 opID=3 putID2offset(ID2offset-40) sleep_f(1) putID1offset(ID1offset) End If Rem chopper If dlg.Listswitchmode=Listswitchmode(3) Then polswitchmode=3 activeID = 1 opID=3 putID2offset(ID2offset) sleep_f(1) putID1offset(ID1offset) End If 'putlinrotmodeID1(0) 'putlinrotmodeID2(0) Rem linear rot mode ID1 If dlg.PolID1=Polstring(5) And opID=1 Then 'putpolID1(3) 'set to linear mode for feedforward table putpolID1(5) 'set to linear mode for feedforward table sleep(3) 'putID1alpha(ID1alpha) 'PHS_mode(0) opID=1 activeID =1 'putlinrotmodeID1(dlg.linrotID1+1) 'linrotID1=dlg.linrotID1 'If setEnergy=0 Then setEnergy=rbkEnergy 'putlinrotID1(setEnergy) putID1offset(ID1_linrot_offset(ID1alpha)) End If Rem linear rot mode ID2 If dlg.PolID2=Polstring(5) And opID=2 Then 'putpolID2(3) 'set to linear mode for feedforward table putpolID2(5) 'set to linear mode for feedforward table sleep(3) 'putID2alpha(ID2alpha) 'PHS_mode(0) opID=2 activeID =2 'putlinrotmodeID2(dlg.linrotID2+1) 'linrotID1=dlg.linrotID1 'If setEnergy=0 Then setEnergy=rbkEnergy 'putlinrotID2(setEnergy) putID2offset(ID2_linrot_offset(ID2alpha)) End If Rem linear rot mode ID1+ID2 If dlg.PolID1=Polstring(5) And dlg.PolID2=Polstring(5) Then 'putpolID1(3) 'set to linear mode for feedforward table putpolID1(5) 'set to linear mode for feedforward table sleep(3) 'putID1alpha(ID1alpha) 'PHS_mode(0) opID=3 activeID =3 'putlinrotmodeID1(dlg.linrotID1+1) 'linrotID1=dlg.linrotID1 'If setEnergy=0 Then setEnergy=rbkEnergy 'putlinrotID1(setEnergy) putID1offset(ID1_linrot_offset(ID1alpha)) 'putpolID2(3) 'set to linear mode for feedforward table putpolID2(5) 'set to linear mode for feedforward table sleep(3) 'putID2alpha(ID2alpha) 'PHS_mode(0) 'putlinrotmodeID2(dlg.linrotID2+1) 'linrotID1=dlg.linrotID1 'If setEnergy=0 Then setEnergy=rbkEnergy 'putlinrotID2(setEnergy) putID2offset(ID2_linrot_offset(ID2alpha)) End If If dlg.ListopID="" Or dlg.Listswitchmode="" Then Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"Select mode and ID",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror3 As UserDialog Dialog scanerror3 doneinput=False End If Loop While doneinput=False ' putIDmotors(2) 'auto saveX11MA_PEEMconfig Rem write logfile getbeamline write_logfile(0,"activeID :"+CStr(activeID)+" Polarization :"+Polstring(pol)+" "+linrotstring+" IDswitching :"+switchstring(polswitchmode)) End Sub Sub config_measure Dim ListKeithleyMode(10) As String Dim ListKeithleyNo(5) As String Dim ListKeithley_set_mode(10) As String ListKeithleyMode(0) = "use GBIP, without injection test, no average of energy readback" ListKeithleyMode(1) = "use GBIP, pause while injection, no average of energy readback" ListKeithleyMode(2) = "use GBIP, without injection test, average of energy readback" ListKeithleyMode(3) = "use A/D, without injection test, no average of energy readback" ListKeithleyMode(4) = "use A/D, without injection test, average of energy readback" ListKeithleyMode(5) = "use A/D, pause while injection, average of energy readback" ListKeithleyMode(6) = "use A/D, pause while injection, no average of energy readback" ListKeithleyMode(7) = "trigger Keithley extern, injection test" ListKeithleyMode(8) = "trigger analog ADC, injection test, no average of energy readback" ListKeithleyNo(0) = "Keithely1" ListKeithleyNo(1) = "Keithely2" ListKeithleyNo(2) = "Keithely1+2+norm" ListKeithleyNo(3) = "Keithely1+2+3" ListKeithleyNo(4) = "Keithely1+2+norm+4Analog" ListKeithley_set_mode(0) = "def setting" ListKeithley_set_mode(1) = "pull curr fast" ListKeithley_set_mode(2) = "pull curr medi" ListKeithley_set_mode(3) = "pull curr slow" ListKeithley_set_mode(4) = "trig setting" ListKeithley_set_mode(5) = "trigger extern" ListKeithley_set_mode(6) = "trigger TLIN" ListKeithley_set_mode(7) = "trigger BUS" ListKeithley_set_mode(8) = "pol volt medi" ListKeithley_set_mode(9) = "not running" loadX11MA_PEEMconfig getbeamline Do Begin Dialog UserDialog 800,100,970,189,"config_measure" ' %GRID:10,7,1,1 ListBox 140,14,480,70,ListKeithleyMode(),.KeithleyMode Text 30,14,90,14,"Keithley Mode",.Text1 Text 110,105,130,14,"no of reading",.Text2 Text 90,126,140,14,"(10 about 1 sec)",.Text3 TextBox 250,105,90,21,.noint OKButton 400,147,90,21 CancelButton 520,147,90,21 CheckBox 400,91,270,14,"Check beamline status",.do_checkbeamline CheckBox 400,112,160,14,"Check ring status",.do_checkring ListBox 670,14,260,70,ListKeithleyNo(),.KeithleyNo Text 140,154,90,14,"Integration time ADC",.Text4 TextBox 250,147,90,21,.noADC TextBox 790,98,130,21,.Keithley1_set TextBox 790,126,130,21,.Keithley2_set TextBox 790,154,130,21,.Keithley3_set Text 720,105,60,14,"Keithley1",.Text5 Text 720,133,60,14,"Keithley2",.Text6 Text 720,154,60,14,"Keithley3",.Text7 End Dialog Dim dlg As UserDialog dlg.noint=Format(noint) dlg.noADC=Format(noADC) dlg.KeithleyMode=KeithleyMode dlg.KeithleyNo=KeithleyNo dlg.Keithley1_set=ListKeithley_set_mode(get_keithley1_mode) dlg.Keithley2_set=ListKeithley_set_mode(get_keithley2_mode) dlg.Keithley3_set=ListKeithley_set_mode(get_keithley3_mode) dlg.do_checkbeamline=do_checkbeamline dlg.do_checkring=do_checkring r=Dialog(dlg) If r=0 Then stopMacro Exit Sub End If If r=-1 Then doneinput=True End If noint=CInt(dlg.noint) KeithleyMode=CInt(dlg.KeithleyMode) KeithleyNo=CInt(dlg.KeithleyNo) do_checkbeamline=CInt(dlg.do_checkbeamline) do_checkring=CInt(dlg.do_checkring) noADC=CInt(dlg.noADC) Rem put integration time to ADC putADC_integration(noADC) Loop While doneinput=False saveX11MA_PEEMconfig End Sub Function string2double(ByRef n As String, ByRef d As Double) As Integer Rem returns 0 if okay, 1 if error On Error GoTo nostring d=CDbl(n) GoTo yesString nostring: string2double=1 GoTo done yesstring: string2double=0 done: On Error GoTo 0 End Function Function string2long(ByRef n As String, ByRef d As Long) As Integer Rem returns 0 if okay, 1 if error On Error GoTo nostring d=CDbl(n) GoTo yesString nostring: string2long=1 GoTo done yesstring: string2long=0 done: On Error GoTo 0 End Function Sub wronginput Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"type in numbers!",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror5 As UserDialog Dialog scanerror5 End Sub Sub wrongvalue Begin Dialog UserDialog 1000,100,260,77 ' %GRID:10,7,1,1 Text 50,7,170,21,"value out of range",.Text1 OKButton 70,35,110,21 End Dialog Dim scanerror3 As UserDialog Dialog scanerror3 End Sub Function date2name As String Dim n As String n="" n=Format(Date,"yy") n=n+Format(Date,"mm") n=n+Format(Date,"dd") date2name=n End Function Function averKeithley(t As Integer,ByRef Keithley1 As Double,ByRef Keithley2 As Double,ByRef Keithleynorm As Double) As Integer Rem 1: okay Rem 2: injection Dim Keithley(3) As Double Dim Analog(4) As Double 'Dim Injection_test As Single Dim rEnergy As Double 'KeithleyMode = 0 ' use GBIP non test 'KeithleyMode = 1 'use GBIP break while injection 'KeithleyMode = 2 ' use GBIP, without injection test, user energy readback 'KeithleyMode = 3 ' use A/D signal no injection test 'KeithleyMode = 4 ' use A/D signal without injection test, use energy readback 'KeithleyMode = 5 ' use A/D signal with injection test, use energy readback 'KeithleyMode = 6 ' use A/D signal with injection test, no average of energy 'KeithleyMode = 7 ' new hardware trigger 'KeithleyMode = 8 ' new trigger for analog 'KeithleyNo = 0 ' read Keithley1 'KeithleyNo = 1 ' read Keithley2 'KeithleyNo = 2 ' read Keithley1+2+Norm this is the default 'KeithleyNo = 3 ' read Keithley1+2+3 'KeithleyNo = 4 ' read Keithley1+2+Norm + 4 analog only in XFMR Rem one empty read due to keithley bufferproblem 'keithley_read(2,keithley(1),keithley(2),keithley(3)) Select Case KeithleyMode Case 0 Rem one empty read due to keithley bufferproblem keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 addKeyVal "Status","measuring" For i=1 To t keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t averKeithley=1 avrbkenergy=getEnergy Case 1 keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Else addKeyVal "Status","injection" Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 i=0 averKeithley=2 addKeyVal "Status","measuring" End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t averKeithley=1 avrbkenergy=getEnergy Case 2 keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 rEnergy=0 addKeyVal "Status","measuring" For i=1 To t keithley_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) rEnergy=rEnergy+getEnergy Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t avrbkenergy=rEnergy/t averKeithley=1 Case 3 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 addKeyVal "Status","measuring" For i=1 To t keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) sleep_f(1) Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t averKeithley=1 avrbkenergy=getEnergy Case 4 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 rEnergy=0 addKeyVal "Status","measuring" For i=1 To t keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) rEnergy=rEnergy+getEnergy sleep_f(1) Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t avrbkenergy=rEnergy/t averKeithley=1 Case 5 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 rEnergy=0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) rEnergy=rEnergy+getEnergy sleep_f(1) Else addKeyVal "Status","injection" Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 rEnergy=0 averKeithley=0 i=0 averKeithley=2 addKeyVal "Status","measuring" End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t avrbkenergy=rEnergy/t averKeithley=1 Case 6 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) sleep_f(1) Else addKeyVal "Status","injection" Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 i=0 averKeithley=2 addKeyVal "Status","measuring" End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t averKeithley=1 avrbkenergy=getEnergy Case 7 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then Rem start trigger keithley1_trigger_doinit keithley2_trigger_doinit sleep_f(2) keithley1_new_trigger 'keithley2_new_trigger sleep_f(1) Rem wait for result tstart=Int(Timer())+30 Do While True If cancelmacro() = 0 Then Exit Function 'If injection()= 0 Then Exit Do If keithley1_new_done = 0 And keithley2_new_done = 0 Then Exit Do Rem timeout tnow=Int(Timer()) If tstart < tnow Then write_logfile(1,"timeout Keithley at: "+Format(setEnergy)) keithley2_new_trigger 'keithley1_new_fetch 'keithley2_new_fetch Exit Do End If Loop Rem read keithley sleep_f(2) keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Rem calculate Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Else addKeyVal "Status","injection" Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 i=0 averKeithley=2 addKeyVal "Status","measuring" End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t averKeithley=1 avrbkenergy=getEnergy Case 8 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 addKeyVal "Status","measuring" For i=1 To t 'If injection() = 0 Then Rem start trigger Do addKeyVal "Status","measuring" averKeithley=0 keithley_analog_trigger sleep_f(1) Rem wait for result Do While True If cancelmacro() = 0 Then Exit Function If injection()= 1 Then averKeithley=2 addKeyVal "Status","injection" Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 'i=0 sleep_f(5) End If If keithley_analog_done = 0 Then Exit Do Loop Loop While averKeithley=2 Rem read ADC signals keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) 'sleep_f(1) 'Else ' addKeyVal "Status","injection" ' Rem signal for FMR that injection ' putChopper(1) ' Do While True ' If cancelmacro() = 0 Then Exit Function ' If injection()= 0 Then Exit Do ' Loop ' sleep_f(2) ' keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' Analog1=0.0 ' Analog2=0.0 ' Analog3=0.0 ' Analog4=0.0 ' averKeithley_XFMR=0 ' i=0 ' averKeithley_XFMR=2 ' addKeyVal "Status","measuring" ' Rem signal for FMR that injection done ' putChopper(0) 'End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t averKeithley=1 avrbkenergy=getEnergy End Select End Function Function averKeithley_XFMR(t As Integer,ByRef Keithley1 As Double,ByRef Keithley2 As Double,ByRef Keithleynorm As Double, ByRef Analog1 As Double, ByRef Analog2 As Double, ByRef Analog3 As Double, ByRef Analog4 As Double) As Integer Rem 1: okay Rem 2: injection Dim Keithley(3) As Double Dim Analog(4) As Double 'Dim Injection_test As Single Dim rEnergy As Double 'KeithleyMode = 0 ' use GBIP non test 'KeithleyMode = 1 'use GBIP break while injection 'KeithleyMode = 2 ' use GBIP, without injection test, user energy readback 'KeithleyMode = 3 ' use A/D signal no injection test 'KeithleyMode = 4 ' use A/D signal without injection test, use energy readback 'KeithleyMode = 5 ' use A/D signal with injection test, use energy readback 'KeithleyMode = 6 ' use A/D signal with injection test, no average of energy 'KeithleyMode = 7 ' new hardware trigger 'KeithleyMode = 8 ' new trigger for analog 'KeithleyNo = 0 ' read Keithley1 'KeithleyNo = 1 ' read Keithley2 'KeithleyNo = 2 ' read Keithley1+2+Norm this is the default 'KeithleyNo = 3 ' read Keithley1+2+3 'KeithleyNo = 4 ' read Keithley1+2+Norm + 4 analog only in XFMR Rem one empty read due to keithley bufferproblem 'keithley_read(2,keithley(1),keithley(2),keithley(3)) Select Case KeithleyMode Case 0 Rem one empty read due to keithley bufferproblem keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 addKeyVal "Status","measuring" For i=1 To t keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t averKeithley_XFMR=1 avrbkenergy=getEnergy Case 1 keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) Else addKeyVal "Status","injection" Rem signal for FMR that injection putChopper(1) Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 averKeithley_XFMR=0 i=0 averKeithley_XFMR=2 addKeyVal "Status","measuring" Rem signal for FMR that injection stopped putChopper(1) End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t averKeithley_XFMR=1 avrbkenergy=getEnergy Case 2 keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 rEnergy=0 addKeyVal "Status","measuring" For i=1 To t keithley_read_XFMR(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) rEnergy=rEnergy+getEnergy Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t avrbkenergy=rEnergy/t averKeithley_XFMR=1 Case 3 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 addKeyVal "Status","measuring" For i=1 To t keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) sleep_f(1) Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t averKeithley_XFMR=1 avrbkenergy=getEnergy Case 4 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 rEnergy=0 addKeyVal "Status","measuring" For i=1 To t keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) rEnergy=rEnergy+getEnergy sleep_f(1) Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t avrbkenergy=rEnergy/t averKeithley_XFMR=1 Case 5 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 rEnergy=0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) rEnergy=rEnergy+getEnergy sleep_f(1) Else addKeyVal "Status","injection" Rem signal for FMR that injection putChopper(1) Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 rEnergy=0 averKeithley_XFMR=0 i=0 averKeithley_XFMR=2 addKeyVal "Status","measuring" Rem signal for FMR that injection done putChopper(0) End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t avrbkenergy=rEnergy/t averKeithley_XFMR=1 Case 6 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) sleep_f(1) Else addKeyVal "Status","injection" Rem signal for FMR that injection putChopper(1) Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 averKeithley_XFMR=0 i=0 averKeithley_XFMR=2 addKeyVal "Status","measuring" Rem signal for FMR that injection done putChopper(0) End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t averKeithley_XFMR=1 avrbkenergy=getEnergy Case 7 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 addKeyVal "Status","measuring" For i=1 To t If injection() = 0 Then Rem start trigger keithley1_trigger_doinit keithley2_trigger_doinit sleep_f(1) keithley1_new_trigger keithley2_new_trigger sleep_f(1) Rem wait for result Do While True If cancelmacro() = 0 Then Exit Function 'If injection()= 0 Then Exit Do If keithley1_new_done = 0 And keithley2_new_done = 0 Then Exit Do Loop Rem read keithley keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Rem calculate Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Else addKeyVal "Status","injection" Do While True If cancelmacro() = 0 Then Exit Function If injection()= 0 Then Exit Do Loop sleep_f(2) keithley_new_read(KeithleyNo,keithley(1),keithley(2),keithley(3)) Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 i=0 averKeithley_XFMR=2 addKeyVal "Status","measuring" End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t averKeithley_XFMR=1 avrbkenergy=getEnergy Case 8 Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 averKeithley_XFMR=0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 addKeyVal "Status","measuring" For i=1 To t 'If injection() = 0 Then Rem start trigger Do addKeyVal "Status","measuring" averKeithley_XFMR=0 keithley_analog_trigger sleep_f(1) Rem wait for result Do While True If cancelmacro() = 0 Then Exit Function If injection()= 1 Then averKeithley_XFMR=2 addKeyVal "Status","injection" Keithley1=0.0 Keithley2=0.0 Keithleynorm=0.0 Analog1=0.0 Analog2=0.0 Analog3=0.0 Analog4=0.0 'i=0 sleep_f(5) End If If keithley_analog_done = 0 Then Exit Do Loop Loop While averKeithley_XFMR=2 Rem read ADC signals keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) Keithley1=Keithley1+keithley(1) Keithley2=Keithley2+keithley(2) Keithleynorm=Keithleynorm+keithley(3) Analog1=Analog1+Analog(1) Analog2=Analog2+Analog(2) Analog3=Analog3+Analog(3) Analog4=Analog4+Analog(4) 'sleep_f(1) 'Else ' addKeyVal "Status","injection" ' Rem signal for FMR that injection ' putChopper(1) ' Do While True ' If cancelmacro() = 0 Then Exit Function ' If injection()= 0 Then Exit Do ' Loop ' sleep_f(2) ' keithley_analog(KeithleyNo,keithley(1),keithley(2),keithley(3), analog(1), analog(2), analog(3), analog(4)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' Analog1=0.0 ' Analog2=0.0 ' Analog3=0.0 ' Analog4=0.0 ' averKeithley_XFMR=0 ' i=0 ' averKeithley_XFMR=2 ' addKeyVal "Status","measuring" ' Rem signal for FMR that injection done ' putChopper(0) 'End If Next i Keithley1=Keithley1/t Keithley2=Keithley2/t Keithleynorm=Keithleynorm/t Analog1=Analog1/t Analog2=Analog2/t Analog3=Analog3/t Analog4=Analog4/t averKeithley_XFMR=1 avrbkenergy=getEnergy End Select End Function 'Function averKeithley3(t As Integer,ByRef Keithley1 As Double,ByRef Keithley2 As Double,ByRef Keithleynorm As Double) As Integer Rem 1: okay Rem 2: injection Rem read 3 Keithleys 'Dim Keithley(3) As Double 'Dim Injection_test As Single 'Dim rEnergy As Double 'KeithleyMode = 0 ' use GBIP non test 'KeithleyMode = 1 'use GBIP break while injection 'KeithleyMode = 2 ' use GBIP, without injection test, user energy readback 'KeithleyMode = 3 ' use A/D signal no injection test 'KeithleyMode = 4 ' use A/D signal without injection test, use energy readback 'KeithleyMode = 5 ' use A/D signal with injection test, use energy readback 'KeithleyMode = 6 ' use A/D signal with injection test, no average of energy 'KeithleyMode = 7 ' new hardware trigger Rem one empty read due to keithley bufferproblem 'keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Select Case KeithleyMode ' Case 0 ' Rem one empty read due to keithley bufferproblem ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' addKeyVal "Status","measuring" ' For i=1 To t ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=Keithley1+keithley(1) ' Keithley2=Keithley2+keithley(2) ' Keithleynorm=Keithleynorm+keithley(3) ' Next i ' Keithley1=Keithley1/t ' Keithley2=Keithley2/t ' Keithleynorm=Keithleynorm/t ' averKeithley3=1 ' avrbkenergy=getEnergy ' ' Case 1 ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' addKeyVal "Status","measuring" ' For i=1 To t ' If injection() = 0 Then ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=Keithley1+keithley(1) ' Keithley2=Keithley2+keithley(2) ' Keithleynorm=Keithleynorm+keithley(3) ' Else ' addKeyVal "Status","injection" ' Do While True ' If cancelmacro() = 0 Then Exit Function ' If injection()= 0 Then Exit Do ' Loop ' sleep_f(2) ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' i=0 ' averKeithley3=2 ' addKeyVal "Status","measuring" ' End If ' Next i ' Keithley1=Keithley1/t ' Keithley2=Keithley2/t ' Keithleynorm=Keithleynorm/t ' averKeithley3=1 ' avrbkenergy=getEnergy ' Case 2 ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' rEnergy=0 ' addKeyVal "Status","measuring" ' For i=1 To t ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=Keithley1+keithley(1) ' Keithley2=Keithley2+keithley(2) ' Keithleynorm=Keithleynorm+keithley(3) ' rEnergy=rEnergy+getEnergy ' Next i ' Keithley1=Keithley1/t ' Keithley2=Keithley2/t ' Keithleynorm=Keithleynorm/t ' avrbkenergy=rEnergy/t ' averKeithley3=1 ' Case 3 ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' addKeyVal "Status","measuring" ' For i=1 To t ' keithley_analog(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=Keithley1+keithley(1) ' Keithley2=Keithley2+keithley(2) ' Keithleynorm=Keithleynorm+keithley(3) ' sleep_f(1) ' Next i ' Keithley1=Keithley1/t ' Keithley2=Keithley2/t ' Keithleynorm=Keithleynorm/t ' averKeithley3=1 ' avrbkenergy=getEnergy ' Case 4 ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' rEnergy=0 ' addKeyVal "Status","measuring" ' For i=1 To t ' keithley_analog(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=Keithley1+keithley(1) ' Keithley2=Keithley2+keithley(2) ' Keithleynorm=Keithleynorm+keithley(3) ' rEnergy=rEnergy+getEnergy ' sleep_f(1) ' Next i ' Keithley1=Keithley1/t ' Keithley2=Keithley2/t ' Keithleynorm=Keithleynorm/t ' avrbkenergy=rEnergy/t ' averKeithley3=1 ' ' Case 5 ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' rEnergy=0 ' addKeyVal "Status","measuring" ' For i=1 To t ' If injection() = 0 Then ' keithley_analog(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=Keithley1+keithley(1) ' Keithley2=Keithley2+keithley(2) ' Keithleynorm=Keithleynorm+keithley(3) ' rEnergy=rEnergy+getEnergy ' sleep_f(1) ' Else ' addKeyVal "Status","injection" ' Do While True ' If cancelmacro() = 0 Then Exit Function ' If injection()= 0 Then Exit Do ' Loop ' sleep_f(2) ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' rEnergy=0 ' averKeithley3=0 ' i=0 ' averKeithley3=2 ' addKeyVal "Status","measuring" ' End If ' Next i ' Keithley1=Keithley1/t ' Keithley2=Keithley2/t ' Keithleynorm=Keithleynorm/t ' avrbkenergy=rEnergy/t ' averKeithley3=1 ' ' Case 6 ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' addKeyVal "Status","measuring" ' For i=1 To t ' If injection() = 0 Then ' keithley_analog(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=Keithley1+keithley(1) ' Keithley2=Keithley2+keithley(2) ' Keithleynorm=Keithleynorm+keithley(3) ' sleep_f(1) ' Else ' addKeyVal "Status","injection" ' Do While True ' If cancelmacro() = 0 Then Exit Function ' If injection()= 0 Then Exit Do ' Loop ' sleep_f(2) ' keithley_read(3,keithley(1),keithley(2),keithley(3)) ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' i=0 ' averKeithley3=2 ' addKeyVal "Status","measuring" ' End If ' Next i ' Keithley1=Keithley1/t ' Keithley2=Keithley2/t ' Keithleynorm=Keithleynorm/t ' averKeithley3=1 ' avrbkenergy=getEnergy ' ' Case 7 ' Keithley1=0.0 ' Keithley2=0.0 ' Keithleynorm=0.0 ' averKeithley3=0 ' addKeyVal "Status","measuring" ' ' Rem start trigger ' put_keithley1_new_busy ' put_keithley2_new_busy ' keithley_new_trigger ' ' Rem wait for result ' Do While True ' If cancelmacro() = 0 Then Exit Function ' 'If injection()= 0 Then Exit Do ' If keithley1_new_done = 1 And keithley2_new_done Then Exit Do ' Loop ' ' Rem read keithley ' keithley_new_read(3,keithley(1),keithley(2),keithley(3)) ' ' Keithley1=keithley(1) ' Keithley2=keithley(2) ' Keithleynorm=Keithley1/Keithley2 ' averKeithley3=1 ' avrbkenergy=getEnergy ' ' End Select 'End Function Sub AverageSeq() Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ... Dim images As Integer Dim anz As Integer 'startMacro("average Sequenz") 'LoadConfig ret = SelectImage_X11MA ("Select Sequence", images) ret = IpSeqGet(SEQ_NUMFRAMES,anz) ret = IPSeqAverage(0,anz) 'stopMacro End Sub Function AddSeq() As Integer Rem adds the images of a sequence into on image Dim tmp As Integer Dim Image1 As Integer Dim Image2 As Integer Dim images As Integer Dim anz As Integer Seq1 = SelectImage_X11MA ("Select Sequence", images) ret = IpSeqGet(SEQ_NUMFRAMES,anz) Image1 = IpSeqExtractFrames (0,1) ret = IpAppSelectDoc(Image1) For n = 0 To anz ret = IpAppSelectDoc(Seq1) Image2 = IpSeqExtractFrames (n,1) ret = IpAppSelectDoc(Image1) Image3 = IpOpImageArithmetics(Image2, 0, OPA_ADD, 1) IpDocCloseEx(Image1) IpDocCloseEx(Image2) Image1=Image3 Next n End Function Function AddSeq_smart() As Integer Rem adds the images of a sequence into one image until the max intensity is 2500, then into a next image etc Dim tmp As Integer Dim Image1 As Integer Dim Image2 As Integer Dim Image3 As Integer Dim Image_result(100) As Integer Dim images As Integer Dim Seq1 As Integer Dim anz As Integer Dim max(10) As Single Dim result As Integer result = 0 Seq1 = SelectImage_X11MA ("Select Sequence", images) ret = IpSeqGet(SEQ_NUMFRAMES,anz) Image1 = IpSeqExtractFrames (0,1) ret = IpAppSelectDoc(Image1) For n = 0 To anz ret = IpAppSelectDoc(Seq1) Image2 = IpSeqExtractFrames (n,1) ret = IpAppSelectDoc(Image1) Image3 = IpOpImageArithmetics(Image2, 0, OPA_ADD, 1) IpDocCloseEx(Image1) IpDocCloseEx(Image2) ret = IpAppSelectDoc(Image3) IpHstCreate() ret = IpHstGet(GETSTATS, 0, max(0)) IpHstDestroy() Image1=Image3 If max(4) > 2500 Then Image_Result(result)=Image1 result=result + 1 ret = IpAppSelectDoc(Seq1) Image1 = IpSeqExtractFrames (n,1) ret = IpAppSelectDoc(Image1) n=n+1 End If Next n Image_Result(result)=Image1 For n = 0 To result-2 ret = IpAppSelectDoc(Image_Result(n+1)) ret = IpWsCopyFrames(0,1) ret = IpDocCloseEx(Image_Result(n+1)) ret = IpAppSelectDoc(Image_Result(0)) ret = IpWsPasteFrames(-1) Next n ret = IpAppSelectDoc(Image_Result(0)) ret = IpSeqGet(SEQ_NUMFRAMES,anz) ret = IPSeqAverage(0,anz) End Function Sub CalcMultShiftsSeq() Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ... Dim n As Integer Dim tmp As Integer Dim refimage As Integer Dim i As Integer Dim ab As Integer Dim Iname As String * 255 Dim s As String Dim t As String *255 Dim ext As String Dim r As RECT Dim deltax As Integer Dim deltay As Integer Dim resultt As String Dim anz As Integer Dim Image As Integer startMacro("CalcMultShifts") message ="Select Sequence uses active AOI" Image = selectImage(message) If Image <0 Then Exit Sub End If ret = IpAoiManager(AOIADD,"RAOI") IpSeqGet (SEQ_NUMFRAMES, anz) IpSeqSet (SEQ_ACTIVEFRAME, 0) IpAoiShow(FRAME_NONE) IpSeqSet (SEQ_APPLY, 0) ' current frame refimage = IpWsDuplicate() If refimage < 0 Then Exit Sub End If ret = IpStGetName("Save As",Path,"*.DAT", Iname) If ret = 0 Then Exit Sub End If t = Iname i = InStr(1,t,".DAT") If i = 0 Then t = t + ".DAT" Open t For Output As #1 resultt = "0" + Chr(9) + "0" + Chr(9) + "0" Print #1, resultt For i = 1 To (anz-1) IpAppSelectDoc(Image) 'ret = IpAoiManager(AOISET,"AOI") IpSeqSet (SEQ_ACTIVEFRAME, i) IpAoiShow(FRAME_NONE) IpSeqSet (SEQ_APPLY, 0) ' current frame tmp = IpWsDuplicate() ret = FastAutoAlign(refimage, tmp, deltax, deltay, 1) 'ret = FastAutoAlign(refimage, tmp, deltax, deltay, 0) ret = IpDocClose() resultt = Str(i) + Chr(9) + Str(deltax) + Chr(9) + Str (deltay) Print #1, resultt Next i Close #1 IpAppSelectDoc(Image) ret = IpSeqSet(SEQ_APPLY, 1) ' set back to apply for all stopMacro End Sub Sub CalcMultShiftsSeqRef() Rem Calculates multiple images from image stack in selected areas AOI1, AOI2, ... Dim n As Integer Dim tmp As Integer Dim refimage As Integer Dim i As Integer Dim ab As Integer Dim Iname As String * 255 Dim s As String Dim t As String *255 Dim ext As String Dim r As RECT Dim deltax As Integer Dim deltay As Integer Dim resultt As String Dim anz As Integer Dim Image As Integer startMacro("CalcMultShifts") message ="Select Sequence uses active AOI" Image = selectImage(message) If Image <0 Then Exit Sub End If ret = IpAoiManager(AOIADD,"RAOI") IpSeqGet (SEQ_NUMFRAMES, anz) IpSeqSet (SEQ_ACTIVEFRAME, 0) 'IpAoiShow(FRAME_NONE) 'IpSeqSet (SEQ_APPLY, 0) ' current frame 'refimage = IpWsDuplicate() message ="Select Reference image" refimage = selectImage(message) If refimage <0 Then Exit Sub End If If refimage < 0 Then Exit Sub End If ret = IpStGetName("Save As",Path,"*.DAT", Iname) If ret = 0 Then Exit Sub End If t = Iname i = InStr(1,t,".DAT") If i = 0 Then t = t + ".DAT" Open t For Output As #1 'resultt = "0" + Chr(9) + "0" + Chr(9) + "0" 'Print #1, resultt For i = 0 To (anz-1) IpAppSelectDoc(Image) 'ret = IpAoiManager(AOISET,"AOI") IpSeqSet (SEQ_ACTIVEFRAME, i) IpAoiShow(FRAME_NONE) IpSeqSet (SEQ_APPLY, 0) ' current frame tmp = IpWsDuplicate() ret = FastAutoAlign(refimage, tmp, deltax, deltay, 1) 'ret = FastAutoAlign(refimage, tmp, deltax, deltay, 0) ret = IpDocClose() resultt = Str(i) + Chr(9) + Str(deltax) + Chr(9) + Str (deltay) Print #1, resultt Next i Close #1 IpAppSelectDoc(Image) ret = IpSeqSet(SEQ_APPLY, 1) ' set back to apply for all stopMacro End Sub Sub setIDalpha(ByVal v As Double) Select Case opID Case 1 putID1alpha(v) sleep_f(1) putID1offset(ID1_linrot_offset(v)) Case 2 putID2alpha(v) sleep_f(1) putID2offset(ID2_linrot_offset(v)) Case 3 putID1alpha(v) sleep_f(1) putID1offset(ID1_linrot_offset(v)) putID2alpha(v) sleep_f(1) putID2offset(ID2_linrot_offset(v)) End Select End Sub Function checkVG10() As Integer Rem check whether VG10 is open, open it when closed Rem returns 1 when it is closed Dim statusVG10 As Single checkVG10=0 statusVG10 = getVG10() If statusVG10 = 0 Then checkVG10=1 putVG10(0) sleep(1) putVG10(1) write_logfile(1,"VG10 was closed") sleep(1) End If End Function Function focus_algo(ByVal startOb As Double, ByVal startSV As Double, ByVal SV As Double) As Double Rem function for focus change with changing startvoltage Rem fit from Eletra Rem focus = startfocus + A * startvoltage^pow Const y0 As Double = 1650 Const A As Double = 5.9924 Const pow As Double = 0.34653 'focus_algo = startOb + A * SV ^ pow focus_algo = startOb + A * (SV ^ pow - startSV ^ pow) End Function