[VBA程序]： 怎么样改变标注比例

xsquan

为什么我用LinearScaleFactor 来改变改变标注比例，不行呢？
请问是怎么样做的？

efan2000

如果是改变尺寸值的高度，用TextHeight属性，
如果是改变尺寸值的宽高比例，用ScaleFactor属性，
如果是改变标注对象的整体比例，用ScaleEntity方法。

xsquan

如果图上距离是100，我要标准的是10，应该怎么样让标准的是10而不是100

efan2000

这个可以用标注对象的TextOverrid属性来实现，它的作用就是用自己定义的尺寸代替标注当中的实际测量值，恢复时只要把它设为空字符串就可以了。
如下：

1. 
   
2.   [FONT=courier new]
   
3. 
   
4.     ' dimObj.Measurement的值为100，测量值，只读。
   
5.     dimObj.TextOverride = "10"
   
6.     dimObj.Update
   
7. 
   
8.     ' 恢复测量尺寸
   
9.     dimObj.TextOverride = ""
   
10.     dimObj.Update
    
11. 
    
12.   [/FONT]
    

复制代码

xsquan

如果我有好多这样的标注，这样是不是很麻烦？
l=obj.Measurement
obj.TextOverride =l/10
obj.update
这样我想也行吧，不过，有点麻烦，要是有一个想在cad那样的设一个比例，它就可以改过来，
那多好！

efan2000

如果仅是简单的比例变化，可以用LinearScaleFactor属性啊，但它只对这几种标注对象有用：DimAligned, DimDiametric, DimOrdinate, DimRadial, DimRotated，你可能设置了对其它的标注对象进行这种操作了，它的值必须大于零。

efan2000

下面是一个通用的函数设置线性标注比例。
传入的参数：SSetObj ，选择集对象。LinearScaleFactor，线性比例因子。

2. 
   
3.   [FONT=courier new]
   
4. Public Sub DimLinearScaleFactor(ByVal SSetObj As AcadSelectionSet, ByVal LinearScaleFactor As Double)
   
5.     Dim i As Integer
   
6.     For i = 0 To SSetObj.Count - 1
   
7.         If SSetObj(i).ObjectName = "AcDbAlignedDimension" _
   
8.             Or SSetObj(i).ObjectName = "AcDbDiametricDimension" _
   
9.             Or SSetObj(i).ObjectName = "AcDbOrdinateDimension" _
   
10.             Or SSetObj(i).ObjectName = "AcDbRadialDimension" _
    
11.             Or SSetObj(i).ObjectName = "AcDbRotatedDimension" Then
    
12.                 SSetObj(i).LinearScaleFactor = LinearScaleFactor
    
13.         End If
    
14.     Next
    
15. End Sub
    
16.   [/FONT]
    

<br />   [FONT=courier new]<br /> Public Sub DimLinearScaleFactor(ByVal SSetObj As AcadSelectionSet, ByVal LinearScaleFactor As Double)<br />     Dim i As Integer<br />     For i = 0 To SSetObj.Count - 1<br />         If SSetObj(i).ObjectName = "AcDbAlignedDimension" _<br />             Or SSetObj(i).ObjectName = "AcDbDiametricDimension" _<br />             Or SSetObj(i).ObjectName = "AcDbOrdinateDimension" _<br />             Or SSetObj(i).ObjectName = "AcDbRadialDimension" _<br />             Or SSetObj(i).ObjectName = "AcDbRotatedDimension" Then<br />                 SSetObj(i).LinearScaleFactor = LinearScaleFactor<br />         End If<br />     Next<br /> End Sub<br />   [/FONT]<br />