关于SelecOnScreen的问题求教,急!
最近学习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问题出现在只能运行一次,运行第二次的时候就回出现"命名选择集已存在"的错误,研究了一天也没改出来,请高手指教啊 修改为如下试试：
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
谢谢楼上的回复!
不过好象其中的:ThisDrawing.SelectionSets.delete("TEST_SSET")
有点问题啊,SelectionSets本身并没有Delete方法啊
'创建安全选择集
If Not IsNull(ThisDrawing.SelectionSets.Item("SS5")) Then
Set sstext = ThisDrawing.SelectionSets.Item("SS5")
sstext.Delete
End If
Set sstext = ThisDrawing.SelectionSets.Add("SS5")
按这种方式设置选择集就行了。
问题已经解决 ,多谢谢两位不吝赐教!
明道真是个好地方!
因为运行一次，选择集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是可选项
页:
[1]