Добрый день итак продолжим начатую тему по изменению координат и их последствиях. Сегодня я расскажу про задачу, которую мне пришлось недавно решать, которая может возникнуть в процессе привязки.
Каким-то образом у Вас появились два слоя: полигоны и их центроидов- точек. Атрибутика находится в точечных объектах. Достаточно неудобно. Во-первых приходится хранить два слоя, во вторых неудобно отображать информацию. Например, разокрасить полигоны в зависимости от значений.
Итак задача:
1)необходимо каждому полигону сопоставить точечный объект с атрибутивной информацией, т.е. записать уникальный номер точки в таблицу полигона. В моём случае это было поля Name. две таблицы pk-с точечными объектами и gk- полигоны.
2) в случае если точки сдвинулись по каким-то причинам: вышли за пределы полигона, уточнить. Т.е. если на территории одного полигона находятся не одна точка, то подкорректировать. Такие полигоны, к котрым добавить атрибутику автоматически не удалось, выделяются красным цветом. Для этого в меню "MY" создаются две команды "Select poly" и "Add info", которые работают следующим образом: Вы Выбираете красный полигон, нажимаете "Select poly"(ctrl+1) затем выбираете соответствующий ему точечный объект, нажимаете "ADD Info" (ctrl+2). Значение колонки Name таблицы pk записывается в соответствующее поле Name таблицы gk.
Я эту задачку решал на MapBasic.
Ниже приводится пример скрипта. Т.к. скрипт я писал для себя то не делал проверки, "защиту от дурака".
Include "mapbasic.def" 'включаем стандартные переменные
Declare Sub FromPkToGk
Declare Sub DrawMap
Declare Sub Create_Menu
Declare Sub Select_Button_On
Declare Sub Point_Button_On
Declare Sub myExit
Declare Sub main
'=====================================
Sub FromPkToGk 'автоматическое сопоставление полигонов и точек
Dim oPk, oGk as Object
Dim nRow as Integer
Dim sPop as String
Dim iUser_Id, iName as Integer
'здесь путь к вашим таблицам. Можно использовать
'ApplicationDirectory$()+"\file_name", тогда таблицы и макрос должны быть
' в одной папке
open table "d:\work\test\pk" as pk
open table "d:\work\test\gk" as gk
Fetch first from gk
nRow=1
Do While Not EOT(gk)
Select * from Gk Where RowID = nRow Into tCurGk
oGk=tCurGk.obj
Select * From pk Where obj within oGk Into Work_Table
'проверка чтобы каждой точке соответствовал один полигон
If TableInfo("Work_Table",TAB_INFO_NROWS)=1 Then
iName= Work_Table.Name
update tCurGk
Set Name=iName
End If
nRow=nRow+1
Fetch Next From gk
Loop
End Sub
'==================================Exit========
Sub myExit 'закончить работу программы
End Program
End Sub
'================================== Menu и комбинации клавиш
Sub Create_Menu
Create Menu "MY" As
"SELECT_POLY" + Chr$(9) + "CTRL+1/W^%49" Calling Select_Button_On,
"ADD Info From POINT" + Chr$(9) + "CTRL+2/W^%50"Calling Point_Button_On,
"(-",
"Exit" Calling myExit
Alter Menu Bar Add "MY"
End sub
'=============== Выбираем полигон и запоминаем в таблицу tWork
Sub Select_Button_On
select * From Selection Into tWork
End Sub
'=============================сопоставляем полигону точечный объект
Sub Point_Button_On
Dim iName as Integer
select * From Selection Into tPoint
iName=tPoint.Name
update tWork
Set Name=iName
commit table tWork
Select * From gk Where Name=0 Into tWork
set map redraw off
Add Map Layer tWork Set Map Order 2,1,3
'когда Вам лень думать как делать, иногда помогает окно MapBasic в котором
'отображаются выполняемые команды. Берёте их и копируете. Так, например, я
'получил следующую строку. И ведь работает!!! :)
Set Map Layer 2 Display Global Zoom (0, 100000) Units "m" Off Editable Off Selectable On Global Line (1,2,0) Global Pen (1,2,0) Global Brush (2,16732240,16777215) Global Symbol (35,0,12) Global Font ("Arial Cyr",0,9,0) Label Line None Position Center Font ("Arial Cyr",0,9,0) Pen (1,2,0) With USER_ID Parallel On Auto Off Overlap Off PartialSegments Off Duplicates On Offset 2 Max Visibility On Nodes Off Arrows Off Centroids Off
set map redraw on
End Sub
'==================
Sub DrawMap 'находим все безымянные полигоны и разокрашиваем их красным цветом
Select * From gk Where Name=0 Into tWork
Map From pk, tWork, gk max
Set Map Layer 2 Display Global Global Brush (2,16732240,16777215)
set map redraw on
End Sub
'===========================================Main=====
Sub main 'главная процедура, которая выполняется при запуске.
call Create_Menu
call FromPkToGk
Call DrawMap
End Sub
'======================КОНЕЦ==========================
Возможно, если у Вас будет похожая задача, то придётся параллельно выполнить:
замыкание полилиний, создание полигонов из полилиний, редактирование таблиц, …
Если будет кому-то это интересно- напишу, но всё это есть в хелпе.
С уважением.
Дмитрий Суворов.
sdm98"собачка"mail.ru