删除一个图层上的所有实体，用什么办法比较好呢？

topirol

我目前用的方法是
for i=0 to mospace.count-1 step 1

if mospace.item(i).layer="kk" then
set entry=mospace.item(i)
entry.delete
end if
next

但如果mospace中实体数量很大的时候就很慢了，请问有没有更好的办法呢？

mccad

用选择集的方法比较好

dongcijie

如何使用选择集？

mccad

2. Sub DelLayEnt()
   
3.     Dim LayerName As String
   
4.     LayerName = "0"  '这里保存着要删除的图层名称
   
5.     Dim ss As AcadSelectionSet
   
6.     Set ss = CreateSelectionSet()
   
7.     Dim fType As Variant
   
8.     Dim fDate As Variant
   
9.     BuildFilter fType, fData, 8, LayerName
   
10.     ss.Select acSelectionSetAll, , , fType, fData
    
11.     Dim Ent As AcadEntity
    
12.     For Each Ent In ss
    
13.         Ent.Delete
    
14.     Next
    
15.     Update
    
16.     Debug.Print "所有在图层" & LayerName & "上的对象都已经被删除了。"
    
17. End Sub
    
18. 
    
19. Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
    
20.     Dim fType() As Integer, fData()
    
21.     Dim index As Long, i As Long
    
22.    
    
23.     index = LBound(gCodes) - 1
    
24.         
    
25.     For i = LBound(gCodes) To UBound(gCodes) Step 2
    
26.         index = index + 1
    
27.         ReDim Preserve fType(0 To index)
    
28.         ReDim Preserve fData(0 To index)
    
29.         fType(index) = CInt(gCodes(i))
    
30.         fData(index) = gCodes(i + 1)
    
31.     Next
    
32.     typeArray = fType: dataArray = fData
    
33. End Sub
    
34. 
    
35. Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
    
36. 
    
37.     Dim ss As AcadSelectionSet
    
38.    
    
39.     On Error Resume Next
    
40.     Set ss = ThisDrawing.SelectionSets(ssName)
    
41.     If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
    
42.     ss.Clear
    
43.     Set CreateSelectionSet = ss
    
44. End Function
    
45. 
    

Sub DelLayEnt()<br />     Dim LayerName As String<br />     LayerName = "0"  '这里保存着要删除的图层名称<br />     Dim ss As AcadSelectionSet<br />     Set ss = CreateSelectionSet()<br />     Dim fType As Variant<br />     Dim fDate As Variant<br />     BuildFilter fType, fData, 8, LayerName<br />     ss.Select acSelectionSetAll, , , fType, fData<br />     Dim Ent As AcadEntity<br />     For Each Ent In ss<br />         Ent.Delete<br />     Next<br />     Update<br />     Debug.Print "所有在图层" & LayerName & "上的对象都已经被删除了。"<br /> End Sub<br /> <br /> Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())<br />     Dim fType() As Integer, fData()<br />     Dim index As Long, i As Long<br />     <br />     index = LBound(gCodes) - 1<br />         <br />     For i = LBound(gCodes) To UBound(gCodes) Step 2<br />         index = index + 1<br />         ReDim Preserve fType(0 To index)<br />         ReDim Preserve fData(0 To index)<br />         fType(index) = CInt(gCodes(i))<br />         fData(index) = gCodes(i + 1)<br />     Next<br />     typeArray = fType: dataArray = fData<br /> End Sub<br /> <br /> Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet<br /> <br />     Dim ss As AcadSelectionSet<br />     <br />     On Error Resume Next<br />     Set ss = ThisDrawing.SelectionSets(ssName)<br />     If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)<br />     ss.Clear<br />     Set CreateSelectionSet = ss<br /> End Function<br /> <br />

清风明月名字

谢谢mccad，代码非常好用

千度Show颖

这个是什么语言的代码