Библиотека полезных скриптов

Назрела тема для обмена различными полезными скриптами. Милости просим всех, кому есть чем поделиться.

Пояснение для тех, кто не знаком со скриптами Digitals

Скрипт позволяет автоматизировать различные типовые операции, обычно выполняемые над группой карт и/или объектов. Даже если вы не умеете писать скрипты сами, то можете использовать подходящие готовые.

Для использования готового скрипта нужно создать пользовательскую панель инструментов (меню Окно|Создать панель инструментов), щелкнуть на ней правой кнопки мыши и выбрать пункт контекстного меню Добавить кнопку. Затем скопировать текст скрипта в правую часть открывшегося окна редактирования и нажать ОК.

Затем, по желанию, можно назначить кнопке иконку, имя и т.д. с использованием все того же контекстного меню, вызываемого щелчком правой кнопкой мыши на кнопке со скриптом.

Текст скрипта в сообщении выделяется курсивом - копировать нужно только его.

Дополнительно

Инструментальные панели и язык скриптов Digitals

Автоматическая загрузка последних открытых карт

Сохранение списка всех открытых карт по выходу из программы в файл openfiles.txt и их автоматическое открытие при повтором запуске Digitals.

%Events.OnShutdown
$C=@MapCount
@If $C<=0 @Break
$I=1
%Start:
$S=@Map[$I].Filename
@Text.Add $S
$I=$I+1
@If $I<=$C @Goto %Start
@Text.Save openfiles.txt
%Events.OnStartup
@Text.Load openfiles.txt
$C=@Text.Count
@If $C<=0 @Break
$I=1
%Start:
$S=@Text.Line[$I]
@FileOpen $S
$I=$I+1
@If $I<=$C @Goto %Start

Примечание: Для корректной работы скрипта нужно установить для кнопки опцию Автозагрузка.

Восстановление всех удаленных объектов карты (undelete)

Восстанавливает все объекты карты, которые удалялись в текущей сессии (после открытия файла) и помечает их.

$V=@Version
@If $V<41023 @Break Для работы скрипта нужно обновить программу
$C=@Map.Count
@IF $C=0 @Break
@Map.DeselectAll
$I=1
%Start:
$D=@Map.Object[$I].Deleted
@If $D=0 @Goto %Next
@Map.Object[$I].Deleted 0
@Map.Object[$I].Select
%Next:
$I=$I+1
@If $I<=$C @Goto %Start
@Window.Refresh

Быстрое конвертирование открытой карты в другой формат

Сохраняет открытую карту в другой формат (по выбору: xml, dxf, dwg, in4, shp, mid/mif), закрывает текущее окно и открывает вновь созданный файл.

$M=@Map.Modified
@If $M=1 @Break Сохраните текущие изменения
$S=@Map.ClearFilename
$E=@Dialog.Select Сохранить как|xml|dxf|dwg|in4|shp|mif
@If $E= then @Break
$S=$S.$E
@Map.SaveToFile $S
$FE=@FileExists $S
@If $FE=0 @Break
@CloseMap
@FileOpen $S

Примечание: Если вам не нужно закрытие текущей карты и открытие новой, то удалите четыре последние строчки скрипта после команды @Map.SaveToFile $S. Вы также можете изменить список форматов в четвертой строке, оставив только необходимые вам или, наоборот, добавив новые.

Конвертирование всех открытых карт в формат DXF

$C=@MapCount
$I=0
%Start
$I=$I+1
@If $I>$C then @Break
$F=@Map[$I].ClearFilename
@Map[$I].SaveToFile $F.dxf
@Goto %Start

Примечание: Для конвертирования в любой другой формат, замените dxf на нужное расширение в предпоследней строке скрипта.

Конвертирование всех карт в папке в другой формат

Когда карт слишком много и открыть их все одновременно не получается, можно использовать скрипт, который по очереди откроет все файлы из заданной папки и сохранит в другой формат.

$Filter=*.dmf
$F=@Dialog.SelectFolder Укажите папку с картами
@Text.FolderList $Filter $F
$C=@Text.Count
@If $C=0 @Break В папке “$F” отсутствуют файлы $Filter
$I=0
%Start
$I=$I+1
@If $I>$C then @Break
$F=@Text.Line[$I]
@FileOpen $F
$F=@Map.ClearFilename
@Map.SaveToFile $F.dxf
@CloseMap
@Goto %Start

