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

Все эти средства есть в дополнении Enterprise Networks Tools стоимостью около $1000. Говорят, что размещение получается не всегда оптимальным, но это легко исправляется.

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

Как визуализировать информацию из базы данных?

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

Принципы визуализации следующие:

1. У вас должен быть заготовлен трафарет с нужными мастер-шейпами. В простейшем случае это Basic Network, в более сложных их существуют десятки для самых разнообразных сетевых устройств. Мастер-шейпы на трафарете адресуются по именам или индексам.

2. Из базы выбирается очередная строка; там должно быть имя или индекс имеющегося мастер-шейпа. Берется нужный мастер и укладывается на страницу рисунка.

3. Точно также берется и укладывается коннектор.

4. Каждый конец коннектора подцепляется к нужным точкам.

И так далее по всей базе. А вот иллюстрация (работа с базой опущена). Здесь рисуются два узла сети. Причем в данном случае трафарет Basic Network Shapes 3D.vss считается уже открытым (вручную). Это можно записать в качестве макроса и выполнить.

Sub Example()

'предположим нужно разместить сервер и рабочую станцию

'Цепляемся за открытый! трафарет Basic Network Shapes 3D.vss, чтобы можно было

оперировать его шейпами

Set stnObj = Documents("Basic Network Shapes 3D.vss")

'Выбираем с трафарета шейп с именем Server (там такой есть)

Set mastObj = stnObj.Masters("Server")

'Сажаем его под именем shpObj1 в точку с координатами 2, 10 на активную старницу

Set shpObj1 = ActivePage.Drop(mastObj, 2, 10)

'Подпишем его

shpObj1.Text = "Хороший сервер"

'Поблизости делаем рабочую станцию из мастер-шейпа Workstation

Set mastObj = stnObj.Masters("Workstation")

Set shpObj2 = ActivePage.Drop(mastObj, 5, 8)

shpObj2.Text = "Так себе станция"

'Теперь нужно добавить коннектор. Берем для этой цели Bottom to Top Angled

Set mstObjConnector = stnObj.Masters("Bottom to Top Angled")

Set shpObjConnector = ActivePage.Drop(mstObjConnector, 0, 0)

'Прячем его, чтобы не перекрывал основные шейпы

shpObjConnector.SendToBack

'И подсоединяем началом к серверу

shpObjConnector.Cells("BeginX").GlueTo shpObj1.Cells("Connections.X1")

'а концом к рабочей станции

shpObjConnector.Cells("EndX").GlueTo shpObj2.Cells("Connections.X1")

End Sub

Цвет и толщина Network connector

Еще один вопрос: как программно можно изменить цвет и толщину Network connector который находится в Stencil Logical Symbols?

Цвет линии программно меняется в ячейке LineColor. В простейшем случае туда подставляются номера цветов из палитры, которая высвечивается в меню Format/Line/Color. Например, красный цвет имеет индекс 2. Толщина меняется в ячейке LineWeight. По умолчанию она устанавливается в дюймах (0,01 in - примерно 3 pt).

Применительно к предыдущему примеру для утолщения коннектора в три раза и окраски его в красный цвет нужно добавить

shpObjConnector.Cells("LineColor") = 2

shpObjConnector.Cells("LineWeight") = 0.01

Примечание. Если этот коннектор вам всегда будет нужен какой-то определенной толщины, может проще изменить его прямо в трафарете, тогда не нужно будет делать это для каждого экземпляра программно. Для этого трафарет открывается для редактирования, выполняется Edit Master, устанавливается нужная толщина и цвет или только толщина и сохраняется. Теперь этот коннектор будет перетаскиваться уже в нужном виде. Если нужно установить толщину в других единицах измерения, то используется конструкция shpObjConnector.Cells("LineWeight").Formula = "2 pt"

Как описать функию, которая возвращала бы объект Visio.Shape?

Осталась одна маленькая загвоздка: можно ли как-нибудь описать функцию, которая возвращала бы объект Visio.Shape?

Например, вот так:

Public Function SetupRouter(docObj As Visio.Document, pagObj As Visio.Page, name

As String) As Visio.Shape

Dim mastObj As Visio.Master

Dim x As Double

Dim y As Double

x = 4.25

y = 9

Set mastObj = docObj.Masters("Router")

Set SetupRouter = pagObj.Drop(mastObj, x, y)

SetupRouter.Text = name

End Function

Как можно объявить массив шейпов

Как можно объявить массив шейпов, и почему не работает вот это:

Dim shpRouters() As Visio.Shape

...........

Set pagsObj = ThisDocument.Pages

Set pagObj = pagsObj.Item(1)

Set stnObj = Documents.Add("Logical Symbols.vss")

Set mastObj = stnObj.Masters("Router")

Set shpRouters(1) = pagObj.Drop(mastObj, 4.25, 9) ?

Причем маршрутизатор он на страницу помещает, а вот двигать его в соответствии с координатами не хочет.

Это не работает, потому что здесь размерность массива нужно объявлять. По умолчанию не работает. Достаточно поставить Dim shpRouters(10) As Visio.Shape и ваш код уже выполняется. А насчет координат. У меня маршрутизатор и так размещается где надо. Только 4.25 и 9 Visio отсчитывает в дюймах и от левого нижнего угла рисунка. Может это вас сбивает?

Как создать документ Visio?

Как создать документ Visio из других приложений (например Excel)? Задача: Создать ( или открыть ) документ Visio из другого приложения. ( Excel, FoxPro и т.д.). Проходит команда CreatObject("Visio.Drawing.6"). А дальше ???

Вот пример, создающий рисунок Visio с привычной надписью "HelloWorld"

Берется Excel, вставляется в него этот макрос, (в VBA проекте нужно также не забыть подключить библиотеку типов Visio), запускается на выполнение.

Макрос создает экземпляр Visio, создает документ на основе шаблона Basic Diagram.vst (при этом открываются и соответствующие трафареты), перетаскивает с трафарета мастер-шейп Rectangle (квадрат) и вписывает в него текст "HelloWorld".

Потом в Excel'e сообщается о завершении работы через окно MsgBox.

После нажатия на кнопку OK Visio закрывается, а созданный рисунок сохраняется в файле hello.vsd.

Sub HelloWorld()

Dim appVisio As Visio.Application 'Это экземпляр Visio

Dim docsObj As Visio.Documents 'Коллекция документов Visio

Dim docObj As Visio.Document 'Отдельный документ

Dim stnObj As Visio.Document ' Трафарет (Stencil)

Dim mastObj As Visio.Master ' Мастер-шейп, который будет перетаскиваться на рисунок

Dim pagsObj As Visio.Pages 'Коллекция страниц в документе

Dim pagObj As Visio.Page 'Отдельная страница

Dim shpObj As Visio.Shape 'Экземпляр мастер-шейпа

'Создается экземпляр Visio

Set appVisio = CreateObject("visio.application")

Set docsObj = appVisio.Documents

'Создается документ на основе шаблона

Set docObj = docsObj.Add("Basic Diagram.vst")

Set pagsObj = appVisio.ActiveDocument.Pages

'Выбирается из коллекции первая страница документа

Set pagObj = pagsObj.Item(1)

Set stnObj = appVisio.Documents("Basic Shapes.vss")

Set mastObj = stnObj.Masters("Rectangle")

'Перетаскивается с трафарета Basic Shapes.vss шейп Rectangle

Set shpObj = pagObj.Drop(mastObj, 4.25, 5.5)

'и в нем пишется текст

shpObj.Text = "Hello World!"

'сохраняется полученный документ

docObj.SaveAs "hello.vsd"

MsgBox "Нарисовано!", , "Hello World!"

'Закрывается Visio

appVisio.Quit

End Sub

Как сохранить документ в формате .htm?

.SaveAs (...htm) пишет неправильно.

Существует метод Export, с помощью которого все делается.

Вот информация из Хелпа. Метод Export экспортирует объект Visio в файлы таких форматов как .pcx, .eps, или .htm.

Синтаксис object.Export fileName.

Object - выражение, возвращающее экспортируемый объект Page, Master, Selection, или Shape.

FileName - полный путь и имя файла для сохранения экспортируемого объекта.

Примечание. Тип преобразования при экспорте определяется расширением файла. Если соответствующий фильтр не установлен, метод Export возвращает ошибку.

Метод использует установки "по умолчанию" соответствующего фильтра и не принимает дополнительных аргументов.

Метод Export, примененный к странице (Page), поддерживает сохранение ее в файле HTML формата с расширением .htm или .html. Страница экспортируется с установками, использованными последний раз при выполнении диалога Save As.

Если заданный файл уже существует, он перезаписывается без дополнительных подтверждений.

Дополнение. Export обязательно требует полный путь.

Вот это у меня работает: pagObj.Export "g:\hello.htm"

