| Author |
 Topic  |
|
|
WiseChen
Russia
12 Posts |
 Posted - 10/30/2003 : 16:11:34
|
'Идея данной процедуры в том чтобы бросить шейп Wall
'по координатам (X;Y), нужной длины, на слой LayerName
'Длина и координаты дб в метрах
'проболвал писать:
'Set CellObj = MasterObj.Shapes.Item(1).CellsSRC(visSectionProp, visRowProp + 4, visCustPropsValue)
'CellObj.Formula = "7,0000 m"
' эффект оригинальный: свойство меняется а длина на самом чертеже
' как была по умолчанию 3 м так и осталась!?
' Вот эти строчки
'Set CellObj = MasterObj.Shapes.Item(1).CellsSRC(visSectionProp, visRowProp + 0, visCustPropsValue)
'CellObj.Formula = "200 mm"
' Дают анналогичный эффект с другим пользовательским свойством - толщиной
' ------------
' Добрался до свойств BeginX, BeginY, но почему в окне Size&Position
' значение одно, ShapeSheet показывает второе значение,
' а CellObj.Formula показывает третье значение.
' В чем прикол????????
' Ниже привожу листинг всей процедуры. Звездочками
' обозначено место эспериментов
Sub Add_Stencil()
Dim DocObj As Visio.Document
Dim MastersObj As Visio.Masters
Dim MasterObj As Visio.Master
Dim MasterName As String
Dim LayerObj As Visio.Layer
Dim i, x, y As Integer
Dim StPath As String
Dim StName As String
Dim LayerName As String
Dim CellObj As Visio.Cell
'Путь к стенсилу
StPath = "C:\Program Files\Microsoft Office\Visio10\1033\Solutions\Building Plan\"
'имя стенсила
StName = "Walls, Doors and Windows.vss"
'название шаблона
MasterName = "Wall"
' На какой слой бросить
LayerName = "2 этаж"
' куда бросить
x = 1
y = 1
Set DocObj = Open_Stencil(StPath, StName)
Set MastersObj = DocObj.Masters
For i = 1 To MastersObj.Count
' UserForm1.ListBox1.AddItem MastersObj.Item(i).Name
If StrComp(MastersObj.Item(i).Name, MasterName, vbTextCompare) = 0 Then
' MsgBox "Master " & MasterName & " found"
Set MasterObj = MastersObj.Item(i)
Exit For
End If
Next i
'Указываем что шаблон будет на слое LayerName
MasterObj.Layers.Item(1).Name = LayerName
' Если шаблон принадлежал каким то еще слоям -удаляем их
For i = 2 To MasterObj.Layers.Count
Set LayerObj = MasterObj.Layers.Item(i)
LayerObj.Remove MasterObj.Shapes.Item(1), 1
Next i
' ******
' собственно бросаем шаблон на страницу по координатам (x,y)
Set CellObj = MasterObj.Shapes.Item(1).CellsSRC(visSectionObject, visRowXForm1D, vis1DBeginX)
CellObj.ResultIU = 500
' Set CellObj = MasterObj.Shapes.Item(1).CellsSRC(visSectionProp, visRowProp + 4, visCustPropsValue)
' CellObj.Formula = "10,0000 m"
ActivePage.Drop MasterObj, x, y
' UserForm1.Show
End Sub
|
|
|
Digitall
Russia
389 Posts |
Posted - 11/06/2003 : 08:31:43
|
quote:
Originally posted by WiseChen
'Идея данной процедуры в том чтобы бросить шейп Wall
'по координатам (X;Y), нужной длины, на слой LayerName
'Длина и координаты дб в метрах
'проболвал писать:
'Set CellObj = MasterObj.Shapes.Item(1).CellsSRC(visSectionProp, visRowProp + 4, visCustPropsValue)
'CellObj.Formula = "7,0000 m"
' эффект оригинальный: свойство меняется а длина на самом чертеже
' как была по умолчанию 3 м так и осталась!?
Вот что я получил немного подкорректировав макрос из документации:
Sub HelloWorld()
'Object variables to be used in the program.
Dim stnObj As Visio.Document 'Stencil document that contains master
Dim mastObj As Visio.Master 'Master to drop
Dim pagsObj As Visio.Pages 'Pages collection of document
Dim pagObj As Visio.Page 'Page to work in
Dim shpObj As Visio.Shape 'Instance of master on page
'Get the first page in the document associated with the VBA program.
'A new document always has one page, whose index in the Pages
'collection is 1.
Set pagsObj = ThisDocument.Pages
Set pagObj = pagsObj.Item(1)
'Get the stencil from the Documents collection and set the master.
Set stnObj = Documents.Add("Walls, Doors and Windows.vss")
Set mastObj = stnObj.Masters("Wall")
'Drop the rectangle in the middle of a US letter-size page.
Set shpObj = pagObj.Drop(mastObj, 4.25, 5.5)
'Set the text of the rectangle.
Set celObj = shpObj.CellsSRC(visSectionProp, visRowProp + 4, visCustPropsValue)
celObj.Formula = "7,0000 m"
'Save the drawing. The message pauses the program
'so you know the drawing is finished.
ThisDocument.SaveAs "hello.vsd"
MsgBox "Drawing finished!", , "Hello World!"
End Sub
Работает в Visio 2002. Судя по пути трафарета, именно он у Вас и установлен.
Стена меняет свой размер до 7 метров.
Использовал макрос из DVS p.335 Getting a Cell object by section, row, and cell indexes
и p.330 Creating a simple drawing: an example |
 |
|
| |
Topic |
|
|
|
All Forums
Работа со свойствами шейпа