Примечание: Скрипт ищет и конвертирует все DMF файлы в указанной папке. Если исходные файлы в другом формате, замените фильтр в первой строке скрипта (например $Filter=*.in4 или $Filter=.). Для конвертирования не в DXF, а в другой формат, замените dxf на другое расширение в третьей с конца строке скрипта. Если необходимо обработать файлы не только в указанной папке, но и во всех ее подпапках, то вместо функции @Text.FolderList можно использовать @Text.FolderListTree.

Поиск участка с заданным кадастровым номером

Ищет на индексно-кадастровой карте участок с заданным номером. Поиск выполняется по значениям двух параметров (сначала SC - для In4-участков, а затем ID7000513 для участков с параметрами в формате XML).

@Map.DeselectAll
$CN=@Dialog.Ask Кадастровый номер
@Map.FindByParameters 1|SC=$CN
$S=@Map.SelCount
@If $S>0 @Goto %Show
@Map.FindByParameters 1|ID7000513=$CN
$S=@Map.SelCount
@If $S=0 @Break Участок не найден
%Show:
@Window.ShowSelected

Этот скрипт легко модифицировать для быстрого поиска по другим параметрам, например по адресу и т.д.

Формирование KMZ файлов с уровнями детализации на основе DMF карт с 3D моделями

Скрипт выполняет полный цикл обработки исходных 3D моделей зданий и сохраняет результат в KMZ формате. Подробнее про используемые команды скрипта смотрите здесь. Пример исходного DMF файла (фрагмента полной карты) во вложении.

;каталог исходных тайлов
$SrcDir=\Bond\Src
;каталог выходных тайлов
$DstDir=\Bond\Out
;каталог поиска текстур
$TexDir=\Server\Images
;каталог сгенеренных KMZ файлов моделей
$KMZDir=\Bond\Out\KMZ
;номер первого тайла для обработки
$FileMin=138
;номер последнего тайла для обработки
$FileMax=138
;
;поехали
$I=$FileMin
%Start
;имя текущего файла
$S=$SrcDir$I.dmf
$B=@FileExists $S
;файл не найден, пропускаем
@if $B<>1 @Goto %Skip
;открываем файл
@FileOpen $S
;если нет 3D объектов, пропускаем
$B=@Map.Has3DModels
@if $B<>1 @Goto %Skip
;помечаем слои рельефа
@Map.SelectLayer ID1001
@Map.SelectLayer ID1002
@Map.SelectLayer ID1003
;строим стены
ЦМР | Переприсвоить высоты
;удаляем помеченные
Правка | Удалить
;накрываем крыши (на случай дождя)
@Map.CoverMultiFlatRoofs
;создаем выходной каталог
$Dir=@Concat $DstDir,$I,
@CreateFolder $Dir
;сохраняем карту в выходном каталоге
$S=@Concat $Dir,$I,.dmf
@Map.SaveToFile $S
;объединяем 3D объекты
@Map.Merge3DObjects
;сохраняем результат объединения
$S=@Concat $Dir,$I,merged.dmf
@Map.SaveToFile $S
;перед генерацией текстур сохраняем под новым именем
$S=@Concat $Dir,$I,tex.dmf
@Map.SaveToFile $S
;генерим текстуры
@Window.GenerateTextures $TexDir pak jpg
;уменьшаем разрешение текстур
@Map.MergeTextures 4096 0.15
;сохраняем результат
@Map.SaveToFile $S
;помечаем рамку тайла, ограничивающего все 3D объекты
@Map.DeselectAll
@Map.SelectLayer ID1006
;экпортируем в KMZ с уровнями детализации
$S=@Concat $KMZDir,$I,.kmz
@Map.SaveToKMZ $S LOD 3DObjs
%Skip
@CloseMap
$I=$I+1
;переход к следующему файлу
@if $I<=$FileMax @Goto %Start
;создаем KMZ со ссылками на все вложенные
@CreateCommonKMZ $KMZDir ShowInfo

138.dmf (137 KB)

Разворот подписей объектов

Выполняет разворот всех подписей помеченных объектов на заданный угол

