How do I center and zoom on a shape?

[Michael Glenn]

Hello all,

I am in the process of writing a custom search form that gives me a list of
shapes. I want to be able to click on a search result, activate the
appropriate page and zoom in on the shape. I'm up to the "zoom in on the
shape part". How do I zoom the page and center it on the shape?

Thanks for your suggestions!

Michael

 

[Chris Roth [Visio MVP]]

Hi Michael,

You need these methods:

Get/SetViewRect
Get/SetWindowRect

The "Visio 2007 SDK" help file or MSDN are the best places to find more
on these guys.

Also, I think that the SDK has some samples using these methods.

Essentially, you translate what the window is showing from Windows
Pixels to page coordinates, and you can do all the zooming and panning
that you need to hone-in on your shape!

--
Hope this helps,

Chris Roth
Visio MVP


Visio Guy: Smart Graphics for Visual People

Articles: http://www.visguy.com
Shapes: http://www.visguy.com/shapes
Dev: http://www.visguy.com/category/development/
Forum: http://www.viguy.com/vgforum

 

[Michael Glenn]

Hello Chris,

Great! I can now jump from page to page and set the viewable area...I can't
for the life of me figure out where to get the coordinates of a shape! I
want to use these to set the page view coordinates to center the page on the
shape...

Help again!

Thanks

 

[AlEdlund]

You might try something like this,
al

'
' there is a problem with a 1D shape in that pinX/pinY
' may not be the real center of the shape
' debug on another day
'
Private Sub searchZoomObject(strObject As String)

On Error Resume Next

Dim visApp As Visio.Application
Dim visWin As Visio.Window
Dim visDoc As Visio.Document
Dim visPage As Visio.Page
Dim visShape As Visio.Shape
Dim visCell As Visio.Cell


Set visApp = ThisDocument.Application
Set visDoc = ThisDocument.pWorkDoc
Set visPage = visApp.ActivePage
Set visWin = visApp.ActiveWindow
visWin.DeselectAll


Set visShape = visPage.Shapes(strObject)

visWin.Select visShape, 2

Dim dblLeft As Double
dblLeft = 0
Dim dblTop As Double
dblTop = 0
Dim dblWidth As Double
dblWidth = 0
Dim dblHeight As Double
dblHeight = 0

Set visCell = visShape.Cells("width")
dblWidth = visCell.ResultIU

Set visCell = visShape.Cells("height")
dblHeight = visCell.ResultIU

Set visCell = visShape.Cells("pinx")
dblLeft = visCell.ResultIU - (dblWidth * 0.5)

Set visCell = visShape.Cells("piny")
dblTop = visCell.ResultIU + dblHeight + (dblHeight * 0.1)

dblHeight = dblHeight
dblWidth = dblWidth

visWin.SetViewRect dblLeft, dblTop, dblWidth, dblHeight

' show the linked record in the external data window
ShowSelectedObjectDataRecord visShape


End Sub


'
' if a shape is selected because of a search, the data link function may
' not be active so we force the display of the appropriate data recordset
'
Private Sub ShowSelectedObjectDataRecord(visShape As Visio.Shape)
'
' this piece of code handles selecting an object and then if it
' is linked to a data recordset, open the external data window and
' select the recordset and record appropriate to the object
'
Dim alngDataRecordsetIDs() As Long
Dim lngRowId As Long
Dim lngRecordSetId As Long
Dim winExternalData As Visio.Window
Dim visDataRecordset As Visio.DataRecordset
Dim intX As Integer

' get the list of recordset ids associated if any
visShape.GetLinkedDataRecordsetIDs alngDataRecordsetIDs

If UBound(alngDataRecordsetIDs) <> -1 Then
' take the first recordset id
lngRecordSetId = alngDataRecordsetIDs(0)
' get the associate row id
lngRowId = visShape.GetLinkedDataRow(lngRecordSetId)
Set winExternalData =
Application.ActiveWindow.Windows.ItemFromID(visWinIDExternalData)
' show the external data window
winExternalData.Visible = True
' set the linked row
Set visDataRecordset =
Application.ActiveDocument.DataRecordsets.ItemFromID(lngRecordSetId)
winExternalData.SelectedDataRecordset = visDataRecordset
winExternalData.SelectedDataRowID = lngRowId
End If ' test for number of recorsetids associated


End Sub

 

[Michael Glenn]

Actually, I found an easier way to do what I want, but I get an error I'm
having trouble figuring out. I get a "Inappropriate target object for this
action" on the line

ActiveWindow.Selection = vsoSelection

in the code below.

Any ideas?

Here's the code:

Sub HighlightShape(aShape As Shape)
Dim vsoSelection As Visio.Selection

'If the shape contains other shapes, recursively call the highlight
routine
If aShape.Shapes.Count > 0 Then
For n = 1 To aShape.Shapes.Count
HighlightShape aShape.Shapes(n)
Next
Else
'If the text property of this shape contains the search string,
highlight it
If InStr(1, aShape.Text, CMDBSearchForm.CIName, vbTextCompare) > 0
Then
'Display the page containing the shape in the active window
ActiveWindow.Page = aShape.ContainingPage

'Set the active window selection to be the shape we want to
highlight
Application.Settings.CenterSelectionOnZoom = True
Call Application.ActiveWindow.DeselectAll
Set vsoSelection = aShape.ContainingPage.CreateSelection(0)
Call vsoSelection.Select(aShape, 2)
ActiveWindow.Selection = vsoSelection

'Zoom onto the selected shape
ActiveWindow.Zoom = 2

'Prompt to go on to next shape found
MsgBox ("Next")
End If
End If
End Sub

 

[Michael Glenn]

Ok, I found this one myself while going through some other posts...
Apparently, the ActiveWindow selection doesn't like it when I try to add a
shape that has a parent shape...if I use shape.parent everything works fine!

 

[Scott Helmers]

Michael,

I just happened across your original post -- and was going to suggest the
solution that you discovered for yourself, namely using
Application.Settings.CenterSelectionOnZoom = True

I've used this before and have one suggestion: you probably want to set it
back to the Visio default (False) when you're finished because this setting
is saved across Visio sessions -- which may or may not be what you want. Even
better: save the current value of the setting before setting it to True, then
restore the initial value before you exit.

Scott

Actually, I found an easier way to do what I want

<snip>