删除一个图层上的所有实体，用什么办法比较好呢？
我目前用的方法是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中实体数量很大的时候就很慢了，请问有没有更好的办法呢？ 用选择集的方法比较好 如何使用选择集？ Sub DelLayEnt()
Dim LayerName As String
LayerName = "0"'这里保存着要删除的图层名称
Dim ss As AcadSelectionSet
Set ss = CreateSelectionSet()
Dim fType As Variant
Dim fDate As Variant
BuildFilter fType, fData, 8, LayerName
ss.Select acSelectionSetAll, , , fType, fData
Dim Ent As AcadEntity
For Each Ent In ss
Ent.Delete
Next
Update
Debug.Print "所有在图层" & LayerName & "上的对象都已经被删除了。"
End Sub
Public Sub BuildFilter(typeArray, dataArray, ParamArray gCodes())
Dim fType() As Integer, fData()
Dim index As Long, i As Long
index = LBound(gCodes) - 1
For i = LBound(gCodes) To UBound(gCodes) Step 2
index = index + 1
ReDim Preserve fType(0 To index)
ReDim Preserve fData(0 To index)
fType(index) = CInt(gCodes(i))
fData(index) = gCodes(i + 1)
Next
typeArray = fType: dataArray = fData
End Sub
Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
Dim ss As AcadSelectionSet
On Error Resume Next
Set ss = ThisDrawing.SelectionSets(ssName)
If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
ss.Clear
Set CreateSelectionSet = ss
End Function
谢谢mccad，代码非常好用 这个是什么语言的代码
页:
[1]