日々の記録

ほどよく書いてきます。

広告

※このエリアは、60日間投稿が無い場合に表示されます。記事を投稿すると、表示されなくなります。

Rigaku XRDのrasファイル処理

2018年01月28日 22時41分26秒 | プログラム

RigakuのXRDを使っているが、出力されるrasファイルの中身が実際にはただのテキストファイルなので、それを読み込んでまとめてしまうマクロを作ろうと思っている。
解析は専用の解析ソフトがあるのだが、なんとなく画面キャプチャではなく、グラフはエクセルで書いて出そうなんて思っている。

rasファイルのフォーマットは

*RAS_DATA_START
*RAS_HEADER_START
*DISP_FMT_X "%.2f"
*DISP_FMT_Y "%.0f"

~中略~

*MEAS_SCAN_UNIT_X "deg"
*MEAS_SCAN_UNIT_Y "counts"
*RAS_HEADER_END
*RAS_INT_START
30.0000 877.0000 1.0000
30.0100 911.0000 1.0000

~測定データが続く~

79.9900 189.0000 1.0000
80.0000 189.0000 1.0000
*RAS_INT_END
*RAS_DATA_END

 

というようなファイル形式となっている。

測定データ以外の行は*で始まるので、これ以外の行の数字を処理していく。

データの並びは、

2θ 検出X線強度 アッテネータ減衰率

の並びであるので、出力としては

2θ, 検出X線強度×アッテネータ減衰率を出力すればよい。

 

 作ったコードはこんな感じ。5000点あるデータを12個処理するのに5秒くらいかかる鈍足だが、手でやるよりは早い。

Private Sub CommandButton1_Click()
Dim TwoTheta() As Double
Dim XrayIntensity() As Double
Dim FileName
Dim FileNames
Dim i As Long
Dim j As Long
Dim T1 As Double
Dim T2 As Double

ChDrive ThisWorkbook.Path


'複数のファイルを開く
FileNames = Application.GetOpenFilename("RAS File,*.ras", , , , True)
'キャンセルのとき、Booleanが帰ってくるので、Variant()のときだけ処理実行
If TypeName(FileNames) <> "Variant()" Then
    Exit Sub
End If

Application.ScreenUpdating = False

T1 = Timer()

'マクロに値を出力したくないので新しいワークブックを作る
Workbooks.Add
With ActiveWorkbook.Sheets(1)

j = 2

For Each FileName In FileNames  'ファイル名ごとに中身を調べていく
    
    Call LoadRasFile(FileName, TwoTheta(), XrayIntensity)
        .Cells(2, j + 1) = GetFileNameOnly(FileName)    'ファイル名を出力しておく
        For i = 1 To UBound(TwoTheta())                 '値の出力
            .Cells(i + 2, j) = TwoTheta(i)
            .Cells(i + 2, j + 1) = XrayIntensity(i)
        Next i
    j = j + 2
Next FileName
End With

T2 = Timer()
Application.ScreenUpdating = True
Application.StatusBar = "処理時間=" & Format(T2 - T1, "0.00") & "[s]"
  
End Sub
Function GetFileNameOnly(FullPath) As String
'ファイルのフルパスからファイル名のみを取り出す
GetFileNameOnly = Right(FullPath, Len(FullPath) - InStrRev(FullPath, "\"))  '最後の\より右側を取り出す
GetFileNameOnly = Left(GetFileNameOnly, InStrRev(GetFileNameOnly, ".") - 1)    '拡張子のピリオドで切り落とす

End Function

Sub LoadRasFile(FileName, ByRef TwoTheta() As Double, ByRef XrayIntensity() As Double)
'rasファイルの中身を読み込んでくる。TwoThetaに2θを、XrayIntensityにX線強度を格納する。
Dim TempString As String
Dim SplitedTempString() As String
Dim Fn As Integer
Dim i As Long
i = 1

Fn = FreeFile
Open FileName For Input As #Fn
    
    '■ヘッダ読み飛ばし
    Do
        Line Input #Fn, TempString
    Loop While Left(TempString, 1) = "*"
    
    
    '■データ読み込み
    Do
        SplitedTempString = Split(TempString, " ")
           
        ReDim Preserve TwoTheta(i)
        ReDim Preserve XrayIntensity(i)
        
        TwoTheta(i) = Val(SplitedTempString(0))
        XrayIntensity(i) = Val(SplitedTempString(1)) * Val(SplitedTempString(2))
        
        Line Input #Fn, TempString
        SplitedTempString = Split(TempString, " ")
                
        i = i + 1
        
    Loop Until Left(TempString, 1) = "*"
    
Close Fn
End Sub
コメント

天体改造カメラ(Hα増感)

2018年01月22日 23時27分19秒 | 星空

天体の写真撮影にもう少し精を出してみようと思って、Hα線の感度の高いカメラを買ってみた。
カメラは前から使っているD90の改造品、お値段25,000円なり。

買ってから2周間くらい経ってようやく撮影。街のど真ん中からの撮影なのでロクな絵はないがHαの感度が高いことがわかる。

 

 


これが改造品で撮影したもの


こちらは純正のままの状態。

改造品はオリオン大星雲が赤く浮き上がっている。

コメント (2)

謹賀新年

2018年01月04日 01時31分47秒 | その他雑記

新年あけましておめでとうございます。

年賀状送ってくださった方、今年は諸事情により筆がなおさら遅いです。

去年は何とか生き延びましたが、治療という面倒ごとが残り、実家で寝正月を送っています。

今後「生き延びる」事態にならないように気をつけます。

 

安全第一。

コメント (1)