Author Topic: Space Maker Shape Moving Tool  (Read 9606 times)

0 Members and 1 Guest are viewing this topic.

Yacine

  • Hero Member
  • *****
  • Posts: 2770
Space Maker Shape Moving Tool
« on: June 09, 2010, 11:19:55 PM »
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.

Code
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
« Last Edit: August 12, 2010, 07:43:46 AM by Visio Guy »
Yacine

Yacine

  • Hero Member
  • *****
  • Posts: 2770
Re: Space Maker Shape Moving Tool
« Reply #1 on: June 09, 2010, 11:21:02 PM »
.
« Last Edit: August 12, 2010, 07:43:58 AM by Visio Guy »
Yacine

Visio Guy

  • Administrator
  • Hero Member
  • *****
  • Posts: 1729
  • Smart Graphics for Visual People...n' Stuff
    • Visio Guy
Re: Space Maker Shape Moving Tool
« Reply #2 on: August 12, 2010, 07:42:19 AM »
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!
For articles, tips and free content, see the Visio Guy Website at http://www.visguy.com
Get my Visio Book! Using Microsoft Visio 2010

Yacine

  • Hero Member
  • *****
  • Posts: 2770
Re: Space Maker Shape Moving Tool
« Reply #3 on: August 12, 2010, 01:16:14 PM »
Hi Chris,
thanks for the flowers and the advertising. I appreciate very much.
Yacine
Yacine

kurtkite

  • Newbie
  • *
  • Posts: 2
Re: Space Maker Shape Moving Tool
« Reply #4 on: May 16, 2011, 12:15:57 PM »
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!

Jumpy

  • Hero Member
  • *****
  • Posts: 1061
Re: Space Maker Shape Moving Tool
« Reply #5 on: May 16, 2011, 04:45:25 PM »
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.

kurtkite

  • Newbie
  • *
  • Posts: 2
Re: Space Maker Shape Moving Tool
« Reply #6 on: May 17, 2011, 11:04:37 PM »
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