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

sccat 发表于 2005-2-28 16:24:00

1.我想将一个信息附加在单行文本上，例如"data001",

2.在复制这个文本的时候自动把附加信息也一起复制

3.在我更改这个文本的时候，自动搜索跟他附加信息一样的单行文本，然后改成相同的。

tfyyf 发表于 2005-2-28 17:59:00

1、2

可以使用扩展数据

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

sccat 发表于 2005-3-1 08:37:00

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

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

雪山飞狐_lzh 发表于 2005-3-1 08:59:00

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

sccat 发表于 2005-3-2 11:29:00

CAD的帮助

lineObj.GetXData "", xtypeOut, xdataOut

“”里面是不是application name

xtypeOut ,xdataOut

返回的东西怎样读取利用阿？

yulijin608 发表于 2005-3-2 11:46:00

以前写的

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 发表于 2005-3-2 11:58:00

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 发表于 2005-5-27 10:59:00

我把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 发表于 2005-5-27 15:43:00

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

.net里应该是：

Dim linext(4) As Short

Dim linexd(4) As Object

twosun 发表于 2005-5-27 17:11:00

本帖最后由作者于 2005-6-2 11:19:53 编辑

多谢版主指点！

页: [1]

明经CAD社区's Archiver

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