Не могу передать строку в .Cells("User....")

Не могу передать строку в .Cells("User....") (Цифры пишет а строку нет).

Строка передается с тремя кавычками, типа вот так:

shpObj.Cells("Prop.ttr.Label").Formula = """Текстовая строка""".

Как в VB работать с группой?

Подскажите пожалуйста, как в VB работать с группой? Я создал группу:

ActiveWindow.Select shp1Obj, visSelect

ActiveWindow.Select shp2Obj, visSelect

ActiveWindow.Group

А как этой группе присвоить имя, чтобы можно было менять размер, положение и т.п.?

Образовавшаяся группа сама является шейпом, имеет имя и т.д.

Один из способов узнать имя - воспользоваться тем, что после команды Group группа выбрана и выбрана только эта группа. То есть MsgBox ActiveWindow.Selection.Item(1).Name покажет вам ее имя.

Как VB закрасить прямоугольник?

Подскажите, как VB нарисовать прямоугольник и закрасить его, допустим, красным цветом.

MyObj = ActivePage.DrawRectangle(5, 5, 6, 6) а дальше?

Нажимаете Format/Fill/Color. Видите, слева красного цвета стоит цифра 2. Это номер цвета в палитре Visio. Красить шейпы можно цветами из палитры от 0 до 23 (туда можно включать и свои цвета).

Делается это так:

Рисуем шейп прямоугольник

Set MyObj = ActivePage.DrawRectangle(5, 5, 6, 6)

Определяем ячейку, отвечающую за цвет

Set cellObj = MyObj.Cells("FillForegnd")

Говорим, что шейп должен быть красным

cellObj.Formula = 2

Вместо прямого указания индекса палитры можно использовать функцию rgb(), например rgb(255, 0, 0) возвратит индекс красного цвета.

cellObj.Formula = "RGB(255; 0; 127)"

Путем определения в документе пользовательских цветов можно нарастить палитру еще на 232 цвета, но при этом нужно быть осторожным при переносе шейпов из одного документа в другой (при некорректной работе могут перекраситься).

Как можно вставить Visio в Word?

Есть документ в ворде и документ в визио (страниц много). В ворде делаю ThisDocument.Shapes.AddOLEObject "Visio.Drawing", File_vsd, , , , , , 75, 75, 400, 450, Selection.Range

Но это только первая страница, а нужно вставить в Word страницы из Visio одна за другой(не обязательно в том же порядке, как в Visio), под рисунок написать: Рис. "N"-i "appVisio.ActiveDocument.Pages.Item(i)" , за ней следующую и т.д.

Вставляя OLE объект из файла Вы вставляете весь многостраничный документ, а не только первую страницу. Тем более, что вставляется не первая страница, а та, на которой был закрыт документ Visio, например, последняя или пятая. Если сделать ту же операцию вручную из меню Word, то во вставленном объекте можно переходить с одной страницы на другую. Можно вставить объект два раза в разные места, а потом в одном из них перейти на другую страницу, и в Word'е Вы увидите две разные картинки. Если Вы хотите вставить несколько объектов, отображающих по умолчанию разные страницы рисунка Visio, то это будут просто копии одного и того же объекта, но открытые на разных страницах.

Как иллюстрация работает такой вариант:

Документ Visio был сохранен на третьей странице. Программка делает следующее:

вставляет третью страницу (первый AddOle), перелистывает файл на первую страницу,

вставляет первую страницу (второй AddOle).

ActiveDocument.InlineShapes.AddOLEObject _

ClassType:="Visio.Drawing", DisplayAsIcon:=False, _

FileName:="g:\Business\MP\Orders\importer.vsd", _

Range:=ActiveDocument.Paragraphs(2).Range

On Error Resume Next

Dim appObj As Visio.Application

Set appObj = CreateObject("Visio.Application")

If appObj Is Nothing Then

MsgBox "Failed creating Visio instance."

Else

' MsgBox "ProcessID: " & appObj.ProcessID

' appObj.Visible = True

End If

Set docsObj = appObj.Documents.Open("g:\Business\MP\Orders\importer.vsd")

Set pagsObj = docsObj.Pages

appObj.ActiveWindow.Page = "Page-1"

appObj.ActiveDocument.Save

appObj.Quit

ActiveDocument.InlineShapes.AddOLEObject _

ClassType:="Visio.Drawing", DisplayAsIcon:=False, _

FileName:="g:\Business\MP\Orders\importer.vsd", _

Range:=ActiveDocument.Paragraphs(3).Range

Возможен и другой вариант - вставлять объекты не из файла, а открыть приложение Visio, не закрывая листать его и передавать объекты через Clipboard.

Как программно отформатировать текст в шейпе?

Как программно отформатировать текст в шейпе используя несколько шрифтов?

Все параметры шейпов в Visio отображаются и меняются в шейп-листе (ShapeSheet).

Если не знаете, как сделать что-то программно, делайте это вручную и смотрите, как это отражается в шейп-листе. Потом пытайтесь внести такое же изменение в ячейку шейп-листа программно.

Например.

Рисуем на листе только один квадрат, пишем в нем 1234567890. Открываем шейп лист. Находим секцию Character (на будущее). Теперь на листе рисунка красим текст в красный цвет. В шейп листе тут же в ячейке Color секции Character появляется 2 (номер красного цвета). Делаем вывод - если записать в ячейку Color значение 2, текст станет красным.

Проверяем. Отменяем ручные изменения и выполняем макрос

Sub ttt()

ActivePage.Shapes(1).Cells("Char.Color").Result("") = "2"

End Sub

Убеждаемся, что текст после этого макроса опять становится красным.

Точно также можно работать и с другими атрибутами секции Character: Font, Size, Scale и т.д.

Примечание.

Если в одном шейпе текст имеет разное форматирование (например 3 буквы красные, потом 5 синих), то в секции Character это будет отражено двумя строчками и можно менять параметры каждой группы текста отдельно. Больше групп - больше строчек. Однако, если первоначально текст был отформатирован одинаково (в секции была только одна строка), то возникнет проблема. В документации прямо указывается, что добавление и удаление строк из четырех секций запрещено (visSectionCharacter, visSectionParagraph, visSectionTextField, or visSectionTab).

Так что хорошо бы заранее готовить шейпы с нужным числом строк.

