Excel to CAD 绘图技术

905738810 · 发表于 2020-7-26 09:37

选择集操作
选择集可以理解为，存储一个或多个图形对象的集合对象，这个集合对象有自己的方法和属性。
一、创建选择集

Sub 选择集()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Set S = doct.SelectionSets.Add("SL") '创建选择集
S.Delete '删除选择集
End Sub

复制代码

在图形文档中有SelectionSets集合，这个集合包含了所有选择集对象，通过Add方法，向SelectionSets集合中新建一个选择集，名称SL
注意1：选择集是对象，所以需要用Set S = 赋值
注意2：在每个图形文档中，选择集名称是唯一的不能重复，如果执行两次Set S = doct.SelectionSets.Add("SL") 会报错“名称选择集已存在”，
所以在用完选择集后必须加上S.Delete 方法删除选择集，为了避免有时代码中断没有删除成功，可以单独写出函数用On Error Resume Next出错的方法来防止报错。代码如下↓↓↓

Sub 创建选择集()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Set S = AddSelect(doct, "SL") '创建选择集自定义函数
S.Delete
End Sub
Public Function AddSelect(ByVal doct As AcadDocument, ByVal SelectName As String) As AcadSelectionSet
On Error Resume Next
doct.SelectionSets.Item(SelectName).Delete '取得名称为SelectName选择集并删除
Set AddSelect = doct.SelectionSets.Add(SelectName) '创建择集
End Function

复制代码

905738810 · 发表于 2020-7-26 11:17

二、选择操作先在图中画些图形，运行下方代码

Sub 画两个圆做例子()
Dim doct As Object
Set doct = doc '引用之前函数，自己去找
If doct Is Nothing Then Exit Sub
Dim pt(0 To 2) As Double
pt(0) = 0
pt(1) = 0
pt(2) = 0
Rad = 30
Set Circl = doct.ModelSpace.AddCircle(pt, Rad)
pt(0) = 50
pt(1) = 50
pt(2) = 0
Rad = 30
Set Circl = doct.ModelSpace.AddCircle(pt, Rad)
pt(0) = 200
pt(1) = 200
pt(2) = 0
Rad = 30
Set Circl = doct.ModelSpace.AddCircle(pt, Rad)
End Sub

复制代码

画完再看后边

Sub 选择集选择操作1() 'Select方法选择
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.Select acSelectionSetAll '选择全部
Dim pt1(2) As Double, pt2(2) As Double
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 100: pt2(1) = 100: pt2(2) = 0
S.Clear
S.Select acSelectionSetCrossing, pt1, pt2 '矩形窗交选择(矩形包含和相交的图形)
S.Clear
S.Select acSelectionSetWindow, pt1, pt2 '矩形窗口选择(只有矩形包含的图形)
S.Clear
S.Select acSelectionSetLast '最后一个生成的图形选择
S.Clear
S.Select acSelectionSetPrevious '上一次选择
S.Delete '删除选择集
End Sub

复制代码

Select方法：Select Mode [, Point1] [, Point2] [, FilterType] [, FilterData]
Mode：选择模式常量

acSelectionSetWindow'矩形窗口选择

acSelectionSetCrossing'矩形窗交选择

acSelectionSetPrevious'上一次选择

acSelectionSetLast '最后一个生成的图形选择

acSelectionSetAll '选择全部

窗交与窗口的区别是，窗交会把窗口相交的图形也选择进去。

当窗交或窗口选择时需要提供矩形两个角点参数[, Point1][, Point2]，参数是双精度一维三元素数组

[, FilterType][, FilterData]：选择集过滤参数，此参数以后单独讲

Sub 选择集选择操作2() 'SelectByPolygon多边形方法选择
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
Dim pt3(8) As Double
pt3(0) = 0: pt3(1) = 0: pt3(2) = 0
pt3(3) = 100: pt3(4) = 0: pt3(5) = 0
pt3(6) = 0: pt3(7) = 100: pt3(8) = 0
S.SelectByPolygon acSelectionSetCrossingPolygon, pt3 '多边形窗交选择(多边形包含和相交的图形)
S.Clear
S.SelectByPolygon acSelectionSetWindowPolygon, pt3 '多边形窗口选择(只有多边形包含的图形)
S.Clear
S.SelectByPolygon acSelectionSetFence, pt3 '栅选(点组成多段线相交的图形)
S.Delete '删除选择集
End Sub

复制代码

SelectByPolygon方法：Mode, PointsList [, FilterType] [, FilterData]

Mode：选择模式常量

acSelectionSetFence'栅选

acSelectionSetWindowPolygon'多边形窗口选择

