Reliably putting a specific shape in the center of the window with code!

[Visisthebest]

The built-in Visio code for putting a shape in the center of a Visio window has been unreliable for me.

Visio Guy's code was great but changed the zoom level.

If you need a solution for this, please use the changed Visio Guy code below. It puts the shape you select at the center of the ActiveWindow, and it re-sets the zoom level so it is identical to the zoom level setting before running the sub.

I made the most lazy change possible to get it to work for my needs, I will post optimized code at a later time (+ the vb.net version) but this works fine for the purpose already.

Code Select Expand


Sub ZoomOnSelected()

Dim Sel As Selection
Dim S As Shape

Set S = ActiveWindow.Selection(1)

Call CenterShapeInViewZoomLevelUnchanged(S)


End Sub


Public Sub CenterShapeInViewZoomLevelUnchanged(ByRef visShp As Visio.Shape)

  '// Notes:
  '// 'w' stands for 'width' and 'window'
  '// 'h' stands for 'height',
  '// 'l', 't', 'r', 'b' stand for 'left', 'top', 'right', 'bottom'
 
  Dim win As Visio.Window
  Set win = visShp.Application.ActiveWindow
 
  Dim OldZoomLevel As Double
 
  OldZoomLevel = win.Zoom
 
  If (win.Type = Visio.VisWinTypes.visDrawing) Then
 
    '// Switch the page in the active window so
    '// that it is the page that visShp is on:
    win.Page = visShp.ContainingPage
   
    '// Select the shape:
    Call win.DeselectAll
    Call win.Select(visShp, Visio.VisSelectArgs.visSelect)
   
    '// Zoom and pan:
   
    '// Get the dimensions of the active window. These
    '// are PAGE coordinates for what is displayed in the
    '// window:
    Dim wl As Double, wt As Double, ww As Double, wh As Double
    Call win.GetViewRect(wl, wt, ww, wh)
   
    '// Get the size and position of the shape:
    Dim flags As Integer
    flags = Visio.VisBoundingBoxArgs.visBBoxUprightWH
   
    '// Get the left, bottom, right, top of the shape, and
    '// calculate the center point:
    Dim sl As Double, sb As Double, sr As Double, st As Double
    Dim sx As Double, sy As Double
    Call visShp.BoundingBox(flags, sl, sb, sr, st)
    sx = (sl + sr) * 0.5
    sy = (st + sb) * 0.5
           
    '// Calculate the width and height:
    Dim sw As Double, sh As Double
    sw = Math.Abs(sr - sl)
    sh = Math.Abs(st - sb)
   
    '// Add some padding around the shape, because win.SetViewRect
    '// doesn't seem to be exact when we try to zoom. Let's take
    '// a percentage of the shape's size:
    Const PaddingPct# = 0.05 '//...5% padding
    Dim padding As Double
    If (sw > sh) Then
      padding = PaddingPct * sw
    Else
      padding = PaddingPct * sh
    End If
   
    '// Recalculate the shape dimensions with the added padding:
    sl = sl - padding
    sr = sr + padding
    st = st + padding
    sb = sb - padding
    sw = sr - sl
    sh = st - sb
   
    '// Calculate aspect rations of window and shape.
    '// Greater-than-one means 'more wide than tall':
    Dim arw As Double, ars As Double
    arw = ww / wh
    ars = sw / sh
   
   
    '// We will maximize the view of the shape in the
    '// window. This means that either the sides of the shape
    '// or the shape's top and bottom will be against the
    '// edges of the window. We have to figure this out using
    '// geometry.
   
    '// We'll set up some new dimensions for the window's view:
    Dim wlNew As Double, wtNew As Double, wrNew As Double, wbNew As Double
    Dim wwNew As Double, whNew As Double
   
    If (ars > arw) Then
     
      '// The shape is more 'wider' than the window.
     
      '// The window's left and right should match that
      '// of the shape:
      wlNew = sl
      wrNew = sr
      wwNew = wrNew - wlNew '//...the new view width
     
      '// Thew window's top and bottom SHOULD be calculated,
      '// but since the size of the window won't really change,
      '// we COULD enter nonsense values. But we'll try and
      '// calculate anyway:
      whNew = wwNew / arw '//...width/(width/height) => height
      wtNew = sy + wwNew * 0.5
      wbNew = sy - wwNew * 0.5
     
    Else
   
      '// The window is more 'wider' than the shape.
     
      '// The window's top and bottom should match that
      '// of the shape:
      wtNew = st
      wbNew = sb
      whNew = wtNew - wbNew '//...the new view height
     
      '// Thew window's left and right must be calculated:
      wwNew = arw * whNew '//...(width/height)*height => width
      wlNew = sx - wwNew * 0.5
      wrNew = sx + wwNew * 0.5
     
    End If
   
    '// Set the new window view:
    Call win.SetViewRect(wlNew, wtNew, wwNew, whNew)
   
    win.Zoom = OldZoomLevel
   
  Else
    '// Make the active window a ShapeSheet window to
    '// make this happen:
    Call MsgBox("Active window is not a drawing window, I'm not sure what to do!")
  End If


