VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Public Kompas As Object
Public attr As Object
Public doc As Object

Sub ShowCol(par As Object, iCol As Integer, fl As Boolean)
  Dim s As String
  If fl Then
    s = "структура"
  Else
    s = ""
  End If

  ' выдадим поля колонки не указатели
  Kompas.ksMessage s & " i = " & iCol & " header=" & par.Header & " type=" & par.Type & _
                   " def=" & par.Def & " flagEnum=" & par.FlagEnum
  If par.Type = RECORD_ATTR_TYPE Then         ' структура
    Dim pCol As Object
    Set pCol = par.GetColumns
    If Not pCol Is Nothing Then
      ShowColumns pCol, True
      pCol.ksDeleteArray
      Set pCol = Nothing
    End If
  End If
End Sub

Sub ShowColumns(pCol As Object, fl As Boolean)
  Dim par As Object
  Set par = Kompas.GetParamStruct(ko_ColumnInfoParam)
  If Not par Is Nothing Then
    par.Init
    Dim n As Integer
    n = pCol.ksGetArrayCount

    Dim i As Integer
    For i = 0 To n - 1
      If pCol.ksGetArrayItem(i, par) = 0 Then
        Kompas.ksMessageBoxResult  ' проверяем результат работы нашей функции
      Else
        ShowCol par, i, fl
      End If
    Next i
    Set par = Nothing
  End If
End Sub

' создание типа аттрибута
Sub FuncAttrType()
  Dim type_ As Object
  Dim col As Object
  Set type_ = Kompas.GetParamStruct(ko_AttributeType)
  Set col = Kompas.GetParamStruct(ko_ColumnInfoParam)
  If Not type_ Is Nothing And Not col Is Nothing Then
    type_.Init
    col.Init
    type_.Header = "double_str_long"          ' заголовoк-комментарий типа
    type_.RowsCount = 1                       ' кол-во строк в таблице
    type_.FlagVisible = True                  ' видимый, невидимый   в таблице
    type_.password = ""                       ' пароль, если не пустая строка  - защищает от несанкционированного изменения типа
    type_.Key1 = 10
    type_.Key2 = 20
    type_.Key3 = 30
    type_.Key4 = 0
    Dim arr As Object
    Set arr = type_.GetColumns
    If Not arr Is Nothing Then
      ' первая колонка  структуры
      col.Header = "double"               ' заголовoк-комментарий столбца
      col.Type = DOUBLE_ATTR_TYPE         ' тип данных в столбце - см.ниже
      col.Key = 0                         ' дополнительный признак, который позволит отличить две переменные с одинаковым типом
      col.Def = "123456789"               ' значение по умолчанию
      col.FlagEnum = False                ' флаг включающий режим, когда значение поля атрибута
      arr.ksAddArrayItem -1, col

      ' вторая колонка структуры
      col.Header = "str"                  ' заголовoк-комментарий столбца
      col.Type = STRING_ATTR_TYPE         ' тип данных в столбце - см.ниже
      col.Key = 0                         ' дополнительный признак, который позволит отличить две переменные с одинаковым типом
      col.Def = "string"                  ' значение по умолчанию
      col.FlagEnum = False                ' флаг включающий режим, когда значение поля атрибута
      arr.ksAddArrayItem -1, col

      ' третья колонка структуры
      col.Header = "long"                 ' заголовoк-комментарий столбца
      col.Type = LINT_ATTR_TYPE           ' тип данных в столбце - см.ниже
      col.Key = 0                         ' дополнительный признак, который позволит отличить две переменные с одинаковым типом
      col.Def = "1000000"                 ' значение по умолчанию
      col.FlagEnum = False                ' флаг включающий режим, когда значение поля атрибута
      arr.ksAddArrayItem -1, col
      Set arr = Nothing
    End If
    Dim nameFile As String
    nameFile = ""
    ' запросить имя библиотеки
    nameFile = Kompas.ksChoiceFile("*.lat", "", False)
    ' создать тип атрибута
    Dim numbType As Double
    numbType = attr.ksCreateAttrType(type_, nameFile)
    If numbType > 1 Then
      Kompas.ksMessage "numbType = " & numbType
    Else
      Kompas.ksMessageBoxResult  ' проверяем результат работы нашей функции
    End If

    ' удалим  массив колонок
'    arr.ksDeleteArray
    Set type_ = Nothing
    Set col = Nothing
  End If
End Sub

