Форум пользователей Visio

Форум по вопросам применения и программирования в Visio
Текущее время: 29 мар 2024, 00:39

Часовой пояс: UTC + 3 часа [ Летнее время ]


Правила форума


При размещении файлов предпочтительным является формат vsd (а не vsdx/vsdm)
Размещая ваши вложения на форуме не используйте имена файлов содержащих кириллицу, в противном случае файл будет иметь имя .<расширение файла> !

Для форматирования ваших сообщений используйте BBCodes, описание используемых на форуме BBCodes.



Начать новую тему Ответить на тему  [ Сообщений: 7 ] 
Автор Сообщение
 Заголовок сообщения: Как вернуть шейп на исходный слой после операции объединения
СообщениеДобавлено: 17 авг 2015, 14:13 
Не в сети
Новичок

Зарегистрирован: 10 ноя 2014, 17:01
Сообщений: 39
Использую Visio c: 2002
Уровнь квалификации: Shapesheet, Программирование, VB6, VBA
Очков репутации: 9

Добавить очки репутацииУменьшить очки репутации
Коллеги, подскажите решение следующей задачки:
На плане здания на разных слоях лежат сгруппированные шейпы. Каждый из них (но не все, а лишь по определенному признаку, в частности по имени мастера) надо объединить и поместить на первоначальный слой. Собственно задачку решил, вот только не могу найти способа определить ID вновь образованного шейпа, чтобы положить его на нужный слой. Надеюсь на вашу помощь. В качестве примера выбран мастер "Дверь" (см. код).

Код:
Sub Test()
1   On Error GoTo Err_Export
2   Dim ShpCnt As Integer, Shp As Visio.Shape, ShpLayCnt As Integer, ShpLayName As String, _
        ShpLay As Visio.Layer, LayNum As String, NewShpCnt As Integer, NewShp As Visio.Shape, _
        Sel As Visio.Selection, ShpName As String, LenName As Integer, SelCnt As Integer, _
        ShpIDs() As Long, ShpID As Long
3   ShpName = "Дверь": LenName = Len(ShpName)
4   For ShpCnt = Application.ActivePage.Shapes.Count To 1 Step -1
5       Set Shp = Application.ActivePage.Shapes.Item(ShpCnt)
6       If Shp.Master Is Nothing Then GoTo NextShp
7       If Left(Shp.Master.Name, LenName) = ShpName Then
8          ShpLayCnt = Shp.LayerCount
9          If ShpLayCnt = 1 Then
10            ShpLayName = Shp.Layer(1).Name
11            Set ShpLay = Application.ActivePage.Layers.ItemU(ShpLayName)
12            LayNum = Application.ActiveWindow.Page.Shapes.ItemFromID(Shp.ID). _
                       CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU
13            Application.ActiveWindow.Select _
              Application.ActivePage.Shapes.ItemFromID(Shp.ID), visDeselectAll + visSelect
14            Application.ActiveWindow.Selection.Combine
15            SelCnt = Application.ActiveWindow.Selection.Count: Debug.Print SelCnt

              'Set Sel = Application.ActiveWindow.Selection
              'Call Sel.GetIDs(ShpIDs): ShpID = UBound(ShpIDs): Debug.Print ShpID
             
              'Set NewShp = Application.ActivePage.Shapes.Item(ShpID): Debug.Print NewShp.ID
              'ShpLay.Add NewShp, 1
             
16            'Application.ActivePage.Shapes.ItemFromID(ShpID). _
              AddRow visSectionObject, visRowLayerMem, visTagDefault
17            'Application.ActivePage.Shapes.ItemFromID(ShpID). _
              CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaForceU = LayNum
18         End If
19      End If
NextShp:
20  Next
21  Set NewShp = Nothing: Set Sel = Nothing: Set ShpLay = Nothing: Set Shp = Nothing
22  Application.ActiveWindow.DeselectAll
23  Exit Sub
Err_Export:
24  MsgBox "Line: " & Erl() & vbCrLf & Err.Description & vbCrLf & _
           "Shape ID: " & Shp.ID, vbExclamation + vbOKOnly, _
           "Error!"
End Sub


Вложения:
Test.vsd [1.05 Mб]
Скачиваний: 149
Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Как вернуть шейп на исходный слой после операции объединения
СообщениеДобавлено: 17 авг 2015, 15:44 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 939
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 127

Добавить очки репутацииУменьшить очки репутации
DarkSide писал(а):
вот только не могу найти способа определить ID вновь образованного шейпа

я делал так:
на момент операций с шейпами, когда должен быть образован новый шейп, включаю обработчик событий на уровне приложения или документа _ShapeAdded. ловлю событие, определяю ID шейпа и отключаю обработчик.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Как вернуть шейп на исходный слой после операции объединения
СообщениеДобавлено: 17 авг 2015, 16:43 
Не в сети
Новичок

