cad的选择集是什么_CAD插件开发

1. 定义一个永不重复的时间变量

Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) ''------强制退出AutoCAD当前运行的命令
''------------
Private Type SYSTEMTIME
 wYear As Integer
 wMonth As Integer
 wDayOfWeek As Integer
 wDay As Integer
 wHour As Integer
 wMinute As Integer
 wSecond As Integer
 wMilliseconds As Integer
End Type


Public Function MyNow() As String
Dim st As SYSTEMTIME
GetSystemTime st
MyNow = "a" & st.wDay & st.wHour & st.wMinute & st.wSecond & st.wMilliseconds
End Function

vba中

Public Function MyNow() As String
    MyNow = Format(Now, "HH-MM-SS")
End Function

2. 创建一个选择集变量

Dim sset As AcadSelectionSet
Set sset = acadApp.ActiveDocument.SelectionSets.Add(MyNow)

3. 选择集选择对象

①  selectOnscreen  提示用户从屏幕上拾取对象。

Dim fType(0) As Integer, fData(0) As Variant
Dim sset As AcadSelectionSet, elem As AcadEntity
Set sset = acadApp.ActiveDocument.SelectionSets.Add(MyNow)
fType(0) = 0: fData(0) = "Insert"
'fData(0) = "Text,MText"
Err.Clear
acadApp.ActiveDocument.Utility.Prompt vbCr & "请选择预设属性随层的护套图块对象："
sset.SelectOnScreen fType, fData
If sset.Count < 1 Then MsgBox "选择对象中没有发现护套图块.", vbOKOnly + vbInformation, "选择护套图块提示": sset.Delete: Exit Sub

For Each elem In sset

next

sset.delete

② sset.Select

 过滤模式有以下几种：

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

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

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

Last（acselectionsetlast） 选择最近生成的可见对象。

All（acselectionsetall） 选择所有对象。

由于选取选择集，受限制于窗口(全图不限制)，需要缩放图纸

acadApp.ZoomAll ‘用于缩放当前视图，显示整个图形。 
acadApp.ZoomWindow MinP, MaxP ‘由用户在绘图区域指定窗口缩放当前视图。
acadApp.ZoomExtents ‘全图缩放 将当前视图缩放到图形界限。
acadApp.ZoomPrevious ‘恢复到上一个视图
acadApp.ActiveDocument.Application.ZoomCenter txtInp, 150 通过指定缩放中心点和比例缩放当前视图 。

例子：

    Dim Nos() As String
    Dim fType(0) As Integer, fData(0) As Variant
    Dim sset As AcadSelectionSet, elem As AcadEntity
    Dim bType As Variant, bData As Variant  '用于获取拓展数据
    Dim Array1 As Variant  '用于获取属性
    Dim xh As Integer

    Public LTP1(0 To 2) As Double    '查找范围左下角点，线号查找排除
    Public LTP2(0 To 2) As Double    '查找范围右上角点，线号查找排除


    Public Type GGBJ '变更标记块
        GGCode As String
        GGDesc As String
        GGDate As String
    End Type


    '提取范围变更标记
40  iniTmp = ReadIniFile("C:\Users\Public\XSCADCAPP.ini", "提取图纸", "提取范围")
41  If iniTmp <> "" Then
42      Nos = Split(iniTmp, ",", , vbTextCompare)
43      If UBound(Nos) = 4 Then
44          LTP1(0) = Val(Nos(0)): LTP1(1) = Val(Nos(1))
45          LTP2(0) = Val(Nos(2)): LTP2(1) = Val(Nos(3))
46      End If
47  End If

    '提取范围内的标记

48  Set sset = acadApp.ActiveDocument.SelectionSets.Add(MyNow)
49  fType(0) = 1001: fData(0) = "变更标记块"

50  If LTP1(0) = 0 And LTP1(1) = 0 Then
51      sset.Select acSelectionSetAll, , , fType, fData  '已加：可见过滤  5-acSelectionSetAll 全图不需要范围
52  Else
53      acadApp.ZoomWindow LTP1, LTP2    '需要先缩放一下
54      sset.Select acSelectionSetWindow, LTP1, LTP2, fType, fData  '已加：可见过滤 0-acSelectionSetWindow
55      acadApp.ZoomPrevious    '还原成之前的 视图
56  End If

57  ReDim GGBJArr(1 To sset.Count) As GGBJ

58  For Each elem In sset
        '         elem.GetXData "变更标记块", bType, bData
        '         If IsEmpty(bData) Then '有拓展数据
        '            If UBound(bData) > 2 Then bData(2) = "给拓展数据赋的值"
        '         End If
59      xh = 1
60      If elem.HasAttributes Then    '获取属性

61          Array1 = elem.GetAttributes
62          For i = 0 To UBound(Array1)
                '               '读属性
63              Select Case Array1(i).TagString
                Case "序号"
64                  GGBJArr(xh).GGCode = Array1(i).TextString
65              Case "变更说明"
66                  GGBJArr(xh).GGDesc = Array1(i).TextString
67              Case "变更日期"
68                  GGBJArr(xh).GGDate = Array1(i).TextString
69              End Select
70          Next
71      End If
72      xh = xh + 1
73  Next
74  sset.Delete

 常用的DXF组码一般有：

0 ： 图元类型

1 ： 图元的主文字值(似乎多行文字 不起作用)

60 ：可见性 0 = 可见  1= 不可见

1001 :   扩展数据的注册应用程序名（最多可以包含 31 个字节的 ASCII 字符串）

1000：扩展数据中的 ASCII 字符串（最多可以包含 255 个字节） 1070： 扩展数据 16 位有符号整数

1071：扩展数据 32位有符号整数

1040：双精度浮点数

CAD DXF组码 – 360文档中心

 对于组码0：图元类型一般有这些

Insert 图块

LWPolyline  多段线

Text ,MText   单行文本，多行文本(,表示或的关系)

Hatch  图案填充，由直线图案组成的区域填充

Dimension  标注

ATTDEF  属性

acadApp.ZoomCenter center, 4000  '需要缩放一下，保证图元能够被拾取到
sset.Select acSelectionSetWindow, P1, P2, fType, fData  

CADVBA选择集研究笔记CADVBA选择集研究笔记http://www.360doc.com/content/21/1030/09/51100410_1001897889.shtml

一些实例

ReDim fType(0): ReDim fData(0)
fType(0) = 0: fData(0) = "Text,MText"  '逗号表示或的关系
Set sset = acadApp.ActiveDocument.SelectionSets.Add(MyNow)

 i = 2
    fType(i) = -4: fData(i) = "<or"
    i = i + 1: fType(i) = -4: fData(i) = "<and"
    i = i + 1: fType(i) = 0: fData(i) = "Text"
    i = i + 1: fType(i) = 1: fData(i) = "*" & txtFindLine & "*"
    i = i + 1: fType(i) = -4: fData(i) = "and>"
    
    i = i + 1: fType(i) = -4: fData(i) = "<and"
    i = i + 1: fType(i) = 0: fData(i) = "Text"
    i = i + 1: fType(i) = 1: fData(i) = "*" & UCase(txtFindLine) & "*"
    i = i + 1: fType(i) = -4: fData(i) = "and>"
    
    i = i + 1: fType(i) = -4: fData(i) = "or>"

Cad 对象

dim txtObj as acadText      .EntityType = 21 OR .EntityType = 32

dim elem as AcadEntity

dim Blk as AcadBlockReference

今天的文章cad的选择集是什么_CAD插件开发分享到此就结束了，感谢您的阅读。