Visio - Очень медленно отрабатывает функция SpatialNeighbo

All Forums

Категория Visio

Форум Вопросы и ответы

Очень медленно отрабатывает функция SpatialNeighbo

Author

Topic

LeoAbyss

Russia
20 Posts

Posted - 05/24/2010 : 10:29:35

Приветствую всех!
Подскажите, пожалуйста, по каким причинам может оооочень долго отрабатывать функция SpatialNeighbors? Ниже- сама функция:


Private Sub Binding(ByVal Shape As IVShape)

Dim intTolerance As Integer
Dim vsoReturnedSelection As Visio.Selection
Dim intSpatialRelation As VisSpatialRelationCodes

'Устанавливаем максимальное расстояние до рейки (дюймы)
intTolerance = Shape.Cells("Height") / 2

'Устанавливаем тип проверки - пересечение
intSpatialRelation = visSpatialOverlap

'ищем пересечения
Set vsoReturnedSelection = Shape.SpatialNeighbors(intSpatialRelation, intTolerance, 0)
'Если пересечений нет то:
If vsoReturnedSelection.Count = 0 Then

'Устанавливаем тип проверки - касание
    intSpatialRelation = visSpatialTouching
'ищем касания (с учетом максимального расстояния до рейки)
    Set vsoReturnedSelection = Shape.SpatialNeighbors(intSpatialRelation, intTolerance, 0)
'Если касаний нет то:
    If vsoReturnedSelection.Count = 0 Then
'Пока ничего не делаем

'Если касание есть то:
    Else
'Ищем имена шейпов с которыми соприкоснулись
        For Each vsoShapeOnPage In vsoReturnedSelection
'Если это рейка то:
            If Left(vsoShapeOnPage.Name, 21) = "Несущие шины TS 35/15" Then
'Находим ее координаты Y
                Set vsoPinY = vsoShapeOnPage.Cells("PinY")
'Если координаты рейки и объекта не совпадают то:
                If Shape.Cells("PinY").Formula <> vsoPinY Then
'Перемещаем объект на позицию рейки
                    Shape.Cells("PinY").Formula = vsoShapeOnPage.NameID & "!PinY"
                End If
            End If
        Next
    End If
'Если пересечения есть то:
Else
'Ищем имена шейпов с которыми пересекаемся
    For Each vsoShapeOnPage In vsoReturnedSelection
'Если это рейка то:
        If Left(vsoShapeOnPage.Name, 21) = "Несущие шины TS 35/15" Then
'Находим ее координаты Y
            Set vsoPinY = vsoShapeOnPage.Cells("PinY")
'Если координаты рейки и объекта не совпадают то:
            If Shape.Cells("PinY").Formula <> vsoPinY Then
'Перемещаем объект на позицию рейки
                Shape.Cells("PinY").Formula = vsoShapeOnPage.NameID & "!PinY"
            End If
        End If
    Next
End If
'Перемещаем объект на передний план
    Application.ActiveWindow.Selection.BringToFront
End Sub

На листе один объект (группа) "Несущие шины TS 35/15" и один объект (группа), на котором отрабатывается этот скрипт. Время выполнения скрипта - секунд 20. Машина серьезная.
Заранее спасибо за ответы.

LeoAbyss

Russia
20 Posts

Posted - 05/24/2010 : 10:36:26

Забыл добавить. Зависает на этой строчке:

Set vsoReturnedSelection = Shape.SpatialNeighbors(intSpatialRelation, intTolerance, 0)

Tumanov

Russia
1198 Posts

Posted - 05/24/2010 : 16:24:14

Никакие обработчики событий при перемещениях не могут сработать? Уверены, что функция запускается однократно?
Если предположить, что группы очень сложные, можно попробовать для эксперимента заменить шейпы на квадраты и оценить, изменится ли время.

LeoAbyss

Russia
20 Posts

Posted - 05/24/2010 : 18:37:54

Нет, никаких обработчиков больше нет. С квадратами все работает, хотя и не идеально, на мой взгляд. До секунды задержка бывает. Но и группы не монструозные, не больше 20 членов.

Tumanov

Russia
1198 Posts

Posted - 05/24/2010 : 19:24:13

А пришлите файлик на ttt@post.rzn.ru
Вдруг что разгляжу...

LeoAbyss

Russia
20 Posts

Posted - 05/26/2010 : 05:30:46

