代码如下：
CLEA
oleapp=Createobject("autocad.application") && 启动autocad
oleapp.Visible=.T. && 显示autocad
ThisDrawing=oleapp.activedocument
Dime startPt(3) As Double
dime endPt(3) As Double
startPt(1) = 1
startPt(2) = 1
startPt(3) = 0
endPt(1) = 5
endPt(2) = 5
endPt(3) = 0
lineObj = ThisDrawing.ModelSpace.AddLine(@startPt,@endPt) &&画一根线
* oleapp.ZoomAll
* 下面代码是为这根线增加一个属性
Dime xdataType(2) as Integer
Dime strdata(2) As Variant
* ' 为每个数组定义值
* '1001 指示 appName
xdataType(1) = 1001
strdata(1) = "MY_APP"
* '1000 指示字符串值
xdataType(2) = 1000
strdata(2) = "Thisissomexdata"
=COMARRAY(oleapp,0) &&数组是基于零的数组，并且按值传递
lineObj.SetXData(@xDataType,@strdata) &&为线对象增加属性 ------------------这里出错了！
retu
SetXData函数帮助文件中的说明：
说明：Sets the extended data (XData) associated with an object.
object.SetXData XDataType, XData
Object
All Drawing Objects , AttributeReference, Block, Dictionary, DimStyle, Group, Layer, Linetype, PlotConfigurations, RegisteredApplication, TextStyle, UCS, View, Viewport; XRecord
The object this method applies to.
XDataType
Variant (array of short); input-only
XData
Array of Variant; input-only
Remarks
Extended data is an example of instance-specific data created by applications written with ObjectARX or AutoLISP. This data can be added to any entity. This data follows the entity's definition data and is maintained in the order in which it was saved into the document. (AutoCAD maintains this information but doesn't use it.)
这是一个帮助文件上的例子：
Sub Example_SetXdata()
' This example creates a line and attaches extended data to that line.
' Create the line
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double, endPt(0 To 2) As Double
startPt(0) = 1#: startPt(1) = 1#: startPt(2) = 0#
endPt(0) = 5#: endPt(1) = 5#: endPt(2) = 0#
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
ZoomAll
' Initialize all the xdata values. Note that first data in the list should be
' application name and first datatype code should be 1001
Dim DataType(0 To 9) As Integer
Dim Data(0 To 9) As Variant
Dim reals3(0 To 2) As Double
Dim worldPos(0 To 2) As Double
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
' Attach the xdata to the line
lineObj.SetXData DataType, Data
' Return the xdata for the line
Dim xdataOut As Variant
Dim xtypeOut As Variant
lineObj.GetXData "", xtypeOut, xdataOut
End Sub
[此贴子已经被作者于2018-7-5 12:48编辑过]
2018-07-05 10:23