Если известно, что в каком-то типе шейпа может понадобиться менять форматирование фрагмента текста - взять и подправить мастер-шейп, то-есть внести несколько строк в секцию еще на уровне мастер-шейпа. Будет специальный мастер. А на рисунке уже работать с подготовленными секциями. Вот только разметка позиций будет фиксированной. Еще один кривой вариант - работать с группой. В принципе наверно можно иметь несколько шейпов-текстовых блоков, менять их размер в зависимости от введенного текста (типа Width = GUARD(EVALTEXT(TheText)) и позиционировать один за другим. Тогда каждый будет управляться сам по себе, а выглядеть это будет как одна текстовая строка (сам не пробовал, но почему бы не работать).

Некоторые эффекты получаются с использованием ячеек Scale и Transparency. То есть фрагмент текста можно сделать невидимым и сжать, а когда нужно развернуть.

Как красиво приклеить?

Для склеивания двух объектов Shape использую Line Connector и Connection Point:

CObj, NObj - объекты Shape, хост и сегмент

conObj - объект Line Connector

(1) conObj.Cells("BeginX").GlueTo CObj

(2) conObj.Cells("EndX").GlueTo NObj.Cells ("Connections.X1")

Часто, при переносе какого-либо из двух объектов, "Line Connector" пересекает изображение объекта, выглядит плохо.

Вручную можно "Line Connector" приклеить к Shape объекту целиком, при этом используемый "Connection Point" выбирается автоматически в соответствии с расположением Shape объектов. Как образовать такое соединение программным путём?

Коннектор можно клеить к:

- точкам соединения - Connections.Xn или Connections.Yn (Ваш пример)

- изломам геометрии - Geometry.Xn или Geometry.Yn

- сторонам шейпа - AlignLeft, AlignCenter, AlignRight, AlignTop, AlignMiddle или AlignBottom

- наконец, динамический клей (то, что Вам нужно) - к PinX или PinY

Типа: conObj.Cells("EndX").GlueTo NObj.Cells("PinX")

А если уж совсем хочется эффектов, то можно еще поманипулировать секцией Shape Layout для совершенстования обтекания (это аналогично вкладке Format/Behavior/Placement).

Подскажите, как в VBA получить координаты шейпа

Подскажите, как в VBA получить координаты шейпа относительно страницы, на которой он находится?

Координаты шейпа относительно листа рисунка хранятся в шейп-листе данного шейпа в секции ShapeTransform в ячейках PinX и PinY. При этом под координатами шейпа понимаются координаты центра описанного прямоугольника. Доступ из VBA производится по имени ячейки .Cells("PinX") и .Cells("PinY").

Например, выражение ActivePage.Shapes(1).Cells("PinX") даст X координату первого шейпа на активной странице.

Координаты считаются от левого нижнего угла страницы в дюймах.

Как выделить фигуры на слое?

Подскажите, как программным образом, произвести выделение определенных фигур на каком-то определенном слое.

Как я понимаю, делается это долго и нудно.

Селектированные шейпы являются членами коллекции Selection. (Window/Selection).

Коллекция слоев относится к странице документа Document/Page/Layers.

Привязка шейпа к слою определяется в секции Layer Membership.

Вот и получается, что нужно найти индекс нужного слоя, а потом перебирать все шейпы на странице и проверять, не относятся ли они к нужному слою. А уж если относятся, то включать их в коллекцию Selection методом Select от окна.

Типа winObj.Select shpObj,visSelect

где winObj - окно

shpObj - селектируемый шейп

visSelect - константа такая.

Чтобы другие не мешались, возможно придется также использовать visDeselect или visDeselectAll.

Да, если хочется еще и только определенные шейпы выбрать, то вдобавок нужно проверять, такой ли это шейп, например, по имени.

Где взять инфу про Pinx и Piny?

Немножко есть прямо в Help'е, только не в основном, а в том, который открывается из окна Visual Basic. Побольше - в DVS - (Developing Visio Solutions), который чаще всего входит в комплект поставки Visio. Правда, и то и другое на английском.

Да и что о них говорить-то особо. Просто координаты центра вращения шейпа, которые сидят в секции Shape Transform.

Как обратиться к шейпу по координатам?

Подскажите, можно ли узнать принадлежит ли точка с координатами X,Y какому-нибудь шейпу (и соответственно его имя), и принадлежит ли эта точка какой то линии в этом шейпе (если он составной из нескольких фигур (линий))?

Например, перебираем всю коллекцию шейпов, вычисляя для них

intRet = object.HitTest(x, y, tolerance)

где object - очередной шейп.

Как только натыкаемся на шейп, выдающий visHitOnBoundary или visHitInside, выбираем имя данного шейпа.

Почему в коде нельзя присвоить CustomProp тип Row = 1?

Может, кто подскажет, почему в коде нельзя присвоить CustomProp тип Row = 1?

p3 = Shape.AddNamedRow(visSectionProp, "tttt", 1)

Почему нельзя - не могу подсказать, а вот выкрутиться вроде можно. Можно создать тип по умолчанию, а потом переопределить его

p3 = ActivePage.Shapes(1).AddNamedRow(visSectionProp, "tttt", 0)

Set cellObj = ActivePage.Shapes(1).Cells("Prop.tttt.Type")

cellObj.Formula = 1

Как перехватить events в поле Value, если произошли изменения данных?

Вот такая конструкция (после выполнения макроса ttt) срабатывает на любое изменение первого шейпа на странице и через MsgBox перечисляет все изменившиеся ячейки, в том числе и пользовательские. Остается отфильтровать их и реагировать только на нужную ячейку.

Dim WithEvents m_shpObj As Visio.Shape

Public Sub InitWith(ByVal aShape As Visio.Shape)

Set m_shpObj = aShape

End Sub

Private Sub m_shpObj_CellChanged(ByVal Cell As Visio.IVCell)

MsgBox Cell.Shape.Name & " " & Cell.Name & " changed to =" & Cell.Formula

End Sub

Sub ttt()

Set m_shpObj = ActivePage.Shapes(1)

End Sub

Пример работы с текстом и файлами.

Я никогда не программировала для Visio и, чтобы разобраться как это делается, не поможете ли с программой для примера.

В открытом документе по указанию на какой-либо допустим квадратик (double-click?), берется его подпись (может activePage.Shapes.Text ?), открывается другой более общий файл visio, находится там квадратик с тем же текстом, увеличивается просмотр с центром экрана на этом квадратике.

Заранее спасибо.

Sub ttt()

s0 = ActiveWindow.Selection.Item(1).Text

Dim docObj As Visio.Document

Dim selObj As Visio.Selection

Dim winObj As Window

Set docObj = Documents.Open("C:\FileБолееОбщий.vsd")

Set pagObj = docObj.Pages(1)

For i = 1 To pagObj.Shapes.Count

s = pagObj.Shapes(i).Text

If (InStr(s, s0) > 0) Then

Set winObj = ActiveWindow

winObj.Select pagObj.Shapes(i), visSelect + visDeselectAll

px = winObj.Selection.Item(1).Cells("PinX")

py = winObj.Selection.Item(1).Cells("PinY")

winObj.SetViewRect px - 1, py + 1, 5, 5

MsgBox ("pX= " & px & " pY= " & py)

End If

End Sub

Двойной щелчок по любому из квадратиков загружает более общий файл, находит в нем шейпы с похожим текстом и позиционирует на них окно. MsgBox пишет координаты шейпа (и тормозит программу на время просмотра).

После выполнения макроса "Более общий" файл закрыть вручную (забыл Close написать)

Как можно закрепить длину линии?

Как можно закрепить длину линии (а координаты можно было бы менять)?

конкретно:

Надо перенести с рисунка многоугольник, у которого точно известны только длины сторон.

А может у кого-нибудь есть такой многоугольник (вручную вводится кол-во сторон и их длина, а потом на листе можно произвольно менять форму - длина сторон не меняется)

p/s прошу сильно не пинать, первый раз начал работать с Visio

Просто закрепить длину линии (ребра многоугольника) нельзя.

Но можно подойти с другой стороны.

Visio рисует геометрическую фигуру последовательным применением функции MoveTo(x,y). Значит если вычислить координаты x и y всех точек многоугольника так, чтобы они удовлетворяли заданным условиям (фиксированные расстояния между вершинами), то задача будет решена. Останется только вписать соответствующие формулы в ячейки секции Geometry шейп-листа и защитить их функцией Guard от изменения.

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

Причем управляться может не одна соседняя вершина, а несколько. И тянуть можно в принципе любую вершину, что еще более запутывает вычисления.

Короче, задача в принципе разрешима, но не думаю, чтобы у кого-то был такой многоугольник.

Как программно добавить трафарет (*.vss) в уже открытый документ?

Как программно добавить трафарет (*.vss) в уже открытый документ, чтоб он попал в группу Shapes в левой части документа. Это можно вручную сделать так:

File->Stencils->Open Stencil

но

Dim appVisio As Object, dc As Visio.Document

Set dc = appVisio.Documents.Add("...El.vss")

или Set dc = appVisio.Documents.Open("...El.vss")

открывают его, но в отдельном окне, не добавленном в группу Shapes исходного документа

Мне кажется немного не так.

File->Stencils->Open Stencil

ничего не добавляет в группу Shapes исходного документа. Открывается новый документ с трафаретом. Только этот трафарет, что называется docked, на первом документе. И его компоненты лежат в коллекции Masters этого второго документа.

Такой же эффект дает использование OpenEx с указанием, как открывать. Например:

Dim ds As Visio.Document

Set ds = Application.Documents.OpenEx("Blocks.vss", visOpenDocked)

MsgBox Documents(1).Name

MsgBox Documents(2).Name

Как определить удаляемый шейп?

Некоторые проблемы при работе с событиями:

меня интересуют обработка событий работы с шейпами - добавление Events с кодом вып visActCodeRunAddon:

а)событие добавления:

evl.Add visEvtAdd + visEvtShape, visActCodeRunAddon, "MyShp.exe", "1"

или evl.Add &H8040, visActCodeRunAddon, "MyShp.exe", "1"

работает нормально, а вот с удалением шейпа - проблемы:

вроде есть событие BeforeShapeDelete с кодом &H4040. Оно срабатывает, но в программе-обработчике уже

Dim dc As Visio.Window, shp As Visio.Shape, sel As Visio.Selection

Set app = GetObject(, "visio.application")

Set dc = app.ActiveWindow: Set sel = dc.Selection

i = sel.Count

получаю i=0 тем самым, хотя и вроде до удаления, я не могу получить уникальный идентификатор выделенного шейпа

IDString = shpObj.UniqueID(visGetOrMakeGUID)

события на Selection у шейпа нет, событие SelectionChanged (код 701 или &H02BD) - не отрабатывает под Visio2000. Что делать?

А почему нельзя взять шейп из параметров?

Типа, вот так:

Private Sub Document_BeforeSelectionDelete(ByVal Selection As IVSelection)

MsgBox Selection(1).Name 'Печатается имя предназначенного для удаления шейпа

End Sub

И в случае Add-on тоже можно использовать параметры.

Вместо того, чтобы после вызова Add-on'а искать селектированный шейп, попробуйте отловить его непосредственно из параметров вызова Add-on.

Например, строчка

MsgBox Command

