[分享]CAD VBA过滤器、选择集分享

robbin840311

[UseMoney=80][UseMoney=1000]

我看到过这个问题有好几次了，当时只是把代码发给了个人，现在把这些代码贴出来，建立一个专题，加以自己的理解进行说明，希望能对大家在工作中遇到选择集和过滤器问题有所帮助以供大家使用。这种方法建立选择集和过滤器我使用过千百遍，未出现过任何异常。

'——————————————————————————————————
'名称：BuildFilter
'作者：罗简单
'日期：2008-3-11
'功能：创建过滤器
'——————————————————————————————————
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

'——————————————————————————————————
'名称：CreateSelectionSet
'作者：罗简单
'日期：2008-3-11
'功能：创建选择集
'——————————————————————————————————
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

'创建个过程来调用过滤器和选择集
Sub TestBuildFilterAndCteSset()
  '定义过滤器
  Dim pType, pData
  BuildFilter pType, pData, 0, "LWPOLYLINE", 8, "JZD"
  '注意：这里的0与8是通过命令(entget(car(entsel)))获取的对象基本
  '特性，例如：
  '**********************************************************************************
  '((-1 . <图元名: 7ef83b28>) (0 . "LWPOLYLINE") (330 . <图元名:
  '7ef81cc0>) (5 . "425") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 .
  '"JZD") (6 . "Continuous") (100 . "AcDbPolyline") (90 . 2) (70 . 128) (43 . 0.0)
  '(38 . 0.0) (39 . 0.0) (10 92.5011 35.6905) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10
  '208.946 102.652) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
  '**********************************************************************************
  '其中比较常用的(0 . "LWPOLYLINE") 表示对象类型；(8 ."JZD")表示对象所在层
  '所以还可以扩展或收缩过滤器，如下
  'BuildFilter pType, pData, 0, "LWPOLYLINE"：建立图上所有的多段线过滤器
  'BuildFilter pType, pData, 0, "LWPOLYLINE", 8, "JZD"：建立图层是JZD的多段线过滤器
  'BuildFilter pType, pData, 0, "LWPOLYLINE", 8, "JZD",62,3：建立图层是JZD、颜色为绿色的多段线过滤器
 
  '定义选择集
  Dim sset As AcadSelectionSet
  Set sset = CreateSelectionSet
 
  '根据以上指定的过滤器建立选择集
  sset.Clear
  sset.Select acSelectionSetAll, , , pType, pData
  '这里可以通过Select、SelectAtPoint、SelectByPolygon、SelectOnScreen等方法
  '配合Mode和Point1、Point2建立更加用户化的选择集
 
End Sub

'当在一个过程中连续使用两个以上的选择集时，需要重新定义选择集，如下：
'创建空间选择集的函数2
Public Function CreateSelectionSet2(Optional ssName As String = "ss2") As AcadSelectionSet

    Dim ss2 As AcadSelectionSet
    On Error Resume Next
    Set ss2 = ThisDrawing.SelectionSets(ssName)
    If Err Then Set ss2 = ThisDrawing.SelectionSets.Add(ssName)
    ss2.Clear
    Set CreateSelectionSet2 = ss2

End Function

'创建个过程来调用过滤器和选择集
Sub TestBuildFilterAndCteSset()
  '定义过滤器
  Dim pType, pData
  BuildFilter pType, pData, 0, "LWPOLYLINE", 8, "JZD"
  '注意：这里的0与8是通过命令(entget(car(entsel)))获取的对象基本
  '特性，例如：
  '**********************************************************************************
  '((-1 . <图元名: 7ef83b28>) (0 . "LWPOLYLINE") (330 . <图元名:
  '7ef81cc0>) (5 . "425") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 .
  '"JZD") (6 . "Continuous") (100 . "AcDbPolyline") (90 . 2) (70 . 128) (43 . 0.0)
  '(38 . 0.0) (39 . 0.0) (10 92.5011 35.6905) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10
  '208.946 102.652) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
  '**********************************************************************************
  '其中比较常用的(0 . "LWPOLYLINE") 表示对象类型；(8 ."JZD")表示对象所在层
  '所以还可以扩展或收缩过滤器，如下
  'BuildFilter pType, pData, 0, "LWPOLYLINE"：建立图上所有的多段线过滤器
  'BuildFilter pType, pData, 0, "LWPOLYLINE", 8, "JZD"：建立图层是JZD的多段线过滤器
  'BuildFilter pType, pData, 0, "LWPOLYLINE", 8, "JZD",62,3：建立图层是JZD、颜色为绿色的多段线过滤器
 
  '定义选择集
  Dim sset As AcadSelectionSet
  Set sset = CreateSelectionSet
 
  '根据以上指定的过滤器建立选择集
  sset.Clear
  sset.Select acSelectionSetAll, , , pType, pData
  '这里可以通过Select、SelectAtPoint、SelectByPolygon、SelectOnScreen等方法
  '配合Mode和Point1、Point2建立更加用户化的选择集
 
 
  '再调用Createselectionset2
  Dim sset2 As AcadSelectionSet
  Set sset2 = CreateSelectionSet2   '注意这里是调用CreateSelectionSet2，依次类推
 
  sset2.Clear
  sset2.SelectOnScreen pType, pData
End Sub

罗简单

QQ：45096732

欢迎交流

断箭

请问高手们，CAD中选择过滤器保存的过滤器列表如何编程的形式变为工具条的形式，需要的时候直接点过滤器的名称即可选择需要的对象？？若能提供类似的插件，仅有的几个明经币请拿去

wyy623

请问楼主，怎样向已经含有对象的选择集中添加对象呢？

2017forverd

最主要的是dxf码表的选择，这个很关键

robbin840311

走过，路过的朋友请留个言

洋葱老爹

好东西哦。

robbin840311

好东西应该置顶，呵呵。

robbin840311

呵呵，到第二页了，顶一下，非恶意，这个程序自己觉得挺好，应该拿出来与大家分享。

liuyang4740

请问楼主，怎样向已经含有对象的选择集中添加对象呢？

robbin840311

楼上可以参考选择集的AddItems方法。

robbin840311

非恶意灌水

molihuacha1

不错

TopV

好东西噢

学习下