[VBA函数]：用VBA清理空文本

efan2000

在CAD中，如果属性定义的标签（TagString）或者单行文本和多行文本的文本（TextString）为空字符串的话，那么这些对象在屏幕上就不会显示出来，就如隐藏一样，但在使用当中又不可能为人所注意，这时就可以把这些清理掉。
以下的例子实现了这个功能。

2. 
   
3.   [FONT=courier new]
   
4. 
   
5. Public Sub TextPurge()
   
6.     '创建选择集，名称为TextPurge
   
7.     Dim SSetObj As AcadSelectionSet
   
8.     Set SSetObj = ThisDrawing.SelectionSets.Add("TextPurge")
   
9.     '创建过滤器，仅选择Attdef（属性定义）、Text（单行文本）、Mtext（多行文本）
   
10.     '关于过滤器的使用，请参考有关书籍
    
11.     Dim fType(0 To 0) As Integer
    
12.     Dim fData(0 To 0) As Variant
    
13.     fType(0) = 0
    
14.     fData(0) = "Attdef,Text,Mtext"
    
15.     '选择全部的Attdef、Text、Mtext
    
16.     SSetObj.Select acSelectionSetAll, , , fType, fData
    
17.     If SSetObj.Count <> 0 Then
    
18.         Dim i As Integer
    
19.         For i = 0 To SSetObj.Count - 1
    
20.             '在Attdef中显示的是TagString，在Text和Mtext中显示的是TextString
    
21.             If TypeOf SSetObj(i) Is AcadAttribute Then
    
22.                 If SSetObj(i).TagString = "" Then SSetObj(i).Delete
    
23.             Else
    
24.                 If SSetObj(i).TextString = "" Then SSetObj(i).Delete
    
25.             End If
    
26.         Next
    
27.     End If
    
28.     SSetObj.Delete
    
29.     Set SSetObj = Nothing
    
30. End Sub
    
31. 
    
32.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br /> Public Sub TextPurge()<br />     '创建选择集，名称为TextPurge<br />     Dim SSetObj As AcadSelectionSet<br />     Set SSetObj = ThisDrawing.SelectionSets.Add("TextPurge")<br />     '创建过滤器，仅选择Attdef（属性定义）、Text（单行文本）、Mtext（多行文本）<br />     '关于过滤器的使用，请参考有关书籍<br />     Dim fType(0 To 0) As Integer<br />     Dim fData(0 To 0) As Variant<br />     fType(0) = 0<br />     fData(0) = "Attdef,Text,Mtext"<br />     '选择全部的Attdef、Text、Mtext<br />     SSetObj.Select acSelectionSetAll, , , fType, fData<br />     If SSetObj.Count <> 0 Then<br />         Dim i As Integer<br />         For i = 0 To SSetObj.Count - 1<br />             '在Attdef中显示的是TagString，在Text和Mtext中显示的是TextString<br />             If TypeOf SSetObj(i) Is AcadAttribute Then<br />                 If SSetObj(i).TagString = "" Then SSetObj(i).Delete<br />             Else<br />                 If SSetObj(i).TextString = "" Then SSetObj(i).Delete<br />             End If<br />         Next<br />     End If<br />     SSetObj.Delete<br />     Set SSetObj = Nothing<br /> End Sub<br /> <br />   [/FONT]<br />

indal

清理空块是这是也差不多呀？？？

efan2000

对，其实可以对常用的如块、组、选择集之类的清理各自编个函数，方便以后直接调用就可以了。