明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1256|回复: 5

关于SelecOnScreen的问题求教,急!

[复制链接]
发表于 2008-5-27 08:25:00 | 显示全部楼层 |阅读模式

最近学习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
问题出现在只能运行一次,运行第二次的时候就回出现"命名选择集已存在"的错误,研究了一天也没改出来,
请高手指教啊
发表于 2008-5-27 09:28:00 | 显示全部楼层

修改为如下试试:

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

 楼主| 发表于 2008-5-27 09:47:00 | 显示全部楼层

谢谢楼上的回复!

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

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

发表于 2008-5-27 10:38:00 | 显示全部楼层

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

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

 楼主| 发表于 2008-5-27 12:15:00 | 显示全部楼层

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

明道真是个好地方!

发表于 2008-5-30 08:23:00 | 显示全部楼层

因为运行一次,选择集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是可选项

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 09:38 , Processed in 0.177233 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表