CADVBA选择集研究笔记-技术圈

最近工作上遇到一个这样的需求：批量导出图纸中的工程数量表格。

这些个表格不是CAD中的可编辑表格对象，都是各种直线和文字组成的，行数不固定。但是，表格都位于图框的右上角。

之前写过一篇文章，《导出CAD中的表格至Excel》，里面的代码可以直接拿过来使用。但是这篇文章中的代码适用场景是，框选表格，然后导出。

现在的需求，是智能定位图框的右上角，找到表格区域然后导出。这样的话，就要用到选择集来帮忙搞定了。

具体思路：

利用选择集，找到表格左上角的关键字No.，定位关键字的坐标，这样就可以知道表格的范围。接下来，再将这个范围内部的直线和文字写入选择集，就可以调用上次的现成代码，导出数据至Excel。

什么是选择集？

我把它理解成Excel中的筛选功能，选择集可以筛选并存储筛选之后的图元信息。

CAD图纸中是很多个图元组成的图形文件，包含直线、圆、多段线、矩形、文字、块等等。

如果我们要删除图纸中所有的圆，常规的方式我们是遍历所有的图元，判断类型是否是矩形，满足条件的删除。

Sub test()    For Each ent In ThisDrawing.ModelSpace        sss = ent.ObjectName        If ent.ObjectName = "AcDbLine" Then            ent.Delete        End If    NextEnd Sub

但是遍历所有图元，挨个判断类型，这样效率太低了。

有没有一种方法，我给定图元类型，瞬间把满足条件的图元筛选出来呢？

答案是有的，那就是使用选择集。

Sub 使用选择集筛选圆形并删除()    Dim SSetTemp As AcadSelectionSet    Dim gpcode(0)  As Integer    Dim datavalue(0)  As Variant    Dim Fitertype As Variant    Dim Fiterdata As Variant    Dim p1(2) As Double    Dim p2(2) As Double    p1(0) = 0: p1(1) = 0: p1(2) = 0    p2(0) = 10000: p2(1) = 10000: p2(2) = 10000    gpcode(0) = 0    datavalue(0) = "Circle"    SSetName = "选择集1"    Fitertype = gpcode    Fiterdata = datavalue    On Error Resume Next    If Not IsNull(ThisDrawing.SelectionSets.Item(SSetName)) Then        Set SSetTemp = ThisDrawing.SelectionSets.Item(SSetName)        SSetTemp.Delete    End If    Set SSetTemp = ThisDrawing.SelectionSets.Add(SSetName)    SSetTemp.Select acSelectionSetWindow, p1, p2, Fitertype, Fiterdata    For Each ent In SSetTemp        ent.Delete    NextEnd Sub

代码虽然长，但是这都是固定的框架代码。对于效率的提升不是一星半点的。

如何使用选择集？

选择集很强大，我们下面说选择集如何使用。

我们创建选择集的目的就是为了筛选和存储图元，VBA给了以下几种方法进行选择筛选。后台自动框选筛选、由人手动框选之后再筛选、点选等。本次用到的是第一种方式，不用人为去框选图元。

◎后台自动框选筛选

语法：

object.Select Mode[, Point1][, Point2][, FilterType][, FilterData]

这几个参数里面，就是对于筛选图元的区域、图元的类型做了限定。

Object

SelectionSet使用该方法的对象。

Mode

AcSelect 常数; 仅用于输入acSelectionSetWindowacSelectionSetCrossingacSelectionSetPreviousacSelectionSetLastacSelectionSetAll

Point1

Variant[变体] (双精度数组); 仅用于输入; 可选项指定 Point1 的三维 WCS 坐标，或坐标数组。查看模式定义以正确使用 Point1。

Point2

Variant[变体] (三元素双精度数组); 仅用于输入; 可选项指定 Point2 的三维 WCS 坐标。查看模式定义以正确使用 Point2。

FilterType