Sub DelTypeAttr()
  Dim numb As Double
  Dim j As Integer
  Dim password As String
  password = ""
  ' запросить имя библиотеки
  Dim nameFile As String
  nameFile = ""
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)
  Do
    j = Kompas.ksReadDouble("Ввести номер типа атрибута", 1000#, 0, 1000000000000#, numb)
    If j <> 0 Then
      password = Kompas.ksReadString("Ввести пароль типа атрибута", "")
      If attr.ksDeleteAttrType(numb, nameFile, password) = 0 Then
        Kompas.ksMessageBoxResult  ' проверяем результат работы нашей функции
      End If
    End If
  Loop While (j <> 0)
End Sub

' получить тип атрибута
Sub ShowTypeAttr()
  Dim numb As Double
  ' запросить имя библиотеки
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)

  Dim type_ As Object
  Set type_ = Kompas.GetParamStruct(ko_AttributeType)
  If Not type_ Is Nothing Then
    type_.Init

    Do
      numb = attr.ksChoiceAttrTypes(nameFile)
      If numb <> 0 Then
        If attr.ksGetAttrType(numb, nameFile, type_) = 0 Then
          Kompas.ksMessageBoxResult  ' проверяем результат работы нашей функции
        Else
          Kompas.ksMessage "key1 = " & type_.Key1 & " key2 = " & type_.Key2 & " key3 = " & _
                           type_.Key3 & " key4 = " & type_.Key4
          Kompas.ksMessage "header = " & type_.Header & " rowsCount = " & type_.RowsCount & _
                           " flagVisible = " & type_.FlagVisible & " password = " & type_.password
          Dim pCol As Object
          Set pCol = type_.GetColumns
          If Not pCol Is Nothing Then
            ShowColumns pCol, False
            pCol.ksDeleteArray
            Set pCol = Nothing
          End If
'          ShowColumns attrType.columns, FALSE  ' пользовательская функция
        End If
      End If
    Loop While (numb)
    ' удалим  массив колонок
'    DeleteArray attrType.columns
    Set type_ = Nothing
  End If
End Sub

