CAD开发者社区

 找回密码
 立即注册

QQ登录

只需一步,快速开始

ActiveX 开发指南

关于分配和检索扩展数据 (VBA/ActiveX)

2023-1-4 19:18| 发布者: admin| 查看: 578| 评论: 0|来自: AutoCAD

摘要: 可以使用扩展数据 (xdata) 作为将信息与图形中的对象链接的方法。

可以使用扩展数据 (xdata) 作为将信息与图形中的对象链接的方法。

将 xdata 分配给选择集中的所有对象

本示例提示用户从图形中选择对象。所选对象将放置在选择集中,指定的 xdata 将附加到该选择集中的所有对象。

Sub Ch10_AttachXDataToSelectionSetObjects()
 ' Create the selection set
 Dim sset As Object
 Set sset = ThisDrawing.SelectionSets.Add("SS1")
 
 ' Prompt the user to select objects
 sset.SelectOnScreen
 
 ' Define the xdata
 Dim appName As String, xdataStr As String
 appName = "MY_APP"
 xdataStr = "This is some xdata"
 Dim xdataType(0 To 1) As Integer
 Dim xdata(0 To 1) As Variant
 
 ' Define the values for each array
 '1001 indicates the appName
 xdataType(0) = 1001
 xdata(0) = appName
 '1000 indicates a string value
 xdataType(1) = 1000
 xdata(1) = xdataStr
 
 ' Loop through all entities in the selection
 ' set and assign the xdata to each entity
 Dim ent As Object
 For Each ent In sset
 ent.SetXData xdataType, xdata
 Next ent
End Sub

查看选择集中所有对象的 xdata

此示例显示与上一个示例一起附加的 xdata。如果附加字符串以外的 xdata(键入 1000),则需要修改此代码。

Sub Ch10_ViewXData()
 ' Find the selection created in previous example
 Dim sset As Object
 Set sset = ThisDrawing.SelectionSets.Item("SS1")
 
 ' Define the xdata variables to hold xdata information
 Dim xdataType As Variant
 Dim xdata As Variant
 Dim xd As Variant
 
 'Define index counter
 Dim xdi As Integer
 xdi = 0
 
 ' Loop through the objects in the selection set
 ' and retrieve the xdata for the object
 Dim msgstr As String
 Dim appName As String
 Dim ent As AcadEntity
 appName = "MY_APP"
 For Each ent In sset
 msgstr = ""
 xdi = 0
 
 ' Retrieve the appName xdata type and value
 ent.GetXData appName, xdataType, xdata
 
 ' If the xdataType variable is not initialized, there
 ' was no appName xdata to retrieve for that entity
 If VarType(xdataType) <> vbEmpty Then
 For Each xd In xdata
 msgstr = msgstr & vbCrLf & xdataType(xdi) _
 & ": " & xd
 xdi = xdi + 1
 Next xd
 End If
 
 ' If the msgstr variable is NULL, there was no xdata
 If msgstr = "" Then msgstr = vbCrLf & "NONE"
 MsgBox appName & " xdata on " & ent.ObjectName & _
 ":" & vbCrLf & msgstr
 Next ent
End Sub

路过

雷人

握手

鲜花

鸡蛋

最新评论

QQ|Archiver|CAD开发者社区 ( 苏ICP备2022047690号-1 )

GMT+8, 2024-5-12 08:45

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

返回顶部