問一個选择集的問題!

david.xw · 发表于 2004-3-1 09:39:00

过滤选择集
你可用过滤器列表通过属性限制选择集，如通过颜色或对象类型。例如，你可以只复制电路板图形中的红色对象或确定图层中的对象。
注意：过滤器只识别直接分配给对象颜色或线型，而非继承于图层的颜色或线型。
使用过滤器机制，必须提供用于分类过滤器类型和过滤器数据。过滤器类型是指定使用哪种过滤的代码。 ActiveX自动操作使用DXF组码来指定过滤器类型。最常用的几个过滤器类型在以下列出。完整的列表，可参见AutoCAD DXF参考。

常用过滤器的DXF代码 DXF代码过滤器类型 0 对象类型(字符串)如"Line"、"Circle"、"Arc"等。 2 对象名称(字符串)命名对象的表(给定)名称。 8 图层名称(字符串)如"Layer 0"。 60 对象的可见性(整数)使用 0 = 可见、1 = 不可见。 62 颜色号(整数)由0到256的数字索引值。0代表随块。256代表随层。负值代表图层关闭。 67 模型/图纸空间指示(整数)使用0或忽略=模型空间、1 = 图纸空间。
以下例子示范了不同的过滤器。

只添加文本对象到选择集：
FilterType = 0
FilterData = "TEXT"
sset.SelectOnScreen FilterType, FilterData
只添加直线对象到选择集：
FilterType = 0
FilterData = "LINE"
sset.SelectOnScreen FilterType, FilterData
只添加在图层FLOOR9上的对象到选择集：
FilterType = 8
FilterData = "FLOOR9"
sset.SelectOnScreen FilterType, FilterData
只添加颜色为红色的对象到选择集：
Filter Type = 62
Filter Data = 5
sset.SelectOnScreen FilterType, FilterData
按以上方法我试了一下:
用屏选时只选名为"AA3"的图块
Sub AA()
Dim sset As AcadSelectionSet
Dim i As Long
Dim entry As AcadEntity
Dim FilterType
Dim FilterData
i = ThisDrawing.SelectionSets.Count
Set sset = ThisDrawing.SelectionSets.Add("SS" & i + 1)
FilterType = "2"
FilterData = "AA3"
sset.SelectOnScreen FilterType, FilterData
For Each entry In sset
MsgBox entry.Name
Next
End Sub
但每次运行到
sset.SelectOnScreen FilterType, FilterData
时会出现
执行阶段错误'-2147467259(80004005)':
'sset.SelectOnScreen'方法('IAcadSelectionSet'对象)失败
请高手帮帮我!先谢了!

subtlation · 发表于 2004-3-1 09:48:00

FilterType应该是integer数组
FilterData是Variant数组
建议用 BuildFilter函数，这样不容易错，下面是一个实例。
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

   Dim ssetObj As AcadSelectionSet
   Set ssetObj = CreateSelectionSet("uniteSS")
   Dim fType, fData
   BuildFilter fType, fData, 2, "AA3"
   '屏选直线或多段线
   ssetObj.SelectOnScreen fType, fData