грубенько по точкам провести линию
потом
создать новый скрипт и повесить его на кнопку инструменты в виде.
'Theme.SnapToThemeTool
'Подтягивание вершин полигонов и линий (из редактируемой темы), а также точек к другим темам (активным)
'в том порядке, в котором они расположены в виде (самая верхняя - самая первая)
'используется на Apply в инструментах, рекомендуемое название Theme.SnapToThemeTool
theView= av.GetActiveDoc
WorkTheme= theView.GetEditableTheme
if (WorkTheme = nil) then
msgbox.error("Нет открытой на редактирование темы","")
return nil
end
ActiveThemes= theView.GetActiveThemes
ActiveTheme1= ActiveThemes.Get(0)
if ((ActiveTheme1 = WorkTheme) and (ActiveThemes.Count<=1)) then
msgbox.error("Не к чему подтягивать,"+NL+"выберите активную тему"+NL+"отличную от редактируемой","Открытая и активная тема совпадают")
return nil
end
ListOfPoints= {}
for each aTheme in ActiveThemes
if (aTheme = WorkTheme) then continue end
ActiveFTab= aTheme.GetFTab
fldShape= ActiveFTab.FindField("shape")
isPoints= fldShape.GetType = #FIELD_SHAPEPOINT
for each rec in ActiveFTab
if (isPoints) then ListOfPoints.Add(aTheme.GetFTab.ReturnValue(fldShape, rec))
else ListOfPoints= ListOfPoints + aTheme.GetFTab.ReturnValue(fldShape, rec).asMultipoint.asList
end
end
end
UserCircle= theView.ReturnUserRect
WorkFTab= WorkTheme.GetFTab
fldShape= WorkFTab.FindField("shape")
WorkFTab.BeginTransaction
if (fldShape.GetType = #FIELD_SHAPEPOINT) then
' WorkFTab.SelectByPoint(UserCircle.ReturnCenter, UserCircle.GetRadius ,#VTAB_SELTYPE_NEW)
WorkFTab.SelectByRect(UserCircle,#VTAB_SELTYPE_NEW)
Selection= WorkFTab.GetSelection
if (Selection.Count>1) then msgbox.error("Выбрано более одной точки","")
return nil
end
newPoint= nil
for each testPoint in ListOfPoints
if (UserCircle.Contains(testPoint)) then
newPoint= testPoint 'нашли
break 'выходим, одной (первой) точки достаточно
end
end
if ((newPoint = nil).not) then
if (Selection.Count=0) then
if (msgbox.MiniYesNo("Точка не найдена, добавить?", true)) then
WorkFTab.SetValue(fldShape, WorkFTab.AddRecord, newPoint) end
else WorkFTab.SetValue(fldShape, Selection.GetNextSet(-1), newPoint)
end
end
else 'Линейная или полигональная тема
for each rec in WorkFTab
Flag= false 'были-ли изменения
apolygon= WorkFTab.ReturnValue(fldShape, rec)
if ((apolygon.Intersects(UserCircle)).not or (apolygon.asMultipoint.Intersects(UserCircle)).not) then continue end
'если пересекается с полигоном/линией в одной из вершин
'прогоняем каждую вершину на совпадение с активными темами
ListOfList= {} 'Для хранения списка списков
for each object in apolygon.asList
ListOfNewPoints= {} 'переделанные точки для полигона/линии
numPoint= 0 'для отслеживания количества точек
if (fldShape.GetType = #FIELD_SHAPEPOLY) then PointsCount= object.Count-2 'для полигонов
else PointsCount= object.Count-1 'для линий
end
for each thePoint in 0..(PointsCount)
newPoint= object.get(thePoint)
if (UserCircle.Contains(newPoint)) then 'для найденой точки проверяем есть-ли совпадения со списком привязочных точек
for each testPoint in ListOfPoints
if (UserCircle.Contains(testPoint)) then
newPoint= testPoint 'нашли
numPoint= numPoint+1
Flag= true
break 'выходим, одной (первой) точки достаточно
end
end
end
ListOfNewPoints.Add(newPoint) 'составляем из точек новый полигон/линию
end
if (numpoint>1) then 'Несколько (numpoint) точек сошлись в одну
if (apolygon.asList.count>1) then 'полигон/линия состоит из нескольких частей
msgbox.report("Не все точки могли обработаться в полигоне/линии!"+NL+
"прична: объект состоит из нескольких подобъектов, в которых выбрано более одной вершины"
,"настоятельно рекомендуется отменить")
else msgbox.error("Вы выбрали более 1-й точки ("++numPoint.asString++")","попробуйте ещё раз")
end
ListOfList.Add(object)
else ListOfList.Add(ListOfNewPoints) 'добавляем Полученный полигон к списку полигонов в одной записи
end
end
if (Flag) then 'Преобразования произошли
if (fldShape.GetType = #FIELD_SHAPEPOLY) then WorkFTab.SetValue(fldShape, rec, Polygon.Make(ListOfList))
else WorkFTab.SetValue(fldShape, rec, PolyLine.Make(ListOfList))
end
end
end
end
WorkFTab.EndTransaction
WorkFTab.UpdateSelection
theView.Invalidate
av.GetProject.SetModified(true)
инструмент выполняет привязку вершины или точки редактируемой темы к вершинам или точкам всех активных тем.
повторим
активная тема или темы - к чему привязывать
редактируемая - что привязывать.
инструментом (подобно черной стрелочке) прямоугольником выделить
вершину линии и точку, к которой привязаться.
выделять поочередно по одной вершине.
Не стреляйте в пианиста, играет, как умеет.
