vba 添加选择集的问题
我在用VBA做CAD二次开发时,定义一个选择集。程序如下:Dim Selset As AcadSelectionSet '定义一个选择集"Selset"
UserForm2.Hide
If Not IsNull(ThisDrawing.SelectionSets.Item("sset")) Then
Set Selset = ThisDrawing.SelectionSets.Item("sset")
Selset.Delete '如果选择集已存在,则删除
End If
Set Selset = ThisDrawing.SelectionSets.Add("sset") '添加选择集Selset
Selset.SelectOnScreen '直接在屏幕上选择
运行时,提示“方法‘item’ ,作用于对象‘IACADSelectionSets’时失败”
1)去掉3-5行,正常。
2) 但第二次运行时出错。此时在加上3-5行,以后都正常。
这是什么原因?请各位帮忙看看,指点
re:
这很正常呀。 选择集不能同名,也就是说你在第一次建立了名称为sset的选择集,第二次就不能再建立该名称的选择集了。你可以先查看是否有该选择集存在,如果存在则清空,如果不在则新建。
加上下列代码
For i = 0 To ThisDrawing.SelectionSets.Count - 1ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next 象这个问题在实用函数中已经有现有的函数供使用 For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next
这样会不会把你不想删除的选择集也误删掉呢?
我想这样更好一点
Dim I As Integer
Dim BL0 As Boolean
Dim Str1 As String
Str1 = "sset"
BL0 = False
For I = ThisDrawing.SelectionSets.Count - 1 To 0 Step -1
If ThisDrawing.SelectionSets(I).Name = Str1 Then
BL0 = True
End If
Next I
IfNot BL0 Then
Set Selset = ThisDrawing.SelectionSets.Add("sset") '添加选择集Selset
End If
Selset.SelectOnScreen '直接在屏幕上选择 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
非常感谢各位的指点! 我的做法是直接在新建选择集之前加上一句:
On Error Resume Next
好象就没有这个问题了 这样还行,不过还是斑竹的够专业!!
页:
[1]
2