[编程申请]：一个图块中包含多个属性时.......

kfboyxwa

能否一次将多个属性的字高改变??

efan2000

这个要通过编程实现，不知道在CAD2002后的版本中有没有改进。

yi.gao

改变属性的特性设置需要进行属性更新的操作。这从R14版就已经有了，在2002里属性更新命令已经更名为“同步属性”。无论在什么版本里，属性更新的方法都是将含有属性的图块分解，然后修改属性定义的设置，最后做属性更新或同步属性的操作。属性更新后，属性值是不变的，改变的只是属性特性。如有问题，请致yi.gao@163.com。祝顺利。

efan2000

2. 
   
3.   [FONT=courier new]
   
4. 
   
5. Public Sub ChangeTextHeight()
   
6.     On Error GoTo ErrTrap
   
7.     Dim EntObj As AcadEntity
   
8.     Dim pPt As Variant
   
9.     ThisDrawing.Utility.GetEntity EntObj, pPt, "请选择块: "
   
10.     Dim Height As Double
    
11.     Height = ThisDrawing.Utility.GetReal("输入属性高度: ")
    
12.     If Height = 0 Then Exit Sub
    
13.     Dim AttRefs As Variant
    
14.     If EntObj.HasAttributes Then AttRefs = EntObj.GetAttributes
    
15.     If IsEmpty(AttRefs) Then Exit Sub
    
16.     Dim i As Integer
    
17.     For i = 0 To UBound(AttRefs)
    
18.         AttRefs(i).Height = Height
    
19.     Next
    
20.     Set EntObj = Nothing
    
21.     Exit Sub
    
22.    
    
23. ErrTrap:
    
24.     If ThisDrawing.GetVariable("errno") = 7 Then Resume
    
25.     On Error GoTo 0
    
26. End Sub
    
27. 
    
28.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br /> Public Sub ChangeTextHeight()<br />     On Error GoTo ErrTrap<br />     Dim EntObj As AcadEntity<br />     Dim pPt As Variant<br />     ThisDrawing.Utility.GetEntity EntObj, pPt, "请选择块: "<br />     Dim Height As Double<br />     Height = ThisDrawing.Utility.GetReal("输入属性高度: ")<br />     If Height = 0 Then Exit Sub<br />     Dim AttRefs As Variant<br />     If EntObj.HasAttributes Then AttRefs = EntObj.GetAttributes<br />     If IsEmpty(AttRefs) Then Exit Sub<br />     Dim i As Integer<br />     For i = 0 To UBound(AttRefs)<br />         AttRefs(i).Height = Height<br />     Next<br />     Set EntObj = Nothing<br />     Exit Sub<br />     <br /> ErrTrap:<br />     If ThisDrawing.GetVariable("errno") = 7 Then Resume<br />     On Error GoTo 0<br /> End Sub<br /> <br />   [/FONT]<br />

用上面的代码试试一下，它可实现把块中的属性更改字高。