$S=@Map.SelCount
@If $S<=0 @Break Нужно пометить объекты
$Angle=@Dialog.Ask Угол разворота подписей Default=0
$Angle=-$Angle*10
$N=0
$C=@Map.Parameters.Count
%Start:
$N=@Map.NextSelected $N
@If $N<=0 @Goto %Finish
$I=1
%NextParam
$S=@Map.Object[$N].Caption[$I]
@if $S= @Goto %NextCap
@Map.Object[$N].Caption[$I] * * * $Angle
%NextCap:
$I=$I+1
@If $I<$C @Goto %NextParam
@Goto %Start
%Finish:
@Window.Refresh

В темі запитів на функції

Во вложенном архиве содержится два скрипта и панель с кнопкой, распакуйте архив в папку Digitals.

  1. FindLeftTopPoint
    Единственный аргумент - номер объекта в карте, результат - номер левой верхней точки объекта. Наличие открытой карты и объекта с заданным номером не проверяется.

  2. StartFromTopLeft
    Скрипт делает начальной левую верхнюю точку всех помеченных замкнутых объектов (игнорируються сложные полигоны) в активной карте. Используется скрипт из п.1, при переносе этого скрипта в какую-либо подпапку папки Library необходимо изменить строку $SP=%Library.FindTopLeftPoint $SO на $SP=%Library.Имя_подпапки\FindTopLeftPoint $SO.

P.S. В скрипте используется новая функция скриптов @Map.Object[N].StartFromPoint PointIndex, доступная в версиях Ged.exe, вышедших после 30.08.2012.
Unpack2DigitalsFolder.zip (1.23 KB)

Файл | Сохранить в XML…
@CloseMap

Пометка объектов карты, имеющих подписи высот

$C=@Map.Count
@If $C<=0 @Break
$I=1
@Map.BeginUpdate
%Start:
$S=@Map.Object[$I].Caption[-2]
@If $S= @Goto %Next
@Map.SelectObject $I
%Next:
$I=$I+1
@If $I<=$C @Goto %Start
@Map.EndUpdate

Сброс коэффициента масштабирования объектов

$C=@Map.Count
@If $C<1 @Break
$N=1
%Start:
@Map.Object[$N].Scale 0
$N=$N+1
@If $N<=$C @Goto %Start

При использовании команды Правка|Специальная вставка|В другом масштабе объекты карты масштабируются (растягиваются или сжимаются) и им присваивается специальный коэффициент масштабирования. Этот коэффициент используется для приведения площади и периметра измененного объекта к исходным значениям до изменения.

Никогда не используйте вставку в другом масштабе в ваших рабочих картах. Эта команда предназначена только для печати документов, схем и т.д.

Замена строк в значениях параметров во всех dmf-файлах в указанной папке

$SearchText=@Dialog.Ask Введите текст для поиска
$STL=@Calc Length(“$SearchText”)
@if $STL=0 then @Break Введите непустой текст
$ReplaceText=@Dialog.Ask Введите текст для замены
$Path=@Dialog.Ask Путь к папке Default=С:\Digitals
@Text[0].FolderListTree *.dmf $Path
$MapCount=@Text[0].Count
@if $MapCount=0 then @Break Файл(ы) не найдены
$FileNumber=0
%LoopEachFile
$FileNumber=$FileNumber+1
$MapFileName=@Text[0].Line[$FileNumber]
@FileOpen $MapFileName
$OC=@Map.Count
$PC=@Map.Parameters.Count
$CC1=0
$I=0
%LoopObject
$I=$I+1
$J=0
$L=@Map.Object[$I].Layer
$LD=@Map.Layers.Get $L
@Dialog.Message $LD
%LoopParameter
$J=$J+1
$S=@Map.Object[$I].Parameter[$J]
$CC2=0
%Repeat
$IP=@Calc pos(“$SearchText”,“$S”)
@if $IP=0 then @Goto %Continue1
$S=@Calc delete(“$S”,$IP,$STL)
$S=@DequoteText $S
$S=@Calc insert(“$S”,“$ReplaceText”,$IP)
$S=@DequoteText $S
$CC2=$CC2+1
@if $CC2>100 then @Goto %Continue1
@Goto %Repeat
%Continue1
@if $CC2=0 then @Goto %Continue2
$CC1=$CC1+1
@Map.Object[$I].Parameter[$J] $S
%Continue2
@if $J<$PC then @Goto %LoopParameter
@if $I<$OC then @Goto %LoopObject
@if $CC1>0 then @Map.SaveToFile $MapFileName
@if $CC1>0 then @Text[1].Add $MapFileName изменен
@if $CC1=0 then @Text[1].Add $MapFileName не изменен
@CloseMap
@if $FileNumber<$MapCount then @Goto %LoopEachFile
@Text[1].Save $Path\Changes.log
@Dialog.Message см. лог-файл $Path\Changes.log

