Resizing several shapes in-place

[Paul]

In Vision 2000, I have a large graph of nodes (ovals and other shapes)
and center-to-center connections (straight-line, not rectilinear). I
want to select all the shapes (and I have a macro to do this). Then I
want to reduce the size of all shapes by some "x" percent without
changing the coordinates of their centers. Hence, their center-to-
center spacings are the same, as are their positions. Their
perimeters shrink toward their centers by "x" percent, so the
connectors get "x" percent longer. Of course, I want the connectors
to remain connected to their respective shapes, with "center-to-
center" style. Can this be done in a simple way?

I will also reduce font sizes by "x" percent, but I believe that is a
trivial thing.

Thanks.

 

[AlEdlund]

if you're already using macros to manipulate the shapes then it should be
relatively simple for you to take the height and width cells from the
shapesheet and multiply them by the percentage you want them to change.
al

 

[WapperDude]

Al's technique is probably the most universally straight-forward approach,
but a possible alternative hinges on your selection macro. Presumably, each
shape type gets it's own percentage reduction. If you select only identical
shapes, then you could just enter a reduction factor in the width and height
fields of the Shape and Position window.

Wapperdude

 

[Paul]

The thing is, I cut and pasted that macro from the web. I have to
take some time to learn VBA at some point. I'd post the macro, but am
unable to access the file at the moment.

 

[WapperDude]

Hi Paul --
I'm not very proficient at VBA and macros, but the two following macros
might give you a head start. The concept is to identify all of the shapes on
a sheet, then, using a shapes "name", the macro will set the width and height
as desired. These values are "hard-coded" into the macro. If you don't know
the name of the shape, the 1st macro will go thru and indicate each cells
name. This name must be hard-coded into the 2nd macro. All I've indicated
is the steps for a single shape.

Sub Macro1()
Dim shape As shape
For Each shape In ThisDocument.Pages(1).Shapes
MsgBox (shape.MasterShape)
Next
End Sub

Sub Macro2()
Dim name As String
name = "Executive"
If ActiveWindow.Selection.Count > 0 Then
For Each shape In ThisDocument.Pages(1).Shapes
If shape.Master = name Then

Application.ActiveWindow.Page.Shapes.ItemFromID(shape.ID).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2 in"

Application.ActiveWindow.Page.Shapes.ItemFromID(shape.ID).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2 in"
End If
Next
End If
End Sub

Hope this helps.
Wapperdude

 

[Paul]

Thanks, WrapperDude.

Al's technique is probably the most universally straight-forward approach,
but a possible alternative hinges on your selection macro.  Presumably,each
shape type gets it's own percentage reduction.  If you select only identical
shapes, then you could just enter a reduction factor in the width and height
fields of the Shape and Position window.  

Wapperdude






- Show quoted text -

 

[Paul]

WrapperDude,

I appreciate the start. For the moment, I found a good way around
it. You can set a setting for an object to say how it behaves when
the group to which it belongs is resized. Two options are to
reposition only or scale with group. You can first select all, set
everything to scale with group, group the whole shebang, and shrink
the group. Then ungroup (making sure everything is still selected),
set to reposition only, then group everything and scale the group back
up. Everything occupies the same position as before, but smaller,
thus yielding more white space. To have the same effect but to have
everything occupy a bigger drawing page, just select everything, set
them to reposition only, group everything, then scale the group up.

I'm glad, you still posted your macro code, however. I am sure that I
will need to scrutinize it for these capabilities that I've been
posting frenetically about. Thanks for that.