[VBA函数]：创建空选择集

fjw_ok

用途：消除烦人的选择集已经存在问题
代码：
Public SUB CreateNUN(Optional Name As String = "AAA") As AcadSelectionSet

    Dim  AAA  As AcadSelectionSet
   
    On Error Resume Next
    Set ss = ThisDrawing.SelectionSets(ssName)
    If Err Then Set AAA= ThisDrawing.SelectionSets.Add(Name)
    AAA.Clear
    Set CreateSelectionSet = AAA
End Function

efan2000

对，重复的东西就是计算机的工作了。
上面的例程还可以这样子：

2. 
   
3.   [FONT=courier new]
   
4.     Dim EntObj As AcadSelectionSet
   
5.     On Error Resume Next
   
6.     If Name = "" Then
   
7.         Set ss = ThisDrawing.PickfirstSelectionSet '用于执行命令前是否已经选择了实体，如CAD中的旋转、移动就是采用这种做法。
   
8. '注意这里不能把选择集中的实体清除了，这正是我们所需要的。
   
9.          Exit Function
   
10.     Else
    
11.         Set ss = ThisDrawing.SelectionSets(Name)
    
12.         If Err Then Set ss= ThisDrawing.SelectionSets.Add(Name) '不存在就创建一个。
    
13.          ss.Clear '清除选择集中的所有实体。
    
14.     End If
    
15.   [/FONT]
    

<br />   [FONT=courier new]<br />     Dim EntObj As AcadSelectionSet<br />     On Error Resume Next<br />     If Name = "" Then<br />         Set ss = ThisDrawing.PickfirstSelectionSet '用于执行命令前是否已经选择了实体，如CAD中的旋转、移动就是采用这种做法。<br /> '注意这里不能把选择集中的实体清除了，这正是我们所需要的。<br />          Exit Function<br />     Else<br />         Set ss = ThisDrawing.SelectionSets(Name)<br />         If Err Then Set ss= ThisDrawing.SelectionSets.Add(Name) '不存在就创建一个。<br />          ss.Clear '清除选择集中的所有实体。<br />     End If<br />   [/FONT]<br />

foxzz

Dim m_iii As Integer
For m_iii = 0 To AcadApp.ActiveDocument.SelectionSets.Count - 1
    If AcadApp.ActiveDocument.SelectionSets.Item(m_iii).Name = "AAA" Then
       AcadApp.ActiveDocument.SelectionSets.Item(m_iii).Delete
    End If
Next

cityplan

三楼的方法比较合理，用ON ERROR总是有些不妥！