'********************************************************************* ' Получение высоты для объекта с 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