贴: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, "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
AUTOCAD VBA——选择集2010-06-23 20:40在AutoCAD程序中使用选择集复制时出错，搜索了一下。
发现AutoCAD自带的例子没有删除选择集，因此在反复使用时出错（后来就放弃了）。
hi.baidu/bati8888/blog/item/d96d67ed66c1ec362797914f.html
vba编程技巧每个dwg文档中有一个选择集集合对象，引用方式：ThisDrawing.SelectionSets。选择对象前，先向该集合中添
加一个选择集，然后再调用选择集的方法，选择集添加对象。处理完毕，记得删除创建的选择集对象。简单的例子如下：
Public Sub ExmSel1()
Dim ss1 As AcadSelectionSet
Dim mode As Integer
On Error GoTo ErrorHandle                            '错误处理，出错时跳转到最后删除选择集
Set ss1 = ThisDrawing.SelectionSets.Add("selectset1")        '添加空选择集
ss1.SelectOnScreen                                    '用屏幕选择方法，向选择集添加对象
'对象处理
ErrorHandle:
ThisDrawing.SelectionSets.Item("selectset1").Delete    '删除选择集
End Sub
SelectOnScreen方法让用户手动选择对象，和平常操作一样，可以一个一个选，也可以用窗口选择。
有时我们需要有条件地选择对象，比如选择所有的圆等，这需要为SelectOnScreen方法增加过滤器参数，过滤器是两个数组参数，一个是整形数组，一个是可变类型数组，维数相同，整形数组指定过滤类型，可变类型数组指定过滤值，它们一一对应。下面的例程只选择圆对象：
'用过滤器，选择圆
Public Sub ExmSel2()
Dim ss1 As AcadSelectionSet
Dim mode As Integer
Dim FilterType(0) As Integer
Dim FilterData(0) As Variant
FilterType(0) = 0                                    '按类型选择
FilterData(0) = "Circle"                              '选择圆，与 FilterType对应
On Error GoTo ErrorHandle                            '错误处理，出错时跳转到最后删除选择集
Set ss1 = ThisDrawing.SelectionSets.Add("selectset1") '添加空选择集
ss1.SelectOnScreen FilterType, FilterData            '用屏幕选择方法，向选择集添加对象
'对象处理
ErrorHandle:
ThisDrawing.SelectionSets.Item("selectset1").Delete    '删除选择集
End Sub
可以用关系运算符指定复杂的过滤器，下面的例子选择半径大于等于100的圆
'选择半径大于或等于100的圆
Public Sub ExmSel3()
Dim ss1 As AcadSelectionSet
Dim mode As Integer
Dim FilterType(2) As Integer
Dim FilterData(2) As Variant
FilterType(0) = 0
FilterData(0) = "Circle"
FilterType(1) = -4          '-4表示对应的filtertype是运算符
FilterData(1) = ">="
FilterType(2) = 40          '40在DXF组码中表示半径
FilterData(2) = 100#        '指定过滤的半径值
On Error GoTo ErrorHandle                            '错误处理，出错时跳转到最后删除选择集
Set ss1 = ThisDrawing.SelectionSets.Add("selectset1") '添加空选择集
ss1.SelectOnScreen FilterType, FilterData            '用屏幕选择方法，向选择集添加对象
'对象处理
ErrorHandle:
ThisDrawing.SelectionSets.Item("selectset1").Delete    '删除选择集
End Sub
-4 DXF 组码来指示过滤器规格中的关系运算符。
下面的例子用OR（或）运算符选择圆和圆弧
'选择圆或圆弧
Public Sub ExmSel4()
Dim ss1 As AcadSelectionSet
Dim
mode As Integer
Dim FilterType(3) As Integer
Dim FilterData(3) As Variant
FilterType(0) = -4
FilterData(0) = "<or"                            '或运算符开始，指定or>之前的条件为并列
FilterType(1) = 0
FilterData(1) = "Circle"
FilterType(2) = 0
FilterData(2) = "Arc"
FilterType(3) = -4
FilterData(3) = "or>"                            '或运算结束
On Error GoTo ErrorHandle                            '错误处理，出错时跳转到最后删除选择集
Set ss1 = ThisDrawing.SelectionSets.Add("selectset1") '添加空选择集
ss1.SelectOnScreen FilterType, FilterData            '用屏幕选择方法，向选择集添加对象
'对象处理
ErrorHandle:
ThisDrawing.SelectionSets.Item("selectset1").Delete    '删除选择集
End Sub
SelectionSet对象还可以用AddItems、 Select、 SelectAtPoint、SelectByPolygon等方法添加对象。 这4种方法由程序参数控制，除AddItems外都支持过滤器参数。

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。