Исходный текст

Option Explicit
Call Application_AttributeDefs()

'==============================================================================
'Протестировать все свойства и методы объекта TDMSAttributeDefs: 
'проверить наличие в коллекции, создание, добавление в коллекцию и удаление.

'Для выполнения скрипта необходимы права системного администратора.
'==============================================================================
Sub Application_AttributeDefs()
        
        Dim ADefs, AttrDef, RetVal, strRetID, dlgInput, SelDlg, ObjDef
        
        'ПОлучить системное имя атрибута для проверки через диалог ввода.
        Set dlgInput = ThisApplication.Dialogs.SimpleEditDlg
        dlgInput.Caption = "Системное имя атрибута для проверки"
        dlgInput.Prompt = "SysID:"
        RetVal = dlgInput.Show
        strRetID = dlgInput.Text
        
        'Если пользователь отменил диалог или ввел пустую строку - закончить работу
        If RetVal <> TRUE Or strRetID = "" Then Exit Sub
        
        ' Получаем ссылку на глобальную коллекцию типов атрибутов 
        Set ADefs = ThisApplication.AttributeDefs
        
        'Если нет информации о типах атрибутов, выйти из процедуры
        If ADefs.Count = 0 Then 
                MsgBox "Типы атрибутов в системе отсутствуют.", _
                        vbInformation, "Информация о текущей настройке"
                Exit Sub
        End If
        
        'Проверить, содержит ли коллекция интересующий нас атрибут
        If Not ADefs.Has(strRetID) Then
                
                ' Если тип атрибута в системе не существует, но пользователь
                'просит создать его - создадим.
                RetVal = MsgBox("Атрибута """ & strRetID & """ в системе" & Chr(13)_
                     & "не существует. Создать его?", vbQuestion + vbYesNo)
                     
                If RetVal <> vbNo Then
                        Set AttrDef = ADefs.Create
                        AttrDef.SysName = strRetID
                        AttrDef.Description = "Тестовый атрибут"
                        
                Else:Exit Sub 'Если типа нет в системе и создавать его не надо - выйти из подпрограммы
                End If
                
        Else
                'Если тип уже существует в системе, получить ссылку на него
                Set AttrDef = ADefs.Item(strRetID)
        End If

        'Сообщить, под каким номером в глобальной коллекции значится наш тип атрибута.        
        RetVal = MsgBox("Тип атрибута """ & strRetID & """ найден в глобальной коллекции" & Chr(13)_
             & "под номером " & ADefs.Index(AttrDef) & ". Добавить его в коллекцию типа объекта?"_
             , vbQuestion + vbYesNo)
        
        'Добавить тип атрибута к типу объекта
        If RetVal <> vbNo Then 
                Set ObjDef = ThisApplication.ObjectDefs(0)
                ObjDef.AttributeDefs.Add AttrDef 
                etVal = MsgBox("Тип атрибута добавлен к типу объекта """ & ObjDef.Description & """." _
                & Chr(13) & "Удалить его из коллекции?", vbQuestion + vbYesNo)
                
                'Можно удалить тип из коллекции объекта - он останется в глобальной коллекции ADefs:
                If RetVal <> vbNo Then ObjDef.AttributeDefs.Remove AttrDef
        End If
             
        RetVal = MsgBox("Удалить тип атрибута """ & strRetID & """ из системы?", vbQuestion + vbYesNo)
        
        'Если пользователь нажал "Да", удалить тип из приложения методом Erase.
        'Это может не получиться, если тип существовал ранее и в системе есть объекты с производными атрибутами 
        If RetVal <> vbNo Then
                On Error Resume Next    
                AttrDef.Erase
                If Err <> 0 Then
                        MsgBox Err
                Else
                        MsgBox "Тип атрибута """ & strRetID & """ успешно удален из системы.", vbInformation
                End If
        End If

End Sub
'==============================================================================