' заменить тип атрибута
Sub ChangeType()
  Dim numb As Double
  Dim password As String
  password = ""
  ' запросить имя библиотеки
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)
  Dim j As Integer

  Dim type_ As Object
  Set type_ = Kompas.GetParamStruct(ko_AttributeType)
  If Not type_ Is Nothing Then
    type_.Init
    Do
      j = Kompas.ksReadDouble("Ввести номер типа атрибута", 1000#, 0, 1000000000000#, numb)
      If j <> 0 Then
        password = Kompas.ksReadString("Ввести пароль типа атрибута", "")
        ' считаем тип атрибута
        If attr.ksGetAttrType(numb, nameFile, type_) = 0 Then
          Kompas.ksMessageBoxResult  ' проверяем результат работы нашей функции
        Else
          type_.password = password
          Dim arr As Object
          Dim par1 As Object
          Dim parN As Object
          Set arr = type_.GetColumns()
          Set par1 = Kompas.GetParamStruct(ko_ColumnInfoParam)
          Set parN = Kompas.GetParamStruct(ko_ColumnInfoParam)
          If Not arr Is Nothing And Not par1 Is Nothing And Not parN Is Nothing Then
            par1.Init
            parN.Init
            ' число колонок
            Dim n As Integer
            n = arr.ksGetArrayCount()
            ' считаем первую колонку
            arr.ksGetArrayItem 0, par1
            ' считаем последнюю колонку
            arr.ksGetArrayItem n - 1, parN
            ' заменим первую колонку
            arr.ksSetArrayItem 0, parN
            ' заменим последнюю колонку
            arr.ksSetArrayItem n - 1, par1

            ' заменим  тип атрибута  на новый
            Dim numbType As Double
            numbType = attr.ksSetAttrType(numb, nameFile, type_, password)
            If numbType > 1 Then
              Kompas.ksMessage "numbType = " & numbType
            Else
              Kompas.ksMessageBoxResult  ' неудачное завершение - выдадим результат работы нашей функции
            End If
            arr.ksDeleteArray
            Set arr = Nothing
            Set par1 = Nothing
            Set parN = Nothing
          End If
        End If
      End If
    Loop While (j <> 0)
    Set type_ = Nothing
  End If
End Sub

' создадим атрибут типа,полученного из функции FuncTypeAttr
Sub NewAttr()
  Dim attrPar As Object
  Dim usPar As Object
  Dim fVisibl As Object
  Dim colKeys As Object
  Set attrPar = Kompas.GetParamStruct(ko_Attribute)
  Set usPar = Kompas.GetParamStruct(ko_UserParam)
  Set fVisibl = Kompas.GetDynamicArray(LTVARIANT_ARR)
  Set colKeys = Kompas.GetDynamicArray(LTVARIANT_ARR)
  If Not attrPar Is Nothing And Not usPar Is Nothing And Not fVisibl Is Nothing And _
        Not colKeys Is Nothing Then
    attrPar.Init
    usPar.Init
    attrPar.setValues usPar
    attrPar.setColumnKeys colKeys
    attrPar.setFlagVisible fVisibl
    attrPar.Key1 = 1
    attrPar.Key2 = 10
    attrPar.Key3 = 100
    attrPar.password = "111"

    Dim item As Object
    Dim arr As Object
    Set item = Kompas.GetParamStruct(ko_LtVariant)
    Set arr = Kompas.GetDynamicArray(LTVARIANT_ARR)
    If Not item Is Nothing And Not arr Is Nothing Then
      usPar.setUserArray arr
      item.Init
      item.DoubleVal = 987654321#
      arr.ksAddArrayItem -1, item
      item.Init
      item.StrVal = "qwerty"
      arr.ksAddArrayItem -1, item
      item.Init
      item.LongVal = 999991
      arr.ksAddArrayItem -1, item

      item.Init
      item.UCharVal = 1
      fVisibl.ksAddArrayItem -1, item
      fVisibl.ksAddArrayItem -1, item
      fVisibl.ksAddArrayItem -1, item
      Set item = Nothing
      Set arr = Nothing
    End If

    Dim info As Object
    Set info = Kompas.GetParamStruct(ko_RequestInfo)
    If Not info Is Nothing Then
      info.Init
      info.Prompt = "Укажите объект"
      Dim x As Double
      Dim y As Double
      Dim j As Integer
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          doc.ksLightObj pObj, 1
          ' запросить имя библиотеки
          Dim nameFile As String
          nameFile = Kompas.ksChoiceFile("*.lat", "", False)
          Dim numb As Double
          j = Kompas.ksReadDouble("Ввести номер типа атрибута", 1000#, 0, 1000000000000#, numb)
          If j <> 0 Then
            Dim pAttr As Long
            pAttr = attr.ksCreateAttr(pObj, attrPar, numb, nameFile)
            If pAttr = 0 Then
              Kompas.ksMessageBoxResult  ' неудачное завершение - выдадим результат работы нашей функции
            End If
          End If
          doc.ksLightObj pObj, 0
        End If
      End If
      Set info = Nothing
    End If
    Set attrPar = Nothing
    Set usPar = Nothing
    Set fVisibl = Nothing
    Set colKeys = Nothing
  End If
End Sub

' удалить первый атрибут  у данного объекта
Sub DelObjAttr()
  Dim info As Object
  Set info = Kompas.GetParamStruct(ko_RequestInfo)
  If Not info Is Nothing Then
    info.Init
    info.Prompt = "Укажите объект"
    Dim x As Double
    Dim y As Double
    Dim j As Integer
    Do
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          doc.ksLightObj pObj, 1
          ' создадим итератор для хождения по атрибутам объекта
          Dim iter As Object
          Set iter = Kompas.GetIterator
          If Not iter Is Nothing Then
            If iter.ksCreateAttrIterator(pObj, 0, 0, 0, 0, 0) <> 0 Then
              ' встали на первый атрибут
              Dim pAttr As Long
              Dim n As Long
              pAttr = iter.ksMoveAttrIterator("F", n)
              If pAttr <> 0 Then
                Dim password As String
                password = Kompas.ksReadString("Ввести пароль типа атрибута", "")
                If attr.ksDeleteAttr(pObj, pAttr, password) = 0 Then
                  Kompas.ksMessageBoxResult
                End If
              Else
                Kompas.ksMessage "атрибут не найден"
              End If
                
              doc.ksLightObj pObj, 0
            End If
          End If
        End If
      End If
    Loop While (j <> 0)
    Set info = Nothing
  End If
End Sub

' считать  атрибут  типа double_str_long
Sub ReadObjAttr()
  Dim res As Boolean
  res = False
  Dim usPar As Object
  Set usPar = Kompas.GetParamStruct(ko_UserParam)
  If Not usPar Is Nothing Then
    usPar.Init
    Dim item As Object
    Dim arr As Object
    Set item = Kompas.GetParamStruct(ko_LtVariant)
    Set arr = Kompas.GetDynamicArray(LTVARIANT_ARR)
    If Not item Is Nothing And Not arr Is Nothing Then
      usPar.setUserArray arr
      item.Init
      item.DoubleVal = 987654321#
      arr.ksAddArrayItem -1, item
      item.Init
      item.StrVal = "qwerty"
      arr.ksAddArrayItem -1, item
      item.Init
      item.LongVal = 999991
      arr.ksAddArrayItem -1, item
      res = True
      Set item = Nothing
      Set arr = Nothing
    End If
  End If
  If res Then
    Dim info As Object
    Set info = Kompas.GetParamStruct(ko_RequestInfo)
    If Not info Is Nothing Then
      info.Init
      info.Prompt = "Укажите объект"
      Dim x As Double
      Dim y As Double
      Dim j As Integer
      Do
        j = doc.ksCursor(info, x, y, Nothing)
        If j <> 0 Then
          Dim pObj As Long
          pObj = doc.ksFindObj(x, y, 1000000#)
          If doc.ksExistObj(pObj) <> 0 Then
            doc.ksLightObj pObj, 1
            ' создадим итератор для хождения по атрибутам объекта
            Dim iter1 As Object
            Set iter1 = Kompas.GetIterator
            If Not iter1 Is Nothing Then
              If iter1.ksCreateAttrIterator(pObj, 0, 0, 0, 0, 0) <> 0 Then
                ' встали на первый атрибут
                Dim pAttr As Long
                Dim n As Long
                pAttr = iter1.ksMoveAttrIterator("F", n)
                If pAttr <> 0 Then
                  Kompas.ksMessage "тип и ключи атрибута"
                  Dim k1 As Long
                  Dim k2 As Long
                  Dim k3 As Long
                  Dim k4 As Long
                  Dim numb As Double
                  attr.ksGetAttrKeysInfo pAttr, k1, k2, k3, k4, numb
                  Kompas.ksMessage "k1 = " & k1 & " k2 = " & k2 & " k3 = " & k3 & " k4 = " & k4 & _
                                   " numb = " & numb
  
                  Kompas.ksMessage "строка атрибута"
                  attr.ksGetAttrRow pAttr, 0, Nothing, Nothing, usPar
  
                  Kompas.ksMessage "заменим строку атрибута"
                  Dim item1 As Object
                  Dim arr1 As Object
                  Set item1 = Kompas.GetParamStruct(ko_LtVariant)
                  Set arr1 = usPar.GetUserArray
                  If Not item1 Is Nothing And Not arr1 Is Nothing Then
                    item1.Init
                    item1.DoubleVal = numb
                    arr1.ksSetArrayItem 0, item1
                    item1.Init
                    item1.StrVal = "1234567\nasdfgh\nzxcvb"
                    arr1.ksSetArrayItem 1, item1
                    item1.Init
                    item1.LongVal = 888881
                    arr1.ksSetArrayItem 2, item1
                    attr.ksSetAttrRow pAttr, 0, Nothing, Nothing, usPar, "111"
                    Set item1 = Nothing
                    Set arr1 = Nothing
                  End If
                Else
                  Kompas.ksMessage "атрибут не найден"
                End If
              End If
            End If
            doc.ksLightObj pObj, 0
          End If
        End If
      Loop While (j <> 0)
      Set info = Nothing
    End If
    Set usPar = Nothing
  End If
End Sub

' просмотреть  атрибут
Sub ShowObjAttr()
  Dim info As Object
  Set info = Kompas.GetParamStruct(ko_RequestInfo)
  If Not info Is Nothing Then
    info.Init
    info.Prompt = "Укажите объект"
    Dim x As Double
    Dim y As Double
    Dim j As Integer
    Do
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          doc.ksLightObj pObj, 1
          attr.ksChoiceAttr pObj
          doc.ksLightObj pObj, 0
        End If
      End If
    Loop While (j <> 0)
    Set info = Nothing
  End If
End Sub

Sub ShowLib()
  ' запросить имя библиотеки
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)

  Dim numb As Double
  numb = attr.ksChoiceAttrTypes(nameFile)
  If numb > 1 Then
    Kompas.ksMessage "numbType = " & numb
  End If
End Sub

Sub ShowType()
  ' запросить имя библиотеки
  Dim nameFile As String
  nameFile = Kompas.ksChoiceFile("*.lat", "", False)
  Dim password As String
  Dim numb As Double
  Dim j As Integer
  j = Kompas.ksReadDouble("Ввести номер типа атрибута", 1000#, 0, 1000000000000#, numb)
  If j <> 0 Then
    password = Kompas.ksReadString("Ввести пароль типа атрибута", "")
    attr.ksViewEditAttrType nameFile, 2, numb, password
  End If
End Sub

' пройтись у объекта, по атрибутам  с ключом
' key1=10 и выдать количество  колонок и строк для данного атрибута
Sub WalkFromObjWithAttr()
  Dim info As Object
  Set info = Kompas.GetParamStruct(ko_RequestInfo)
  If Not info Is Nothing Then
    info.Init
    info.Prompt = "Укажите объект"
    Dim x As Double
    Dim y As Double
    Dim j As Integer
    Do
      j = doc.ksCursor(info, x, y, Nothing)
      If j <> 0 Then
        Dim pObj As Long
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) <> 0 Then
          ' создадим итератор для движения по атрибутам с ключом 10
          Dim iter As Object
          Set iter = Kompas.GetIterator
          If Not iter Is Nothing Then
            If iter.ksCreateAttrIterator(pObj, 0, 0, 0, 0, 0) <> 0 Then
              doc.ksLightObj pObj, 1
              ' встали на первый атрибут
              Dim pAttr As Long
              Dim n As Long
              pAttr = iter.ksMoveAttrIterator("F", n)
              If pAttr <> 0 Then
                Do
                  attr.ksViewEditAttr pAttr, 1, ""
                  pAttr = iter.ksMoveAttrIterator("N", n)
                Loop While (pAttr <> 0)
              End If
              doc.ksLightObj pObj, 0
            End If
            Set iter = Nothing
          End If
        End If
      End If
    Loop While (j <> 0)
    Set info = Nothing
  End If
End Sub

Public Function GetLibraryName() As String
  GetLibraryName = "Работа с аттрибутами"
End Function

Public Sub ExternalRunCommand(ByVal command As Integer, ByVal mode As Integer, ByVal kompas_ As Object)
  Set Kompas = kompas_
    
  ' получить интерфейс 2D документа
  Set doc = Kompas.ActiveDocument2D    ' интерфейс активного документа
  Set attr = Kompas.GetAttributeObject ' интерфейс работы с атрибутами
  
  Select Case command
    
    Case 1
      FuncAttrType        ' создать тип атрибута
    Case 2
      DelTypeAttr         ' удалить  тип атрибута
    Case 3
      ShowTypeAttr        ' получить  тип атрибута
    Case 4
      ChangeType          ' заменить  тип атрибута
    Case 5
      NewAttr             ' создать атрибут определенного типа
    Case 6
      DelObjAttr          ' удалить атрибут
    Case 7
      ReadObjAttr         ' считать атрибут
    Case 8
      ShowObjAttr         ' просмотреть атрибут
    Case 9
      ShowLib             ' просмотреть библиотеку
    Case 10
      ShowType            ' просмотреть тип
    Case 11
      WalkFromObjWithAttr ' просмотреть атрибут
  
  End Select
End Sub

Public Function ExternalMenuItem(ByVal number As Integer, itemType As Integer, command As Integer) As String
    itemType = 3 '"ENDMENU"'
    ExternalMenuItem = ""
    command = -1

    Select Case number
        Case 1
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Создать тип атрибута"
            command = 1
        Case 2
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Удалить тип атрибута"
            command = 2
        Case 3
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Получить тип атрибута"
            command = 3
        Case 4
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Заменить тип атрибута"
            command = 4
        
        Case 5
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Создать атрибут определенного типа"
            command = 5
        Case 6
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Удалить атрибут"
            command = 6
        Case 7
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Считать атрибут"
            command = 7
        Case 8
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "просмотреть атрибуты объекта"
            command = 8
        Case 9
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Просмотреть библиотеку"
            command = 9
        Case 10
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Просмотреть тип"
            command = 10
        Case 11
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Просмотреть атрибут"
            command = 11
        Case 12
            itemType = 3 '"ENDMENU"'
            ExternalMenuItem = ""
            command = -1
    End Select
End Function