Пересчет всех In4-файлов в указанной папке в новую систему координат (основан на датумах)

;выбираем папку с исходными файлами
$Ext=.in4
$InF=@Dialog.SelectFolder Укажите папку с картами
;формируем список файлов в папке
@Text.FolderList *$Ext $InF
;проверяем или список пустой
$C=@Text.Count
@If $C=0 @Break В папке “$InF” отсутствуют файлы $Ext
;для сконвертированных файлов создаем подкаталог
$OutF=$InF\TransformedToSK63
@CreateFolder $OutF
;очищаем подкаталог, если он уже был создан ранее
@CleanFolder $OutF
;открываем файлы из списка по одному
$I=0
%Start
$I=$I+1
@If $I>$C then @Break
$InF=@Text.Line[$I]
@FileOpen $InF
;пересчитываем в новую СК
@Map.RecalculateToNewDatum Имя_местной_СК SK63
;меняем значение дескриптора, указывающего на СК
@Map.SelectLayer ID10000
@Map.Selected.ChangeParameter ID10050 2,X
;сохраняем в подкаталоге
$InF=@Map.ClearShortFilename
@Map.SaveToFile $OutF$InF$Ext
@CloseMap
@Goto %Start

Если строку @Map.RecalculateToNewDatum Имя_местной_СК SK63 заменить на строки

@if $I > 1 then @SendChars
Карта | Система координат…

тогда можно выполнять пересчет, основанный на связующих точках. При этом окно Карта>Система координат откроется перед началом трансформации (здесь нужно ввести координаты связующих точек). И все найденные файлы будут пересчитаны в новую систему координат на основе введенных точек.

Установка слоя помеченного объекта слоем для сбора

При создании топографических карт с большим количеством слоев выбор слоя из списка отнимает время. Данный скрипт устанавливает слой для сбора по помеченному объекту. Кнопке со скриптом нужно назначить горячую клавишу, например [b][/b] (которая на многих клавиатурах находится выше клавиши Enter).

Теперь, не покидая режима сбора будтет достаточно нажать Enter для выбора объекта нужного слоя, а затем [b][/b] для установки его в качестве текущего.

$N=@Map.NextSelected
@If $N<=0 then @Break
$L=@Map.Object[$N].Layer
@Map.SetCollectionLayer $L

Копирование значения заданного параметра из внешнего объекта из другой карты.

Данный скрипт для помеченного объекта карты находит внешний объект в другой карте, копирует из внешнего объекта значение заданного параметра и присваивает его исходному объекту. Чтобы скрипт сработал, помеченный объект должен целиком попадать во внешний объект второй карты. Если таковой объект не найден, выдается соответствующее предупреждение и открытая карта не закрывается для анализа ошибки.

;путь к карте - источнику копируемого параметра
$SourceMap=d:\test.dmf
;параметр, значение которого копируется
$SrcParam=ID20030
;параметр, в исходной карте принимающий значение
$DestParam=ID20030
$N=@Map.SelCount
@If $N<>1 @Break Выделите один объект
;запоминаем номер нашей карты
$ThisMap=@ActivateMap
;копируем помеченный объект в буфер
@Map.Copy
;открываем карту из которой хотим получить параметр
@FileOpen $SourceMap
;вставляем в открытую карту наш объект
@Map.Paste
;номер нашего объекта
$ThisObj=@Map.SelectedObject
;полигон, в который объект попал
$ParentObj=@Map.ParentObject $ThisObj
;не закрываем открытую карту, если не найден внешний объект
@if $ParentObj=$ThisObj then @Break Внешний полигон не найден
;копируем значение параметра внешнего объекта
$P=@Map.Object[$ParentObj].Parameter[$SrcParam]
;возвращаемся к исходной карте
@CloseMap
@ActivateMap $ThisMap
;вставляем скопированный параметр
$ThisObj=@Map.SelectedObject
@Map.Object[$ThisObj].Parameter[$DestParam] $P
;обновляем объект
@Map.RefreshObject $ThisObj

