Форум » Программистские штучки » Статистика по Las-файлам » Ответить
Статистика по Las-файлам
Проезжий: Каюсь, грешен. Комментарии просто ужасны, код на 99% сырой требует приведения в более качественный вид. Но ведь работает! Макрос выводит на лист Excel статистику (имя скважины в файле, метод, начало записи, конец записи, минимальное значение, максимальное значение, код пустого значения, путь к файлу) по группе Las файлов [pre2] Sub open_file() 'Диалоговое окно открытия файлов. 'Имена файлов записываются в глобальную переменную Global fname() As String, а их количество в не менее глобальную t as integer Dim metod() As String 'Имя метода, который будет вырезаться Dim result As Integer 'Сначала отвечает за наличие вабранных файлов, а потом счётчик Dim t As Integer Dim l As String 'Директория Dim log_n As Integer Close Application.ScreenUpdating = False With Application.FileDialog(1) 'Если не ошибаюсь, то это "метод" для диалогового окна открытия файлов .Title = "Выбирите файл" 'Заголовок окна .InitialFileName = "D:\Work\Petrel11\LAS_MODIF" 'Адрес по умолчанию .AllowMultiSelect = True 'Включена возможность выбора нескольких файлов .Filters.Clear 'Очистка фильтра по расширенью .Filters.Add "las файлы", "*.las", 1 'Добавление фильтра на расширение *.las result = .Show 'ХЗ t = .SelectedItems.Count - 1 'Запись количества выбранных файлов If result = 0 Then Exit Sub 'Если ничего не выбрано, то выход из программы Range("A1").Select kkkk = 1 Range("A2:H" & Application.Rows.Count).ClearContents 'Очистка выходных строк For result = 0 To t 'Цикл записи имён выбранных файлов в массив fname() Call Las(Trim(.SelectedItems.Item(result + 1)), l, log_n, metod) For i = 0 To UBound(metod, 2) ActiveCell.Offset(i + kkkk, 0) = metod(0, i) 'Имя скважины ActiveCell.Offset(i + kkkk, 1) = metod(1, i) 'Метод ActiveCell.Offset(i + kkkk, 2) = metod(2, i) 'Начало записи ActiveCell.Offset(i + kkkk, 3) = metod(3, i) 'Конец записи ActiveCell.Offset(i + kkkk, 4) = metod(5, i) 'Min ActiveCell.Offset(i + kkkk, 5) = metod(6, i) 'Max ActiveCell.Offset(i + kkkk, 6) = metod(4, i) 'Null ActiveCell.Offset(i + kkkk, 7) = Trim(.SelectedItems.Item(result + 1)) Next i kkkk = kkkk + i Next result End With 'Конец метода Close MsgBox ("Исполнено!") Application.ScreenUpdating = True End Sub Sub Las(name, l, log_n, ByRef metod) 'Кусок кода, который позвовяет вырезать из *.las файлов нужные зонды. В данной версии 'зондов два, но путём нехитрых манипуляций их число может стать произвольным. 'Как обычно интерфейс суров до безобразия, управление с помощью редактирования тела кода. 'Выходные файлы создаются в той же директории, где находятся *.las, имя файлов - префикс "prb" '(буквы добавляются, чтобы MatLab воспринимал без лишних вопросов)+имя скважины из *.las 'Файлы содежат стлобцы: "dept" и заданные пользователем metod1/metod2 'Dim metod(50, 4) As String 'Имя метода, который будет вырезаться 'Dim metod2 As String 'Имя метода, который будет вырезаться Dim dl1 As Byte 'Длина имени первого метода Dim dl2 As Byte '->>- второго метода Dim i As Integer 'Счётчик las-файлов Dim numstl(50) As Integer 'Массив номеров столбцов глубин и методов Dim Las 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 outPUTfile As String 'Полное имя выходного файла Dim numOUT As Integer 'Номер выходного файла Dim pluk As Byte 'Счётчик, отвечает за номер текущего столбца при чтении значений Dim sRt As String 'Переменная для вывода значения глубины и методов в выходной файл Dim poeben As Double 'Переменная, в которую читаются ЗНАЧЕНИЯ из .*las Dim flag As Boolean ReDim metod(6, 50) '____________________ metod1 = "PS" '| Имена интересующих методов, должны в точности соответствовать названиям в *.las metod2 = "GK" '| '--------------------- dl1 = Len(metod1) dl2 = Len(metod2) numstl(0) = 0 'Обнуление переменной, отвечающей за положение записи градиент зонда. Необх. при открытии нескольких файлов, если отсутствуют значения "GZ3" numstl(1) = 0 numstl(2) = 0 Las_n = FreeFile 'Присвоили свободный номер открываемому las-файлу Open name For Input As Las_n 'Открыли las-файл Do 'Цикл чтения шапки *.las Line Input #Las_n, str If Trim(Left(str, 2)) = "~W" Then 'Если строка начинается с ~W, бум считать, что это Well Information. Условие такое куцее, т.к. боюсь разного регистра букав. Do Line Input #Las_n, str Loop While Trim(Left(str, 1)) = "#" nUl(0) = 0 well = "" NULLtmp = "" weLLtmp = "" Do 'Циииииииииииииккккккккккккккккккклллллллллллллллллллл чтения строк в "Data Type Information" shortSTR = Trim(Left(str, 6)) 'Вырезал я первые десять символов, а то строки могут и с пробела начинаться, да и вообще пусть хрень будет маленькая If Left(shortSTR, 4) = "NULL" Then 'Если первые четыре символа NULL, то, соответственно и читаем Null varNULL = spa(str, 7) 'Пропуск пробелов до значения 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, 7) 'Пропуск пробелов Do If Mid(str, varNULL, 1) Like ":" Then well = "No": Exit 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 Line Input #Las_n, str Loop While nUl(0) = 0 Or well = "" 'Конец ццциииииииккккккллллллаааа, когда всё, что нам надо уже прочитано. Всё хорошо, только тут будет косяк, если в шапке не будет указанно имя скважины. Впрочем, *.las без имени никуда не приткнёшь. ElseIf Left(str, 2) = "~C" Then 'А если строка начинается с ~C, то думаетм, что это Curve Information и ищем номера интересующих нас столбцов Do Line Input #Las_n, str Loop While Trim(Left(str, 1)) = "#" kui = 0 'Обнуление счётчика столбцов Do 'Цикл чтения строк "API CODE CURVE DESCRIPTION" и запись номеров интересующих столбцов metod(0, kui) = well metod(1, kui) = read_met(str) metod(4, kui) = nUl(0) If metod(2, kui) Like "DEPT" Then numstl(0) = kui + 1 kui = kui + 1 'В итоге kui будет равняться количеству столбцов в *.las shortSTR = Trim(Left(str, 10)) Line Input #Las_n, str Loop While Left(str, 1) <> "~" And Left(str, 1) <> "#" And Trim(str) <> "" yyy = Trim(str) ReDim Preserve metod(6, kui - 1) End If If EOF(Las_n) = True Then ReDim Preserve metod(6, 0) metod(0, kui) = "Формат файла не поддерживается" Exit Do End If Loop Until Left(str, 2) = "~A" Or EOF(Las_n) 'Шапка читается, пока не встретится "~A", что подразумевает "~ASCII Log Data", в версии 2.0 было написано кратко "~A"... Do 'Цикл чтения *.las до конца For pluk = 1 To kui 'Цикл чтения строк If EOF(Las_n) = True Then Exit Do Input #Las_n, poeben 'Последовательное чтение значений If pluk - 1 = numstl(0) Then tmp_dept = poeben If pluk <> numstl(0) And poeben <> nUl(0) And metod(2, pluk - 1) = "" Then metod(2, pluk - 1) = tmp_dept If pluk <> numstl(0) And poeben <> nUl(0) Then metod(3, pluk - 1) = tmp_dept If pluk <> numstl(0) And poeben <> nUl(0) And metod(6, pluk - 1) = "" Then metod(6, pluk - 1) = poeben If pluk <> numstl(0) And poeben <> nUl(0) And poeben < metod(5, pluk - 1) Then metod(5, pluk - 1) = poeben If pluk <> numstl(0) And poeben <> nUl(0) And poeben > metod(6, pluk - 1) Then metod(6, pluk - 1) = poeben Next pluk Loop Until EOF(Las_n) 'Цикл чтения *.las до конца Close 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 Function read_met(str) 'Функция чтения имени метода Dim position As Byte Dim spa_position As Byte Dim tab_position As Byte Dim point_position As Byte Dim comma_position As Byte str = Trim(str) position = 255 spa_position = InStr(str, " ") If spa_position <> 0 Then position = spa_position tab_position = InStr(str, Chr(9)) If tab_position <> 0 And tab_position < position Then position = tab_position point_position = InStr(str, Chr(46)) If point_position <> 0 And point_position < position Then position = point_position comma_position = InStr(str, Chr(44)) If comma_position <> 0 And comma_position < position Then position = comma_position read_met = Left(str, position - 1) End Function [/pre2]
Ответов - 0
полная версия страницы