acSelectionSetCrossingPolygon '多边形窗交选择

PointsList：组成多边形的点数组，参照不优化多段线数组

[, FilterType] [, FilterData]：忽略

注意：当窗交或窗口选择时多段线点自动封闭处理，定义的多边形不能自身相交。

当栅选是多段线不自动封闭，只选择与多段线相交的图形。

Sub 选择集选择操作3() 'SelectAtPoint指定点方法选择
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
Dim pt1(2) As Double
pt1(0) = 30: pt1(1) = 0: pt1(2) = 0
S.SelectAtPoint pt1 '经过点的图形
S.Delete '删除选择集
End Sub

复制代码

SelectAtPoint方法：选择经过点的图形(不是所有经过的都被选择，只选择最上层的一个图形)

参数Point [, FilterType] [, FilterData]

Point：三维坐标点（一维三元素双精度数组）

[, FilterType] [, FilterData]忽略

Sub 选择集选择操作4() '通过用户选择
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.SelectOnScreen '切换到CAD进行手动选择
S.Delete '删除选择集
End Sub

复制代码

SelectOnScreen方法：[, FilterType] [, FilterData]

只有两个可选参数[, FilterType] [, FilterData]先忽略

SelectOnScreen方法会暂时挂起，等待用户去CAD界面手动选择后把选择的图形添加到选择集。

905738810 · 发表于 2020-7-26 11:41

三、选择集选择技巧
先上代码
在此之前先运行上贴中的<画两个圆做例子>代码,名字起了两个我画了三个哈哈

Sub 选择集选择技巧()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
Dim pt1(2) As Double, pt2(2) As Double
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 100: pt2(1) = 100: pt2(2) = 0
S.Clear
doct.Application.ZoomWindow pt1, pt2 '两点缩放视图
'第一次选择
S.Select acSelectionSetCrossing, pt1, pt2 '矩形窗交选择(矩形包含和相交的图形)
Debug.Print "选择数量" & S.Count '打印出是2
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = -100: pt2(1) = -100: pt2(2) = 0
doct.Application.ZoomWindow pt1, pt2 '两点缩放视图
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 100: pt2(1) = 100: pt2(2) = 0
S.Clear
'第二次选择
S.Select acSelectionSetCrossing, pt1, pt2 '矩形窗交选择(矩形包含和相交的图形)
Debug.Print "选择数量" & S.Count '打印出是1
S.Clear
'第三次选择
S.Select acSelectionSetAll '选择全部
Debug.Print "选择数量" & S.Count '打印出是3
S.Delete '删除选择集
End Sub

复制代码

代码以Select方法为例子，其他方法同理
主要操作是代码中加了视图缩放，通过立即窗口可以看出第一次选择和第二次选择数量不一样，但是选择范围没有改变，改变的是视图。
第一次视图和选择范围一致选择了两个，第二次视图偏了只选择出一个，我们看出在视图范围的会被选择，不在视图的就不会选择，
所以在以后的选择集选择操作时，为了避免出现选择失误，应该配合视图操作，视图定位到图形后再执行选择代码。

第三次选择全部图形，打印出的数量是三，最三视图没有包含所有图形，但是还是可以选择，所以acSelectionSetAll模式不受视图影响。

905738810 · 发表于 2020-7-26 11:59

没完接上贴↑↑↑
技巧2代码↓↓↓

Sub 选择集选择技巧2()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
'第一次选择
S.Select acSelectionSetAll '选择全部
Debug.Print "选择数量" & S.Count '打印出是3
Dim pt1(2) As Double, pt2(2) As Double
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 100: pt2(1) = 100: pt2(2) = 0
doct.Application.ZoomWindow pt1, pt2 '两点缩放视图
'第二次选择
S.Select acSelectionSetCrossing, pt1, pt2 '矩形窗交选择(矩形包含和相交的图形)
Debug.Print "选择数量" & S.Count '打印出还是3
S.Delete '删除选择集
End Sub

复制代码

通过两次选择发现打印出来的数量全是3，我按技巧1里的同样代码粘贴过来的按理说第二次应该是数量2才对。
由此可以发现选择集执行选择前不会自动清空选择集里以前的图元，只会添加。
所以当需要重新选择图形时，用Clear方法清空选择集后再进行第二次选择，选择集选择操作代码中有示例

技巧3代码↓↓↓

Sub 选择集选择技巧3()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
'第一次选择
S.Select acSelectionSetAll '选择全部
Debug.Print "选择数量" & S.Count '打印出是3
S.Erase
S.Select acSelectionSetAll '选择全部
Debug.Print "选择数量" & S.Count '打印出是3
S.Delete '删除选择集
End Sub

