Аналитика http://geosystema.net/forum/ |
|
Библиотека полезных скриптов http://geosystema.net/forum/viewtopic.php?f=1&t=2539 |
Страница 2 из 15 |
Автор: | Bondarets Alexander [ 28 фев 2013 09:22 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Копирование значения заданного параметра из внешнего объекта из другой карты. Данный скрипт для помеченного объекта карты находит внешний объект в другой карте, копирует из внешнего объекта значение заданного параметра и присваивает его исходному объекту. Чтобы скрипт сработал, помеченный объект должен целиком попадать во внешний объект второй карты. Если таковой объект не найден, выдается соответствующее предупреждение и открытая карта не закрывается для анализа ошибки. ;путь к карте - источнику копируемого параметра $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 |
Автор: | Bondarets Alexander [ 01 мар 2013 17:10 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Трансформирование сканированных планшетов топокарт с обрезкой зарамочного оформления Скрипт выполняет трансформацию всех 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 Если расширять внутренние рамки не требуется, тогда скрипт значительно упрощается. |
Автор: | Bondarets Alexander [ 06 мар 2013 09:17 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Расчет суммарной площади всех выделенных объектов карты $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 установить разделить целой и дробной части - точка. |
Автор: | voha [ 16 мар 2013 22:07 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Знайти полігони з шарів зі стилем "тільки полігон" у статусі "правка", що частково/повністю накладаються на інші полігони того-ж шару, чи будь-яких шарів стилю "тільки полігон" у статусі "правка". Наведений скрипт - спроба компенсувати відсутність функції [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 |
Автор: | Bondarets Alexander [ 27 мар 2013 15:27 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Изменение указанного параметра для всех объектов заданного слоя во всех 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 |
Автор: | Bondarets Alexander [ 02 апр 2013 13:44 ] | ||
Заголовок сообщения: | Re: Библиотека полезных скриптов | ||
Перемещение выделенного ортогонального прямоугольника к двум точкам сверху и слева от него В карте выделяется прямоугольный объект, который требуется переместить и 2 точки слева и сверху от объекта. После выполнения скрипта прямоугольник смещается по осям X и Y, так что точки оказываются на его верхней и левой сторонах. Разделитель целой и дробной частей числа обязательно должен быть точка. Смотрите пример во вложении. $C=@Map.SelCount @If $C<>3 @Break Нужно пометить прямоугольник и 2 точки, к которым требуется переместить прямоугольник ; ;получаем индексы прямоугольника и 2-х точек $N=1 $Rect=0 $Pnt1=0 $Pnt2=0 %Start1 $C=@Map.Object[$N].Count @If ($C=5) and ($Rect=0) then $Rect=$N @If ($C=1) and ($Pnt1=0) then $Pnt1=$N @If ($C=1) and ($Pnt2=0) and ($Pnt1<>$N) then $Pnt2=$N $N=@Map.NextSelected $N @If $N>0 @Goto %Start1 @If ($Rect=0) or ($Pnt1=0) or ($Pnt2=0) then @Break Среди помеченных не найдены прямоугольник либо точки ; ;находим верхнюю и левую границы прямоугольника ;в карте не должно быть отрицательных координат! $Top=0 $Left=10000000 $N=1 %Start2 $P=@Map.Object[$Rect].Point[$N] $X=@StringPart 1 $P $Y=@StringPart 2 $P @If $X>$Top then $Top=$X @If $Y<$Left then $Left=$Y $N=$N+1 @If $N<5 @Goto %Start2 ; ;определяем какая точка выше $P1=@Map.Object[$Pnt1].Point[1] $X1=@StringPart 1 $P1 $Y1=@StringPart 2 $P1 $P2=@Map.Object[$Pnt2].Point[1] $X2=@StringPart 1 $P2 $Y2=@StringPart 2 $P2 ; ;находим векторы перемещения прямоугольника по X и по Y ;если первая точка выше @If $X1>=$X2 then $VX=$X1-$Top @If $X1>=$X2 then $VY=$Left-$Y2 ;если вторая точка выше @If $X1<$X2 then $VX=$X2-$Top @If $X1<$X2 then $VY=$Left-$Y1 ; ;перемещаем прямоугольник @Map.Undo.StartOperationGroup $N=1 %Start3 $P=@Map.Object[$Rect].Point[$N] $X=@StringPart 1 $P $Y=@StringPart 2 $P $Z=@StringPart 3 $P $X=$X+$VX $Y=$Y-$VY @Map.Object[$Rect].Point[$N] $X $Y $Z $N=$N+1 @If $N<=5 @Goto %Start3 @Map.RefreshObject $Rect @Window.Refresh
|
Автор: | Dmitry_Zolotar [ 08 апр 2013 15:05 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Заполнение параметра ID7001004 "Додаткова інформація" смежника в XML-файле, строками вида "від ... до ... - <название смежника>". Важно чтобы смежники в карте были в порядке возрастания "первой буквы". При открытии ранее сохраненного (версиями после 03.2013) XML-файла этот порядок достигается. ;счетчик для смежников $I=0 ;букаффки $Letters=АБВГДЄЕЖЗІИЙКЛМНОПРСТУФХватит ;кол-во объектов в карте $CN=@Map.Count ;кол-во объектов в слое XML_Суміжник $AC=@Map.Layers.ObjectCount ID70010 ;счетчик для смежников $CC=0 ;начало цикла %Loop ;номер следующего объекта $I=$I+1 ;находим ID слоя текущего объекта $LID=@Map.Object[$I].LayerID ;если не смежник, то идем дальше @if $LID<>70010 then @Goto %Continue ;найден новый смежник $CC=$CC+1 ;первая буква $FirstLetter=@Calc Copy("$Letters",$CC,1) $FirstLetter=@DequoteText $FirstLetter ;вторая буква $SecondLetter=@Calc Copy("$Letters",$CC+1,1) ;если последний смежник, то буква "А" @if $CC=$AC then $SecondLetter=@Calc Copy("$Letters",1,1) $SecondLetter=@DequoteText $SecondLetter ;получить название смежника используя формулу XMP(значение по умолчанию) $S=@Map.Object[$I].CalculateFormula XMP(Землі загального користування) ;присвоить значение параметру ID7001004 @Map.Object[$I].Parameter[ID7001004] <AdditionalInfoBlock><AdditionalInfo>від $FirstLetter до $SecondLetter - $S</AdditionalInfo></AdditionalInfoBlock> ;продолжаем для каждого объекта в карте %Continue @if $I<$CN then @Goto %Loop |
Автор: | Dmitry_Zolotar [ 18 апр 2013 14:34 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Извлечение в In4 всех участков в карте Скрипт извлекает в In4 все участки и записывает в рабочую папку(Сервис-Настройки-Главная-Рабочая папка по умолчанию). Удобен при большом кол-ве участков в карте тем что, в отличии от команды "Извлечь в ин4...", закрывает за собой окна и следит за дубляжем имен файлов. $Source=@ActivateMap @Map.DeselectAll $Count=@Map.Count $CurrentObject=0 %Loop $CurrentObject=$CurrentObject+1 $LID=@Map.Object[$CurrentObject].LayerID @if $LID<>20000 then @Goto %Continue @Map.SelectObject $CurrentObject Файл | Извлечь участок в In4 $Target=@ActivateMap $CurrObj=@Map.SelectedObject $FName=@Map.ClearFilename $Suffix=0 %NextSuffix $Suffix=$Suffix+1 $FFN=$FName @if $Suffix<>1 then $FFN=$FFN($Suffix) $FFN=$FFN.in4 $FE=@FileExists $FFN @if $FE<>0 then @Goto %NextSuffix %SaveIn4 @Map.SaveToFile $FFN @CloseMap $Target %Continue @ActivateMap $Source @Map.DeselectAll @if $CurrentObject<$Count then @Goto %Loop |
Автор: | Bondarets Alexander [ 25 апр 2013 10:45 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Вырезание объектов карты внутри заданных полигонов Скрипт получает от пользователя слой в котором находятся полигоны, по которым выполняется обрезка. Далее перебирает эти полигоны по одному и обрезает все объекты за пределами режущего полигона. Результат копируется в новую карту. Полигоны, по которым выполняется обрезка не должны быть сложными полигонами. ;выбираем слой с полигонами по которым выполняется обрезка $Layers=@Map.Layers.List $Layer=@Dialog.ListSelect Выберите слой с полигонами|$Layers $LayerId=@StringPart 1 $Layer ;запоминаем номер нашей карты $ThisMap=@ActivateMap ;создаем чистую карту без шаблона popTemplate | <Чистый> ;запоминаем ее номер $NewMap=@ActivateMap ;переключаемся в исходную карту @ActivateMap $ThisMap ;цикл по объектам заданного слоя $I=@Map.Count %Start $ObjLayerId=@Map.Object[$I].LayerId @if $ObjLayerId<>$LayerId then Goto %Continue ;выделяем полигон @Map.DeselectAll @Map.SelectObject $I ;обрезаем все объекты за пределами полигона Сервис | Обрезать по полигону/рамке ;копируем все объекты в буфер @Map.SelectAll @Map.Copy ;активируем результирующую карту @ActivateMap $NewMap ;вставляем объекты @Map.Paste ;возвращаемся в исходную карту @ActivateMap $ThisMap ;отменяем обрезку @Map.Undo.Undo %Continue $I=$I-1 @if $I>1 then Goto %Start ;переключаемся в результирующую карту @ActivateMap $NewMap @Map.DeselectAll Вид | Показать все |
Автор: | Laroc [ 05 июн 2013 11:53 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
добавил этот скрипт и открыл ІКК но он там нече не ищет,пишет участок не найден |
Автор: | Bondarets Alexander [ 07 авг 2013 08:40 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Laroc писал(а): добавил этот скрипт и открыл ІКК но он там нече не ищет,пишет участок не найден Нужен пример вашей ИКК. |
Автор: | Bondarets Alexander [ 07 авг 2013 08:45 ] | ||
Заголовок сообщения: | Re: Библиотека полезных скриптов | ||
Подписывание высот точек объектов Скрипт обрабатывает событие добавление точечного объекта, находит ближайший к добавленному объект карты и его ближайшую точку. Создает таблицу со значением высоты найденной ближайшей точки. %Events.OnCollect ;задайте здесь ID для слоя таблиц с подписями высоты $TableLayerID=ID1 $TableLayer=@Map.Layers.FindByID $TableLayerID @if $TableLayer=0 then @Break Layer with $TableLayerID not found ;номер только что собранного объекта $N=@EventObject ;берем первую точку этого объекта $P=@Map.Object[$N].Point[1] ;ищем ближайший к этой точке объект $FoundObj=@Map.NearestObject 50 $N $P @if $FoundObj=0 then @Break Nearest object not found ;удаляем только что собранный объект @Map.DeleteObject $N ;ищем ближайшую точку в ближайшем объекте $FoundPnt=@Map.NearestPoint $FoundObj 0 $P ;берем ее координаты $P2=@Map.Object[$FoundObj].Point[$FoundPnt] ;выделяем Z координату $Z=@StringPart 3 $P2 ;создаем таблицу с подписью высоты $TableObj=@Map.NewObject $TableLayer @Map.Object[$TableObj].Point[1] $P @Map.Object[$TableObj].TableText $Z @Map.RefreshObject $TableObj
|
Автор: | Bondarets Alexander [ 09 авг 2013 08:00 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Групповая обработка файлов в указанной папке. Выполнение команды совмещения точек. $Ext=*.dmf $SourceDir=@Dialog.SelectFolder Каталог исходных файлов $DestDir=@Dialog.SelectFolder Каталог результирующих файлов @Text.FolderList $Ext $SourceDir $C=@Text.Count @If $C=0 @Break В папке "$SourceDir" файлы $Ext не найдены %Start $FileName=@Text.Line[$C] @FileOpen $FileName @Map.SelectAll Правка | Совместить с соседними $FileName=@ExtractFileName $FileName @Map.SaveToFile $DestDir\$FileName @FileClose $C=$C-1 @if $C>0 then @Goto %Start Команды обработки выделены в скрипте жирным и могут быть заменены любыми другими командами. |
Автор: | Bondarets Alexander [ 09 авг 2013 08:38 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Перевод в верхний регистр букв в значении заданного параметра во всех объектах карты. $ParamNumber=1 $C=@Map.Count @if $C=0 then @Break %Start $S=@Map.Object[$C].Parameter[$ParamNumber] $S=@UpperCase $S @Map.Object[$C].Parameter[$ParamNumber] $S @Map.RefreshObject $C $C=$C-1 @Window.Refresh |
Автор: | voha [ 09 авг 2013 10:12 ] |
Заголовок сообщения: | Re: Библиотека полезных скриптов |
Приведення шарів карти в плановість згідно переліку назв шарів у текстовому файлі \Digitals\Templates\PlanLay.txt. Список назв шарів має бути сортований в порядку бажаного розміщення їх (від нижнього плану до верхнього). $MapExist=@MapCount @If $MapExist=0 then @Break Відкрийте карту для приведення її до порядку плановості шарів $FilFold=@ProgramPath $FilFold=$FilFold\Templates\PlanLay.txt $ExistFile=@FileExists $FilFold @If $ExistFile=0 then @Break Не знайдено довідника плановості шарів||Відсутній файл $FilFold $Worker=@Dialog.Confirm Скрипт виконає приведення карти до порядку плановості шарів|згідно файла $FilFold||Продовжити? @If $Worker=0 @Break @Map.BeginUpdate @Map.DeselectAll @Text[1].Load $FilFold $CountLinText=@Text[1].Count $NLin=1 %StartLine $Lay=@Text[1].Line[$NLin] @Map.FindByParameters 1|-5=$Lay @Map.Selected.BringToFront $NLin=$NLin+1 @If $NLin<=$CountLinText @Goto %StartLine @Map.CancelUpdate @Map.DeselectAll @Map.CalculateRange @Window.Refresh |
Страница 2 из 15 | Часовой пояс: UTC + 2 часа |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |