|
|
Sub OpenFile()
fileToOpen = Application _
.GetOpenFilename("Dat Files (*.dat), *.dat, Text Files (*.txt), *.txt")
If fileToOpen = False Then
GoTo MyEnd
End If
Open fileToOpen For Input As #1
'find first empty line
i = 9
While IsEmpty(Worksheets("Sheet1").Cells(i, 2)) = False Or IsEmpty(Worksheets("Sheet1").Cells(i + 1, 2)) = False Or IsEmpty(Worksheets("Sheet1").Cells(i + 2, 2)) = False
i = i + 1
Wend
If i <> 2 Then
i = i + 2
End If
Worksheets("Sheet1").Cells(i, 2) = "Operator:"
Worksheets("Sheet1").Cells(i, 5) = "Batch:"
Worksheets("Sheet1").Cells(i, 8) = "Lot:"
'Filename = Worksheets("Sheet1").Cells(1, 3) = Value
Line Input #1, Data 'Read one line and puts it into the varible Data.
While Left(Data, 8) <> "Operator"
Line Input #1, Data
Wend
Worksheets("Sheet1").Cells(i, 3) = Right(Data, Len(Data) - 15)
Line Input #1, Data
Line Input #1, Data
Line Input #1, Data
Worksheets("Sheet1").Cells(i, 6) = Right(Data, Len(Data) - 15)
Line Input #1, Data
Worksheets("Sheet1").Cells(i, 9) = Right(Data, Len(Data) - 16)
Line Input #1, Data
If Left(Data, 5) = "Name1" Then
Worksheets("Sheet1").Cells(i, 2) = Right(Data, Len(Data) - 7) + ":"
Line Input #1, Data
Worksheets("Sheet1").Cells(i, 5) = Right(Data, Len(Data) - 7) + ":"
Line Input #1, Data
Worksheets("Sheet1").Cells(i, 8) = Right(Data, Len(Data) - 7) + ":"
End If
containsT1 = False
' search for the first [Measurement 1]
Line Input #1, Data
While Left(Data, 1) <> "["
Line Input #1, Data
If EOF(1) Then
Close #1
GoTo MyEnd
End If
pos = InStr(1, Data, "Center Cross")
If pos <> 0 Then
containsT1 = True
End If
Wend
i = i + 2
Worksheets("Sheet1").Cells(i, 2) = "#"
Worksheets("Sheet1").Cells(i, 3) = "EFL"
Worksheets("Sheet1").Cells(i, 4) = "FFL"
Worksheets("Sheet1").Cells(i, 5) = "S1"
j = 5
For k = 1 To 13
Worksheets("Sheet1").Cells(i, j) = "S" & Str(k)
j = j + 1
If k <> 1 Or containsT1 Then
Worksheets("Sheet1").Cells(i, j) = "T" & Str(k)
j = j + 1
End If
Next
colTrayFile = j
Worksheets("Sheet1").Cells(i, colTrayFile) = "Tray File"
colLensNumber = j + 1
Worksheets("Sheet1").Cells(i, colLensNumber) = "Lens Number"
colLensPosition = j + 2
Worksheets("Sheet1").Cells(i, colLensPosition) = "Lens Position"
colDefocus = j + 3
Worksheets("Sheet1").Cells(i, colDefocus) = "Defocus"
colAzimuth = j + 4
Worksheets("Sheet1").Cells(i, colAzimuth) = "Azimuth"
colAngle = j + 5
Worksheets("Sheet1").Cells(i, colAngle) = "Angle"
colAngleType = j + 6
Worksheets("Sheet1").Cells(i, colAngleType) = "Angle Type"
colCurvatureHeightNegative = j + 7
Worksheets("Sheet1").Cells(i, colCurvatureHeightNegative) = "Curvature Height Negative"
colCurvatureHeightPositive = j + 8
Worksheets("Sheet1").Cells(i, colCurvatureHeightPositive) = "Curvature Height Positive"
colDepthOfFocus = j + 9
Worksheets("Sheet1").Cells(i, colDepthOfFocus) = "Depth of Focus"
undefValue = "UNDEF"
nr = 1
NrOfCameras = 0
NewFileType = True
ffl = 0
defocus = 0
While Not EOF(1)
Status = "" 'represents the status of the lens
Line Input #1, Data
While Left(Data, 3) <> "EFL"
If Left(Data, 9) = "Tray Name" Then
Worksheets("Sheet1").Cells(i + nr, colTrayFile) = Right(Data, Len(Data) - 10)
Line Input #1, Data
Worksheets("Sheet1").Cells(i + nr, colLensNumber) = Right(Data, Len(Data) - 7)
Line Input #1, Data
Worksheets("Sheet1").Cells(i + nr, colLensPosition) = Right(Data, Len(Data) - 9)
End If
If Left(Data, 6) = "Result" Then
Status = Right(Data, Len(Data) - 7)
End If
If Left(Data, 3) = "FFL" Then
ffl = Right(Data, Len(Data) - 4)
End If
If Left(Data, 7) = "Defocus" Then
defocus = Right(Data, Len(Data) - 8)
Worksheets("Sheet1").Cells(i + nr, colDefocus) = defocus
End If
If Left(Data, 7) = "Azimuth" Then
azimuth = Right(Data, Len(Data) - 8)
Worksheets("Sheet1").Cells(i + nr, colAzimuth) = azimuth
Line Input #1, Data
Angle = Right(Data, Len(Data) - 6)
Worksheets("Sheet1").Cells(i + nr, colAngle) = Angle
End If
If Left(Data, 10) = "Angle Type" Then
Angle = Right(Data, 1)
Worksheets("Sheet1").Cells(i + nr, colAngleType) = Angle
End If
sText = "Curvature Height Negative "
If Left(Data, Len(sText)) = sText Then
curvature = Right(Data, Len(Data) - Len(sText))
Worksheets("Sheet1").Cells(i + nr, colCurvatureHeightNegative) = curvature
Line Input #1, Data
sText = "Curvature Height Positive "
curvature = Right(Data, Len(Data) - Len(sText))
Worksheets("Sheet1").Cells(i + nr, colCurvatureHeightPositive) = curvature
Line Input #1, Data
sText = "Depth of Focus "
dof = Right(Data, Len(Data) - Len(sText))
Worksheets("Sheet1").Cells(i + nr, colDepthOfFocus) = dof
End If
Line Input #1, Data
Wend
' write the number and the status
Worksheets("Sheet1").Cells(i + nr, 2) = Str(nr) & " " & Status
' color the field depending on status
Worksheets("Sheet1").Cells(i + nr, 2).Font.Bold = True
If Status = "FAIL" Then
Worksheets("Sheet1").Cells(i + nr, 2).Font.Color = RGB(255, 0, 0)
Else
If Status = "PASS" Then
Worksheets("Sheet1").Cells(i + nr, 2).Font.Color = RGB(0, 255, 0)
Else
If Status = "THRESHOLD" Then
Worksheets("Sheet1").Cells(i + nr, 2).Font.Color = RGB(255, 255, 128)
Else
If Status = "MISS" Then
Worksheets("Sheet1").Cells(i + nr, 2).Font.Color = RGB(0, 0, 255)
End If
End If
End If
End If
'write efl value
Worksheets("Sheet1").Cells(i + nr, 3) = Right(Data, Len(Data) - 4)
Worksheets("Sheet1").Cells(i + nr, 4) = ffl
'write mtf values
Line Input #1, Data
col = 5
While Len(Data) > 1
st1 = 1
While Mid(Data, st1, 1) <> " "
st1 = st1 + 1
Wend
st1 = st1 + 1
st = st1
While Mid(Data, st, 1) <> " "
st = st + 1
Wend
If col = 5 And Mid(Data, 1, 2) = "T2" Then
NewFileType = False
End If
If NewFileType = False And col > 4 Then
If Mid(Data, 1, 1) = "T" Then
Worksheets("Sheet1").Cells(i + nr, col + 1) = Mid(Data, st1, st - st1)
Else
Worksheets("Sheet1").Cells(i + nr, col - 1) = Mid(Data, st1, st - st1)
End If
Else
Worksheets("Sheet1").Cells(i + nr, col) = Mid(Data, st1, st - st1)
End If
If nr = 1 Then
NrOfCameras = NrOfCameras + 1
End If
col = col + 1
Line Input #1, Data
Wend
If Status = "MISS" Then
For j = 3 To colDepthOfFocus
Worksheets("Sheet1").Cells(i + nr, j) = undefValue
Next
End If
While Not EOF(1) And Len(Data) < 2
Line Input #1, Data
Wend
nr = nr + 1
Wend
'NrOfCameras = (NrOfCameras + 1) / 2
Close #1
'------------------------------------------------------------------'
' end reading from file
'------------------------------------------------------------------'
Worksheets("Sheet1").Cells(i + nr, 2) = "Avg"
Worksheets("Sheet1").Cells(i + nr + 1, 2) = "Std. Deviation"
Worksheets("Sheet1").Cells(i + nr + 2, 2) = "3 x Std. Deviation"
Dim Avg As Double
Dim Sum2 As Double
For j = 3 To NrOfCameras + 4 Step 1
'calculate average
total = 0
Sum = 0
For k = 1 To nr - 1 Step 1
Vall = Worksheets("Sheet1").Cells(i + k, j).Value
If Vall <> undefValue Then
total = total + 1
Sum = Sum + Vall
End If
Next
Avg = Sum / total
Worksheets("Sheet1").Cells(i + nr, j) = Format(Avg, "0.00")
'calculate standard deviation
Dim tt As String
Sum2 = 0
total = 0
For k = 1 To nr - 1 Step 1
m = Worksheets("Sheet1").Cells(i + k, j).Value
If m <> undefValue Then
Sum2 = Sum2 + (m - Avg) * (m - Avg)
tt = Format(Sum2, "0.000000000")
total = total + 1
End If
Next
If nr - 2 > 0 Then
Sum2 = Sum2 / total
Else
Sum2 = 0
End If
'calculate difference
Worksheets("Sheet1").Cells(i + nr + 1, j) = Format(Sqr(Sum2), "0.0000")
Worksheets("Sheet1").Cells(i + nr + 2, j) = Format(3 * Sqr(Sum2), "0.0000")
Next
MyEnd:
End Sub
Sub CalculateLinesCount()
NLines = 20000
For j = 9 To NLines Step 1
c = Worksheets("Sheet1").Cells(j, 2).Value
If c = "" Then
c1 = Worksheets("Sheet1").Cells(j + 1, 2).Value
c2 = Worksheets("Sheet1").Cells(j + 2, 2).Value
c3 = Worksheets("Sheet1").Cells(j + 3, 2).Value
If c1 = "" And c2 = "" And c3 = "" Then
NLines = j
GoTo MyEnd
End If
End If
Next
MyEnd:
End Sub
Sub DeleteAll()
CalculateLinesCount
With Worksheets("Sheet1")
.Range(.Cells(1, 2), Cells(NLines + 30, 50)).ClearContents
.Range(.Cells(1, 2), Cells(NLines + 30, 50)).Font.Bold = False
.Range(.Cells(1, 2), Cells(NLines + 30, 50)).Font.Color = RGB(0, 0, 0)
End With
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2014-12-19 22:33