- 积分
- 2468
- 明经币
- 个
- 注册时间
- 2004-7-22
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2004-11-10 13:40: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) & "," & xdataout(2) & "," & xdataout(3) & "," & xdataout(4) End If Next ThisDrawing.SelectionSets.Item("ss").Delete End Sub |
|