End Sub


[Visisthebest]

And here is the greatly simplified and more optimized code. Works like a charm for me, I hope for everyone else as well!

Code Select Expand


Sub ZoomOnSelected()

Dim Sel As Selection
Dim S As Shape

Set S = ActiveWindow.Selection(1)

'Dim W As Window

'Set W = ActiveWindow

Call CenterShapeInViewZoomLevelUnchangedV2(S)

'Call CenterShapeInViewZoomLevelUnchanged(S)


End Sub

Public Sub CenterShapeInViewZoomLevelUnchangedV2(ByRef visShp As Visio.Shape)

  '// Notes:
  '// 'w' stands for 'width' and 'window'
  '// 'h' stands for 'height',
  '// 'l', 't', 'r', 'b' stand for 'left', 'top', 'right', 'bottom'
 
  Dim win As Visio.Window
  Set win = visShp.Application.ActiveWindow
 
    '// Switch the page in the active window so
    '// that it is the page that visShp is on:
    win.Page = visShp.ContainingPage
   
    '// Select the shape:
    Call win.DeselectAll
    Call win.Select(visShp, Visio.VisSelectArgs.visSelect)
   
    '// Zoom and pan:
   
    '// Get the dimensions of the active window. These
    '// are PAGE coordinates for what is displayed in the
    '// window:
    Dim wl As Double, wt As Double, ww As Double, wh As Double
    Call win.GetViewRect(wl, wt, ww, wh)
   
    '// Get the size and position of the shape:
    Dim flags As Integer
    flags = Visio.VisBoundingBoxArgs.visBBoxUprightWH
   
    '// Get the left, bottom, right, top of the shape, and
    '// calculate the center point:
    Dim sl As Double, sb As Double, sr As Double, st As Double
    Dim sx As Double, sy As Double
    Call visShp.BoundingBox(flags, sl, sb, sr, st)
    sx = (sl + sr) * 0.5
    sy = (st + sb) * 0.5
           
    Dim wlNew As Double, wtNew As Double
   
    'The new left corner is the shape center minus half the window length
    'The top corner is the shape center plus half the window length
    wlNew = sx - ww * 0.5
    wtNew = sy + wh * 0.5
       
    '// Set the new window view:
    Call win.SetViewRect(wlNew, wtNew, ww, wh)
   

End Sub


[Visisthebest]

As promised here is the VB.NET code for VSTO Addins as well:

Code Select Expand


    Public Sub CenterShapeInViewZoomLevelUnchangedV2(visShp As Visio.Shape)
        Dim win As Visio.Window = visShp.Application.ActiveWindow

        '// Zoom and pan:

        '// Get the dimensions of the active window. These
        '// are PAGE coordinates for what is displayed in the
        '// window:
        Dim wl As Double, wt As Double, ww As Double, wh As Double
        win.GetViewRect(wl, wt, ww, wh)

        '// Get the size and position of the shape:
        Dim flags As Visio.VisBoundingBoxArgs = Visio.VisBoundingBoxArgs.visBBoxUprightWH

        '// Get the left, bottom, right, top of the shape, and
        '// calculate the center point:
        Dim sl As Double, sb As Double, sr As Double, st As Double
        Dim sx As Double, sy As Double
        visShp.BoundingBox(CShort(flags), sl, sb, sr, st)
        sx = (sl + sr) * 0.5
        sy = (st + sb) * 0.5

        Dim wlNew As Double, wtNew As Double

        'The new left corner is the shape center minus half the window length
        'The top corner is the shape center plus half the window length
        wlNew = sx - ww * 0.5
        wtNew = sy + wh * 0.5

        '// Set the new window view:
        win.SetViewRect(wlNew, wtNew, ww, wh)
    End Sub


[wapperdude]

Just wondering...  As long as the shape is smaller than the page, and the window centers on it, do you care what size it is?

@Visisthebest:
Your 1st step fetches the existing dL, dT, dWidth, and dHeight for the current window.  But all you need are width & height.

The shape in question is already selected, so you can determine its location, i.e., PinX and PinY.

Then, calc the new dL & dT:  dL = PinX - dWidth/2; dT = PinY + dHeight/2.  Width & height values remain same.  So, the shape is now centered.  Who cares about its size?!?

Just musing.
Edit note:  Took the presented VBA macro and simplified it.  Mostly out of curiosity to explore the above observations and further simplify since the zoom level is unchanged.  Plus, learned a couple things along the way.  So, if nothing else, this exercise helped me.

Code Select Expand


Sub cntrIt()
'Adapted from John Goldsmith and Visisthebest
'Macro centers the activewindow containing the selected
'shape.  There are 2 methods to do the centering.
'Both give same results on limited basis.
'Macro assumes that
'   a) the current activewindow is the desired window
'   b) that the zoom level is unchanged.

    Dim vApp As Visio.Application
    Dim vWin As Visio.Window
    Dim vShp As Visio.Shape
    Dim dL As Double
    Dim dT As Double
    Dim dWid As Double
    Dim dHt As Double
    Dim cPinX As Visio.Cell
    Dim cPiny As Visio.Cell
   
    Set vApp = Visio.Application
    Set vShp = ActiveWindow.Selection(1)
    Set vWin = vShp.Application.ActiveWindow
   
