CAD VBA过滤器选择集.docVIP

CAD VBA过滤器选择集 贴:CAD VBA过滤器选择集 分类： vb编程技巧 2009-10-17 18:49 —————————————————————————————————— 名称：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, LWPO