关于SelecOnScreen的问题求教,急!

ivy.xiaoyu

最近学习VBA遇到了些困难,

其中有一个,当我试图在模块里建立一个Sub过程时:代码如下:

Sub Example_SelectOnScreen()
        
    ' Create the selection set
    Dim ssetObj As AcadSelectionSet
    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")
    
    ' Add objects to a selection set by prompting user to select on the screen
    ssetObj.SelectOnScreen
    
End Sub

问题出现在只能运行一次,运行第二次的时候就回出现"命名选择集已存在"的错误,研究了一天也没改出来,

请高手指教啊

xinglee

修改为如下试试：

Dim ssetObj As AcadSelectionSet
    on error resume netx

    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")
    if err>0 then

      ThisDrawing.SelectionSets.delete("TEST_SSET")
      Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET")

   endif


    ' Add objects to a selection set by prompting user to select on the screen

    ssetObj.SelectOnScreen

ivy.xiaoyu

谢谢楼上的回复!

不过好象其中的:ThisDrawing.SelectionSets.delete("TEST_SSET")

有点问题啊,SelectionSets本身并没有Delete方法啊

hbyu2003

 '创建安全选择集
    If Not IsNull(ThisDrawing.SelectionSets.Item("SS5")) Then
        Set sstext = ThisDrawing.SelectionSets.Item("SS5")
        sstext.Delete
    End If
   Set sstext = ThisDrawing.SelectionSets.Add("SS5")

按这种方式设置选择集就行了。

ivy.xiaoyu

问题已经解决 ,多谢谢两位不吝赐教!

明道真是个好地方!

robbin840311

因为运行一次，选择集TEST_SSET已经存在，可以使用如下办法：

'创建过滤器的函数
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

'返回Thisdrawing，使用CreateSelectionSet和BuildFilter

  '定义空白选择集
  Dim LwPSelSet As AcadSelectionSet
  Set LwPSelSet = CreateSelectionSet
 
     
    '建立选择集过滤器
  Dim TypeArray As Variant
  Dim DateArray As Variant
  BuildFilter TypeArray, DateArray, 0, "LWPOLYLINE", 8, "jmd"
  '0 是类型  8是图层

  LwPSelSet.SelectOnScreen TypeArray, DateArray  ’其中TypeArray和DateArray是可选项