'bil2grd.bas converts a BIL file with HDR, STX, and BLW files from ' the USGS NED Seamless Data web page to a Surfer GRD file. ' 17 Apr 03 - MB. ' 'Added ability to read 8 bit data. ' 15 Aug 03 - TB. ' 'Changed final GRD file name to prevent conflict with HDR file. ' 22 Sep 03 - TB. ' 'The HDR and BLW files downloaded from the USGS Seamless site use just a LF as a 'line separator and this script was originally written to expect that format. It was 'found that a CD ordered from the USGS could have CR/LF separators, so the script 'was modified to handle that format, as well. ' 10-Nov-2006 - MB 'Option Explicit Private bilFile,zLo,zHi As String Private swapBytes As Boolean Private iRows,iCols As Integer Private xLo,xHi,yLo,yHi As Double Private ibits As Integer Sub GetHdr Dim hdrFile,s,t,byteorder,layout As String 'Dim iBands,ibits As Integer Dim iBands As Integer Dim i,j As Integer hdrFile = Mid(bilFile, 1, Len(bilFile)-3) + "hdr" Debug.Print FileLen(hdrFile) Open hdrFile For Input As #2 t = Input(FileLen(hdrFile),2) s = Replace(t,vbCr,"") Debug.Print Len(t); " "; Len(s) 'BYTEORDER i = InStr(s,"BYTEORDER") j = InStr(i,s,vbLf) i = InStrRev(s," ",j) + 1 byteorder = Mid(s,i,j-i) swapBytes = False If byteorder = "M" Then swapBytes = True MsgBox("This script does not support byte swapping yet") ElseIf Not byteorder = "I" Then MsgBox("Unrecognized BYTEORDER") End If 'LAYOUT i = InStr(s,"LAYOUT") j = InStr(i,s,vbLf) i = InStrRev(s," ",j) + 1 layout = Mid(s,i,j-i) If Not layout = "BIL" Then MsgBox("Unrecognized LAYOUT") End If 'NROWS i = InStr(s,"NROWS") j = InStr(i,s,vbLf) i = InStrRev(s," ",j) + 1 iRows = Mid(s,i,j-i) Debug.Print iRows;" rows" 'NCOLS i = InStr(s,"NCOLS") j = InStr(i,s,vbLf) i = InStrRev(s," ",j) + 1 iCols = Mid(s,i,j-i) Debug.Print iCols;" columns" 'NBANDS i = InStr(s,"NBANDS") j = InStr(i,s,vbLf) i = InStrRev(s," ",j) + 1 iBands = Mid(s,i,j-i) Debug.Print iBands;" bands" If Not iBands = 1 Then MsgBox("Unrecognized NBANDS") End End If 'NBITS i = InStr(s,"NBITS") j = InStr(i,s,vbLf) i = InStrRev(s," ",j) + 1 ibits = Mid(s,i,j-i) Debug.Print ibits;" bits" If Not ibits = 16 And Not ibits = 8 Then Debug.Print " NBITS not 16." MsgBox("Unrecognized NBITS" & CStr(ibits) & vbCrLf & _ " Must be 8 or 16.") End End If Close #2 End Sub Sub GetBlw Dim blwFile,s,t As String Dim xScl,yScl,x,y As String blwFile = Mid(bilFile, 1, Len(bilFile)-3) + "blw" Open blwFile For Input As #2 t = Input(FileLen(blwFile),2) s = Replace(t,vbCr,"") xScl = Split(s,vbLf)(0) yScl = Split(s,vbLf)(3) x = Split(s,vbLf)(4) y = Split(s,vbLf)(5) xLo = CDbl(x) xHi = xLo + CDbl(xScl)*(iCols-1) yHi = CDbl(y) yLo = yHi + CDbl(yScl)*(iRows-1) Debug.Print xLo;" ";xHi;" ";yLo;" ";yHi;" XY min max" Close #2 End Sub Sub GetStx Dim stxFile,s As String stxFile = Mid(bilFile, 1, Len(bilFile)-3) + "stx" Open stxFile For Input As #2 Line Input #2,s zLo = Split(s)(1) zHi = Split(s)(2) Debug.Print zLo;" ";zHi;" Z min max" Close #2 End Sub Sub Main Debug.Print "----- ";Time;" -----" Set surf = CreateObject("surfer.application") surf.Documents.Add Dim grdFile,s As String Dim i,j,z As Integer Dim z8 As Byte '8 bit unsigned integer. bilFile = GetFilePath("","bil","","Open BIL File") If bilFile = "" Then End grdtmp = Left(bilFile,Len(bilFile)-4) + "Tmp.grd" grdFile = Mid(bilFile, 1, Len(bilFile)-4) + "Final.grd" Open bilFile For Binary Access Read As #1 Open grdtmp For Output As #4 Print #4,"DSAA" Call GetHdr Print #4,iCols;" ";iRows Call GetBlw Print #4,xLo;" ";xHi Print #4,yLo;" ";yHi Call GetStx Print #4,zLo;" ";zHi If ibits = 16 Then For i = 1 To FileLen(bilFile)/2 j = j + 1 Get #1,,z If j < 10 Then Print #4,z; Else Print #4,z j = 0 End If Next i ElseIf ibits = 8 Then For i = 1 To FileLen(bilFile) j = j + 1 Get #1,,z8 If j < 10 Then Print #4,z8; Else Print #4,z8 j = 0 End If Next i End If Close #1,#4 surf.GridTransform(ingrid:=grdtmp, _ operation:=srfGridTransMirrorY, _ outgrid:=grdFile) MsgBox(grdFile+" created") End Sub