Трансформирование сканированных планшетов топокарт с обрезкой зарамочного оформления

Скрипт выполняет трансформацию всех TIF растров из указанного каталога с заданными параметрами результирующего изображения. Результирующие орто записываются в указанный каталог и вставляются в виде ссылок на изображения в DMF файл. Исходные растры должны быть сориентированы по углам внутренней рамки. Результирующие орто не содержат изображение за областью внутренней рамки, расширенной на значение $ExpandValue (задается в метрах на местности).

$SourceDir=@Dialog.Ask Каталог исходных растров Default=d:\Images\Src
$DestDir=@Dialog.Ask Каталог результирующих растров Default=d:\Images\Dst
$MapScale=@Dialog.Ask Масштаб плaншетов Default=10000
;расширять рамки трапеций на указаное значение
$ExpandValue=@Dialog.Ask Расширять рамки трапеций на, м Default=50
;разрешение орто
$DPI=@Dialog.Ask DPI Default=200
;оттенки серого или цветное орто
$ColorChannels=@Dialog.Ask Цветовых каналов (1/3) Default=1
;создаем новую карту
@FileNew
;устанавливаем масштаб карты
@Map.SetProperties $MapScale Ortho
;вставляем растры в карту
@Map.InsertTriangulation $SourceDir*.tif
$I=@Map.Count
@if $I=0 then @Break Растры в “$SourceDir” не найдены
;копируем рамки растров в буфер, они нам еще пригодятся
@Map.SelectAll
@Map.Copy
;расширяем рамки растров
@Map.Selected.ExpandPolygon $ExpandValue
;трансфоррмируем
@OrthoRectification $DPI $ColorChannels $DestDir
;запоминаем кол-во объектов карты
$RasterCount=@Map.Count
;разбиваем сложные полигоны изображений на внешние и внутренние рамки
[ Операции с объектами.Разделить ]
;удаляем внутренние рамки изображений
$I=@Map.Count
%Start1
@Map.DeleteObject $I
$I=$I-1
@if $I>$RasterCount then @Goto %Start1
@Map.DeselectAll
;вставляем исходные (не расширенные) рамки растров
@Map.Paste
;запоминаем слой добавленных объектов
$TriangLayer=@Map.Selected.Layer
;создаем сложный полигон
$I=$RasterCount
%Start2
@Map.DeselectAll
@Map.SelectObject $I
[ Операции с объектами.Сложный полигон ]
$I=$I-1
@if $I>0 then @Goto %Start2
;удаляем лишние объекты
@Map.Layers.Delete $TriangLayer
;сохраняем карту с ортофрагментами
@Map.SaveToFile

Если расширять внутренние рамки не требуется, тогда скрипт значительно упрощается.

Расчет суммарной площади всех выделенных объектов карты

$N=@Map.SelCount
@if $N=0 then @Break Выделите объекты для которых требуется расчитать суммарную площадь
$SumArea=0
$N=0
%Start
$N=@Map.NextSelected $N
@if $N=0 then @Break Площадь выделенных объектов $SumArea
$Area=@Map.Object[$N].Parameter[0]
$SumArea=@Calc $SumArea+$Area
@Goto %Start

Единица измерения площади и формат вывода значения задаются маской параметра Площадь в Карта>Параметры. Чтобы скрипт работал правильно необходимо в Региональных настройках Windows установить разделить целой и дробной части - точка.

Знайти полігони з шарів зі стилем “тільки полігон” у статусі “правка”, що частково/повністю накладаються на інші полігони того-ж шару, чи будь-яких шарів стилю “тільки полігон” у статусі “правка”.

Наведений скрипт - спроба компенсувати відсутність функції [Overlay] серед доступних для написання сценарію контроля. Допрацьовувати скрипт спільними зусиллями, при бажанні та необхідності, прошу в темі “Все про скрипти”.

