[VBA程序]：一次统一所有文字风格[上传]

chenlei

请指正。

efan2000

对于你的程序，思路是不错的，但设置相对比较繁琐，我修改了一下，可直接借用CAD的文本样式设置功能来进行处理。

2. 
   
3.   [FONT=courier new]
   
4. 
   
5. Sub Test()
   
6.     ' 用法：首先把要统一的文本样式设置为当前的文本样式，
   
7.     '       程序自动把当前图形中的所有文本对象的样式名称设置为当前的文本样式的名称
   
8.     '       对于当前图形中的所有单行文本对象的宽度比例因子设置为当前的文本样式的宽度比例因子
   
9.    
   
10.     On Error Resume Next
    
11.    
    
12.     ' 设置文本样式
    
13.     ThisDrawing.SendCommand "'_style" & vbCr
    
14. 
    
15.     ' 创建选择集
    
16.     Dim ssetObj As AcadSelectionSet
    
17.     Set ssetObj = ThisDrawing.SelectionSets("SSET")
    
18.     If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")
    
19.    
    
20.     ' 使用过滤机制，仅选择文本对象
    
21.     Dim gpCode(0) As Integer
    
22.     Dim dataValue(0) As Variant
    
23.     gpCode(0) = 0
    
24.     dataValue(0) = "*Text"
    
25.    
    
26.     ' 使用过滤机制，添加所有的文本对象到选择集
    
27.     ssetObj.Select acSelectionSetAll, , , gpCode, dataValue
    
28.    
    
29.     ' 枚举文本对象，更改文本样式
    
30.     Dim i As Integer
    
31.     For i = 0 To ssetObj.Count - 1
    
32.         ssetObj(i).StyleName = ThisDrawing.ActiveTextStyle.Name '使用当前的文本样式
    
33.         If TypeOf ssetObj(i) Is AcadText Then ssetObj(i).ScaleFactor = ThisDrawing.ActiveTextStyle.Width '对于单行文本设置宽度比例因子
    
34.     Next
    
35. End Sub
    
36.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br /> Sub Test()<br />     ' 用法：首先把要统一的文本样式设置为当前的文本样式，<br />     '       程序自动把当前图形中的所有文本对象的样式名称设置为当前的文本样式的名称<br />     '       对于当前图形中的所有单行文本对象的宽度比例因子设置为当前的文本样式的宽度比例因子<br />     <br />     On Error Resume Next<br />     <br />     ' 设置文本样式<br />     ThisDrawing.SendCommand "'_style" & vbCr<br /> <br />     ' 创建选择集<br />     Dim ssetObj As AcadSelectionSet<br />     Set ssetObj = ThisDrawing.SelectionSets("SSET")<br />     If Err Then Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br />     <br />     ' 使用过滤机制，仅选择文本对象<br />     Dim gpCode(0) As Integer<br />     Dim dataValue(0) As Variant<br />     gpCode(0) = 0<br />     dataValue(0) = "*Text"<br />     <br />     ' 使用过滤机制，添加所有的文本对象到选择集<br />     ssetObj.Select acSelectionSetAll, , , gpCode, dataValue<br />     <br />     ' 枚举文本对象，更改文本样式<br />     Dim i As Integer<br />     For i = 0 To ssetObj.Count - 1<br />         ssetObj(i).StyleName = ThisDrawing.ActiveTextStyle.Name '使用当前的文本样式<br />         If TypeOf ssetObj(i) Is AcadText Then ssetObj(i).ScaleFactor = ThisDrawing.ActiveTextStyle.Width '对于单行文本设置宽度比例因子<br />     Next<br /> End Sub<br />   [/FONT]<br />

chenlei

是的，选择集我不太会用，我用地毯式搜索，效率低了点。好在现在机器快。