Sign in
 
Home20132010Other VersionsLibraryForumsGallery
TechCenter >
> 
> 
Scale Shape on Zoom

Answered Scale Shape on Zoom

  • Thursday, March 22, 2012 2:58 PM
     
      Has Code
    Sign In to Vote
    0

    Web maps have push pin location shapes that rescale to maintain the same size when zooming in and out.  I'd like to mimic that behavior in Visio 2010.

    So I created a push pin Visio Shape (0.5 in Height, 0.25 in Width) to recreate that feature, but it's not clear to me how to edit the Height/Width ShapeSheet cells with a zoom status formula.  I did a Macro capture of a down, up and back zoom using View->Zoom that generated this code:

    Sub Macro2()

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140

    Application.ActiveWindow.Zoom = 0.75

    Application.ActiveWindow.Zoom = 1.5

    Application.ActiveWindow.Zoom = 1#

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

    I see that I would divide the base values by the zoom value.  But don't know the way to refer to the ActiveWindow zoom value.  Any clever ideas on how to complete the process?

    Thanks,

    Steve

    Steve Mack


    • Edited by Stephen Mack Thursday, March 22, 2012 3:02 PM
    •  
     

All Replies

  • Thursday, March 22, 2012 3:33 PM
     
     Answered
    Sign In to Vote
    0

    Steve,

    I use something like this to zoom on a shape,

    hth,

    al

        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

    If this answer solves your problem, please check Mark as Answered. If this answer helps, please click the Vote as Helpful button. Al Edlund Visio MVP