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, "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自带的例子没有删除选择集，因此在反复使用时出错（后来就放弃了）。
https://www.360docs.net/doc/c87676368.html,/bati8888/blog/item/d96d67ed66c1ec362797914f.html
每个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) = "之前的条件为并列
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外都支持过滤器参数。