Variant[变体](整数数组); 仅用于输入; 可选项指定使用的过滤器类型的 DXF 组码。

FilterData

Variant[变体](变体数组); 仅用于输入; 可选项过滤器的值。

说明

过滤模式有以下几种：

Window（acselectionsetwindow）

选择完全在矩形区域内的所有对象，矩形对角由 Point1 和 Point2 定义。

Crossing（acselectionsetcrossing）

选择在矩形区域内和与矩形区域相交的对象，矩形对角由 Point1 和 Point2 定义。

Previous（acselectionsetprevious）

选择最近的选择集。如果用户在图纸空间和模型空间之间进行切换并试图使用选择集，该模式将被忽略。

Last（acselectionsetlast）

选择最近生成的可见对象。

All（acselectionsetall）

选择所有对象。

关于DXF组码表

上述参数中，FilterType是指的过滤类型的组码，通俗的说就是筛选条件的类型。我可以按图元所在图层名称筛选、也可以按图元类型筛选。

复杂的选择集，难点就在于DXF组码的各种组合，来达到多条件筛选。类似于正则表达式的匹配规则。

▶以下是一些常用的DXF组码：

群码	说明	预设值
-4	过滤群组方式,例如、、、	单一条件时可省略
-1	图元名称(会随每一个图档开启而有所不同)	不可省略
0	图元类型,例如 "ARC"、 "LINE"、"CIRCLE"...	不可省略
5	处理码	不可省略
6	线型名称(如果线型不为"BYLAYER",此群码值会出现)	BYLAYER
8	图层名称	不可省略
48	线性比例(选择性)	1
60	物件可见性, 0=可见, 1=不可见	0
62	颜色编号 (如果线型不为"BYLAYER",此群群码会出現)当值为0時,即指BYLAYER,如果是负值即指该图层是关闭的(选择性)	BYLAYER
67	值为空或0时即指图元在模型空间,如果为1指在图形空间	0

▶过滤群组方式

过滤群组方式	內含项目	描述
""	1 或多个	所有项目的交集
""	1 或多个	所有项目的并集
""	2个	两个项目的异或运算
""	1个	不包含此项目的值

▶DXF组码范例

◎过滤条件为图元为MTEXT（多行文字）

FilterData	MTEXT
FilterType	0

◎过滤条件为图元为CIRCLE或LINE

FilterData		CIRCLE	LINE	OR>
FilterType	-4	0	0	-4

◎过滤条件为图元在DIM图层(LAYER)中的CIRCLE或LINE

FilterData			CIRCLE	LINE	OR>	DIM	AND>
FilterType	-4	-4	0	0	-4	8	-4

经典案例

利用筛选到某个关键字。

Sub 使用选择集筛选内容为No.的文字()    Dim SSetTemp As AcadSelectionSet    Dim gpcode(1)  As Integer    Dim datavalue(1)  As Variant    Dim Fitertype As Variant    Dim Fiterdata As Variant    Dim p1(2) As Double    Dim p2(2) As Double    p1(0) = 0: p1(1) = 0: p1(2) = 0    p2(0) = 10000: p2(1) = 10000: p2(2) = 10000    gpcode(0) = 0    datavalue(0) = "Text"    gpcode(1) = 1    datavalue(1) = "No."        SSetName = "选择集1"    Fitertype = gpcode    Fiterdata = datavalue    On Error Resume Next    If Not IsNull(ThisDrawing.SelectionSets.Item(SSetName)) Then        Set SSetTemp = ThisDrawing.SelectionSets.Item(SSetName)        SSetTemp.Delete    End If    Set SSetTemp = ThisDrawing.SelectionSets.Add(SSetName)    SSetTemp.Select acSelectionSetWindow, p1, p2, Fitertype, Fiterdata    For Each ent In SSetTemp        ent.Delete    NextEnd Sub

筛选到关键字之后，再利用GetBoundingBox获取文字的最大包围框坐标。就可以得到表格的位置了。