tariel
Зарегистрирован: 26.09.2005
Сообщения: 72
Откуда: г.Орск Оренбургская обл.
|
 Добавлено: Ср 13 Авг 2008 11:31 Заголовок сообщения: Ошибка в модуле автозаполнения семантики |
 |
|
Здравствуйте Все!
работал модуль автозаполнения семантическими данными из таблиц , заполнял координатами подписи точек
3Автозаполнение семантики поворотные точки Град план
| Код: |
option explicit
' слой поворотные точки карта Градостроительный план
const AutoFillLayerID = "001D00093147"
const AutoFillTableID = "001D00093150"
const AutoFillStyleID = "001D0009314F"
const XFieldName = "X"
const YFieldName = "Y"
const DecimalCount = 3
function GetCoordinates(aMapObject, byref X, byref Y)
dim Shape
for each Shape in aMapObject.Shapes
if Shape.StyleID = AutoFillStyleID then
if Shape.Contour.Count > 0 then
dim Part
set Part = Shape.Contour(0)
if Part.VertexCount > 0 then
dim C
Part.sGetVertex 0, X, Y, C
GetCoordinates = True
exit function
end if
end if
end if
next
GetCoordinates = False
end function
function NeedUpdateData(MapObjectID)
NeedUpdateData = (ActiveDb.MapObjects.LayerIDFromObjectID(MapObjectID) = AutoFillLayerID)
end function
sub UpdateObjectData(MapObjectID)
if not NeedUpdateData(MapObjectID) then
exit sub
end if
dim MapObjects, MapObject
set MapObjects = ActiveDb.MapObjects
set MapObject = MapObjects.GetObject(MapObjectID)
dim X,Y
if not GetCoordinates(MapObject, X, Y) then
exit sub
end if
dim SemTableName
SemTableName = ActiveDb.SemTableFromID(AutoFillTableID).Name
X = round(X, DecimalCount)
Y = round(Y, DecimalCount)
MapObject.SemData.SetValue SemTableName, XFieldName, X, 0
MapObject.SemData.SetValue SemTableName, YFieldName, Y, 0
MapObjects.UpdateChanges
end sub
' Вызывается после обновлением пространственного объекта
sub DbMapObjects_UpdateComplete(aMapObjectID, aMy)
if aMy then
UpdateObjectData(aMapObjectID)
end if
end sub
' Вызывается после создания пространственного объекта
sub DbMapObjects_CreateComplete(aMapObjectID, aMy)
if aMy then
UpdateObjectData(aMapObjectID)
end if
end sub |
при создании точки мигает несколько секунд курсор потом выдает :
Недостаточно места в стеке:"NeedUpdateData"
тоже самое при пририсовывании самой подписи ..
но после отбивания по ESC объект всё же создан.
скопировал слой проводником ... без модуля на чисто создается все ровно ! скопировал модуль переписал
const AutoFillLayerID = "001D00093147"
const AutoFillTableID = "001D00093150"
const AutoFillStyleID = "001D0009314F"
на новый слой и всё повторяется .... прошу помощи! |
|
FAQ
Поиск
Пользователи
Группы
Регистрация
Профиль
Войти и проверить личные сообщения
Вход
