Сохранение данных в чертеже

Уважаемые коллеги,
привожу код трех процедур, демонстрирующий технику сохранения в самом чертеже дескрипторов объектов Автокада с целью обеспечения многосеансовой работы.
Пользователь должен запустить на выполнение процедуру SaveDATA(), выделить мышью интересующие его объекты и нажать Enter, а затем сохранить чертеж и завершить сеанс работы Автокада. Затем загрузите Автокад снова, откройте сохраненный ранее чертеж и запустите на исполнение процедуру GetDATA(). Программа окрасит объекты, выделенные в предыдущем сеансе, в зеленый цвет acGreen.
Прошу извинения за неказистое оформление кода - форматирование убито в процессе размещения текста программы в форуме.
   ALink
'=================================================
' Демонстрационный пример использования объектов
' Dictionary и XRecord
' для сохранения дескрипторов выделенных юзером объектов
' между сеансами работы в Автокаде
'    ALink    avova2000@mtu-net.ru
Option Explicit
'Мои "собственные" типы данных на базе DXF-кодов
Public Const ALink_INTEGER = 70
Public Const ALink_HANDLE = 5
'для сохранения других типов данных следует этот список
'обобщить на прочие типы - Double, Long, String и т.д.
'Имя моего собственного глобального словаря
'в главной коллекции  Document.Dictionaries
Public Const DictName As String = "ALink_Dict"
'Имя записи (тип XRecords) в словаре DictName
Public Const XRName As String = "ALink_XRName"
'
Sub SaveDATA()
'Сохранение дескрипторов выделенных объектов в словаре DictName
'для дальнейшего использования в следующих сеансах работы с чертежом
   Dim ssetObj    As AcadSelectionSet
   Dim Dict       As AcadDictionary
   Dim XR         As AcadXRecord
   Dim obj        As AcadObject
   Dim DataCode() As Integer
   Dim Data()     As Variant
   Dim NN  As Integer 'кол-во сохраняемых объектов
   Dim i   As Integer
   'Найдем главный словарь
   Set Dict = GetMainDictionary
   If Dict Is Nothing Then
      MsgBox "Не удалось сохранить в документе основные данные проекта."
      Exit Sub
   End If
   'Удаляем все записи из словаря
   If Dict.Count > 0 Then
      For Each XR In Dict
         XR.Delete
      Next
   End If
   'дадим юзеру возможность выделить нужные объекты
   Set ssetObj = ThisDrawing.SelectionSets.Add("SSET1")
   ssetObj.SelectOnScreen
   If ssetObj.Count = 0 Then
      'ничего не выделено
      ThisDrawing.SelectionSets.Item("SSET1").Delete
      Exit Sub
   End If
   Set XR = Dict.AddXRecord(XRName)
   NN = ssetObj.Count  'кол-во выделенных объектов
   'подгонка размерностей массивов, в которых будут передаваться данные
   ReDim DataCode(0 To NN)
   ReDim Data(0 To NN)
   DataCode(0) = ALink_INTEGER
   Data(0) = NN
   For i = 1 To NN
      Set obj = ssetObj.Item(i - 1)
      DataCode(i) = ALink_HANDLE
      Data(i) = obj.Handle
   Next i
   XR.SetXRecordData DataCode, Data
   ThisDrawing.SelectionSets.Item("SSET1").Delete
End Sub  'SaveDATA
'"""""""""""""""""""
Sub GetDATA()
'Извлечение данных из словаря,
'сохраненного в предущем сеансе работы
   Dim ssetObj    As AcadSelectionSet
   Dim Dict       As AcadDictionary
   Dim XR         As AcadXRecord
   Dim obj        As AcadObject
   Dim ObjHandle  As String         ' дескриптор объекта
   Dim DataCode   As Variant        ' <-- обратить внимание на тип
   Dim Data       As Variant        ' <-- обратить внимание на тип
   Dim NN  As Integer 'кол-во объектов
   Dim i   As Integer
   'Найдем главный словарь
   Set Dict = GetMainDictionary
   If Dict Is Nothing Then
      MsgBox "Не найден словарь " & DictName
      Exit Sub
   End If
   Set XR = Dict.Item(XRName)
   XR.GetXRecordData DataCode, Data
   NN = Data(0)
   For i = 1 To NN
      ObjHandle = Data(i)
      Set obj = ThisDrawing.HandleToObject(ObjHandle)
      'отмечаем зеленым цветом "синтезированные" объекты
      obj.color = acGreen
      obj.Update
   Next i
End Sub  'GetDATA
'""""""""""""""""""
Function GetMainDictionary() As AcadDictionary
' Возвращает указатель на мой главный словарь
' Если словаря еще не было, то он создается
    Dim Dict As AcadDictionary
    'Попытка подключения к словарю
    On Error GoTo СОЗДАТЬ
    Set Dict = ThisDrawing.Dictionaries(DictName)
    On Error GoTo 0
    Set GetMainDictionary = Dict
    Exit Function
СОЗДАТЬ:
    If Dict Is Nothing Then  'Словарь не существует - создаем
        Set Dict = ThisDrawing.Dictionaries.Add(DictName)
    End If
    Resume
    Set GetMainDictionary = Dict
End Function 'GetMain
'""""""""""""""""""""""