How properly set line scaling in ms visio

Question

I trying to create scallable shapes in Visio I manage to set scaling for text, but when it comes to lines i cant make it work:

Here i have shape

I setup linewidth as described here http://visguy.com/vgforum/index.php?topic=5261.0

Now i set scale for a page to metric 1:5

I have a ethernet switch shape and need that scale so it fit on page.

So, when i did it, i get this:

So it did not scale lines at all.

How to fix it?

Answer 1

It's pretty simple actually, you need use advanced formula from - http://visguy.com/vgforum/index.php?topic=5261.0

You need add User Cells:

User.Width_LineWeight = 2 in
User.Height_LineWeight = 1 in
User.AntiScale = ThePage!PageScale/ThePage!DrawingScale

now just set formula

LineWeight  = SETATREFEXPR(1 pt) * (Width / SETATREF(User.Width_LineWeight, SETATREFEVAL(Width)) + Height / SETATREF(User.Height_LineWeight, SETATREFEVAL(Height))) / 2  *  User.AntiScale

For my example i have 1 rectangle shape and line shape

For rectangle you need this settings

User.Width_LineWeight = set rect real width
User.Height_LineWeight = set rect real height

In formula set first number as line width

LineWeight  = SETATREFEXPR(2.5 pt)...

For line

User.Width_LineWeight = set line width in pt
User.Height_LineWeight = set to 1

That all. Well it seems not 100% accurate, but on scaling to smaller sizes it so far looks just fine.

Answer 2

For this I just use copy paste a simple script that affects all shapes on the current page

Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()
Private Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function SetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Boolean
'Used for Localization compability
 
Public Function loopShapes(ByRef shapes) As Long
Debug.Print "loopShapes called:"
Dim shapeCount As Long
shapeCount = 0

For Each shape In shapes
Call WriteCell(shape)
shapeCount = shapeCount + loopShapes(shape.shapes)
Debug.Print shape
Next
Debug.Print "count:"
Debug.Print shapeCount
countShapes = shapeCount + 1
End Function
 
Public Sub ResizeWeightWith()
 
'Declare object variables as Visio object types.
Dim vsoPage As Visio.Page
Dim vsoDocument As Visio.Document
Dim vsoDocuments As Visio.Documents
Dim vsoPages As Visio.Pages
Dim a As Visio.shapes
 
' record the settings in the variable LocalSettingsDecimal
Dim LocalSettingsDecimal As String
Dim Buffer As String
Buffer = String(256, 0)
Dim le As Integer
le = GetLocaleInfoA(GetUserDefaultLCID(), 14, Buffer, Len(Buffer))
LocalSettingsDecimal = Left(Buffer, le - 1)
 
' force decimal settings to '.'
Call SetLocaleInfoA(GetUserDefaultLCID(), 14, ".")
 
'Iterate through all open documents.
Set vsoDocuments = Application.Documents
Set a = Application.Documents.Item(1).Pages.Item(1).shapes
Debug.Print loopShapes(Application.Documents.Item(1).Pages.Item(1).shapes)

Call SetLocaleInfoA(GetUserDefaultLCID(), 14, LocalSettingsDecimal)
 
End Sub

Sub WriteCell(ByRef shape)

   On Error Resume Next
   Dim l As String
 
l = shape.CellsSRC(visSectionObject, visRowLine, visLineWeight) / (10 * shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight) * shape.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight)) & "*Width*Height"
  Debug.Print l
shape.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = l
    
End Sub

Answer 3

I wanted to add some thoughts - not meant as criticisms, just food for thought for those who land here in the future, or those who want to try some other things out.

We should probably question why you want to change the line scale in the first place.

A lot of "antiscaling" formulas for Visio compare the original height of a shape to the current height of the shape (often for resizing text), but I don't think that is your case. This would result in different lineweights for shapes of differing sizes, but you still want all shapes on the page to have consistent lineweights.

You just need to reduce the lineweights when drawing scales cross various threshholds, and the other answers seem to have figured this out. A few details that I worry about:

1. Shapes are often grouped, so you need to dig into sub shapes and set their lineweights.
2. If you are going to change the scale again in the future, will your code be able to properly change the lineweights again? Think about ways that you can adjust the lineweights up or down such that you can get back to where you started :)
3. You may be able to edit a single style attribute and save yourself a lot of trouble. If you have only one page in your drawing file, or if all of the pages in your drawing have the same scale, then you might try editing the Normal style. You can use the Drawing Explorer window to get at the Normal style. Right-click and Show ShapeSheet. Then edit the Lineweight for the style - divide it by, say, 3 or 4. All of the shapes will change (except where you have explicitly applied distinct lineweights already) Visio has some sort of inheritance hierarchy for formatting styles that you can take advantage of.

4. Consider NOT changing the drawing scale at all! Just make the page bigger. Explore the Page Setup dialog's tabs. You can make the page bigger and bigger to fit your shapes. When you go to print, just make sure to "fit to 1 page across by 1 page down". Then the printing process will handle the scaling, and you can avoid this whole fight!