Приветствую всех.
С помощью господина Туманова удалось выяснить, что функция SpatialNeighbors непременима к группам с более или менее сложной структурой. Получается, что данная функция выполняется не для конкретной группы, а для всех входящих в нее членов. Вывод - для групп нужна своя функция. Этим я сейчас и займусь. Готовую функцию выложу.
Всем спасибо.

LeoAbyss

Russia
20 Posts

Posted - 05/26/2010 : 08:50:31

Как и обещал, выкладываю функцию привязки:


Private Sub Binding(ByVal Shape As IVShape)

Dim dblTolerance As Double
Dim BottomShift As Double
Dim TopShift As Double

'Устанавливаем максимальное расстояние до рейки (равно высоте шейпа)
dblTolerance = Shape.Cells("Height")
BottomShift = Shape.Cells("Height") - (Shape.Cells("Height") - Shape.Cells("LocPinY"))
TopShift = Shape.Cells("Height") - Shape.Cells("LocPinY")

'В цикле проверяем все шейпы на листе
For i = 1 To ActivePage.Shapes.Count
'Если шейп - рейка, то:
    If Left(ActivePage.Shapes.Item(i).Name, 21) = "Несущие шины TS 35/15" Then
'Если рейка расположена горизонтально, то:
        If (ActivePage.Shapes.Item(i).Cells("Angle") = 0) Or (Left(CStr(ActivePage.Shapes.Item(i).Cells("Angle")), 9) = "3,1415926") Then
'Если координаты рейки и шейпа не совпадают, то:
            If Shape.Cells("PinY") <> ActivePage.Shapes.Item(i).Cells("PinY") + ActivePage.Shapes.Item(i).Cells("Height") / 2 Then
'Если шейп ниже рейки, то
                If Abs((ActivePage.Shapes.Item(i).Cells("PinY") - Shape.Cells("PinY"))) = (ActivePage.Shapes.Item(i).Cells("PinY") - Shape.Cells("PinY")) Then
'Проверяем расстояние до рейки. Если входим в допуск, то:
                    If Abs(ActivePage.Shapes.Item(i).Cells("PinY") - (Shape.Cells("PinY") + TopShift)) <= dblTolerance Then
'Поворачиваем шейп
                        Shape.Cells("Angle").Formula = ActivePage.Shapes.Item(i).NameID & "!Angle"
'Вычисляем смещение шейпа относительно рейки по горизонтали
                        XShift = Shape.Cells("PinX") - ActivePage.Shapes.Item(i).Cells("PinX")
'Присваиваем шейпу координату рейки по вертикали
                        Shape.Cells("PinY").Formula = ActivePage.Shapes.Item(i).NameID & "!PinY+" & ActivePage.Shapes.Item(i).Cells("Height") / 2
'Присваиваем шейпу координату рейки по горизонтали со смещением
                        Shape.Cells("PinX").Formula = ActivePage.Shapes.Item(i).NameID & "!PinX+" & XShift
                    End If
'Шейп выше рейки
                Else
'Проверяем расстояние до рейки. Если входим в допуск, то:
                    If Abs(ActivePage.Shapes.Item(i).Cells("PinY") - (Shape.Cells("PinY") - BottomShift)) <= dblTolerance Then
'Поворачиваем шейп
                        Shape.Cells("Angle").Formula = ActivePage.Shapes.Item(i).NameID & "!Angle"
'Вычисляем смещение шейпа относительно рейки по горизонтали
                        XShift = Shape.Cells("PinX") - ActivePage.Shapes.Item(i).Cells("PinX")
'Присваиваем шейпу координату рейки по вертикали
                        Shape.Cells("PinY").Formula = ActivePage.Shapes.Item(i).NameID & "!PinY+" & ActivePage.Shapes.Item(i).Cells("Height") / 2
'Присваиваем шейпу координату рейки по горизонтали со смещением
                        Shape.Cells("PinX").Formula = ActivePage.Shapes.Item(i).NameID & "!PinX+" & XShift
                    End If
                End If
            End If
'Рейка расположена вертикально
        Else
'Если координаты рейки и шейпа не совпадают, то:
            If Shape.Cells("PinX") <> ActivePage.Shapes.Item(i).Cells("PinX") + ActivePage.Shapes.Item(i).Cells("Height") / 2 Then
'Если шейп правее рейки, то
                If Abs((ActivePage.Shapes.Item(i).Cells("PinX") - Shape.Cells("PinX"))) = (ActivePage.Shapes.Item(i).Cells("PinX") - Shape.Cells("PinX")) Then
'Проверяем расстояние до рейки. Если входим в допуск, то:
                    If Abs(ActivePage.Shapes.Item(i).Cells("PinX") - (Shape.Cells("PinX") + TopShift)) <= dblTolerance Then