'    vWin.Page = vShp.ContainingPage
   
    Set cPinX = vShp.Cells("PinX")
    Set cPiny = vShp.Cells("PinY")
   
    vWin.GetViewRect dL, dT, dWid, dHt
       
    dL = cPinX - dWid * 0.5
    dT = cPiny + dHt * 0.5
   
'    vWin.SetViewRect dL, dT, dWid, dHt
    vWin.CenterViewOnShape vShp, visCenterViewSelectShape
   
End Sub


[wapperdude]

Taking the big leap...I know Visisthebest had trouble with this method, but here is the simplist code implementation.

Code Select Expand


Sub cntrIt()
'Adapted from John Goldsmith and Visisthebest
'Macro centers the ActiveWindow containing the selected shape. 

'Macro assumes that
'   a) the current activewindow is the desired window
'   b) that the zoom level is unchanged.

    Dim vShp As Visio.Shape
   
    Set vShp = ActiveWindow.Selection(1)   
    Activewindow.CenterViewOnShape vShp, visCenterViewSelectShape
   
End Sub


[Visisthebest]

Thank you Wapperdude for the improved version, the adapted versions of Visio Guy's code work great every time I use them, but:

Activewindow.CenterViewOnShape vShp, visCenterViewSelectShape

just doesn't work reliably in some diagrams / use cases.

[wapperdude]

It was mostly a curiosity thing for me as you had a working solution.  There was some code line syntaxes that were unique to me that were revelatory.  Couple other things too. 

So, the window centering method has issues at times.  Being the kitty cat, what kinda response and is there something unique as far as the page or shape?  No pressure.  Just curious.  Might help if, unlikely, similar situation might arise.

[wapperdude]

LOL!!!  I was trying to find a scenario that breaks the CenterWindow method.  Instead, I came across scenario where it worked but the SetRect method failed miserably.  Well, it didn't fail in the sense that it didn't execute, but, it was very literal and that was very wrong.

Scenario:  draw some rectangles spread out across the page.  3 is plenty.  Don't put any of them in the center of the page.  Change the 1st rect to be a group.  Lock the length/width calculation.  Now, select it plus the other two and add to group.  Each of the group member's PinX and PinY values are now based upon the group and not the page.  Ominous drum roll. 

Select one of the subshapes.  Modify the macro to recognise the selection, something like:     
Set vShp = ActiveWindow.Page.Shapes.ItemFromID(4)  The actual shape ID may be different than "4".
Run the macro using the CenterWindow method and result is correct. 
Reset the window, and rerun macro using the SetRect method.  It too runs without execution error, but the window does not center on the shape... the PinX and PinY have incorrect values.

Apparent moral of the story, neither method seems to work for all cases.

[Visisthebest]

Good find Wapperdude!

The adapted version of Visio Guy's code works well for me, but apparently also not perfect.

Because these are customer diagrams I cannot share them, but I am pretty sure what some factors are.

They are very big (500+ shapes, some 2000+ shapes), bigger than an A0 poster often and a lot of shapes are on hidden layers at the time I am trying to center a shape (of course only doing this on shapes that are visible at the time).

These factors, the size and the hidden layers, may play a role.

[wapperdude]

Thanks for the info.  I may try the hidden layer scenario... or, if convenient, may be you could try a drawing by un-hiding all layers?

So,what happens on these drawings?  Does the routine run, but end up in completely wrong place?  Or, perhaps, the selected shape isn't quite, perfectly centered?

Edit:  Tried modest attempt using layers to hide some (most) shapes, on E size drawing.  The desired shape was a group subshape, and also looked at top level shape.  CenterWindows worked fine in both cases.  Didn't try SetRect method.

[Visisthebest]

What happens on a large diagram with the Visio built in function, the ActiveWindow view just doesn't move enough to center the specific shape or sometimes it hardly moves at all. I've tried the few options the function has (default or move only if shape out of view) but nothing works in these cases.

[wapperdude]

Good to know what behavior is.  As you have working solution, guess no interest in pursuing the cause of this.  Probably it's number of shapes thing which pushes the page size to be large in order to accommodate the all of the shapes.

The issue with the subshapes and secrecy ought to be fixed with bit more code.  Check if selection is member of group, if so, use, perhaps, some code to get equivalent page coordinates, and then proceed with those values.

[wapperdude]

Not sure getting PG location is straight forward.  Perhaps good test for the chatty AI?

[Visisthebest]

I am not impressed by the quality of the code produced by the LLMs for Visio. Lots of mistakes and often code that doesn't make sense at all.

[Visisthebest]

This forum and Stackoverflow still far outsmart the AIs for Visio.