摘要：

RPC Photonics公司有高品質的的工程漫射體BSDF測試數據，但它對于FRED幫助甚少，下面這個步驟描述了如何利用FRED腳本轉換RPC Photonics提供的TXT文件，并將數據直接應用到FRED的Tabulated scatter 散射模型。

 

背景： 

Thorlabs和RPC Photonics聯手共同推出的新型漫射體及光束整形技術，可以解決其他技術的不足，大大改善了諸如光刻系統、有效固態照明，顯示，背光，顯示亮度增強和投影屏等大多數應用的性能。這項我們稱之為工程漫射體（Engineered DiffusersTM）的新概念，與其他技術有許多不同。與諸如磨砂玻璃、乳色玻璃和全息元件等隨機漫射體截然不同，工程漫射體要求對于每個散射中心，通常為微透鏡單元，都進行控制。例如全息漫射體可以視為一組隨機排列的透鏡，但是通過全息曝光形成的類透鏡效果只能通過靜態方式進行控制：而無法單獨操控每個微透鏡單元，這也幫助解釋了全息漫射體無法控制光的分布和輪廓。另一方面，在工程漫射體中，每個微透鏡單元形成漫射體，由其凹形縱斷面和在陣列中的位置所確定。同時，為了確保漫射體不受輸入光束變化的影響，并且不產生衍射效果，微透鏡單元的分布是隨機的，根據產生相應的光束形狀函數所選取的概率分布函數來確定。因此，工程漫射體同時保留了隨機與確定性漫射體的優點，從而實現高性能的光束整形功能。

FRED是美國Photon Engineering 公司開發的光學工程仿真軟件，其在雜散光分析中獨特的算法、高效的準確性，使其與其它同類產品相比更具優勢。本案例我們重點講述如何由RPC Photonics的BSDF數據轉為FRED可識別的散射數據。

圖1. RPC Photonics工程漫射體結構及光束投射形狀

 

 

 

步驟

 

1、在http://www.rpcphotonics.com/bsdf-data-optical-diffusers/下載并解壓BSDF數據到某一文件夾下，選擇“Raw data”文件。

 

圖2. RPC Photonics工程漫射體不同類型的散射數據

 

2、將  http://fred-kb.photonengr.com/wp-content/uploads/sites/2/2015/06/constructRpcScatterFile.frs腳本文件放在步驟1中的文件下。（腳本代碼放在了本文的最后）

3、打開FRED并運行腳本文件，會輸出如下“<SAMPLE>_FRED.txt”格式，<SAMPLE>即為RPC Photonics散射片數據集

例如下所示：

Sample name: EDF-C1-56

Merging data from file EDF-C1-56 0-0.txt

Finished merging RPC data for sample EDF-C1-56

FRED formatted data file: D:\FRED\散射片數據\EDF-C1-56_FRED.txt

4、生成了FRED可識別的文件后，將散射模型導入到FRED里面

a.創建一個新的散射庫

b.散射模型命名

c.改變散射模型為“Tabulated BSDF”.

d.在File框出右鍵選擇“Replace With Data From a File”, 選擇步驟三生成的數據文件（如EDF-C1-56_FRED.txt ）

e.切換為“Varies w/angle” 選項（假定所有的RPC Photonics datasets 數據有多個測試角度。

f.在底部的對話框中，選擇透射散射、反射停并且你需要終止入射光線，

g.點擊OK

5、數據輸入后，可點擊“Plot”按鈕驗證BSDF模型及總的散射值

 

 

腳本代碼：

 

'#Language "WWB-COM"

 

Option Explicit

 

Sub Main

 

  'Cleanup

  ClearOutputWindow()

 

  Print "Merging RPC Photonics BSDF Data Files"

  SetTextColor(255,0,0)

  Print "Note: Script should be located in the same folder as the BSDF TXT files."

  Print "Note: Do not run this script multiple times without deleting the output file between executions."

  SetTextColor(0,0,0)

 

  'Current directory of this script (should be the same as the text files being merged)

  Dim cDir As String

  cDir = MacroDir$ & "\"

 

  'Array which will be populated with the list of files to be merged

  Dim fList() As String, curFile As String

  GetFileList( cDir, fList )

 

  Print ""

  Print "Files found for merging:"

  For Each curFile In fList

    Print Chr(9) & curFile

  Next

 

  'Split the first text file name found to get the sample name. First file should be 0-0 measurement.

  Dim nameArray() As String, sampName As String

  nameArray = Split(fList(0)," 0-0.txt")

  sampName = nameArray(0)

  Print ""

  Print "Sample name: " & Chr(9) & sampName

 

  'Open an output file and write the FRED header data

  Dim outFile As String

  outFile = cDir & sampName & "_FRED.txt"

  Open outFile For Output As #1

  Print #1, "type bsdf_data"

  Print #1, "format angles=deg bsdf=value scale=1"

 

  'Loop the file list, skip the two header lines and write the remaining data to file

  Dim lineArray() As String, curLine As Long

  For Each curFile In fList

    Print "Merging data from file " & curFile

    ReadFile( cDir & curFile, lineArray )

    For curLine = 2 To UBound(lineArray)

      Print #1, lineArray(curLine)

    Next

  Next

 

  'Close the output file

  Close #1

 

  Print "Finished merging RPC data for sample " & sampName

  Print "FRED formatted data file: " & Chr(9) & outFile

End Sub

 

'Utility function to read the contents of a file into an array of strings.

Function ReadFile(ByVal fileName As String, _

         ByRef lineArray() As String) As Long

 

  ReadFile = -1

  Dim oFSO As Object

  Set oFSO = CreateObject("Scripting.FileSystemObject")

  Erase lineArray

 

  Dim fid As Long

  If oFSO.fileexists( fileName ) Then

    fid = FreeFile()

    Open fileName For Input As fid

    lineArray = Split(Input(LOF(fid), fid), vbCrLf)

    Close fid

  End If

  Set oFSO = Nothing

  Return UBound( lineArray )

 

End Function

 

Sub GetFileList( ByVal in_dir As String, _

         ByRef in_flist() As String )

 

  'Redimension the file list array

  Erase in_flist

 

  'Tracks how many files are found

  Dim fCount As Long

  fCount = 0

 

  'Recurse directory and search for text files

  Dim f As String

  f = Dir$(in_dir & "*.txt")

  While f <> ""

    ReDim Preserve in_flist(fCount)

    in_flist(fCount) = f

    fCount += 1

    f = Dir$()

  Wend

  ReDim Preserve in_flist(fCount-1)

 

End Sub