复制代码

代码中两次选择中间用了Erase方法，该方法会清空选择集并且删除选择集中的图形，比Clear方法多了一个删除图形功能
运行之后你会发现选择集数量是0了，回到CAD中图形也没有了。（测试前不要打开有用的图形文档测试，小心被删）

高度保密 · 发表于 2020-7-26 22:16

本帖最后由高度保密于 2020-7-26 22:19 编辑

905738810 发表于 2020-7-26 11:17
二、选择操作先在图中画些图形，运行下方代码
画完再看后边

您太厉害了，excel和CAD都精通。本人CAD也不太熟，创建选择集成功了图上有什么不一样的地方吗？怎么才看得出来效果呢？谢谢！

905738810 · 发表于 2020-7-27 06:46

这些方法我已经解释了，如果你想观察可以在cad中根据pt点坐标画一个矩形，就知道选择范围了，单步运行代码观察本地窗口中s选择集里面Count数量，你会发现同样范围数量不一样。

905738810 · 发表于 2020-7-27 09:57

选择集的动态添加
前面说了选择集的各种选择图形方法，但是用VBA画出的图形怎么能动态的添加到集合当中？
有两种方法：第一种是利用S.Select acSelectionSetLast方法选择最后一个生成的图形，前面讲过了，示例代码如下

Sub 动态添加1()
Dim doct As Object
Set doct = doc
If doct Is Nothing Then Exit Sub '判断对象是否存在
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
x = 0: y = 0: A = 100: b = 100
Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double '声明两个坐标
pt1(2) = 0: pt2(2) = 0
pt1(0) = x: pt1(1) = y
pt2(0) = x + A: pt2(1) = y
Set Line = doct.ModelSpace.AddLine(pt1, pt2) '第一条直线
S.Select acSelectionSetLast '添加对象到选择集
pt2(0) = x + A: pt2(1) = y + b
Set Line = doct.ModelSpace.AddLine(Line.EndPoint, pt2) '第二条直线
S.Select acSelectionSetLast '添加对象到选择集
pt2(0) = x: pt2(1) = y + b
Set Line = doct.ModelSpace.AddLine(Line.EndPoint, pt2) '第三条直线
S.Select acSelectionSetLast '添加对象到选择集
pt2(0) = x: pt2(1) = y
Set Line = doct.ModelSpace.AddLine(Line.EndPoint, pt2) '第四条直线
S.Select acSelectionSetLast '添加对象到选择集
'遍历选择集，把图形高亮显示
For Each ss In S
ss.Highlight True
Next
End Sub

复制代码

代码中画一个矩形，每画一条直线就执行一次S.Select acSelectionSetLast方法，这样就把直线添加到集合中了。
第二种是利用选择集的AddItems方法：该方法只有一个参数（对象数组）数组下限必须是0，类型必须是Object或AcadEntity，示例代码如下

Sub 动态添加2()
Dim doct As Object
Set doct = doc
If doct Is Nothing Then Exit Sub '判断对象是否存在
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
Dim SZ(0 To 3) As Object
' Dim SZ(0 To 3) As AcadEntity
x = 0: y = 0: A = 100: b = 100
Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double '声明两个坐标
pt1(2) = 0: pt2(2) = 0
pt1(0) = x: pt1(1) = y
pt2(0) = x + A: pt2(1) = y
Set Line = doct.ModelSpace.AddLine(pt1, pt2) '第一条直线
Set SZ(0) = Line
pt2(0) = x + A: pt2(1) = y + b
Set Line = doct.ModelSpace.AddLine(Line.EndPoint, pt2) '第二条直线
Set SZ(1) = Line
pt2(0) = x: pt2(1) = y + b
Set Line = doct.ModelSpace.AddLine(Line.EndPoint, pt2) '第三条直线
Set SZ(2) = Line
pt2(0) = x: pt2(1) = y
Set Line = doct.ModelSpace.AddLine(Line.EndPoint, pt2) '第四条直线
Set SZ(3) = Line
S.AddItems SZ '将SZ数组中的图形添加到选择集
'遍历选择集，把图形高亮显示
For Each ss In S
ss.Highlight True
Next
End Sub

复制代码

和上一个示例一样画一个矩形，画完图形后将图形添加到数组中如Set SZ(0) = Line，最后用S.AddItems SZ方法将SZ数组中的对象添加到选择集中。

905738810 · 发表于 2020-7-27 15:00

本帖最后由 905738810 于 2020-7-29 13:24 编辑

