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
- участник сейчас на форуме
- участник вне форума