(в запускающемся Add-on) выводит приблизительно такую строку.

/visio=4194304 /doc=1 /page=1 /shape=Sheet.1 /event=16448 /eventid=89 /args=Shape deleted!

Здесь /shape=Sheet.1 - это имя удаляемого шейпа. (/args=... - это могут быть еще и дополнительные аргументы).

Такая строка - результат события, формирующегося после

eventsObj.Add &H4040, visActCodeRunAddon, "SHOWARGS.EXE", "/args=Shape deleted!"

Вам ведь, как я понял, нужно именно отловить в Add-on удаляемый шейп?

Почему срабатывает ShapeAdded при открытии файла?

Работая через VBasic с Visio Type Library,я пытался использовать обработчик события ShapeAdded в клиенте (объявлена переменная dim WithEvents app As Visio.Application)

Sub appVisio_ShapeAdded(ByVal Shape As Visio.IVShape)

...

End Sub

и пришел к неожиданному выводу - что он срабатывает при открытии файла *.WMF (не только при добавлении шейпов). При открытии стандартного *.VSD обработчик "молчит".

Почему это? Может Visio при чтении такого файла воспринимает процесс как добавление шейпов или недоработка?

При открытии стандартного vsd обработчик молчит, потому что просто открывается пустой рисунок.

При открытии WMF Visio открывает для него пустой документ, а затем помещает на него картинку (WMF). Эта картинка является тоже шейпом, у него существует шейп-лист, полный набор атрибутов и т.д. То есть срабатывание добавления шейпа вполне закономерно и соответствует правилам Visio.

Как определить путь?

Я хочу взять элемент из трафарета. У меня на компьютере он лежит

C:\Program Files\Visio\Solutions\папкастрафаретами ,

а у соседа чего-то там Visio10/1033/ и вообще какой-то другой путь.

Если я напишу

Set stnObj = appVisio.Documents.Open(appVisio.Path &

"\Solutions\centel\adress_узел.vss"), то соседний компьютер все равно не поймет, у него же между программной директорией и папкой Solutions лежит еще папка 1033.

Нельзя ли как-то указать на папку Solutions вне зависимости от версии Visio?

У объекта Application существуют свойства:

AddonPaths, StartupPaths, DrawingPaths, StencilPaths, FilterPaths, TemplatePaths, and HelpPaths.

В данном случае следует использовать

Set stnObj = appVisio.Documents.Open(appVisio.StencilPaths &

"\centel\adress_узел.vss")

Как задать требуемый номер и свойства элемента?

Подскажите пожалуйста, как задать требуемый (а не присваиваемый) номер и свойства элемента (узел и ветви графа), и как затем организовать ссылку в проекте VBA на эти данные. (где это все хранится?)

Номер (а точнее имя, которое может включать и номер) задать нельзя. Это делается только автоматикой. А для своей идентификации можно использовать поля данных, пользовательские свойства, текстовое поле, вводить дополнительные поля и т.д.

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

Некоторые мастер-шейпы на трафаретах уже имеют поля для пользовательских свойств, открываемые по Shape / Custop Properties. Если при этом пишут No custom properties exist, то можно нажать OK и здесь же определить эти свойства, а затем и ввести в них значения.

"как затем организовать ссылку в проекте VBA"?

Все шейпы на рисунке собраны в коллекцию. Просматривая эту коллекцию, можно найти нужный шейп (по имени или каким-то свойствам). Свойства доступны через ячейки шейп-листа (уже упомянутая таблица). Для выхода на эти ячейки существуют либо константы для указания секции, строки, ячейки в строке, либо некоторые ячейки имеют уникальные имена.

Как программно извлечь все свойства шейпа?

Как программно извлечь все свойства шейпа (имеется в виду Properties которые можно вызвать через контекстное меню на правый клик). Конкретно нужно извлечь свойства UML шейпов

Вот программка, выбирающая значения свойств Part_Number, Manufacturer и Cost. У Вас свойства будут называться немного по-другому, но принцип тот же.

Private Sub Document_DocumentSaved(ByVal doc As IVDocument)

Dim pagObj As Visio.Page 'Visio Page Object

Dim shpsObj As Visio.Shapes 'Visio Shapes collection

Dim shpObj As Visio.Shape 'Visio Shape object

Dim celObj As Visio.Cell 'Visio Cell object

Dim OrderInfo() As String 'Array to hold Purchase Order Info

Dim iShapeCount As Integer 'Counter

Dim i As Integer'Counter

Set pagObj = ActivePage 'Get the active page

Set shpsObj = pagObj.Shapes 'Get the Shapes collection of the page

IshapeCount = shpsObj.Count 'Total number of shapes

'Set the array size to hold all of the shape information

'0 based array, 4 by total # of shapes

ReDim OrderInfo(3, iShapeCount - 1)

'For each shape on the page, collect the Name, Part Number

'Manufacturer, and Cost

For i = 1 To iShapeCount

'Get the i'th shape

Set shpObj = shpsObj(i)

'Get the shape name

OrderInfo(0, i - 1) = shpObj.Name

'Get the Part Number Property, then get the value as a string

If shpObj.CellExists("Prop.Part_Number", visExistsLocally) Then

Set celObj = shpObj.Cells("Prop.Part_Number")

OrderInfo(1, i - 1) = celObj.ResultStr("")

End If

'Get the Manufacturer Property, then get the value as a string

If shpObj.CellExists("Prop.Manufacturer", visExistsLocally) Then

Set celObj = shpObj.Cells("Prop.Manufacturer")

OrderInfo(2, i - 1) = celObj.ResultStr("")

End If

'Get the Cost Property, then get the value

If shpObj.CellExists("Prop.Cost", visExistsLocally) Then

Set celObj = shpObj.Cells("Prop.Cost")

OrderInfo(3, i - 1) = celObj.ResultIU

End If

'Release Shape object

Set shpObj = Nothing

'Print to Immediate window to verify data collection

For i = 0 To pagObj.Shapes.Count - 1

Debug.Print OrderInfo(0, i) & "," _

& OrderInfo(1, i) & "," _

& OrderInfo(2, i) & "," _

& OrderInfo(3, i)

'Call a function to write data out to any external

'data storage, pass the array of collected data

'ExportData OrderInfo

End Sub

Как программно добраться до свойств шейпа (Properties)?

Как программно добраться до свойств шейпа (Properties)? В Cells их не видно. Например, у шейпа Class есть много свойств (Attributes, Operations) - там довольно большой уровень вложенности и их нигде не видно

Начинаем исследования.

Создаем рисунок UML и бросаем всего один шейп Class (о нем шла речь в примере).

Нажимаем View / Drawing Explorer Window и раскрываем в дереве Foregorund Pages. Видим последовательно вложенные Static Structure-1, Shapes, Class. Это наш первый шейп Class на рисунке. Пытаемся раскрыть дальше и видим, что в нем появляются еще Shapes и целая линейка из 8 шейпов. Вот они наши Attributes, Parameters и т.д.

Вывод - Class представляется вроде как группой из восьми шейпов, каждый из которых несет свою информацию. Как несет - пока не видно.

Чтобы было, что искать, задаем пару атрибутов. Например attribute1 : Short и attribute2 : bool.

Сохраняем рисунок в виде XML, открываем в текстовом редакторе и даем поиск "attribute1". Ну, вот оно и проявилось - -attribute1 : Short -attribute2 : bool.

То есть искомые атрибуты хранятся внутри группы в шейпе Attributes в виде обычного текста.

Проверяем из VBA:

Sub ttt()

MsgBox ActivePage.Shapes(1).Shapes.Count

MsgBox ActivePage.Shapes(1).Shapes(6).Name

MsgBox ActivePage.Shapes(1).Shapes(6).Text

End Sub

Видим последовательно:

8 - (число шейпов в группе)

Attributes - (шестой шейп - этот как раз шейп Attributes)

attribute1 : Short

attribute2 : bool

А это значения атрибутов, которые мы и ожидали увидеть.

Все (вкратце)

Подскажите, можно ли отловить изменение шейпа?

Подскажите, можно ли отловить изменение шейпа? Дело в том, что необходимо написать процедуру, запрещающую некоторые изменения шейпов. Стандартной функции нет (есть только при добавлении шейпа ShapeAdded или при изменении текста шейпа, а необходимо отловить изменение геометрии шейпа).

На изменение геометрии срабатывает EventXFMod.

Что-нибудь типа Shape.Cells("EventXFMod").Formula = "RUNADDON (""ThisDocument.ttt"")" позволит в дальнейшем при изменении геометрии шейпа выходить на макрос ttt.

Как формировать список выбора в пользовательском поле?

Необходимо формировать список выбора в пользовательском поле Shape из поля базы данных. Скажите, пожалуйста, как это сделать?