;Перевірка наявності відкритої карти
$CountMap=@MapCount
@If $CountMap=0 then @Break Для перевірки накладання ділянок відкрийте карту
;Отримуєм перелік шарів зі стилем тільки полігон що в статусі правка
$CounObgAll=@Map.Count
$CountLay=@Map.Layers.Count
$I=0
$StrOllLayPolig=
@Progress.Start $CountLay Перебираю шари карти
%StartLayList
$I=$I+1
@If $I>$CountLay @Goto %EndLeyList
@Progress.StepBy
$LayPolig=@Map.Layers.Polygon $I
@If $LayPolig=0 @Goto %StartLayList
$LayAttrib=@Map.Layers.GetAttributes $I
$StatLay=@StringPart 7 $LayAttrib
@If $StatLay<>0 then @Goto %StartLayList
@Map.CalculateRange
$CountObgLayPolig=@Map.Layers.ObjectCount $I
@If $CountObgLayPolig=0 @Goto %StartLayList
$StrLayPolig=@Map.Layers.Get $I
$IDLayPolig=@StringPart 1 $StrLayPolig
$StrOllLayPolig=$StrOllLayPolig ID$IDLayPolig
@Text.Add $StrLayPolig
@Goto %StartLayList
%EndLeyList
@Progress.Stop
;Вносим допуск по площі перекриття, вибираєм шар, що будем контролювати на накладку, з переліку шарів
$Dopusk=@Dialog.Ask Вкажіть максимально допустиме значення площі перекриття|(в розмірності нульового параметра карти) Default=1.0 Size=255
$Dopusk=@Calc Numeric(“$Dopusk”)
$TextLayPolig=@Text.Text
$LayControl=@Dialog.ListSelect Виберіть шари, накладки на які треба знайти|Всі шари зі стилем тільки полігон|$TextLayPolig
@If “$LayControl”=“” then @Break
@If $LayControl<>Всі шари зі стилем тільки полігон then $StrOllLayPolig=@StringPart 1 $LayControl
@If $LayControl<>Всі шари зі стилем тільки полігон then $StrOllLayPolig=ID$StrOllLayPolig
@Map.DeselectAll
@Map.BeginUpdate
@Map.SelectLayer $StrOllLayPolig
;Отримуєм перелік номерів об’єктів, накладку з якими треба шукати
$ListObjControl=@Map.Selected.List
@Text[1].Text=$ListObjControl
@Map.DeselectAll
$ListObjCount=@Text[1].Count
$I=0
@Progress.Start $ListObjCount Перебираю полігони
;Перебираєм об’єкти, перекриття з якими треба знайти
%StartObgList
$I=$I+1
@Progress.StepBy
@If $I>$ListObjCount @Goto %EndObgList
$NumObg=@Text[1].Line[$I]
@If $LayControl=Всі шари зі стилем тільки полігон then $ObjOverlayList=@Map.Object[$NumObg].OverlayList else $ObjOverlayList=@Map.Object[$NumObg].OverlayList $StrOllLayPolig
@If $ObjOverlayList= @Goto %StartObgList
@Text[2].Text=$ObjOverlayList
$CountObgOverlay=@Text[2].Count
$I1=0
;;Перебираєм об’єкти, що накривають об’єкт $NumObg
%StartObgOverlayList
$I1=$I1+1
@If $I1>$CountObgOverlay @Goto %EndObgOverlayList
$NumObgOverlay=@Text[2].Line[$I1]
@Map.DeselectAll
;;Виловлюєм об’єкти, що перекривають полігон, заведені як полігон але не зі стилем “тільки полігон”
$IDLayObgOverlay=@Map.Object[$NumObgOverlay].LayerID
$StyleLayObgOverlay=@Map.Layers.Polygon ID$IDLayObgOverlay
@If $StyleLayObgOverlay=0 @Goto %StartObgOverlayList
;;Визначаєм площу перекриття полігонів
@Map.Object[$NumObg].Select
@Map.Object[$NumObgOverlay].Select
$CounObgAll=$CounObgAll+1
@Map.Undo.StartOperationGroup
;;;Якщо результатом функції spbIntersect є створений полігон - його номер останній в карті
;;;Якщо кількість об’єктів не збільшилась - перекриття не вважається накладкою полігонів.
@ExecuteMenu spbIntersect
$CountObgAllNew=@Map.Count
@If $CounObgAll=$CountObgAllNew @Goto %BeforPresentOverlay
$CounObgAll=$CounObgAll-1
@Goto %StartObgOverlayList
%BeforPresentOverlay
$ShapeObgCreate=@Map.Object[$CounObgAll].Parameter[0]
$ShapeObgCreate=@Calc Numeric(“$ShapeObgCreate”)
@If $ShapeObgCreate>$Dopusk @Goto %PresentOverlay
%NextOverlay
@Map.Undo.Undo
@Goto %StartObgOverlayList
%EndObgOverlayList
@Goto %StartObgList
%EndObgList
@Map.DeselectAll
@Progress.Stop
$TextListOverlay=@Text[3].Text
;Оцінюєм результат
@Map.EndUpdate
$CountLineOverlay=@Text[3].Count
@If $CountLineOverlay=0 @Break Не знайдено жодного перекриття полігонів за вказаними умовами пошуку.
;Пропонуйте, будь-ласка, що робити зі знайденими полігонами
$ResAsk=@Dialog.Select Перелік полігонів з перекриттям зформовано. Як оформити результат:|копіювати всі полігони, що перекриваються, на чисту карту|зберегти текстовий файл з переліком пар об’єктів що перекриваються|створити групи пар об’єктів, що перекриваються
@If “$ResAsk”=“копіювати всі полігони, що перекриваються, на чисту карту” then @Goto %ResAsk1
@If “$ResAsk”=“зберегти текстовий файл з переліком пар об’єктів що перекриваються” then @Goto %ResAsk2
;;Дописувати інші варіанти збереження результатів
@Break Функціональність недопрацьована
;
;Копіюєм всі полігони, що перекриваються, на чисту карту
%ResAsk1
$CountPresentOverlay=@Text[3].Count
$I3=0
%StartPresentOverlay
$I3=$I3+1
@If $I3>$CountPresentOverlay @Goto %EndPresentOverlay
$StrI3=@Text[3].Line[$I3]
$ObgOverlay1=@StringPart 1 $StrI3
$ObgOverlay2=@StringPart 2 $StrI3
@Map.Object[$ObgOverlay1].Select
@Map.Object[$ObgOverlay2].Select
@Goto %StartPresentOverlay
%EndPresentOverlay
@Map.Selected.Copy
;;Створюєм чисту карту
$MapName=@Map.ClearShortFilename
$NewMapName=$MapName-накладки
@FileNew $NewMapName
@Map.Paste
@Map.CalculateRange
@Dialog.Message В активній карті - лише ті полігони, що мають перекриття.|В карті $MapName - позначені полігони з накладкою.
@Window.ShowSelected
@Break
;
%ResAsk2
$CountPresentOverlay=@Text[3].Count
$I3=0
%StartPresentOverlayAsk2
$I3=$I3+1
@If $I3>$CountPresentOverlay @Goto %EndPresentOverlayAsk2
$StrI3=@Text[3].Line[$I3]
$ObgOverlay1=@StringPart 1 $StrI3
$ObgOverlay2=@StringPart 2 $StrI3
@Map.Object[$ObgOverlay1].Select
@Map.Object[$ObgOverlay2].Select
@Text[4].Add Об’єкт №$ObgOverlay1 перекривається з об’єктом №$ObgOverlay2
@Goto %StartPresentOverlayAsk2
%EndPresentOverlayAsk2
;;Записуєм текстовий файл
$MapName=@Map.ClearFilename
$FileNameOverlay=$MapName-накладки.txt
@Text[4].Save $FileNameOverlay
@Window.ShowSelected
$Text=@Text[4].Text
@Dialog.Message Знайдено:||$Text||Записано в файл $FileNameOverlay
@Break
;
;Перебираєм знайдені раніше перекриття, для уникнення повтору рядків з парами об’єктів
%PresentOverlay
$CountLineOverlay=@Text[3].Count
@If $CountLineOverlay=0 then @Text[3].Add $NumObg $NumObgOverlay
@If $CountLineOverlay=0 @Goto %NextOverlay
$I2=0
%StartLineOverlay
$I2=$I2+1
@If $I2>$CountLineOverlay then @Text[3].Add $NumObg $NumObgOverlay
@If $I2>$CountLineOverlay @Goto %NextOverlay
$TestStr=@Text[3].Line[$I2]
@If “$TestStr”=“$NumObgOverlay $NumObg” then @Goto %NextOverlay
@Goto %StartLineOverlay

