Làm v ic vi Xrecord 1 Khái ni m v Xrecord

Một phần của tài liệu vba_cad_25_8_08 (Trang 97 - 101)

Xrecord là đ i t ng thu c Collection Dictionaries. Khái ni m v Xrecord c ng t ng t nh Xdata, nh ng Xrecord không b gi i h n v kích th c c ng nh th t và nó có th ch a b t k lo i d li u nào.

Khác v i Xdata, XRecords ch a d li u trong standard AutoCAD group codes, t c là không ph i

B浦 MÔN T IN H窺C XÂY D衛NG KHOA CÔNG NGH烏 THÔN G TIN TR姶云NG A萎 I H窺C XÂY D衛NG

AutoCAD group codes đ u đ c s d ng đ ch a d li u. M t đi u quan tr ng n a là ta có th qu n lý Xrecord b ng object IDs.

Ví d : Các b c AutoCAD ghi l i các thông tin c a m t Layer nh sau :

̇ T o ra m t t đi n m r ng (Extension dictionary) trong layer collection.

̇ T o m t Dictionary object l y tên là ACAD_LAYERSTATE trong extension dictionary.

̇ L u t t c các thu c tính c a layer vào m t XRecord object trong ACAD_LAYERSTATE dictionary. AutoCAD l u t t c các thi t l p c a các layer vào Xrecord n u b n ch n ch c n ng Save. Khi b n khôi ph c l i (restore the layer setting, AutoCAD s l y d li u t XRecord đ khôi ph c l i).

Nh v y, ta c ng có th ghi l i các d li u c n thi t trong quá trình l p trình s lý b n v b ng cách s d ng Xrecord.

Nh ng Group code sau có th đ c s d ng trong XRecord objects:

̇ 100 : Subclass marker (AcDbXrecord)

̇ 1-369 : (except 5 and 105)

XRecord obects đ c ghi l i cùng v i b n v , và chúng có th đ c truy c p m t cách tr c ti p b i ObjectARX và LISP. Do v y, n u b n c n b o m t d li u, b n ph i mã hóa chúng. :

VBA class name: AcadXRecord

Create using: Dictionary.AddXRecord

Access via: Dictionary.Item

2. Ph ng th c AddXRecord

RetVal = object.AddXRecord(Keyword)

̇ Object : ki u Dictionary, đ i t ng s ch a XRecord.

̇ Keyword : String, input-only. Là tên c a XRecord trong dictionary.

̇ RetVal : XRecord object Sub Example_AddXRecord()

' This example creates a new XRecord if one doesn't exist,

' appends data to the XRecord, and then reads it back. To see data being added, ' run the example more than once.

Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord Dim XRecordDataType As Variant, XRecordData As Variant

Dim ArraySize As Long, iCount As Long

Dim DataType As Integer, Data As String, msg As String

' Unique identifiers to distinguish this XRecordData from other XRecordData Const TYPE_STRING = 1

Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary"

B浦 MÔN T IN H窺C XÂY D衛NG KHOA CÔNG NGH烏 THÔN G TIN TR姶云NG A萎 I H窺C XÂY D衛NG

Const TAG_XRECORD_NAME = "ObjectTrackerXRecord" ' Connect to the dictionary in which to store the XRecord

On Error GoTo CREATE

Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME) Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME) On Error GoTo 0

' Get current XRecordData

TrackingXRecord.GetXRecordData XRecordDataType, XRecordData ' If there is no array yet then create one

If VarType(XRecordDataType) And vbArray = vbArray Then ArraySize = UBound(XRecordDataType) + 1

' Get the size of the data elements returned ArraySize = ArraySize + 1

' Increase to hold new data

ReDim Preserve XRecordDataType(0 To ArraySize) ReDim Preserve XRecordData(0 To ArraySize) Else

ArraySize = 0

ReDim XRecordDataType(0 To ArraySize) As Integer ReDim XRecordData(0 To ArraySize) As Variant End If

' Append new XRecord Data

' For this sample we only append the current time to the XRecord

XRecordDataType(ArraySize) = TYPE_STRING: XRecordData(ArraySize) = _ CStr(Now)

TrackingXRecord.SetXRecordData XRecordDataType, XRecordData ' Read back all XRecordData entries

TrackingXRecord.GetXRecordData XRecordDataType, XRecordData ArraySize = UBound(XRecordDataType)

' Retrieve and display stored XRecordData For iCount = 0 To ArraySize

' Get information for this element

DataType = XRecordDataType(iCount) Data = XRecordData(iCount) If DataType = TYPE_STRING Then msg = msg & Data & vbCrLf End If

Next