Тип поля должен быть установлен, например, в Fixed List, а в ячейку Format нужно подсунуть данные, выбранные из базы. Например, ="12;13;14" будет давать для выбора список из трех величин.

Как формировать список выбора по данным из базы?

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

В обработчике события ShapeAdded коннектитесь к базе, выбираете список вентиляторов, формируете из типов вентиляторов текстовую строку (не "12;13;14", а "ВПГ-56-380; ПВ-250" или что там будет в базе) и эту строку засовываете в ячейку Format в секции пользовательских свойств в нужную строку. Лучше, если соответствующее свойство в мастер-шейпе уже есть - тогда надо только подсунуть значение в одну ячейку.

То есть, как только Вы бросите шейп на лист, в нем уже появится сформированный список из базы. Далее уже ручками открываете свойства и выбираете нужную позицию.

Где описывать обработчик ShapeAdded и как его вызывать?

Обработчик будет вызываться сам, как только на страницу упадет шейп.

Чтобы его описать, нужно вызвать Microsoft Visual Basic (Tools / Macros / Visual Basic Editor), щелкнуть слева по ThisDocument, справа в списке объектов выбрать Document, а еще правее в списке событий выбрать ShapeAdded.

При этом на листе появится заготовка типа:

Private Sub Document_ShapeAdded(ByVal Shape As IVShape)

…

End Sub

Впишите туда для проверки MsgBox, например:

Private Sub Document_ShapeAdded(ByVal Shape As IVShape)

MsgBox "Ой, Добавилось!"

End Sub

Теперь возвращайтесь на страницу рисунка и добавьте любой шейп или просто проведите линию и наблюдайте, как срабатывает Ваш обработчик.

Как задать программно формату ячейки форматную строку?

Предположим, есть процедура

Private Sub Document_ShapeAdded(ByVal Shape As IVShape)

nam = Shape.Name

If InStr(1, nam, "Вентилятор") > 0 Then

formatstroka = "ВОМД-24;ВОМ-18"

' здесь надо задать формат в соответствии с форматной строкой

End If

End Sub

Как задать программно формату ячейки форматную строку?

Пусть в трафарете имеется мастер-шейп, в котором определено пользовательское свойство: Label = Typ; Type = Fixed List (другие аргументы, в том числе и формат, не заполнены).

Тогда при премещении этого мастер-шейпа на лист (срабатывает данный обработчик) нужно будет в ячейку Format записать "ВОМД-24;ВОМ-18".

Если бы данные брались не из базы, а просто как текстовая константа, это делалось бы так:

Shape.Сells("prop.row_1.Format").Formula = """ВОМД-24;ВОМ-18"""

В Вашем же случае вместо константы в тройных кавычках нужно будет подсунуть строку, сформированную из всех возможных значений, полученных из базы.

Ну и, понятно, если пользовательских свойств несколько, то вместо prop.row_1 должна быть указана нужная строка.

Как назначить свойство ActivePage программным образом?

Кто знает, как назначить свойство ActivePage программным образом, так чтобы эта страница стала активной ?

Например, как в Excel:

Sheets("Лист2").Select

Скорее всего вот так:

(Dim appObj As Visio.Application)

appObj.ActiveWindow.Page = "Page-1"

Как извлечь свойства нестандартных шейпов?

На странице много нестандартных шейпов с кучей Custom Properties.

Возможно ли программно извлечь их названия и значения? Они неизвестны на этапе проектирования.

Возможно.

Нужно использовать адресацию по индексам и проверку на CellsSRCExists

Примерно так:

Sub ttt()

iShapeCount = ActivePage.Shapes.Count

s = ""

For i = 1 To iShapeCount

Set shpObj = ActivePage.Shapes(i)

s = s & shpObj.Name & " --> "

'visCustPropsLabel visCustPropsPrompt

'visCustPropsSortKey visCustPropsType

'visCustPropsFormat visCustPropsValue

'visCustPropsInvis visCustPropsAsk

For j = 0 To 7

If shpObj.CellsSRCExists(visSectionProp, visRowProp + j, visCustPropsLabel, True) Then

Set CellObj = shpObj.CellsSRC(visSectionProp, visRowProp + j, visCustPropsLabel)

s = s & CellObj.ResultStr(0)

Set CellObj = Nothing

End If

Set shpObj = Nothing

MsgBox s

End Sub

Как из VISIO связывать Recordset с таблицей в базе данных?

Как из VISIO связывать datPrimaryRS с таблицей в базе данных?

База данных ACCESS

Да так же, как и из любого приложения на VBA. Например, через ADODB. Вот здесь datPrimaryRS связывается с таблицей tabl1 в базе db1.mdb, лежащей в C:\temp, и выбирает из нее поля название и характеристика из всех записей:

Private Sub Document_ShapeAdded(ByVal Shape As IVShape)

Dim cnn As New ADODB.Connection

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source= C:\temp\db1.mdb;"

Dim datPrimaryRS As New ADODB.Recordset

datPrimaryRS.Open "tabl1", cnn, adOpenKeyset, adLockOptimistic, adCmdTable

datPrimaryRS.MoveFirst

While Not datPrimaryRS.EOF

MsgBox datPrimaryRS!название & " " & datPrimaryRS!характеристика

datPrimaryRS.MoveNext

Wend

datPrimaryRS.Close

cnn.Close

End Sub

Возможна ли передача значений из Custom... одного объекта в Custom... другого?

Возможна ли передача значений из Custom... одного объекта в Custom... другого? Через ShapeSheet или помощью VBA? И еще, как сформировать ссылку на ячейку другого объекта в таблице ShapeSheet?

Возможна.

В VBA устанавливается нужная ячейка шейп-листа нужного объекта, затем в нее пишутся или читаются данные. Например,

Set CellObj = shpObj.CellsSRC(visSectionProp, visRowProp + j, visCustPropsValue)

s = CellObj.ResultStr(0)

читает значение пользовательского свойства.

В случае ссылки через Шейп-лист нужно знать имя шейпа, на который ссылаемся. Например,

формула =Sheet.1!Prop.Row_1 , записанная в ячейку Value, обеспечит перенос значения пользовательского свойства из первой строки шейпа Sheet.1 в шейп-приемник.

Как в Visio сделать ссылку на число?

Как в Visio сделать ссылку на число. Т.е. есть одинаковое число в нескольких местах документа (адресация на монтажной схеме панели, формата А1) необходимо, чтобы при изменении в одном месте данного числа, все такие же заменились на вновь введенное.

Можно сделать ссылку на текст другого шейпа (один раз это число где-то придется ввести).

Например, если вставить поле Insert / Field / Custom Formula вот с таким текстом

ShapeText(Sheet.1!TheText)

то в данном шейпе всегда будет повторяться текст шейпа Sheet.1.

Помогите подсчитать программно сколько в тексте на шейпе wrapped строк.

Вот такая штуковина

Sub ttt()

s = ActivePage.Shapes(1).Text

i = 1

While i > 0

i = InStr(i, s, vbLf) + 1

MsgBox i - 1

Wend

End Sub

Вот по такому тексту шейпа

Раз строка

Два строка

Три строка

Говорит последовательно: 11, 22, 0. То есть переводы строк на 11, 22 позиции, а больше нету.

Как подсчитать получившееся количество строк при заполнении шейпа текстом?

При добавлении текста на прямоугольник получается автоматический перенос строк(wrap) по ширине шейпа. Вопрос состоит в подсчете получившегося количества строк, независимо от нажатий при вводе этого текста.

Здесь вычисления могут быть только приближенными. Существует функция, которая выдает расчетную высоту текста с учетом ограничения текстового блока по ширине и прочих параметров форматирования.

TEXTHEIGHT(shapename!TheText,maximumwidth)

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

Как в Visio 2002 включить автопозиционирование шаблона?

Как в Visio 2002 включить автопозиционирование шаблона? Т.е. чтоб при размещении на листе он автоматически вставал на одно и то же место.

(Пример - стандартный штамп для А4,А3 и т.п.)

Рисуешь штамп, группируешь и в ShapeSheet вносишь:

Width "=GUARD(196 mm/ThePage!PageScale*ThePage!DrawingScale)"

Height "=GUARD(283 mm/ThePage!PageScale*ThePage!DrawingScale)"

PinX "=GUARD(ThePage!PageWidth-(3 mm/ThePage!PageScale*ThePage!DrawingScale))"

PinY "=GUARD(7 mm/ThePage!PageScale*ThePage!DrawingScale)"

LocPinX "=GUARD(200 mm/ThePage!PageScale*ThePage!DrawingScale)"

LocPinY "=GUARD(0)"

Это все справедливо для полного штампа А4. С А3, я думаю, проблем не возникнет. На сайте в примерах что-то подобное уже было...

Как сослаться на шейп другого листа?

