vba 添加选择集的问题

liujiping

我在用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行，以后都正常。
  这是什么原因？请各位帮忙看看，指点

3kd

这很正常呀。

mccad

选择集不能同名，也就是说你在第一次建立了名称为sset的选择集，第二次就不能再建立该名称的选择集了。
你可以先查看是否有该选择集存在，如果存在则清空，如果不在则新建。

myfreemind

For i = 0 To ThisDrawing.SelectionSets.Count - 1
ThisDrawing.SelectionSets.Item(i).Clear
ThisDrawing.SelectionSets.Item(i).Delete
Next

mccad

象这个问题在实用函数中已经有现有的函数供使用

pzddzp

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
If  Not BL0 Then
     Set Selset = ThisDrawing.SelectionSets.Add("sset") '添加选择集Selset
End If
Selset.SelectOnScreen '直接在屏幕上选择

mccad

2. Public Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
   
3. 
   
4.     Dim ss As AcadSelectionSet
   
5.    
   
6.     On Error Resume Next
   
7.     Set ss = ThisDrawing.SelectionSets(ssName)
   
8.     If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
   
9.     ss.Clear
   
10.     Set CreateSelectionSet = ss
    
11. End Function
    

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 />

liujiping

非常感谢各位的指点！

bluelover

我的做法是直接在新建选择集之前加上一句：
On Error Resume Next
好象就没有这个问题了

liujiping

这样还行，不过还是斑竹的够专业！！