MsgBox "The data in the XRecord is: " & vbCrLf & vbCrLf & msg, vbInformation

Exit Sub CREATE:

' Create the objects that hold this XRecordData

If TrackingDictionary Is Nothing Then ' Make sure to have tracking object Set TrackingDictionary = _ ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME) Set TrackingXRecord = _ B浦 MÔN T IN H窺C XÂY D衛NG KHOA CÔNG NGH烏 THÔN G TIN TR姶云NG A萎 I H窺C XÂY D衛NG

TrackingDictionary.AddXRecord(TAG_XRECORD_NAME) End If

Resume End Sub

3. Ph ng th c SetXRecordData

object.SetXRecordData XRecordDataType, XRecordData

̇ Object : ki u XRecord Object, đ i t ng s ch a d li u.

̇ XrecordDataType : Variant (array of short); input-only. The following group codes are common to all XRecord objects:

Group codes Description

100 Subclass marker (AcDbXrecord)

1-369 (except 5 and 105) Giá tr có th đ c s d ng b i b t k ng d ng nào.

4. Ph ng th c GetXRecordData

object.GetXRecordData XRecordDataType, XRecordDataValue

̇ Object : ki u XRecord Object, đ i t ng s ch a d li u.

̇ XrecordDataType : Variant (array of short); Output-only.

Sub Example_SetXRecordData()

' This example creates a new XRecord if one doesn't exist,

' appends data to the XRecord, and reads it back. To see data being added, ' run the example more than once.

Dim TrackingDictionary As AcadDictionary, TrackingXRecord As AcadXRecord Dim XRecordDataType As Variant, XRecordData As Variant

Dim ArraySize As Long, iCount As Long

Dim DataType As Integer, Data As String, msg As String

' Unique identifiers to distinguish our XRecordData from other XRecordData Const TYPE_STRING = 1

Const TAG_DICTIONARY_NAME = "ObjectTrackerDictionary" Const TAG_XRECORD_NAME = "ObjectTrackerXRecord" ' Connect to the dictionary in which the XRecord is stored

On Error GoTo CREATE

Set TrackingDictionary = ThisDrawing.Dictionaries(TAG_DICTIONARY_NAME) Set TrackingXRecord = TrackingDictionary.GetObject(TAG_XRECORD_NAME) On Error GoTo 0

' Get current XRecordData

TrackingXRecord.GetXRecordData XRecordDataType, XRecordData

' If there is no array already, create one

If VarType(XRecordDataType) And vbArray = vbArray Then ArraySize = UBound(XRecordDataType) + 1 ' Get the size of the data elements returned

ArraySize = ArraySize + 1 B浦 MÔN T IN H窺C XÂY D衛NG KHOA CÔNG NGH烏 THÔN G TIN TR姶云NG A萎 I H窺C XÂY D衛NG

' Increase to hold new data

ReDim Preserve XRecordDataType(0 To ArraySize) ReDim Preserve XRecordData(0 To ArraySize) Else

ArraySize = 0

ReDim XRecordDataType(0 To ArraySize) As Integer ReDim XRecordData(0 To ArraySize) As Variant End If

' Append new XRecord Data '

' For this sample, we only append the current time to the XRecord

XRecordDataType(ArraySize) = TYPE_STRING: XRecordData(ArraySize) = _ CStr(Now)

TrackingXRecord.SetXRecordData XRecordDataType, XRecordData ' Read back all XRecordData entries

TrackingXRecord.GetXRecordData XRecordDataType, XRecordData ArraySize = UBound(XRecordDataType)

' Retrieve and display stored XRecordData For iCount = 0 To ArraySize ' Get information for this element

DataType = XRecordDataType(iCount) Data = XRecordData(iCount)

If DataType = TYPE_STRING Then msg = msg & Data & vbCrLf End If

Next

MsgBox "The data in the XRecord is: " & vbCrLf & vbCrLf & msg, vbInformation

Exit Sub CREATE:

' Create the objects that hold the XRecordData

If TrackingDictionary Is Nothing Then ' Make sure the tracking object is there Set TrackingDictionary = _ ThisDrawing.Dictionaries.Add(TAG_DICTIONARY_NAME) Set TrackingXRecord = _ TrackingDictionary.AddXRecord(TAG_XRECORD_NAME) End If Resume End Sub B浦 MÔN T IN H窺C XÂY D衛NG KHOA CÔNG NGH烏 THÔN G TIN TR姶云NG A萎 I H窺C XÂY D衛NG

Một phần của tài liệu vba_cad_25_8_08 (Trang 97 - 101)

Tải bản đầy đủ (PDF)

(101 trang)