Здравствуйте, уважаемые!!! Помогите пожалуйста новичку! Надо чтобы при наборе текста в шейпе (любимом штампе А4 конечно же!) на одной странице он автоматически появлялся бы на других. С шейпами на одной странице я поэкспериментировал, но сослаться на шейп другого листа так и получилось. Возможно ли это сделать без макросов? Спасибо!

Приблизительно вот так:

=ShapeText(Pages[Page-2]!Sheet.1!TheText)

Page-2 - это имя другой страницы.

Если таких страниц (приемников) несколько, то лучше сделать фоновую страницу и копировать текст на нее. Он автоматически будет показываться на остальных, для которых эта страница назначена фоновой.

Как определить в Visual Basic цепочку из соединенных шейпов?

Сделал схему ЛВС, рабочие места соединил с портами на патч панели и коммутаторах соединителями. Как можно определить в Visual Basic цепочку из соединенных шейпов и как можно пройти по этой цепочке.

Это надо для того, чтобы легко идентифицировать соответствующие порты в коммутаторах по выбранным рабочим местам.

Доступ к идентификаторам объектов связанных коннектором можно получить из самого коннектора.

Имя_коннектора.Connects.Item(i).ToCell.Shape.NameID

NameID - это идентификатор Шейпа на листе Sheet.номер

Имя трафарета, который использовался при создании, определяется ссылкой к полю Name

i - это номера соединяемых шейпов

Для того чтобы получить доступ к CustomProperties полям надо

page.Shapes.Item(i).Cells("Prop.CodeCable").Formula

Prop.CodeCable - название ячейки, отображаемое в ShapeSheet (в случае патч корда это так и выглядит), отображается название по-другому нежели в CustomProperties

Если такого пропертиса нет, то возвращается ошибка end of expected

Можно ли получить доступ к Connection points шейпа из VB и удалить ненужные точки?

Задача:

есть мастер (прямоугольник), который имеет 10 Connection points слева и 10 справа. Во время перетаскивания мастера на документ и перехода в шейп требуется убрать лишние Connection points (что бы они были не видны и не доступны пользователю). Количество лишних Connection points определяется программой по заданному алгоритму.

В шейп-листе есть секция Connection Points. Для удаления Points нужно из этой секции удалить строку.

Строка в общем случае удаляется примерно так:

shpObj.DeleteRow visSectionFirstComponent + 0, visRowVertex + 3

Для секции Connection Points это будет выглядеть примерно так:

shpObj.DeleteRow visSectionConnectionPts+0, visRowConnectionPts+2

В примере удалится точка № 3 (из расчета 0, 1, 2, 3...).

Sub ttt()

ActivePage.Shapes(1).DeleteRow visSectionConnectionPts + 0, visRowConnectionPts + 2

End Sub

Как отследить изменение в выделении?

Подскажите, если не затруднит, как отследить изменение в выделении.

Пробовал так:

Private Sub ActiveWindow_SelectionChanged(ByVal Window As IVWindow)

MsgBox Time

End Sub

Но не работает.

А ассоциировать с реальным источником не забыли? Типа вот так:

Dim WithEvents tt As Visio.Window

Sub ttt()

Set tt = ActiveWindow

End Sub

Private Sub tt_SelectionChanged(ByVal Window As IVWindow)

MsgBox "Changed"

End Sub

После выполнения ttt событие начинает срабатывать.

Как в EventDrop (секция Events) указать предыдущий объект?

Добрый день!

Как сделать следующее:

1. в EventDrop (секция Events) указать предыдущий объект (т.е. шейп, который до этого бросили)?

2. как можно программно (скажем VB)? перед тем как бросить шейп на рисунок изменить у него какое-нить поле в ShapeSheet?

1. В EventDrop можно и не пытаться. То есть можно придумать какое-нибудь извращение через третий шейп, в котором отслеживать последний размещенный на странице шейп. Но будет куча сложностей, когда шейп бросят, потом удалят, потом бросят новый и т.д. На все случаи не рассчитаешь, так что лучше этим и не заниматься.

А вот с VBA наверное можно попробовать смотреть последний шейп в коллекции. Они вроде всегда в конец добавляются.

2. Нет никакой разницы, когда менять поле - перед тем как бросить или после того, это не заметно. Так что смело обрабатывайте событие ShapeAdded и в этом обработчике изменяйте поле.

Есть ли возможность средствами VB отслеживать событие ShapeAdded?

А есть ли возможность средствами того же VB отслеживать это событие ShapeAdded (в VBA я знаю, как это сделать)?

Конечно, есть.

Если приложение VB делается по технологии COM Add-in (в Visio 2002 стала поддерживаться) то все практически так же, как и в VBA. Это нужно скачать из Microsoft Visio 2002 SDK, он подсаживается в VB6 и добавляет к нему свой пример-шаблон. То есть там уже все понятно становится.

А если технология Add-on, то посложнее. Это уже два разных приложения взаимодействуют. Пример по-моему в том же SDK есть (там еще и документация прилагается, правда на английском).

Есть функция в VB, возвращающая NAME шейпа без цифр?

Думаю вопрос несложный для опытных пользователей. Пытаясь написать программку в VB под Visio, обнаружил что у расположеных на листе нескольких копий одного шейпа различаются имена. Например, на трафарете "реле", на листе одно имя "реле.4" другое "реле.7" и т.д. цифры меняются, в зависимости от элементов из которого состоит шейп. Программа воспринимает шейпы как разные, что мешает нормальной работе. Подскажите, можно ли поменяв настройки, убрать цифры в именах последующих, копируемых, шейпов, или может быть есть функция в VB возвращающая NAME шейпа без цифр. Спасибо за все ответы.

Поменяв настройки - нельзя.

Можно пользоваться ссылкой на Мастер-шейп, от которого они образованы. Его имя для всех таких шейпов будет одинаковым.

ActivePage.Shapes(i).Master.Name

Как сделать, чтобы объект из группы исчезал и появлялся по двойному клику?

Нужно сделать так, чтобы один из объектов группы исчезал и появлялся по двойному клику. Расскажите как.

Зайдите в ТаблицуФигур группы и вставьте раздел Другие свойства.

В ТаблицеФигур группы укажите следующие параметры:

EventDblClick =IF(Prop.Row_1.Prompt=1;SETF(GetRef(Prop.Row_1.Prompt);0);SETF(GetRef(Prop.Row_1.Prompt);1))

И в фигуре, которая должна исчезнуть:

Geometry1.NoShow =Sheet.ID!Prop.Row_1.Prompt

где ID номер группы. Теперь при двойном нажатии эта фигура(ы) будет "исчезать" и "появляться".

Можно еще вот как поступить, если требуется убирать из группы группу.

1) Создать группу (как элемент будущей группы).

2) Скопировать в буфер.

3) Сделать специальную вставку Edit>Paste Special...

4) С этим новым элементом создать группу.

5) Зайдите в ТаблицуФигур группы и вставьте раздел Другие свойства.

В ТаблицеФигур группы укажите следующие параметры:

EventDblClick =IF(Prop.Row_1.Prompt=1;SETF(GetRef(Prop.Row_1.Prompt);0);SETF(GetRef(Prop.Row_1.Prompt);1))

И в группе которая должна исчезнуть:

ImgWidth =Width*Sheet.ID!Prop.Row_1.Prompt

ImgHeight =Height*Sheet.ID!Prop.Row_1.Prompt

где ID номер группы. Теперь при двойном нажатии эта группа(ы) будет "исчезать" и "появляться".

Как сделать, чтобы объект из группы исчезал и появлялся по двойному клику 2?

На строку IF(Prop.Row_1.Prompt=1;SETF(GetRef(Prop.Row_1.Prompt); 0); SETF(GetRef(Prop.Row_1.Prompt);1))

В поле EventDblClick я получаю сообщение "Error in formula". В справке 5-го Визио я не могу найти GetRef. Что это?

Измените =IF(Prop.Row_1.Prompt=1;SETF(GetRef(Prop.Row_1.Prompt);0);SETF(GetRef(Prop.Row_1.Prompt);1))

на

=IF(Prop.Row_1.Prompt=1;SETF("Prop.Row_1.Prompt";0);SETF("Prop.Row_1.Prompt";1))

Примечание: задача решилась так.

EventDblClick=IF(Prop.Row_1.Prompt=1;SETF("Prop.Row_1.Prompt";"0");SETF("Prop.Row_1.Prompt";"1"))

в общей группе.

В группе которая исчезает

Width=Sheet.ID!Width*1*Sheet.ID!Prop.Row_1.Prompt

Height=Sheet.ID!Height*0,7703*Sheet.ID!Prop.Row_1.Prompt

Как программно можно поменять ориентацию страницы?

Как программно можно поменять положение страницы с "книжной" на "альбомную"?

Это можно сделать, изменив одновременно размеры страницы рисунка и ориентацию страницы принтера. Например, вот так:

