Читаем высотные отметки со слои рельефа SRTM и TIN
-
Изучаем получение высотных отметок на моделях рельефа SRTM3 и TIN.
Прямой и буферизованный доступ к данным слоя рельефа.
Пример SQL запроса для записи в базу высотных отметок слоя рельефа.
Получение данных для построения продольного профиля.
'*********************************************************************
' Получение высоты для объекта с ID = 1
'*********************************************************************
Sub GetOneZ
'Активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Слой рельефа текущей карты
Set Rl = Zulu.ActiveMapDoc.Layers.Item(1)
'Объект активного слоя с ID = 1
Set El = L.Elements.Item(1)
'Центроид объекта
Set Pt = El.GetCenter
'Получение высотной отметки по координатам центроида
Z = Rl.ReliefLayer.GetZ(Pt.X, Pt.Y, L.GetCRS())
'Вывод результата на экран
MsgBox "Z: " + CStr(Z)
End Sub
'*********************************************************************
' Получение высоты для объекта с ID = 1 и запись результата в таблицу
'*********************************************************************
Sub WriteOnZ
'Активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Слой рельефа текущей карты
Set Rl = Zulu.ActiveMapDoc.Layers.Item(1)
'Объект активного слоя с ID = 1
Set El = L.Elements.Item(1)
'Центроид объекта
Set Pt = El.GetCenter
'Получение высотной отметки по координатам центроида
Z = Rl.ReliefLayer.GetZ(Pt.X, Pt.Y, L.GetCRS())
'Получение базы данных для примитивов
Set Db = L.OpenDatabase(-1, "")
'Зарпись результата для ID = 1 в поле Z1
Db.UpdateBaseRecord 1, "Z1", CStr(Z)
End Sub
'*********************************************************************
' Запись в активный слой 100 000 точек по габаритам слоя рельефа
'*********************************************************************
Sub FillPoints
'Активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Слой рельефа текущей карты
Set Rl = Zulu.ActiveMapDoc.Layers.Item(1)
'Габариты рельефа
Set Rc = Rl.GetBoundsRectangle
'Активация генератора случайных чисел
Randomize
'Габариты слоя * 1000
Xmin = Rc.Xmin*1000
Xmax = Rc.Xmax*1000
Ymin = Rc.Ymin*1000
Ymax = Rc.Ymax*1000
'Активация режима буферизованной записи
L.StartSequentialWriteMode
For i = 1 To 100000
'Добавляем в слой сивмвол со случайными координатами в пределах габарита слоя рельефа
L.AddSimpleSymbol CLng(Xmin + (Xmax - Xmin) * Rnd)/1000, CLng(Ymin + (Ymax - Ymin) * Rnd)/1000, 0, 1, 100, 0
Next
'Завершение режима буферизованной записи
L.FinishSequentialWriteMode
End Sub
'*********************************************************************
' Заполняем высотными отметками поле Z2 для слоя текущей карты Zulu
'*********************************************************************
Sub FillZSQL
'Текущая карта
Set map = Zulu.ActiveMapDoc
'Активный слой текущей карты
Set L = map.Layers.Active
'SQL запрос не запись высотных отметок для каждого объъекта слоя в таблицу
map.ExecSQL "UPDATE [" + L.UserName + "] Set [" + L.UserName + "].Z2 = [" + L.UserName + "].Geometry.Z()", Nothing
End Sub
'*********************************************************************
' Создание карты и запись высотных отметок для слоя карты
'*********************************************************************
Sub FillZSQL_Map
'Создаем карту
Set map = CreateObject("ZuluLib.MapDoc")
'Добавляем в карту слой рельефа
map.AddLayer "D:\hgt\Heights.zww"
'Добавляем в карту слой с точками
map.AddLayer "D:\hgt\points.b00"
'Слой с точками
Set L = map.Layers.Item(2)
'SQL запрос не запись высотных отметок для каждого объъекта слоя в таблицу
map.ExecSQL "UPDATE [" + L.UserName + "] Set [" + L.UserName + "].Z3 = [" + L.UserName + "].Geometry.Z()", Nothing
End Sub
'*********************************************************************
' Запись в слой текстовых объектов со значениями высотных отметок
'*********************************************************************
Sub WriteText
'Окно сообщений
Set Out = Zulu.OpenOutputChannel("")
Out.Clear
Out.Put "Start" + CHR(10)
'Активный слой текущей карты с точками
Set L = Zulu.ActiveMapDoc.Layers.Active
'Слой рельефа текущей карты
Set Rl = Zulu.ActiveMapDoc.Layers.Item(1)
'Слой для записи текстовых объектов
Set Lw = Zulu.ActiveMapDoc.Layers.Item(3)
'Буферизованный доступ к объектам слоя с точками
Set En = L.EnumElements
En.MoveFirst
'Активация буферизованного доступа к данным слоя рельефа
Rl.ReliefLayer.QuickAccessStart
'Активация режима буферизованной записи
Lw.StartSequentialWriteMode
cnt = 0
Do
' Выход из циикла после перебора всех объектов слоя точек
If En.IsEOF Then Exit Do
cnt = cnt + 1
'Счетчик объектов цикла
Out.Put CStr(cnt ) + CHR(13)
'Центроид текущего объекта итератора
Set Pt = En.GetCenter
'Получение высотной отметки по координатам центроида
Z = Rl.ReliefLayer.GetZ(pt.X, pt.Y, L.GetCRS)
'Запись текстового объекта по коорджинатам центроида с небольшим сдвигом (в градусах)
Lw.AddTextByType pt.X + 0.0001, pt.Y + 0.0001, 0, CStr(CLng(Z*10)/10) , 1, 1
'Переход к следующей точке
En.MoveNext
Loop
'Завершение режима буферизованной записи
Lw.FinishSequentialWriteMode
'Завершение буферизованного доступа к данным слоя рельефа
Rl.ReliefLayer.QuickAccessStop
Out.Put CHR(10) + "Finish" + CHR(10)
End Sub
'*********************************************************************
' Пример построения продольбного профиля по полилинии из слоя
'*********************************************************************
Sub Profile
Dim arr()
'Окно сообщений
Set Out = Zulu.OpenOutputChannel("")
Out.Clear
'Переменные для минимальной и максимальной высоты вдоль ломаной
minZ = 10000000
maxZ = 0
'Переменная для количества точек разбиения дломаной
Dl = 156
'Массив для записи высотных отметок в точках разбиения
ReDim arr(Dl + 1)
'Активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Item(2)
'Слой рельефа текущей карты
Set Rl = Zulu.ActiveMapDoc.Layers.Item(1)
'Полилиния объекта слоя с ID = 100003
Set Poly = L.Elements.Item(100003).PolyLine
'Объект с набором геометрических функций
Set Geo = CreateObject("ZuluLib.ZGeometry")
'По точкам разбиения
For i = 0 To Dl
'Получаем точку разбиения на заданном относительном расстоянии от начала ломаной
Set Pt = Geo.GetPointOnPolyline(Poly, CDbl(i)/CDbl(Dl))
'Получаем высотную отметку в этой точке
Z = Rl.ReliefLayer.GetZ(pt.X, pt.Y, L.GetCRS)
'Уточняем минимальную и максимальную высоту
If minZ > Z Then minZ = Z
If maxZ < Z Then maxZ = Z
'Записываем высоту очередной точки в массив
arr(i) = Z
Next
'Число строк окна сообщения для отображения профиля
Num = 20
'Высота каждой строки
dZ = (maxZ - minZ)/CDbl(Num)
'По всем строкам
For j = 1 To Num
'Перенос строки
Out.Put Chr(10)
'По всем точкам разбиения ломаной
For i = 0 To Dl
'Если высота текущей точки выше или равна уровню текущей строки
If arr(i) >= minZ + (Num - j)*dZ Then
'Пишем в окно сообщений зеленый нолик
Out.Put "{\C008000}0{\c}"
Else
'В противном случае пишем в окно сообщений серый нолик
Out.Put "{\CE0E0E0}0{\c}"
End If
Next
Next
End Sub
Последнее обновление — 26.12.2019 10:34:24