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

robbin840311 发表于 2008-10-25 08:48:00

本帖最后由作者于 2008-10-30 8:09:57 编辑 我看到过这个问题有好几次了，当时只是把代码发给了个人，现在把这些代码贴出来，建立一个专题，加以自己的理解进行说明，希望能对大家在工作中遇到选择集和过滤器问题有所帮助以供大家使用。这种方法建立选择集和过滤器我使用过千百遍，未出现过任何异常。'—————————————————————————————————— '名称：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 = ssEnd 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 = ss2End 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欢迎交流

断箭发表于 2018-2-6 15:46:10

本帖最后由断箭于 2018-2-6 15:47 编辑

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

wyy623 发表于 2018-5-11 16:37:02

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

2017forverd 发表于 2018-2-6 16:12:57

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

robbin840311 发表于 2008-11-2 10:12:00

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

洋葱老爹 发表于 2008-11-2 11:57:00

好东西哦。

robbin840311 发表于 2008-11-4 09:18:00

好东西应该置顶，呵呵。

robbin840311 发表于 2008-11-11 08:05:00

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

liuyang4740 发表于 2008-11-12 19:28:00

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

robbin840311 发表于 2008-11-12 20:33:00

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

robbin840311 发表于 2008-11-19 21:16:00

非恶意灌水

molihuacha1 发表于 2008-11-20 16:45:00

不错

TopV 发表于 2008-12-31 17:56:00

好东西噢学习下

页: [1] 2 3

明经CAD社区's Archiver

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