[求助]请问大虾这个功能怎样实现？

sccat

1.我想将一个信息附加在单行文本上，例如"data001", 2.在复制这个文本的时候自动把附加信息也一起复制 3.在我更改这个文本的时候，自动搜索跟他附加信息一样的单行文本，然后改成相同的。

tfyyf

1、2


可以使用扩展数据


3、在更改这个文本的时候，自动搜索跟他扩展数据一样的单行文本，然后改成相同的

sccat

原理我知道，但是不知怎样下手。


没做过关于扩展数据的程序？有没有例子或者帮助？

雪山飞狐_lzh

CAD的帮助里就有呀，GetXData方法和SetXData方法

sccat

CAD的帮助 lineObj.GetXData "", xtypeOut, xdataOut “”里面是不是application name xtypeOut ,xdataOut 返回的东西怎样读取利用阿？

yulijin608

以前写的 Sub setxRecord() Dim linext(0 To 4) As Integer
Dim linexd(0 To 4) As Variant
Dim sPoint(0 To 2) As Double
Dim ePoint(0 To 2) As Double
sPoint(0) = 10
sPoint(1) = 10
sPoint(2) = 0
ePoint(0) = 30
ePoint(1) = 30
ePoint(2) = 0
Dim lineObj As AcadLine
Set lineObj = ThisDrawing.ModelSpace.addline(sPoint, ePoint)
lineObj.Color = 1 linext(0) = 1001: linexd(0) = "LineInfo"
linext(1) = 1000: linexd(1) = "a"
linext(2) = 1000: linexd(2) = "b"
linext(3) = 1000: linexd(3) = "c"
linext(4) = 1000: linexd(4) = "d" ThisDrawing.RegisteredApplications.Add "LineInfo"
lineObj.SetXData linext, linexd
lineObj.Update End Sub Sub getxRecord()
Dim a As Variant
Dim b As Variant
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("ss")
Dim point As Variant
point = ThisDrawing.Utility.GetPoint()
sset.SelectAtPoint point
Dim entry As AcadEntity
Dim xdataOut As Variant
Dim xtypeOut As Variant

For Each entry In sset
If StrComp(entry.ObjectName, "AcDbLine", 1) = 0 Then
entry.GetXData "", xtypeOut, xdataOut
MsgBox xdataOut(1)
End If
Next
ThisDrawing.SelectionSets.Item("ss").Delete
End Sub

sccat

DataType(0) = 1001: Data(0) = "Test_Application"
DataType(1) = 1000: Data(1) = "This is a test for xdata"

DataType(2) = 1003: Data(2) = "0" ' layer
DataType(3) = 1040: Data(3) = 1.23479137438413E+40 ' real
DataType(4) = 1041: Data(4) = 1237324938 ' distance
DataType(5) = 1070: Data(5) = 32767 ' 16 bit Integer
DataType(6) = 1071: Data(6) = 32767 ' 32 bit Integer
DataType(7) = 1042: Data(7) = 10 ' scaleFactor

reals3(0) = -2.95: reals3(1) = 100: reals3(2) = -20
DataType(8) = 1010: Data(8) = reals3 ' real

worldPos(0) = 4: worldPos(1) = 400.99999999: worldPos(2) = 2.798989
DataType(9) = 1011: Data(9) = worldPos ' world space position
除了1001以外，其他好像不需要连续，但编号还有什么规定呢？跟所占的空间有没有关系？ 楼上的 linext(1) = 1000: linexd(1) = "a"
linext(2) = 1000: linexd(2) = "b"
linext(3) = 1000: linexd(3) = "c"
linext(4) = 1000: linexd(4) = "d" 怎么都是1000啊？

twosun

我把yulijin608的代码改到vb.net中有错。改后的代码如下： Sub setxRecord(ByRef acadDoc As AutoCAD.AcadDocument) Dim linext(4) As Integer
Dim linexd(4) As String
Dim sPoint(2) As Double
Dim ePoint(2) As Double
sPoint(0) = 10
sPoint(1) = 10
sPoint(2) = 0
ePoint(0) = 50
ePoint(1) = 50
ePoint(2) = 0
Dim lineObj As AutoCAD.AcadLine
lineObj = acadDoc.ModelSpace.AddLine(sPoint, ePoint)
lineObj.color = 1 linext(0) = 1001 : linexd(0) = "LineInfo"
linext(1) = 1000 : linexd(1) = "a"
linext(2) = 1000 : linexd(2) = "b"
linext(3) = 1000 : linexd(3) = "c"
linext(4) = 1000 : linexd(4) = "d" acadDoc.RegisteredApplications.Add("LineInfo")
lineObj.SetXData(linext, linexd) ‘这里出错， lineObj.Update() End Sub 出错原因，我猜可能是object和Variant类型不匹配，我把object改成string也不行，不知道应该怎么改？那位知道怎么改，还请指点一下啊？

雪山飞狐_lzh

DataType数组的值表示Data数组的类型，1000，说明对应项是字符串


.net里应该是：


Dim linext(4) As Short


Dim linexd(4) As Object

twosun

多谢版主指点！