Sub ttt()

Height = ActivePage.PageSheet.Cells("PageWidth")

ActivePage.PageSheet.Cells("PageWidth") = ActivePage.PageSheet.Cells("PageHeight")

ActivePage.PageSheet.Cells("PageHeight") = Height

If ActiveDocument.PrintLandscape Then ActiveDocument.PrintLandscape = False Else ActiveDocument.PrintLandscape = True

End Sub

Как программно изменить размер и выравнивание шрифта в шейпе?

Подскажите pls как программно изменить размер и выравнивание шрифта в шейпе и как пользоваться стилями?

Пишу

Set shpObj = pagObj.DrawRectangle(2, 8, 6, 9)

shpObj.Text = "Hello World!"

shpObj.TextStyle = "Arial 24pt centered"

Ошибка: стиль задан неверно!

А Вы создали предварительно стиль с таким названием? Этот способ работает с уже имеющимися стилями.

Создать новый стиль и изменить шрифт - это совершенно разные вещи.

Изменить шрифт легко. Вот эти две строчки сделают размер шрифта 6 pt и выравняют параграф по центру. Для этого стилей создавать не нужно.

Sub tty()

ActivePage.Shapes(1).Cells("Char.Size").Formula = "=6 pt."

ActivePage.Shapes(1).Cells("Para.HorzAlign") = 1

End Sub

А создавать новый стиль лучше все-таки вручную, а программно его только применять. То, что Вы пытались показать в примере, это только применение стиля.

Можно ли значение кастом_пропертис использовать как номер скратч-ячейки?

Необходимо сделать в одном стенсиле несколько заготовок (автопозиционируемая рамка) которые различаются одним-двумя параметрами (допустим заливка, толщина линий). Можно ли в невидимый слой поместить несколько образцов, пронумеровав их 1-n, а затем в соответствии со значением кастом_пропертис выбрать соответствующий порядковый номер из другого списка?

Более конкретно: есть 7 вариантов заливок, но номерация их паттернов идет не подряд 28-30, 36-39. Можно ли значение кастом_пропертис использовать как номер скратч-ячейки? Или, если нельзя, как сделать по-другому (желательно без VBA)?

Пример:

Берем прямоугольник и делаем ему одно Custom Properties со значениями:

- Label - MyPattern

- Type - Fixed List

- Format - 1;2;12;22

- Value - 2

А в ячейку Fill Pattern загоняем вложенный If типа =IF(Prop.Row_1=1;2;IF(Prop.Row_1=2;3;IF(Prop.Row_1=12;4;8)))

Расшифровка:

Если пользовательское свойство = 1, назначить Pattern = 2, Иначе следующий If

Если пользовательское свойство = 2, назначить Pattern = 3, Иначе следующий If

Если пользовательское свойство = 12, назначить Pattern = 4, Иначе назанчить Pattern = 8

То есть значения одного списка перекодируются в значения другого списка. В Custom Properties выбираются значения из 1, 2, 12, 22, а Pattern получается соответственно 2, 3, 4, 8.

Можно ли значение кастом_пропертис использовать как номер скратч-ячейки 2?

Меня интересует более общий подход, можно ли элемент списка 1,2,3,...,n (fixed type в custom properties) использовать как параметр ссылки, например на строку user.row_n.

:) Элементарно!

Делаем Format попроще - 1;2;3;4

Именуем 4 ячейки в User тоже 1, 2, 3, 4 - Это не обязательно, просто ссылаться на User.1 проще, чем на User.row_1.

В User прописываем, например, str1, str2, str3, str4.

А в Scratch всовываем вообще страшную штуку - =GUARD(SETF(GetRef(Fields.Value);"=User."&Prop.Row_1))

Теперь, выбирая значения Custom Properties, мы видим, как в текстовом поле шейпа появляется текст str1, str2 и т.д., который записан в разных ячейках User.

Как из Visio из процедуры на VBA получить доступ к листу в книге Excel?

Так же интересует обратная проблема

Генерация файла Excel из Визио

Sub ReadExcel()

Dim ExcelObject As Object

Set ExcelObject = CreateObject("Excel.Application")

ExcelObject.Workbooks.Add ' Добавляем новую книгу

ExcelObject.Workbooks.Open FileName:="C:\Work\Opis.xls" ' Открываем файл

ExcelObject.Visible = True ' делаем excel видимым

ExcelObject.Range("A1", "A1").Value = "Test:"

ExcelObject.Range("A1", "A1").HorizontalAlignment = 1

ExcelObject.Range("A1", "A1").VerticalAlignment = 2

ExcelObject.Range("A1", "A1").WrapText = 1

' ExcelObject.Quit ' для закрытия excel

End Sub

Соответственно можно только открыть какой-то файл или только создать пустую книгу. Остальные команды и форматы записи управления Excelем можно узнать используя запись макросов в самом Excel, а затем посмотрев текст в редакторе VBA.

Как менять несколько надписей сразу?

Требуется, чтобы при изменении одного текста на листе менялось также несколько надписей. Нашел почти подходящий шейп в Organization Chart (Position и др.), но он, при помощи метода create synchronized copy создает связанные предметы только для разных листов. Можно ли этот метод как-то использовать для простых объектов?

Заранее спасибо.

А может попроще?

Вставить в зависимые шейпы поле вот с такой формулой (в данном случае ссылка на шейп Sheet.1). И то, что появится в Sheet.1, будет транслироваться в эти шейпы.

=ShapeText(Sheet.1!TheText)

Как менять несколько надписей сразу 2?

1.Создаю прямоугольник с текстом внутри.

(тут вопросы: Нужно ли его помещать в shapes и если да то для мастера менять свойства? Дальше куда - в custom properties в format или открыть shape list? куда эту формулу =ShapeText(Sheet.1!TheText) вставлять)

2.Копирую его по всему листу(документу) и хочу, что бы при изменении текста внутри любого (можно одного главного) везде текст также менялся.

1) Создаете прямоугольник.

2) Когда он выделен либо нажимаете F2, либо 2-м нажатием левой кн. мыши.

3) Далее нажимаете правой кнопкой мыши и выбираете Insert Field...(Вставка поля...)

4) В появившемся окне в Category(Категория) выберите Custom Formula(Другая формула).

5) И в строке снизу введите необходимую формулу.

Вот и все.

Как определить размер (длину в мм) текстовой строки?

Подскажите, как определить размер (длину в мм) текстовой строки, а не размер шейпа в котором она написна.

Нужно для функции на VBA.

На основе примера из документации:

Sub Text_width()

Dim shpObj As Visio.Shape

Set pagsObj = ThisDocument.Pages

Set pagObj = pagsObj.Item(1)

Set selectObj = ActiveWindow.Selection

Set shpObj = ActiveWindow.Selection.Item(1)

shpObj.Text = "Text here" 'пишем текст в фигуру или оставляем

shpObj.AddSection visSectionUser 'добавляем раздел

shpObj.AddRow visSectionUser, visRowUser + 0, 0 'добавляем строку

Set celObj = shpObj.Cells("User.Row_1") 'назначаем ячейку

celObj.Formula = "TEXTWIDTH(TheText)" 'забиваем формулу

TextWTH = celObj.Result(visMillimeters) 'забираем результат

MsgBox TextWTH, , "Text width" 'показываем результат

End Sub

Как программно прижать текстовый блок коннектора к одному из концов?

Как программно прижать текстовый блок коннектора к одному из концов. Пожалуйста, помогите.

Например, так.

Sub Text_position()

Dim shpObj As Visio.Shape

Set pagsObj = ThisDocument.Pages

Set pagObj = pagsObj.Item(1)

Set selectObj = ActiveWindow.Selection

Set shpObj = ActiveWindow.Selection.Item(1)

Set celObj1 = shpObj.Cells("TxtPinX") 'назначаем ячейку

Set celObj2 = shpObj.Cells("TxtPinY") 'назначаем ячейку

celObj1.Formula = "Width*1" 'прижимаем к низу

celObj2.Formula = "Height*1" 'прижимаем к низу

celObj1.Formula = "Width*0" 'прижимаем к верху

celObj2.Formula = "Height*0" 'прижимаем к верху

End Sub

Как определить к какому именно конекшен поинту произошло подключение?

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

Коннекторы с точки зрения анализа соединений отличаются от прочих шейпов.

Труба у Вас наверное будет коннектором. У коннектора нужно смотреть коллекцию Connects. В ней будет столько элементов, сколько раз этот коннектор подключен куда-либо. Если труба - ConnectorObj, то коллекция - ConnectorObj.Connects, число подключений - ConnectorObj.Connects.Count.

Вычислить, к чему она подключена, можно через свойство ToSheet. Если у Вас на рисунке выбрана только эта труба, то ActiveWindow.Selection(1).Connects(1).ToSheet.Master.Name даст имя мастер-шейпа элемента, подключенного к первому концу трубы.

