Форум » Программистские штучки » Читалка *.las файлов » Ответить
Читалка *.las файлов
Бутеноп: [pre2] Global name() As String 'Массив имён выбранных las-файлов Global t As Integer 'Количество выбранных файлов Sub las() 'Кусок кода, который позвовяет вырезать из *.las файлов нужные зонды. В данной версии 'зондов два, но путём нехитрых манипуляций их число может стать произвольным. 'Как обычно интерфейс суров до безобразия, управление с помощью редактирования тела кода. 'Выходные файлы создаются в той же директории, где находятся *.las, имя файлов - префикс "prb" '(буквы добавляются, чтобы MatLab воспринимал без лишних вопросов)+имя скважины из *.las 'Файлы содежат стлобцы: "dept" и заданные пользователем metod1/metod2 Dim metod1 As String 'Имя метода, который будет вырезаться Dim metod2 As String 'Имя метода, который будет вырезаться Dim dl1 As Byte 'Длина имени первого метода Dim dl2 As Byte '->>- второго метода Dim i As Integer 'Счётчик las-файлов Dim numstl(2) As Integer 'Массив номеров столбцов глубин и методов Dim TxT As Integer 'Номер открываемого las-файла Dim str As String 'Читаются строки из las-файла Dim nUl(3) As Double 'Массив: 0 Null, 1 значение depth, 2 значение metod1, 3 значение metod2 Dim weLL As String 'Имя скважины Dim weLLtmp As String 'Имя скважины Dim NULLtmp As String 'Переменная, в которую посимвольно будет считываться Null Dim shortSTR As String 'Преременная для поиска имён столбцов Dim varNULL As Byte 'Положение символа в при чтении в заголовке, в общем, в коде более-менее понятно Dim kui As Byte 'Переменная положения столбцов Dim l As String 'Директория Dim outPUTfile As String 'Полное имя выходного файла Dim numOUT As Integer 'Номер выходного файла Dim pluk As Byte 'Счётчик, отвечает за номер текущего столбца при чтении значений Dim sRt As String 'Переменная для вывода значения глубины и методов в выходной файл Dim poeben As Double 'Переменная, в которую читаются ЗНАЧЕНИЯ из .*las metod1 = "NKT" metod2 = "GK" dl1 = Len(metod1) dl2 = Len(metod2) open_file For i = 0 To t 'Глобальный цикл чтения-записи файлов numstl(0) = 0 'Обнуление переменной, отвечающей за положение записи градиент зонда. Необх. при открытии нескольких файлов, если отсутствуют значения "GZ3" numstl(1) = 0 numstl(2) = 0 TxT = FreeFile 'Присвоили свободный номер открываемому las-файлу Open fname(i) For Input As TxT 'Открыли las-файл Do 'Цикл чтения шапки *.las Line Input #TxT, str If Trim(Left(str, 11)) = "#MNEM.UNIT" Then '%Если, вдруг так, невзначай, встретится заголовок, то... If Left((Trim(Mid(str, 11, 20))), 1) = "D" Then ' %Если первый встретившийся символ "D", то предполагаем, что это "Data Type Information", и ищем значения null и well nUl(0) = 0 weLL = "" NULLtmp = "" weLLtmp = "" Line Input #TxT, str Do 'Циииииииииииииккккккккккккккккккклллллллллллллллллллл чтения строк в "Data Type Information" Line Input #TxT, str 'Пропуск строки-разделителя If Left(str, 1) = "#" Or Left(str, 1) = "~" Then Exit Do 'Страховочка, мало ли что... shortSTR = Trim(Left(str, 10)) 'Вырезал я первые десять символов, а то строки могу и с пробела начинаться, да и вообще пусть хрень будет маленькая If Left(shortSTR, 4) = "NULL" Then 'Если первые четыре символа NULL, то, соответственно и читаем Null varNULL = spa(str, 11) 'Пропуск пробелов до значения Do NULLtmp = NULLtmp & Mid(str, varNULL, 1) 'Посимвольное чтение до двоеточия varNULL = varNULL + 1 Loop While Mid(str, varNULL, 1) <> ":" nUl(0) = CDbl(NULLtmp) 'Запись в массив с преобразованием текстовой переменной в double End If If Left(shortSTR, 4) = "WELL" Then 'Если первые 4 символа WELL, то пробуем прочитать имя скважины varNULL = spa(str, 11) 'Пропуск пробелов Do weLL = weLL & Mid(str, varNULL, 1) 'Чтение символов до двоеточия varNULL = varNULL + 1 Loop While Mid(str, varNULL, 1) <> ":" weLL = Trim(weLL) 'Убрали пробелы varNULL = varNULL + 1 'Пропустили двоеточие Do weLLtmp = weLLtmp & Mid(str, varNULL, 1) 'Чтение символов до конца строки varNULL = varNULL + 1 Loop Until varNULL > Len(str) weLLtmp = Trim(weLLtmp) 'Убрали пробелы If weLL = "WELL" Then weLL = weLLtmp 'Вот, собственно, из-за чего имя скважины читается дважды? А всё потому, что в разных версиях, оно может быть в разных местах. На данной строке происходит выбор, что будет именем скважины End If Loop While nUl(0) = 0 Or weLL = "" 'Конец ццциииииииккккккллллллаааа, когда всё, что нам надо уже прочитано ElseIf Left((Trim(Mid(str, 11, 20))), 1) = "A" Then 'А если первый встретившийся символ "A", то предполагаем, что это "API CODE CURVE DESCRIPTION", и ищем номера интересующих нас столбцов Line Input #TxT, str 'Пропуск строки-разделителя Line Input #TxT, str 'Чтение первой строки в "API CODE CURVE DESCRIPTION", вынесено за цикл, чтобы не вычитать 1 из полного количества методов kui = 0 'Обнуление счётчика столбцов Do 'Цикл чтения строк "API CODE CURVE DESCRIPTION" и запись номеров интересующих столбцов kui = kui + 1 'В итоге kui будет равняться количеству столбцов в *.las shortSTR = Trim(Left(str, 10)) If Left(shortSTR, 4) = "DEPT" Then numstl(0) = kui If Left(shortSTR, dl1) = metod1 Then numstl(1) = kui If Left(shortSTR, dl2) = metod2 Then numstl(2) = kui Line Input #TxT, str Loop While Left(str, 1) <> "~" End If End If Loop Until Left(str, 2) = "~A" 'Шапка читается, пока не встретится "~A", что подразумевает "~ASCII Log Data", в версии 2.0 было написано кратко "~A"... If numstl(1) > 0 And numstl(2) > 0 Then 'Если в *.las имеются оба метода, то пишем в выходной файл l = CurDir() 'Чтение текущей директории outPUTfile = l & "\PRB" & weLL 'Запись полного имени выходного файла numOUT = FreeFile 'Номер выходного файла Open outPUTfile For Output As numOUT Do 'Цикл чтения *.las до конца For pluk = 1 To kui 'Цикл чтения строк Input #TxT, poeben 'Последовательное чтение значений If pluk = numstl(0) Then nUl(1) = poeben 'Запись значения в соотв. переменную, при совпадении номеров столбцов. Блин, коряво, надо бы нормально сформулировать... If pluk = numstl(1) Then nUl(2) = poeben If pluk = numstl(2) Then nUl(3) = poeben Next pluk If nUl(2) <> nUl(0) And nUl(3) <> nUl(0) Then 'Если значение методов не null, то они пишутся в выходной файл sRt = nUl(1) & Chr(9) & nUl(2) & Chr(9) & nUl(3) 'Создана строковая переменная, задающая формат вывода с разделителем "табуляция" Print #numOUT, sRt 'Непосредственно запись переменной str в выходной файл End If 'Закрытия условия на значящее значение зондов Loop Until EOF(TxT) 'Цикл чтения *.las до конца End If Close Next i End Sub Function spa(ff, q) 'Функция счёта пробелов Dim f As Byte 'ff имя текстовой переменной q начальное положение поиска пробела f = 0 'spa выдаёт последнее положение пробела Do f = f + 1 Loop While Mid(ff, q + f, 1) = " " spa = f + q End Function Sub open_file() 'Диалоговое окно открытия файлов. 'Имена файлов записываются в глобальную переменную Global fname() As String, а их количество в не менее глобальную t as integer Dim result As Integer 'Сначала отвечает за наличие вабранных файлов, а потом счётчик With Application.FileDialog(1) 'Если не ошибаюсь, то это "метод" для диалогового окна открытия файлов .Title = "Выбирите файл" 'Заголовок окна .InitialFileName = "D:\мои документы\Temp\" 'Адрес по умолчанию .AllowMultiSelect = True 'Включена возможность выбора нескольких файлов .Filters.Clear 'Очистка фильтра по расширенью .Filters.Add "las файлы", "*.las", 1 'Добавление фильтра на расширение *.las result = .Show 'ХЗ t = .SelectedItems.Count - 1 'Запись количества выбранных файлов If result = 0 Then Exit Sub 'Если ничего не выбрано, то выход из программы ReDim fname(t) 'Задание размерности массива имён, в соответствии с количеством выбранных файлов For result = 0 To t 'Цикл записи имён выбранных файлов в массив fname() fname(result) = Trim(.SelectedItems.Item(result + 1)) Next result End With 'Конец метода On Error Resume Next 'ХЗ End Sub [/pre2]
Ответов - 0
полная версия страницы