'Поворачиваем шейп
                        Shape.Cells("Angle").Formula = ActivePage.Shapes.Item(i).NameID & "!Angle"
'Вычисляем смещение шейпа относительно рейки по вертикали
                        YShift = Shape.Cells("PinY") - ActivePage.Shapes.Item(i).Cells("PinY")
'Присваиваем шейпу координату рейки по горизонтали
                        Shape.Cells("PinX").Formula = ActivePage.Shapes.Item(i).NameID & "!PinX+" & ActivePage.Shapes.Item(i).Cells("Height") / 2
'Присваиваем шейпу координату рейки по вертикали со смещением
                        Shape.Cells("PinY").Formula = ActivePage.Shapes.Item(i).NameID & "!PinY+" & YShift
                    End If
'Шейп левее рейки
                Else
'Проверяем расстояние до рейки. Если входим в допуск, то:
                    If Abs(ActivePage.Shapes.Item(i).Cells("PinX") - (Shape.Cells("PinX") - BottomShift)) <= dblTolerance Then
'Поворачиваем шейп
                        Shape.Cells("Angle").Formula = ActivePage.Shapes.Item(i).NameID & "!Angle"
'Вычисляем смещение шейпа относительно рейки по вертикали
                        YShift = Shape.Cells("PinY") - ActivePage.Shapes.Item(i).Cells("PinY")
'Присваиваем шейпу координату рейки по горизонтали
                        Shape.Cells("PinX").Formula = ActivePage.Shapes.Item(i).NameID & "!PinX+" & ActivePage.Shapes.Item(i).Cells("Height") / 2
'Присваиваем шейпу координату рейки по вертикали со смещением
                        Shape.Cells("PinY").Formula = ActivePage.Shapes.Item(i).NameID & "!PinY+" & YShift
                    End If
                End If
            End If
            
            
        End If
    End If
Next

'Перемещаем объект на передний план
Application.ActiveWindow.Selection.BringToFront

End Sub

P.S. Пока не придумал, как сделать так, чтобы уже привязаный шейп поворачивался и перемещался вместе с рейкой. Координаты рейки не меняются. Подозреваю, что нужно копать в сторону преобразования локальных координат в координаты листа, но пока не докопал. :) Может кто подскажет?

Edited by - LeoAbyss on 05/26/2010 08:54:33

Tumanov

Russia
1198 Posts

Posted - 05/27/2010 : 15:57:21

quote:
P.S. Пока не придумал, как сделать так, чтобы уже привязаный шейп поворачивался и перемещался вместе с рейкой. Координаты рейки не меняются. Подозреваю, что нужно копать в сторону преобразования локальных координат в координаты листа, но пока не докопал. :) Может кто подскажет?

Возможно, нужный эффект получится, если в тех местах, где Вы записываете в ячейки абсолютные значения (взятые из ячеек рейки), записать формулы со ссылками на сами ячейки рейки. Тогда и координаты и угол поворота начнут отслеживать перемещение и поворот рейки.

LeoAbyss

Russia
20 Posts

Posted - 05/28/2010 : 05:48:49

Увы и ах. У меня как раз ссылки записываются. С углами все просто получается. А вот координаты... При повороте рейки ее координаты остаются неизменными. Она вращается вокруг своей "оси"...

Tumanov

Russia
1198 Posts

Posted - 05/28/2010 : 16:12:26

Ой, извиняюсь... :)
Ну там еще осталось углы учесть. Типа вот так:
'Присваиваем шейпу координату рейки по вертикали
Shape.Cells("PinY").Formula = ActivePage.Shapes.Item(i).NameID & "!PinY+" & ActivePage.Shapes.Item(i).Cells("Height") / 2 + XShift & "*Sin(Angle)"
'Присваиваем шейпу координату рейки по горизонтали со смещением
Shape.Cells("PinX").Formula = ActivePage.Shapes.Item(i).NameID & "!PinX+" & XShift & "*Cos(Angle)"

Topic

Данный сайт является архивом форума visio.artberg.ru, который был закрыт в связи с переходом на новую платформу visio.getbb.ru
Все материалы доступны только для чтения! Если у вас появились вопросы, или вы хотите что-то обсудить, связанное с Visio, обращайтесь на новый форум!
Архив был создан благодаря совместным усилиям Генадия Туманова @Tumanov (visio.artberg.ru), Александра ака @Surrogate (visio.getbb.ru), и Николая Белых @nbelyh (unmanagedvisio.com)