选择集过滤图形
过滤可以分两种，第一种是先选择后过滤，第二种是用过滤器([, FilterType] [, FilterData]前面忽略的参数)直接过滤选择
准备工作：首先在打开CAD，在CAD中画一些直线和圆
今天说第一种，
利用选择集的RemoveItems方法，该方法和AddItems方法相似，AddItems是添加图形，RemoveItems方法是移除图形
RemoveItems方法参数和AddItems也是一样的（对象数组）数组下限必须是0，类型必须是Object或AcadEntity
先说一个错误的如下代码↓↓↓

Sub 先选择后过滤错误版()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim SZ(0) As Object
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.Select acSelectionSetAll '选择全部图形
Debug.Print S.Count '打印过滤前数量
For Each ss In S '遍历选择集
If TypeName(ss) <> "IAcadLine" Then '判断图形类型，不是直线的就移除
Set SZ(0) = ss
S.RemoveItems SZ '将SZ数组中的图形在选择集中移除
End If
Next
Debug.Print S.Count '打印过滤后数量
End Sub

复制代码

代码功能：将选择集过滤，只剩下直线
代码中利用S.Select acSelectionSetAll方法将CAD中的图形全部添加到选择集
利用For Each 遍历选择集，逐个取出图形附给变量SS
通过TypeName(ss) 判断SS的类型是否是直线
如果不是直线就将图形添加到数组SZ(0) ，用S.RemoveItems SZ方法移除选择集
错误代码分析：
运行完对比一下选择集数量，在看一下实际CAD中的直线数量，是不是发现没有移除完全，仍然有非直线在选择集中，
这是因为在CADVBA中For Each也相当于计数器，当移除了1个元素后，计数器还是加一，而集合会重新排列元素，所以就会有图形被跳过，出现遗漏。
这就像在Excel中插入用VBA插入单元格行类似。在Excel中遍历对象很少出现这种情况，但是遍历CAD对象一定不能这样做。

正确代码如下↓↓↓

Sub 先选择后过滤正确版()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim ss As AcadEntity
Dim SZ() As Object
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.Select acSelectionSetAll '选择全部图形
Debug.Print S.Count '打印过滤前数量
ii = 0
For i = 0 To S.Count - 1 '遍历选择集
Set ss = S.Item(i)
If TypeName(ss) <> "IAcadLine" Then '判断图形类型，不是直线的就放到SZ数组
ReDim Preserve SZ(ii)
Set SZ(ii) = ss
ii = ii + 1
End If
Next
S.RemoveItems SZ '将SZ数组中的图形在选择集中移除
Debug.Print S.Count '打印过滤后数量
End Sub

复制代码

代码做了改良后，利用ReDim Preserve SZ(i)扩展数组大小，先将非直线图形全部添加到SZ数组中，最后用S.RemoveItems一起移除。

905738810 · 发表于 2020-7-28 10:26

接上贴↑↑↑
第二种选择过滤方法是用[, FilterType] [, FilterData]两个参数
以SelectOnScreen ([, FilterType] [, FilterData])方法为例，其他的选择方法最后两个参数也是一样的。
参数一FilterType：一维整数型数组，下限必须是0，数组内容是DXF组码值
参数一FilterData：一维变体型数组，下限必须是0，数组内容是DXF组码类型，数组大小要与参数一FilterType大小相同，DXF组码类型与参数一组码值对应

DXF组码：AutoCAD 图形文件中所包含的全部信息的标记数据的一种表示方法。标记数据的意思是指在每个数据元素前都带一个称为组码的整数。组码的值表明了其后数据元素的类型，也指出了数据元素对于给定对象（或记录）类型的含意。实际上，图形文件中所有用户指定的信息都能够以 DXF 文件格式表示。
简单理解就是一个整数对应一个类型，比如组码值8就表示图层名称信息，组码值0就表示图形类型(圆,直线...)信息，组码可以再百度查到，可以参考https://wenku.baidu.com/view/37aabeee52d380eb63946db8.html查询DXF组码
下面代码过滤选择图层为0的图形
在CAD画些图形，修改成不同的图层(要有0图层)，执行代码后，回到CAD框选图形，只会选择图层为0的图形

Sub Filter过滤器()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim FilterData(0) As Variant
Dim FilterType(0) As Integer
FilterData(0) = "0"
FilterType(0) = 8
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.SelectOnScreen FilterType, FilterData'通过用户选择图形
Debug.Print S.Count
End Sub

复制代码

代码中声明FilterData为Variant类型，FilterType为Integer，类型必须是固定的这个，因为过滤只有一个条件，所以大小是0
FilterData(0)赋值DXF组码值0，FilterData(0) 赋值DXF组码类型(组码值8对应图层名称)"0"
用S.SelectOnScreen 通过用户选择方法选择图形，这次可选参数[, FilterType] [, FilterData]传递了变量FilterType, FilterData

