Знайти полігони з шарів зі стилем “тільки полігон” у статусі “правка”, що частково/повністю накладаються на інші полігони того-ж шару, чи будь-яких шарів стилю “тільки полігон” у статусі “правка”.
Наведений скрипт - спроба компенсувати відсутність функції [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