Visual Basic for Applications/VBA Code to Read ASCII Log Data from LAS File
Jump to navigation
Jump to search
Summary
[edit | edit source]This page lists a VBA Sub procedure to read data from a LAS file. A LAS file is an industry-standard binary format for storing airborne LIDAR data. Sub procedure requirements:
- A LAS file must be located in the same folder where the macro-enabled Excel file is located
- The active worksheet must have in cell A1 the name of the LAS file
VBA Code
[edit | edit source]Sub ReadProperties()
Dim numWords As Long
Dim stringLine As String, fileName As String, lineStringVector() As String, headerStart As String
Dim n As Long, i As Long, numLineHeader As Long, lenStringVector As Long, j As Long
Dim colStart As Long, numProp As Long
Dim rowStart As Long, rowNumCounter As Long, numDepths As Long
Dim StartDatProp As Range, dataArray(1 To 10000, 1 To 20) As Double
fileName = Cells(1, 1).Value
Cells(1, 2).Value = "Num Prop:": Cells(1, 4).Value = "Num Depths"
n = 0: rowStart = 2: colStart = 2: rowNumCounter = 1
Open fileName For Input As 1
Do While Not EOF(1)
Line Input #1, stringLine
headerStart = Left(stringLine, 2) ' stores in headerStart the first two characters of the string stringLine
If headerStart = "~A" Then
numLineHeader = n + 1
lineStringVector() = Split(Trim(stringLine), " ")
lenStringVector = UBound(lineStringVector) - LBound(lineStringVector) + 1
numWords = 0: j = 1
For i = 0 To lenStringVector - 1
If lineStringVector(i) <> "" Then
numWords = numWords + 1
Cells(rowStart, j).Value = lineStringVector(i)
j = j + 1
End If
Next i
numProp = numWords - 1
Cells(1, 3).Value = numProp
End If
If numLineHeader > 0 And n >= numLineHeader Then
lineStringVector() = Split(Trim(stringLine), " ")
lenStringVector = UBound(lineStringVector) - LBound(lineStringVector) + 1
j = 0
For i = 0 To lenStringVector - 1
If lineStringVector(i) <> "" Then
Cells(rowStart + rowNumCounter, colStart + j).Value = lineStringVector(i)
dataArray(rowNumCounter, j + 1) = lineStringVector(i)
j = j + 1
End If
Next i
rowNumCounter = rowNumCounter + 1
End If
n = n + 1
Loop
Close 1
numDepths = rowNumCounter - 1
Cells(1, 5).Value = numDepths
Cells(rowStart, 2).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.NumberFormat = "0.000"
Cells(rowStart, 2).Select
End Sub
Example Data to Test
[edit | edit source]You may create a ASCII file with extension LAS using the following example of data.
Screenshot showing content of LAS file |
---|
Output on worksheet after running VBA Sub
[edit | edit source]Screenshot showing Excel active worksheet after running VBA Sub |
---|