905738810 · 发表于 2020-7-28 11:35

DXF组码太多了，大家可以根据上贴网址去查也可以百度，但并不是所有组码都能过滤需要自己试验。我说3个最常用的示范一下，其他组码按格式套就行。
1、组码值8，图层名称
2、组码值0，图形类型
图形类型和VBA中声明的类型不是一个，他是DXF的类型，查看图形类型可以用CAD中Lisp语言
(setq e (entget (car (entsel "选择图形"))))
画好要查询的图形，将这段话粘贴到CAD命令行按回车，会提示选择图形

选择要查询的图形，命令行就会出现DXF组码表

这个红色框里面(0 . "CIRCLE")就是一个DXF组码，0就是组值，CIRCLE就是圆的图形类型
同样方法查到LINE就是直线组码类型

3、组码值-4，条件运算符，详细参照上贴网址

举例1：只选择CAD中的文字，在CAD中有多行文字和单行文字他们的类型不一样分别是"TEXT"和"MTEXT"
要是想同时包含两种类型就需要配合-4组码中的"<OR"，"OR>",将两个文字类型在OR组码中间"<OR"，"TEXT"，"MTEXT"，"OR>",如代码

Sub 过滤出文字()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim FilterData(3) As Variant
Dim FilterType(3) As Integer
FilterData(0) = "<OR"
FilterData(1) = "TEXT"
FilterData(2) = "MTEXT"
FilterData(3) = "OR>"
FilterType(0) = -4
FilterType(1) = 0
FilterType(2) = 0
FilterType(3) = -4
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.SelectOnScreen FilterType, FilterData
Debug.Print S.Count
End Sub

复制代码

举例1：选择除了文字以外的其他图形，可以用-4组码的"<NOT"，"NOT>"
第一种："<NOT"，"<OR"，"TEXT"，"MTEXT"，"OR>"，"NOT>"
第二种："<AND"，"<NOT"，"TEXT"，"NOT>""<NOT"，"MTEXT"，"NOT>"，"AND>"

Sub 过滤除了文字其他图形1()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim FilterData(5) As Variant
Dim FilterType(5) As Integer
FilterData(0) = "<NOT"
FilterData(1) = "<OR"
FilterData(2) = "TEXT"
FilterData(3) = "MTEXT"
FilterData(4) = "OR>"
FilterData(5) = "NOT>"
FilterType(0) = -4
FilterType(1) = -4
FilterType(2) = 0
FilterType(3) = 0
FilterType(4) = -4
FilterType(5) = -4
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.SelectOnScreen FilterType, FilterData
Debug.Print S.Count
End Sub
Sub 过滤除了文字其他图形2()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim FilterData(7) As Variant
Dim FilterType(7) As Integer
FilterData(0) = "<AND"
FilterData(1) = "<NOT"
FilterData(2) = "TEXT"
FilterData(3) = "NOT>"
FilterData(4) = "<NOT"
FilterData(5) = "MTEXT"
FilterData(6) = "NOT>"
FilterData(7) = "AND>"
FilterType(0) = -4
FilterType(1) = -4
FilterType(2) = 0
FilterType(3) = -4
FilterType(4) = -4
FilterType(5) = 0
FilterType(6) = -4
FilterType(7) = -4
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.SelectOnScreen FilterType, FilterData
Debug.Print S.Count
End Sub

复制代码

举例3：选择图层为0的文字，"<AND"，"<OR"，"TEXT"，"MTEXT"，"OR>"，"0"，"AND>"

Sub 过滤出0图层的文字()
Dim doct As AcadDocument
Set doct = doc
If doct Is Nothing Then Exit Sub
Dim FilterData(6) As Variant
Dim FilterType(6) As Integer
FilterData(0) = "<AND"
FilterData(1) = "<OR"
FilterData(2) = "TEXT"
FilterData(3) = "MTEXT"
FilterData(4) = "OR>"
FilterData(5) = "0"
FilterData(6) = "AND>"
FilterType(0) = -4
FilterType(1) = -4
FilterType(2) = 0
FilterType(3) = 0
FilterType(4) = -4
FilterType(5) = 8
FilterType(6) = -4
Dim S As AcadSelectionSet
Set S = AddSelect(doct, "SL") '创建选择集
S.SelectOnScreen FilterType, FilterData
Debug.Print S.Count
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[原创] Excel to CAD 绘图技术

评分

评分

评分

评分

评分

评分

评分

评分

评分