Зарегистрирован: 10 ноя 2014, 17:01
Сообщений: 39
Использую Visio c: 2002
Уровнь квалификации: Shapesheet, Программирование, VB6, VBA
Очков репутации: 9

Добавить очки репутацииУменьшить очки репутации
Спасибо! Буду пробовать.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Как вернуть шейп на исходный слой после операции объединения
СообщениеДобавлено: 17 авг 2015, 19:17 
Не в сети
Administrator

Зарегистрирован: 30 авг 2009, 11:02
Сообщений: 2253
Очков репутации: 100626

Добавить очки репутацииУменьшить очки репутации
Через Selection тоже наверное можно определить. Там ведь должен быть только один шейп - результат операции.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Как вернуть шейп на исходный слой после операции объединения
СообщениеДобавлено: 17 авг 2015, 19:40 
Не в сети
Новичок

Зарегистрирован: 10 ноя 2014, 17:01
Сообщений: 39
Использую Visio c: 2002
Уровнь квалификации: Shapesheet, Программирование, VB6, VBA
Очков репутации: 9

Добавить очки репутацииУменьшить очки репутации
Я, как раз, через Selection и хочу сделать, только пока не нашел как.


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Как вернуть шейп на исходный слой после операции объединения
СообщениеДобавлено: 17 авг 2015, 19:51 
Не в сети
Ветеран

Зарегистрирован: 21 окт 2011, 12:01
Сообщений: 939
Откуда: г. Екатеринбург
Использую Visio c: 2011
Очков репутации: 127

Добавить очки репутацииУменьшить очки репутации
если через Selection то:
id=ActiveWindow.Selection(1).ID (или .NameID)


Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
 Заголовок сообщения: Re: Как вернуть шейп на исходный слой после операции объединения
СообщениеДобавлено: 18 авг 2015, 13:32 
Не в сети
Новичок

Зарегистрирован: 10 ноя 2014, 17:01
Сообщений: 39
Использую Visio c: 2002
Уровнь квалификации: Shapesheet, Программирование, VB6, VBA
Очков репутации: 9

Добавить очки репутацииУменьшить очки репутации
9rey и Tumanov, спасибо!
Совсем позабыл о такой замечательной конструкции: id=ActiveWindow.Selection(1).ID
Макрос допилил, все работает замечательно. Выкладываю окончательный код (кому интересно).
Код:
Sub Union_Shape()
1   On Error GoTo Err_Export
2   Dim ShpName As String, LenName As Integer, N As Integer, ShpCnt As Integer, _
        Shp As Visio.Shape, ShpLayCnt As Integer, LayNum As String, ShpID As Long, _
        strID As String
3   ShpName = InputBox("Введи Имя Мастера Шейпа", _
                       " Объединение Сгруппированных Шейпов:")
4   If ShpName = "" Then Exit Sub
5   LenName = Len(ShpName): N = 0: strID = ""
6   Application.ScreenUpdating = False
7   For ShpCnt = Application.ActivePage.Shapes.Count To 1 Step -1
8       Set Shp = Application.ActivePage.Shapes.Item(ShpCnt)
9       If Shp.Master Is Nothing Then GoTo NextShp
10      If Not Shp.Type = visTypeGroup Then GoTo NextShp
11      If Left(Shp.Master.Name, LenName) = ShpName Then
12         ShpLayCnt = Shp.LayerCount
13         If ShpLayCnt = 1 Then
14            LayNum = Application.ActiveWindow.Page.Shapes.ItemFromID(Shp.ID). _
                       CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaU
15            Application.ActiveWindow.Select _
              Application.ActivePage.Shapes.ItemFromID(Shp.ID), visDeselectAll + visSelect
16            Application.ActiveWindow.Selection.Combine
17            ShpID = Application.ActiveWindow.Selection(1).ID ': Debug.Print ShpID
18            Application.ActivePage.Shapes.ItemFromID(ShpID). _
              CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaForceU = LayNum
19         Else
20            N = N + 1: strID = strID & " " & Shp.ID
21         End If
22      End If
NextShp:
23  Next
24  Set Shp = Nothing
25  Application.ActiveWindow.DeselectAll
26  Application.ScreenUpdating = True
27  If N > 0 Then MsgBox N & " - шейп(а,ов)" & vbCrLf & _
                        "на нескольких слоях!" & vbCrLf & _
                        "Shape ID:" & strID, vbExclamation + vbOKOnly, _
                        "Внимание!"
28  Exit Sub
Err_Export:
29  MsgBox "Line: " & Erl() & vbCrLf & Err.Description & vbCrLf & _
           "Shape ID: " & Shp.ID, vbExclamation + vbOKOnly, _
           "Error!"
End Sub



Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 7 ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 11


Вы можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Вы можете создать форум бесплатно PHPBB3 на Getbb.Ru, Также возможно сделать готовый форум PHPBB2 на Mybb2.ru
Русская поддержка phpBB