Изменение указанного параметра для всех объектов заданного слоя во всех XML файлах в выбранной папке

Скрипт позволяет произвести массовую замену значения параметра на заданное значение во всех файлах в заданой папке. Список слоев и параметров загружается с указанного шаблона (в примере XMLNormal.dmf).

Если задан файл шаблона заполнения (csv), тогда значение параметра по умолчанию (оно высвечивается в диалоговом окне ввода значения) берется оттуда.

;шаблон для получения списка параметров
$UseTemplate=Templates\XMLNormal.dmf
;шаблон заполнения для получения значения параметра по умолчанию
$UseCSV=Templates\XML.csv
;искать файлы заданного типа
$Ext=.xml
$SourceDir=@Dialog.Ask Каталог исходных XML файлов Default=d:\Temp\Src
$DestDir=@Dialog.Ask Каталог результирующих XML файлов Default=d:\Temp\Dst
;открываем шаблон
@FileOpen $UseTemplate
;формируем список параметров шаблона
$Params=@Map.Parameters.List
$Layers=@Map.Layers.List
;закрываем шаблон
@FileClose
;выбираем слой в котором находятся интересующие объекты
$Layer=@Dialog.ListSelect Выберите слой|$Layers
$LayerId=@StringPart 1 $Layer
;выбираем параметр из списка параметров шаблона
$Param=@Dialog.ListSelect Выберите параметр|$Params
$ParamId=@StringPart 1 $Param
;
$ParamValue=
;из csv вытягиваем значение предлагаемое по умолчанию
$CSVFound=@FileExists $UseCSV
;csv шаблон не найден
@if $CSVFound=0 then @Goto %AskParamValue
@Text.Load $UseCSV
$N=@Text.Count
$I=1
$BlockFound=0
;в csv разделение колонок при помощи Tab
$Tab=@Calc Char(9)
$Tab=@DequoteText $Tab
;ищем строку вида -7 70005
;где -7 это номер параметра ID слоя
;70005 это значение параметра, то есть ID слоя
%CSVLoop
$S=@Text.Line[$I]
$P1=@StringPart 1$Tab$S
$P2=@StringPart 2$Tab$S
@if $P1= then @Goto %SkipRow
;убираем минус из -7 иначе Digitals сравнение рассматривает как арифм. выражение
$TempP1=@Calc Delete($P1,1,1)
;найден слой, соответствующий выбору пользователя
@if ($TempP1=7) and ($P2=$LayerId) then $BlockFound=1
@if ($BlockFound=0) or ($P1<>$ParamId) then @Goto %SkipRow
;найден параметр, соответствующий выбору пользователя
$N=@Calc Length($P1)
;удаляем первую часть строки - код параметра
$ParamValue=@Calc Delete(“$S”,1,$N+1)
;получаем значение параметра по умолчанию, считанное из csv
$ParamValue=@DequoteText $ParamValue
@Goto %AskParamValue
%SkipRow
$I=$I+1
@if $I<=$N then @Goto %CSVLoop
%AskParamValue
;
;значение параметра для заполнения в файлах
$Prompt=Введите значение параметра
@if $ParamValue= then @Goto %EnterParamValue
$Prompt=$Prompt|Значение по умолчанию взято из $UseCSV
%EnterParamValue
$ParamValue=@Dialog.Ask $Prompt Default=$ParamValue Size=450
;находим все файлы заданного типа в указанном каталоге
@Text.FolderList *$Ext $SourceDir
;проверяем или список пустой
$FileCount=@Text.Count
@If $FileCount=0 then @Break В папке “$SourceDir” отсутствуют файлы $Ext
;открываем файлы из списка по одному
$I=0
%MapLoop
$I=$I+1
@If $I>$FileCount then @Break
$F=@Text.Line[$I]
@FileOpen $F
;перебираем все объекты карты по одному
$ObjCount=@Map.Count
$J=0
%ObjLoop
$J=$J+1
@If $J>$ObjCount then @Goto %SaveMap
;пропускаем все объекты кроме нужного слоя
$ObjLayerId=@Map.Object[$J].LayerID
@if $ObjLayerId<>$LayerId then @Goto %ObjLoop
;меняем значение параметра объекта
@Map.Object[$J].Parameter[ID$ParamId]=$ParamValue
@Goto %ObjLoop
;сохраняем измененную карту
%SaveMap
$F=@Map.ClearShortFilename
@Map.SaveToFile $DestDir$F$Ext
@FileClose
;переходим к следующей карте
@Goto %MapLoop