CAD——拓展数据相关

墨家前任巨子

已于 2023-11-08 21:10:47 修改

阅读量408

点赞数

分类专栏： CAD学习文章标签：开发语言

于 2022-10-25 10:20:12 首次发布

本文链接：https://blog.csdn.net/qq_39728950/article/details/127508280

版权

CAD学习专栏收录该内容

9 篇文章 2 订阅

订阅专栏

只使用SetXData 绑定

 Dim bType() As Integer, bData() As Variant

 redim bType(4) As Integer: reDim bData(4) As Variant

9   bType(0) = 1001: bData(0) = "标注配置"
10  bType(1) = 1070    '左定位点的序号
11  bType(2) = 1040    '需要减去的值
12  bType(3) = 1000  '定位点类型（是左边的定位点，还是右边的定位点）
13  bType(4) = 1040  '需要赋予的值

 elem.SetXData bType, bData    '同时绑定 配置 到 数据字典

使用CAD自动加固一下

    Dim objDict As AcadDictionary, objXRecord As AcadXRecord
    Dim bType() As Integer, bData() As Variant

    redim bType(4) As Integer: reDim bData(4) As Variant

9   bType(0) = 1001: bData(0) = "标注配置"
10  bType(1) = 1070    '左定位点的序号
11  bType(2) = 1040    '需要减去的值
12  bType(3) = 1000  '定位点类型（是左边的定位点，还是右边的定位点）
13  bType(4) = 1040  '需要赋予的值


    elem.SetXData bType, bData    '同时绑定 配置 到 数据字典
    Set objDict = elem.GetExtensionDictionary()    '绑定完 获取与对象关联的扩展词典
    Set objXRecord = objDict.AddXRecord("标注配置")    '在任何词典中创建扩展记录(XRecord)对象。
    objXRecord.SetXRecordData bType, bData    '设置与词典相关联的扩展记录数据 (XRecordData)

常用的DXF组码一般有：

0 ：图元类型

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

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

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

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

1071：扩展数据 32位有符号整数 (一般绑定CAD10进制)

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

Insert 图块

LWPolyline 多段线

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

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

Dimension 标注

ATTDEF 属性

去除绑定的拓展数据

dim objDict As AcadDictionary

Set objDict = Ent.GetExtensionDictionary()    '绑定完 获取与对象关联的扩展词典
Call DelobjDictByName(objDict, "配置")


'删除对象数据字典中指定绑定：APPName
Public Function DelobjDictByName(ByRef objDictX As AcadDictionary, AppName As String) As Boolean
On Error GoTo Err_ABC
objDictX.Remove AppName
DelobjDictByName = True
Exit Function
Err_ABC:
End Function

CAD 文档绑定拓展数据

ModelSpace上绑定拓展数据

获取对象绑定的全部拓展数据

   Dim elem As AcadEntity, p As Variant
    Dim bType As Variant, bData As Variant, i As Integer, CColor As Long
2   If CADisBusy Then Exit Sub
3   Me.Hide
4   Set elem = GetEntity("请选择要获取句柄的图纸对象:", p)
5   Me.Show
6   If elem Is Nothing Then Exit Sub
7   txtX(2) = "": txtX(0) = CLng("&H" & elem.Handle)
8   txtX(1) = elem.Handle: txtX(5) = ""
9   txtX(4) = elem.EntityType: txtX(3) = elem.EntityName
10  LVAttBOM.ListItems.Clear

11  elem.GetXData "", bType, bData
12  If Not IsEmpty(bData) Then
13      CColor = vbRed
14      For i = 0 To UBound(bData)
15          If bType(i) = 1001 Then
16              Set itmX = LVAttBOM.ListItems.Add(, , bType(i))
17              itmX.SubItems(1) = bData(i)
18              CColor = IIf(CColor = vbBlack, vbRed, vbBlack)
19          Else
20              Set itmX = LVAttBOM.ListItems.Add(, , bType(i))
21              itmX.SubItems(1) = bData(i)
22          End If
23          itmX.ForeColor = CColor
24      Next
25  End If