One good reason not to use Visio for drafting ideas is it's lack to insert easily space for new items in the mid of already drawn shapes.
In a text editor you move your cursor to the point where you want to insert new text and start typing.
In a spreadsheet you would insert rows and columns - or even individual cells.
In Visio you need to select the "disturbing" shapes and find a new place for them.
A space maker placed a the right place, oriented and able to select a certain number could help in this case.
I definitely want one as standard feature in the next Visio version ... and easier to handle than my Space Maker shape.
Sub Space(shp As Visio.Shape, OneRun As Boolean)
Dim SpaceID As Long
Dim DirX, DirY, Angle, H As Long
Dim Pi As Double
Pi = 4 * Atn(1) 'no pi in VBA?
SpaceID = shp.ID 'do not consider this shape when iterating through all shapes
' ******** get the 4 corners of the area to move
x1 = shp.Cells("beginx").ResultIU
y1 = shp.Cells("beginy").ResultIU
x2 = shp.Cells("endx").ResultIU
y2 = shp.Cells("endy").ResultIU
Angle = shp.Cells("Angle").ResultIU
Areaheight = shp.Cells("controls.row_1.y").ResultIU
x3 = shp.Cells("endx").ResultIU + (Areaheight - shp.Cells("height").ResultIU) * Cos(Angle + Pi / 2)
y3 = shp.Cells("endy").ResultIU + (Areaheight - shp.Cells("height").ResultIU) * Sin(Angle + Pi / 2)
x4 = shp.Cells("beginx").ResultIU + (Areaheight - shp.Cells("height").ResultIU) * Cos(Angle + Pi / 2)
y4 = shp.Cells("beginy").ResultIU + (Areaheight - shp.Cells("height").ResultIU) * Sin(Angle + Pi / 2)
' ******** get the amplitude of the move
H = shp.Cells("Height").ResultIU
DirX = -Cos(Angle + Pi / 2) * H
DirY = -Sin(Angle + Pi / 2) * H
' ******* y = ax+b, considering also vertical and horizontal orientation
If x2 <> x1 Then a1 = (y2 - y1) / (x2 - x1) Else a1 = 10000000000#
b1 = y2 - a1 * x2
If x3 <> x2 Then a2 = (y3 - y2) / (x3 - x2) Else a2 = 10000000000#
b2 = y3 - a2 * x3
a3 = a1
b3 = y4 - a3 * x4
a4 = a2
b4 = y1 - a4 * x1
' ****** factors to define whether we need to look above or underneath the line
If x2 >= x1 Then c12 = -1 Else c12 = 1
If y2 >= y1 Then c34 = 1 Else c34 = -1
' ****** the actual loop
' it will not change protected cells!
For i = 1 To ActivePage.Shapes.Count
If i <> SpaceID Then
x = ActivePage.Shapes.Item(i).Cells("pinx")
y = ActivePage.Shapes.Item(i).Cells("piny")
If y * c12 > c12 * (a1 * x + b1) Then
If y * c34 < c34 * (a2 * x + b2) Then
If y * c12 < c12 * (a3 * x + b3) Then
If y * c34 > c34 * (a4 * x + b4) Then
If Left(ActivePage.Shapes.Item(i).Cells("pinx").FormulaU, 5) <> "GUARD" _
And Not (ActivePage.Shapes.Item(i).OneD) Then 'something to improve!
newx = Replace((ActivePage.Shapes.Item(i).Cells("pinx").ResultIU + DirX) * 25.4, ",", ".") & "mm"
newy = Replace((ActivePage.Shapes.Item(i).Cells("piny").ResultIU + DirY) * 25.4, ",", ".") & "mm"
' how do you assign values regardless the current dimension settings?
ActivePage.Shapes.Item(i).Cells("pinx").FormulaU = newx
ActivePage.Shapes.Item(i).Cells("piny").FormulaU = newy
End If
End If
End If
End If
End If
End If
Next i
If OneRun Then
shp.Delete
End If
End Sub
.
This is really, really, really cool and useful!
Notes to downloaders: the code is in the stencil file (.vss), the drawing (.vsd) is for testing. If the stencil is not open, then the red shape won't have any code to call and the tool won't work.
Again, really nice work, Yacine!
Hi Chris,
thanks for the flowers and the advertising. I appreciate very much.
Yacine
Hi,
These are all probably basic questions, so I will apologize in advance. I am new to writing VBA for Visio.
I was thinking about writing a function like this and was pleased when I found this one. I was able to download the stencil and practice file and get the tool to work. However, I am not able to get the tool to work on any other drawing. I'm sure I am missing a basic step. This is what I have tried:
- I have opened my drawing and then opened the SpaceMaker stencil.
- Then I have dragged the "Master" shape onto the drawing and positioned it to move the shapes.
- Then I have right clicked and selected "Make space", but the macro is not executed.
- I have set a breakpoint at the beginning of the macro but it is not hit.
Any pointers would be appreciated.
Thanks!
Open the ShapeSheet of the Space Maker Shape.
In the Action section in Row 1 you'll find:
CALLTHIS("Space","Medienplan",User.runOnce)
change that to
CALLTHIS("Space","SpaceMaker",User.runOnce)
Reason is, I guess, that Yacine renamed the stencil to an english name, before publishing it here.
Thanks. The macro is being invoked now and I can step through it in the debugger.
The shapes are not being moved but at least I can debug it to see what is wrong. It may have something to do with this being a UML sequence diagram. I will try to use it on some basic shapes to see if it works with those.
Thanks again for your help!
/Kurt