如何在 ms visio 中正确设置线缩放

Question

我试图在 Visio 中创建可缩放的形状我设法为文本设置了缩放比例，但是当涉及到线条时我无法让它工作：

我这里有形状

我按照此处所述设置线宽http://visguy.com/vgforum/index.php?topic=5261.0

现在我将页面的比例设置为公制 1:5

我有一个以太网交换机形状，需要那个比例以适合页面。

所以，当我这样做时，我得到了这个：

所以它根本没有缩放线条。

如何解决？

Answer 1

其实很简单，你需要使用来自 - http://visguy.com/vgforum/index.php?topic=5261.0

的高级公式

您需要添加用户单元格：

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

现在只需设置公式

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

对于我的示例，我有 1 个矩形和线条形状

对于矩形你需要这个设置

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

在公式中设置第一个数字为线宽

LineWeight  = SETATREFEXPR(2.5 pt)...

行

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

就这些。好吧，它似乎不是 100% 准确，但在缩放到更小的尺寸时，到目前为止看起来还不错。

Answer 2

为此我只使用复制粘贴一个影响当前页面上所有形状的简单脚本

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

我想补充一些想法 - 不是批评，只是供那些将来登陆这里的人或想尝试其他东西的人思考。

我们可能应该首先质疑您为什么要更改线比例。

Visio 的许多“抗缩放”公式将形状的原始高度与形状的当前高度进行比较（通常用于调整文本大小），但我认为您的情况并非如此。这会导致不同尺寸的形状具有不同的线宽，但您仍然希望页面上的所有形状具有一致的线宽。

你只需要在绘图比例超过各种阈值时减少线宽，其他答案似乎已经解决了这个问题。我担心的一些细节：

形状通常是分组的，因此您需要挖掘子形状并设置它们的线宽。
如果您以后要再次更改比例，您的代码是否能够再次正确更改线宽？想一想你可以向上或向下调整线宽的方法，这样你就可以回到你开始的地方:)
您也许可以编辑单个样式属性，从而省去很多麻烦。如果绘图文件中只有一页，或者绘图中的所有页面都具有相同的比例，那么您可以尝试编辑 Normal 样式。您可以使用 Drawing Explorer window 获得 Normal 样式。右键单击并显示 ShapeSheet。然后编辑样式的线宽 - 将其除以 3 或 4。所有形状都会更改（除非您已经明确应用了不同的线宽）Visio 具有某种格式样式的继承层次结构，您可以利用的。

请考虑完全不更改绘图比例！只是把页面变大。浏览“页面设置”对话框的选项卡。您可以使页面越来越大以适合您的形状。打印时，只需确保“适合 1 页，向下 1 页”。然后打印过程将处理缩放，你可以避免整个战斗！

如何在 ms visio 中正确设置线缩放

How properly set line scaling in ms visio

visio

line

scale

shapes