А вот у емкости и прочих шейпов смотреть надо уже другую коллекцию - FromConnects (вместо Connects) и свойство FromSheet вместо ToSheet. То есть вроде как смотрим с обратной стороны на то же подключение.

Ну, и еще два свойства - FromPart и ToPart объекта Connect помогут определить часть шейпа (там куча констант, показывающих низ, верх, номер Connection Point'а и т.д.)

Как изменить размеры шейпов по данным Excel?

Хотелось бы из VBA екселевского изменить размеры шейпов... по данным того же екселя.

Я что то не понимаю в иерархии объектов Visio, потому что ни как не могу найти к чему относиться свойство height, отвечющее за высоту шейпа....

вот:

pagsObj.Item(1).Shapes.Item("Vertical text 3-D bar blue.1")....height=3 что поставить вместо точек?

Можно, например, так:

pagsObj.Item(1).Shapes.Item(1).Cells("height").Formula = 3

Здесь height, как ячейка.

Как сослаться на шейп на другой странице?

Есть созданный мастер-шейп с кучей Custom Properties. Напр., именуемый в шейп-листе как Spec.3

Чтобы извлечь нужное свойство, я пишу в Custom formula:

=Spec.3!Prop.XXX.

Это работает в пределах страницы

Чтобы обратиться к нему с другой страницы, я, ессно, пишу

=Pages[Page-X]!Spec.3!Prop.XXX

в ответ - Bad ShapeSheet name...

интересно, что с не-мастер шейпом, т.е. именуемым Sheet.XX все работает... Где загвоздка?

З.Ы. Сорри за столь наивные вопросы по синтаксису, но толкового руководства под рукой нет... может, подскажете, где взять?

З.З.Ы. MS Visio 2002

Похоже, что здесь в Visio 2002 просто присутствует ошибка. Я, правда, не наталкивался до этого на нее, потому что стараюсь использовать ссылки только вверх или в сторону, но не вверх-вниз, как в данном случае.

Вот что я сейчас высмотрел.

Помещаем на Page-1 прямоугольник и два шейпа Triangle. Второму из них даем имя sh1.

Первый из них отзывается на:

Sheet.2

Triangle

Второй на:

Sheet.3

Triangle.3

С первой страницы работают ссылки на Triangle.3!Width и Sheet.3!Width. Причем при попытке ввести ссылку Sheet.3!Width она автоматически заменяется на Triangle.3!Width. То есть Visio так сказать "помогает" пользователю.

Даем второму треугольнику еще и уникальное имя, например sh1. Теперь он отзывается на:

Sheet.3

sh1

Подмена идет уже на sh1.

Начинаем на него ссылаться с Page-2 и видим, что при вводе

=Pages[Page-1]!Sheet.3!Width подмена идет уже на =Pages[Page-1]!Triangle.3!Width, а не на =Pages[Page-1]!sh1!Width, как на первой странице.

Эта ссылка еще работает.

Но! Повторно ее ввести нельзя! То есть, при попытке самому ввести =Pages[Page-1]!Triangle.3!Width получаешь ошибку.

Более того. Если этот файл сохранить не в .vsd, а в .vdx, то Visio уже не может его прочитать. Говорит, что формула сломана и он ее изменяет на 0.

Вывод:

1. Желательно при ссылках в Visio 2002 избегать обратного движения по дереву. То есть, если уж Вы сослались на другую страницу (вверх по дереву), то не опускаться до ее шейпов.

2. Если такая ссылка все-таки нужна, то стараться использовать неименованные шейпы, чтобы Visio не имел возможности "помочь" Вам в духе Microsoft.

3. Проверить, как это работает в Visio 2003. Ошибка настолько явная, что там она вполне может быть уже исправлена.

В DVS написано, что ссылка по имени "Shapename.ID!Cellname" работает только в пределах листа. (DVS.pdf p.74 "Rules for cell references in formulas").

В остальных случаях используется "Sheet.ID!Cellname"

В Visio 2003 все работает так же.

Как из скрипта можно установить единицу измерения?

Есть какая то заморочка с дюймами... вообще хочу работать с см, поэтому меняю для странички в Page setup inches на cm все вроде ок..

Потом, при расстановке фигур по страничке не могу разобраться в чем идет расчет, например:

elements(0).SetBegin x / 2.54, (2 + Kcell_total(0) / step) / 4.54

при значении Kcell_total(0)=4241, x=2 начало получается расположенным в точке (2;4,5) - каким образом.... не могу понять и попутно как из скрипта можно установить единицу измерения для pages или для page..

Единица измерения переключается масштабом

ActivePage.PageSheet.Cells("PageScale").Formula = "1 cm"

ActivePage.PageSheet.Cells("DrawingScale").Formula = "1 cm"

переведет в см, а

ActivePage.PageSheet.Cells("PageScale").Formula = "1 in"

ActivePage.PageSheet.Cells("DrawingScale").Formula = "1 in"

переключит в дюймы.

Но вводите данные Вы все равно в дюймах, поэтому (2дюйма)/2.54 дает 2 см и отстоит на 2 клеточки от края листа, если единицу измерения установили см. (по Y Вы не сообщили значение step).

Короче, видеть Вы будете в см, а вводить в дюймах.

ShapeSheet

Подсчет количества элементов

Имеется рисунок с большим количеством элементов порожденных 10-20 мастерами. Требуется посчитать количество элементов порожденных конкретным мастером. При добавлении поля в произвольный sheet функция ID считает общее количество всех sheet на странице включая саму себя. Может есть способ указать в ID имя конкретного мастера.

Буду рад, если кто-то меня опровергнет, но кажется на уровне ShapeSheet эта задача не имеет решения, так как в ячейке можно дать любую ссылку, но нельзя последовательно опросить множество Shape. И функция ID дает не количество, а номер последнего Shape, который только иногда совпадает с количеством.

Зато на программном уровне задача решается очень легко. Например:

- рисуем на листе единственный квадрат (для вывода результатов);

- вводим в документ макрос вот такого вида:

Sub ttt()

s1 = ""

For i = 1 To ActivePage.Shapes.Count

s1 = s1 + "Name= " + ActivePage.Shapes(i).Name

s1 = s1 + " Id= " + Str(ActivePage.Shapes(i).ID) + vbCrLf

ActivePage.Shapes(1).Text = s1

End Sub

- и подцепляем его к нашему квадрату через Format/Behavior/Double-Click/RunMacro/TchisDocument.ttt

Теперь при двойном щелчке по этому квадрату наша функция будет последовательно опрашивать все имеющиеся на листе Shapes и писать в качестве текста их имена и ID. На этот лист можно набросать много мастеров или нарисовать Shape и двойным щелчком по первому квадрату обновить их список.

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

VBA

Изменение размеров рисунка

Нарисовал планировку этажа здания. Теперь нужно весь рисунок увеличить в размерах. После его растягивания некоторые объекты остаются на месте, линии искажаются и т.д. Как сделать грамотно увеличение?

Не видя самого рисунка, точно не скажешь. Но есть варианты:

1. Если все объекты нарисованы, а не перетащены из трафарета, то нужно объединить их в группу и растягивать всю группу.

Это может не работать, если свойство Format/Behavior/Resize behavior каких-то объектов установлено не в Scale with group (изменяться с группой), а в Reposition only (перемещаться без масштабирования). Кстати, по умолчанию устанавливается Use group's setting, что тоже может подойти, но тогда поведение будет зависеть от соответствующей установки в группе.

2. То есть нужно бы установить у всех объектов Resize behavior в состояние Scale with group. Это тоже может не помочь, если в каких-то объектах установлены блокировки, то есть в Format/Protection установлены галочки на блокировку изменения каких-то параметров.

3. То есть нужно снять лишние блокировки.

Это тоже может не помочь, если используются Смарт-шейпы, - объекты, перетащенные с трафаретов и обладающие своей запрограммированной реакцией на изменение внешней среды. К сожалению, изменив эту реакцию, можно подпортить другие важные свойства. Поэтому в данном случае можно попробовать последний способ

4. Не растягивая рисунок пользоваться масштабированием.

Если все сконцентрировалось, например, в одном углу рисунка, можно сначала обрезать лист так, чтобы он подогнался под заполненную область (File/Page Setup/Page Size установить галочку в Size to fit drawing contents), а потом разместить этот лист на полном печатном листе. (File/Page Setup/Setup - галочки Center horizontally и Center vertically центрируют изображение, а установка Fit to 1 sheet(s) across by 1 sheet(s) down максимально растянет рисунок во весь печатный лист). Можно воспользоваться и процентным масштабированием.

Контакты: Туманов Геннадий Евгеньевич gCroc@yandex.ru