VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "GaykaObj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'--------------------------------------------------------------------------------------
'
'
'-------------------------------------------------------------------------------------
Public Type GaykaParam ' параметры гайки ГОСТ 5915-70
   dr As Single
   s As Single
   d As Single
   da As Single
   H As Single
   d2 As Single
   p As Single
   Class As Integer    ' класс точности
   gost As Integer     ' номер госта
   hatchAng As Single  ' угол штриховки
   hatchStep As Single ' шаг штриховки
   massa As Single     ' масса
   indexMassa As Integer ' 0-металл 1- алюмин сплав 2-латунь
   
   perform As Byte     ' исполнение
   simple As Byte      ' упрощенно
   axis_off As Byte    ' выкл/вкл ось
   
   pitch As Byte       ' мелкий шаг
   pitch_off As Byte   ' мелкий шаг не возможен
   key_s As Byte       ' дополнительный размер под ключ
   key_s_on As Byte    ' дополнительный размер под ключ вкл
   key_s_gray As Byte  ' дополнительный размер под ключ не возможен
   koef_mat_on As Byte ' коэф материала

   ver As Integer      ' версия макро
 End Type

Public Type BaseMakroParam ' базовые параметры
  ang As Single        ' угол поворота
  flagAttr As Integer  ' флаг создания объекта спецификации
  drawType As Integer  ' тип изображения
  typeSwitch As Byte   ' тип запроса положения базовой точки элемента 0 Placement 1 Curso
                       ' 0 - точка + направление оси 0X ( Placement );
                       ' 1 - точка, направление совпадает с осью 0X текущей СК ( Cursor ).
End Type

' указатели на отношения к БД
Public Type SimpleBase
  bg As Long ' указатель базы
  rg As Long ' указатель отношения
End Type

' название колонок для спецификации
Const SPC_FORMAT = 1    ' формат
Const SPC_ZONA = 2      ' зона
Const SPC_POSITION = 3  ' позиция
Const SPC_MARKER = 4    ' обозначение
Const SPC_NAME = 5      ' наименование
Const SPC_COUNT = 6     ' количество
Const SPC_NOTE = 7      ' примечание

Const SPC_CLEAR_GEOM = 0 ' очищать геометрию при редактировании объекта спецификации
Const STANDART_SECTION = 25

Const COUNT_MASSA = 1000
Const MAX_COUNT_SPCOBJ = 4     ' максимальное число объектов СП за раз 4

'-------------------------------------------------------------------------------------
'
'
'-------------------------------------------------------------------------------------
' базовые параметры
Private par As BaseMakroParam  ' базовые параметры
Private tmp As GaykaParam      ' структура параметров гайки ГОСТ 5915-70
Private base As SimpleBase     ' референсы БД

Private flagMode As Long       ' true - режим редактирования
Private refMacr As Long        ' референс МАКРО
Private paramTmp As Object     ' ksUserParam параметры для чтения БД
Private Param As Object        ' ksUserParam параметры для Get/SetMacroParam
Private data As Object         ' объект для работы
Private spcObj(4) As Long      ' массив референсов объектов спецификации
Public countObj As Integer
Private flagSwitch As Boolean  ' false переключения нет true переключение с
                               ' Placement на Cursor

' присвоить значение шага штриховки
Public Property Let GaykaObj_step(ByVal val As Single)
  tmp.hatchStep = val
End Property
' присвоить значение угла штриховки
Public Property Let GaykaObj_angle(ByVal val As Single)
  tmp.hatchAng = val
End Property
' присвоить значение диаметра резьбы
Public Property Let GaykaObj_dr(ByVal val As Single)
  tmp.dr = val
End Property
' вернуть объект для работы с БД
Public Property Get GaykaObj_data() As Object '
  Set GaykaObj_data = data
End Property
' вернуть объект для чтения параметров из БД
Public Property Get GaykaObj_paramTmp() As Object '
  Set GaykaObj_paramTmp = paramTmp
End Property
' установить флаг дополнительный размер под ключ
Public Property Let GaykaObj_key_s(ByVal val As Byte)
  tmp.key_s = val
End Property
' установить флаг мелкий шаг
Public Property Let GaykaObj_SmallStep(ByVal val As Byte)
  tmp.pitch = val
End Property
' установить флаг создать объект спецификации
Public Property Let GaykaObj_attr(ByVal val As Byte)
  par.flagAttr = val
End Property
' установить флаг упрощенное изображение
Public Property Let GaykaObj_simple(ByVal val As Byte)
  tmp.simple = val
End Property
' установить вид изображения гайки
Public Property Let GaykaObj_drawType(ByVal val As Byte)
  par.drawType = val
End Property
' установить исполнение гайки
Public Property Let GaykaObj_perform(ByVal val As Byte)
  tmp.perform = val
End Property
' установить флаг не рисовать ось
Public Property Let GaykaObj_axis_off(ByVal val As Byte)
  tmp.axis_off = val
End Property
' вернуть параметры гайки
Public Property Get GaykaObj_tmp() As GaykaParam
  GaykaObj_tmp = tmp
End Property
' вернуть базовые параметры
Property Get GaykaObj_par() As BaseMakroParam
  GaykaObj_par = par
End Property

Property Get GaykaObj_base() As SimpleBase
  GaykaObj_base = base
End Property
' оператор копирования данных
Sub Assign(obj As GaykaObj)
  tmp = obj.GaykaObj_tmp
  par = obj.GaykaObj_par
  countObj = obj.countObj
End Sub
' инициализация
Sub InitUserParam()
  If Not Param Is Nothing Then
    Dim item As Object ' ksLtVariant
    Set item = iKompasObject.GetParamStruct(ko_LtVariant)
    Dim arr As Object  ' ksDynamicArray
    Set arr = iKompasObject.GetDynamicArray(LTVARIANT_ARR)
    If (Not item Is Nothing) And (Not arr Is Nothing) Then
      Param.init
      Param.SetUserArray arr
      item.init
      item.floatVal = par.ang        ' 0 - ang
      arr.ksAddArrayItem -1, item
      item.shortVal = par.flagAttr   ' 1 - flagAttr
      arr.ksAddArrayItem -1, item
      item.shortVal = par.drawType   ' 2 - drawType
      arr.ksAddArrayItem -1, item
      item.shortVal = par.typeSwitch ' 3 - typeSwitch
      arr.ksAddArrayItem -1, item

      item.floatVal = tmp.dr         ' 4 - dr
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.s          ' 5 - s
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.d          ' 6 - D
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.da         ' 7 - da
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.H          ' 8 - h
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.d2         ' 9 - d2
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.p          ' 10 - p
      arr.ksAddArrayItem -1, item
      item.shortVal = tmp.Class      ' 11 - class
      arr.ksAddArrayItem -1, item
      item.shortVal = tmp.gost       ' 12 - gost
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.hatchAng   ' 13 - hatchAng
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.hatchStep  ' 14 - hatchShag
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.massa      ' 15 - m
      arr.ksAddArrayItem -1, item
      item.shortVal = tmp.indexMassa ' 16 - indexMassa
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.perform    ' 17 - perform
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.simple     ' 18 - simple
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.axis_off   ' 19 - axis_off
      arr.ksAddArrayItem -1, item
   
      item.uCharVal = tmp.pitch      ' 20 - pitch
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.pitch_off  ' 21 - pitch_off
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.key_s      ' 22 - key_s
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.key_s_on   ' 23 - key_s_on
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.key_s_gray ' 24 - key_s_gray
      arr.ksAddArrayItem -1, item
      item.uCharVal = tmp.koef_mat_on ' 25 - koef_mat_on
      arr.ksAddArrayItem -1, item
      item.shortVal = tmp.ver        ' 26 - ver
      arr.ksAddArrayItem -1, item
    End If
  End If
End Sub
' сохранить параметры
Sub SetUserParam()
  If Not Param Is Nothing Then
    Dim item As Object ' ksLtVariant
    Set item = iKompasObject.GetParamStruct(ko_LtVariant)
    Dim arr As Object ' ksDynamicArray
    Set arr = Param.GetUserArray
    If (Not item Is Nothing) And (Not arr Is Nothing) And arr.ksGetArrayCount >= 20 Then
      item.init
      item.floatVal = par.ang        ' 0 - ang
      arr.ksSetArrayItem 0, item
      item.shortVal = par.flagAttr   ' 1 - flagAttr
      arr.ksSetArrayItem 1, item
      item.shortVal = par.drawType   ' 2 - drawType
      arr.ksSetArrayItem 2, item
      item.shortVal = par.typeSwitch ' 3 - typeSwitch
      arr.ksSetArrayItem 3, item

      item.floatVal = tmp.dr         ' 4 - dr
      arr.ksSetArrayItem 4, item
      item.floatVal = tmp.s          ' 5 - s
      arr.ksSetArrayItem 5, item
      item.floatVal = tmp.d          ' 6 - D
      arr.ksSetArrayItem 6, item
      item.floatVal = tmp.da         ' 7 - da
      arr.ksSetArrayItem 7, item
      item.floatVal = tmp.H          ' 8 - h
      arr.ksSetArrayItem 8, item
      item.floatVal = tmp.d2         ' 9 - d2
      arr.ksSetArrayItem 9, item
      item.floatVal = tmp.p          ' 10 - p
      arr.ksSetArrayItem 10, item
      item.shortVal = tmp.Class      ' 11 - class
      arr.ksSetArrayItem 11, item
      item.shortVal = tmp.gost       ' 12 - gost
      arr.ksSetArrayItem 12, item
      item.floatVal = tmp.hatchAng   ' 13 - hatchAng
      arr.ksSetArrayItem 13, item
      item.floatVal = tmp.hatchStep  ' 14 - hatchShag
      arr.ksSetArrayItem 14, item
      item.floatVal = tmp.massa      ' 15 - m
      arr.ksSetArrayItem 15, item
      item.shortVal = tmp.indexMassa ' 16 - indexMassa
      arr.ksSetArrayItem 16, item
      item.uCharVal = tmp.perform    ' 17 - perform
      arr.ksSetArrayItem 17, item
      item.uCharVal = tmp.simple     ' 18 - simple
      arr.ksSetArrayItem 18, item
      item.uCharVal = tmp.axis_off   ' 19 - axis_off
      arr.ksSetArrayItem 19, item
      
      item.uCharVal = tmp.pitch      ' 20 - pitch
      arr.ksSetArrayItem 20, item
      item.uCharVal = tmp.pitch_off  ' 21 - pitch_off
      arr.ksSetArrayItem 21, item
      item.uCharVal = tmp.key_s      ' 22 - key_s
      arr.ksSetArrayItem 22, item
      item.uCharVal = tmp.key_s_on   ' 23 - key_s_on
      arr.ksSetArrayItem 23, item
      item.uCharVal = tmp.key_s_gray ' 24 - key_s_gray
      arr.ksSetArrayItem 24, item
      item.uCharVal = tmp.koef_mat_on ' 25 - koef_mat_on
      arr.ksSetArrayItem 25, item
      item.shortVal = tmp.ver        ' 26 - ver
      arr.ksSetArrayItem 26, item
    End If
  End If
End Sub
' получить параметры
Sub GetUserParam()
  If Not Param Is Nothing Then
    Dim item As Object ' ksLtVariant
    Set item = iKompasObject.GetParamStruct(ko_LtVariant)
    Dim arr As Object ' ksDynamicArray
    Set arr = Param.GetUserArray
    If (Not item Is Nothing) And (Not arr Is Nothing) Then
      Dim count As Single
      count = arr.ksGetArrayCount
      
      If count >= 27 Then
        item.init
        
        arr.ksGetArrayItem 0, item
        par.ang = item.floatVal
        arr.ksGetArrayItem 1, item
        par.flagAttr = item.shortVal
        arr.ksGetArrayItem 2, item
        par.drawType = item.shortVal
        arr.ksGetArrayItem 3, item
        par.typeSwitch = item.shortVal
  
        arr.ksGetArrayItem 4, item
        tmp.dr = item.floatVal
        arr.ksGetArrayItem 5, item
        tmp.s = item.floatVal
        arr.ksGetArrayItem 6, item
        tmp.d = item.floatVal
        arr.ksGetArrayItem 7, item
        tmp.da = item.floatVal
        arr.ksGetArrayItem 8, item
        tmp.H = item.floatVal
        arr.ksGetArrayItem 9, item
        tmp.d2 = item.floatVal
        arr.ksGetArrayItem 10, item
        tmp.p = item.floatVal
        arr.ksGetArrayItem 11, item
        tmp.Class = item.shortVal
        arr.ksGetArrayItem 12, item
        tmp.gost = item.shortVal
        arr.ksGetArrayItem 13, item
        tmp.hatchAng = item.floatVal
        arr.ksGetArrayItem 14, item
        tmp.hatchStep = item.floatVal
        arr.ksGetArrayItem 15, item
        tmp.massa = item.floatVal
        arr.ksGetArrayItem 16, item
        tmp.indexMassa = item.shortVal
        arr.ksGetArrayItem 17, item
        tmp.perform = item.uCharVal    ' 17 - perform
        arr.ksGetArrayItem 18, item
        tmp.simple = item.uCharVal     ' 18 - simple
        arr.ksGetArrayItem 19, item
        tmp.axis_off = item.uCharVal   ' 19 - axis_off
        arr.ksGetArrayItem 20, item
        tmp.pitch = item.uCharVal      ' 20 - pitch
        arr.ksGetArrayItem 21, item
        tmp.pitch_off = item.uCharVal  ' 21 - pitch_off
        arr.ksGetArrayItem 22, item
        tmp.key_s = item.uCharVal      ' 22 - key_s
        arr.ksGetArrayItem 23, item
        tmp.key_s_on = item.uCharVal   ' 23 - key_s_on
        arr.ksGetArrayItem 24, item
        tmp.key_s_gray = item.uCharVal ' 24 - key_s_gray
        arr.ksGetArrayItem 25, item
        tmp.koef_mat_on = item.uCharVal ' 25 - koef_mat_on
        arr.ksGetArrayItem 26, item
        tmp.ver = item.shortVal        ' 26 - ver
      End If
    End If
  End If
End Sub

' сохранить параметры в модели
Sub SetParam()
  SetUserParam
  iDocument2D.ksSetMacroParam refMacr, Param, False, False, False
End Sub

' задать угол штриховки
Sub SetHatchAngl()
  Dim a As Double
  iKompasObject.ksEnableTaskAccess 0
  If iKompasObject.ksReadDouble("Введите угол штриховки", tmp.hatchAng, -90, 90, a) Then
    tmp.hatchAng = a
  End If
  
  iKompasObject.ksEnableTaskAccess 1
End Sub

' задать шаг штриховки
Sub SetHatchShag()
  Dim a As Double
  iKompasObject.ksEnableTaskAccess 0
  If iKompasObject.ksReadDouble("Введите шаг штриховки", tmp.hatchStep, 0.1, 1000, a) Then
    tmp.hatchStep = a
  End If
  
  iKompasObject.ksEnableTaskAccess 1
End Sub

' Функция обратной связи, вызываемая из Placement
Public Function CALLBACKPROCPLACEMENT(comm As Integer, X As Double, _
                                      Y As Double, ang As Double, info As Object, _
                                      phan As Object, dynamic As Integer) As Integer
  Dim t1 As Object
  Set t1 = phan.GetPhantomParam
  If dynamic = 0 Then ' фиксация
    Select Case comm
      Case 8:
        flagSwitch = True
        CALLBACKPROCPLACEMENT = 0
        Exit Function
      Case 2:
        par.drawType = ID_VID
      Case 3:
        par.drawType = ID_TOPVID
      Case 4:
        par.drawType = ID_SIDEVID
      Case 5:
        par.drawType = ID_VIDSEC
      Case 6:
        SetHatchAngl
      Case 7:
        SetHatchShag
      Case 1:
        MacroElementParam
      Case -1:  ' поставить в модель
        par.ang = ang
        SetParam
        iDocument2D.ksSetMacroPlacement refMacr, X, Y, ang, 0
        iDocument2D.ksStoreTmpGroup t1.gr
        If DrawSpcObj(t1.gr) Then
          iDocument2D.ksClearGroup t1.gr, True
          CALLBACKPROCPLACEMENT = 0
          Exit Function
        End If
        
        iDocument2D.ksClearGroup t1.gr, True
        If flagMode > 0 Then
          CALLBACKPROCPLACEMENT = 0
          Exit Function
        End If
    End Select
    
    info.commandsString = ChoiceMenu
    Dim gr As Long
    GetGroup gr
    t1.gr = gr
  Else
    par.ang = ang
  End If
  
  CALLBACKPROCPLACEMENT = 1
End Function

' функция обратного вызова для CURSOR
Public Function CALLBACKPROCCURSOR(comm As Integer, X As Double, Y As Double, info As Object, _
                                   phan As Object, dynamic As Integer) As Integer
    Dim t1 As Object ' ksType1
    Set t1 = phan.GetType1
    If dynamic = 0 Then ' фиксация
      Select Case comm
        Case 8:
         flagSwitch = True
         CALLBACKPROCCURSOR = 0
         Exit Function
        Case 2:
          par.drawType = ID_VID
        Case 3:
          par.drawType = ID_TOPVID
        Case 4:
          par.drawType = ID_SIDEVID
        Case 5:
          par.drawType = ID_VIDSEC
        Case 6:
          SetHatchAngl
        Case 7:
          SetHatchShag
        Case 1:
          MacroElementParam
        Case -1:  ' поставить в модель
          SetParam
          iDocument2D.ksSetMacroPlacement refMacr, X, Y, par.ang, 0
          iDocument2D.ksStoreTmpGroup t1.gr
          If DrawSpcObj(t1.gr) Then
            iDocument2D.ksClearGroup t1.gr, True
            CALLBACKPROCCURSOR = 0
            Exit Function
          End If
          
          iDocument2D.ksClearGroup t1.gr, True
          If flagMode > 0 Then
            CALLBACKPROCCURSOR = 0
            Exit Function
          End If
       End Select

      info.commandsString = ChoiceMenu
      Dim gr As Long
      GetGroup gr
      t1.gr = gr
    End If

  CALLBACKPROCCURSOR = 1
End Function

' меню для процесса
Function ChoiceMenu() As String
If par.typeSwitch = 0 Then
  ChoiceMenu = "!Параметры !Вид !Вид_сверху !Вид_сбоку !Полвида/Полразреза !Угол_штриховки !Шаг_штриховки !Выключить_угол"
Else
  ChoiceMenu = "!Параметры !Вид !Вид_сверху !Вид_сбоку !Полвида/Полразреза !Угол_штриховки !Шаг_штриховки !Включить_угол"
End If
End Function

' процесс вставки гайки в модель
Sub Draw()
  par.typeSwitch = False
  Dim phan As Object ' ksPhantom
  Set phan = iKompasObject.GetParamStruct(ko_Phantom)
  If Not phan Is Nothing Then
    phan.init
    phan.phantom = 1
    Dim t1 As Object ' ksType1
    Set t1 = phan.GetPhantomParam
    If Not t1 Is Nothing Then
      t1.init
      t1.scale_ = 1
      t1.gr = 0    ' временная группа
      Dim j As Integer
      j = 1
      Dim X As Double: Dim Y As Double: Dim ang As Double
      If iKompasObject.ksReturnResult = 0 Then
        flagMode = iDocument2D.ksEditMacroMode
        
        If MacroElementParam() Then
          Do
            flagSwitch = False
            flagCalcPaket = False
            Dim gr As Long
            GetGroup gr
            t1.gr = gr
            t1.angle = par.ang
            
            Dim info As Object ' ksRequestInfo
            Set info = iKompasObject.GetParamStruct(ko_RequestInfo)
            If Not info Is Nothing Then
              info.init
              info.commandsString = ChoiceMenu
              info.dynamic = 1
              
              If par.typeSwitch Then
                ' указываем адрес обратной функции для Cursor
                info.SetCallBackC "CALLBACKPROCCURSOR", 0, Me
                j = iDocument2D.ksCursor(info, X, Y, phan)
              Else
                ' указываем адрес обратной функции для Placement
                info.SetCallBackP "CALLBACKPROCPLACEMENT", 0, Me
                j = iDocument2D.ksPlacement(info, X, Y, ang, phan)
              End If
  
              If spcObj(0) > 0 Then
                Dim iSpc As Object ' ksSpecification
                Set iSpc = iDocument2D.GetSpecification()
                Dim count As Integer
                count = countObj
                For i = 0 To count - 1
                  ' Олегово окно - редактируем параметры
                  If Not iSpc Is Nothing And iSpc.ksEditWindowSpcObject(spcObj(i)) Then
                    DrawPosLeader spcObj(i), iSpc
                  End If
                Next i
                
                spcObj(0) = 0
                
                If flagMode = 0 Then
                  flagSwitch = True
                  If par.typeSwitch Then
                    par.typeSwitch = 0
                  Else
                    par.typeSwitch = 1
                  End If
                End If
                
              End If
  
              If flagSwitch = True Then
                j = 1
                If par.typeSwitch > 0 Then
                  par.typeSwitch = 0
                Else
                  par.typeSwitch = 1
                End If
              End If
            End If
          Loop While j
        End If
      End If
    End If
  End If
End Sub

' создание МАКРО гайки
Public Sub GetGroup(gr As Long)
  Dim k2 As Integer
  If tmp.perform = 1 Then
    k2 = 2
  Else
    k2 = 1
  End If

  If CBool(iDocument2D.ksExistObj(gr)) Then
    iDocument2D.ksDeleteObj gr
  End If

  gr = iDocument2D.ksNewGroup(1)
  iDocument2D.ksMacro 0
  Select Case par.drawType
    Case ID_VID:   ' вид
      If tmp.simple = 0 Then
       gayka_k 0, 0, 0, tmp.s, tmp.d, 0, tmp.H, 1, 0, tmp.d2, k2
       gayka_k 0, 0, 0, tmp.s, tmp.d, 0, tmp.H, -1, 0, tmp.d2, k2
      Else
       gayka_k_y 0, 1
       gayka_k_y 0, -1
      End If
      
      If tmp.axis_off = 0 Then
        iDocument2D.ksLineSeg -3, 0, tmp.H + 3, 0, 3
      End If
    Case ID_SIDEVID:  'вид сбоку
      If tmp.axis_off = 0 Then
        iDocument2D.ksLineSeg -3, 0, tmp.H + 3, 0, 3
      End If
      
      If tmp.simple = 1 Then
        k2 = 3
      End If
      
      gayka_k_side 0, tmp.s, tmp.d, tmp.d2, tmp.H, 1, k2
      gayka_k_side 0, tmp.s, tmp.d, tmp.d2, tmp.H, -1, k2
    Case ID_TOPVID: gayka_sverhu     ' вид ссверху
    Case ID_VIDSEC: ' пол-вида/пол-разреза
      If tmp.simple = 0 Then
        gayka_k 0, 0, 0, tmp.s, tmp.d, 0, tmp.H, 1, 0, tmp.d2, k2
      Else
        gayka_k_y 0, 1
      End If
      
      gayka_p_k -1
      
      If tmp.axis_off = 0 Then
        iDocument2D.ksLineSeg -3, 0, tmp.H + 3, 0, 3
      End If
  End Select
  refMacr = iDocument2D.ksEndObj
  iDocument2D.ksEndGroup
End Sub

' запуск диалогового окна
Function MacroElementParam() As Boolean
  Dim buffer As GaykaObj
  Set buffer = New GaykaObj
  buffer.Assign Me ' копируем данные в буффер
  buffer.OpenGaykaBase
  
  Dim dlg As GaykaDlg
  Set dlg = New GaykaDlg
  
  dlg.SetBufObj buffer
  
  dlg.Show vbModal
  buffer.CloseGaykaBase ' закрытие базы
  
  MacroElementParam = dlg.Result ' результат работы диалога true - выход по OK
  
  If dlg.Result Then ' если редактирование OK, то копируем данные обратно
    Assign buffer
  End If
  
End Function

' отрисовка гайки
Sub gayka_k(ByVal ls As Double, ByVal l As Double, ByVal d1 As Double, ByVal s As Double, ByVal d As Double, _
            ByVal l1 As Double, ByVal H As Double, ByVal j As Integer, ByVal j1 As Integer, ByVal d2 As Double, ByVal j2 As Integer)
  Dim math As Object ' ksMathematic2D
  Set math = iKompasObject.GetMathematic2D
  If Not math Is Nothing Then
    Dim X(9) As Double
    Dim Y(9) As Double
    Dim c As Double: Dim h1 As Double: Dim rb As Double
    Dim xc2 As Double: Dim yc2 As Double: Dim xcbl As Double
    Dim ycbl As Double: Dim xcbp As Double: Dim ycbp As Double
    Dim ycml As Double
    ' Координаты контура рез_части

    'j1=1 -   контровочное отверстие  j1=0 - контров. отв. нет
    'j2=1 исполнение 1   j2=2    исполнение 2

    d = s / math.ksCosD(30)
    c = (d - d2) / 2 * math.ksTanD(30)
    h1 = d * 0.5 * math.ksSinD(30)
    rb = (h1 * h1 + c * c) / 2 / c

    X(1) = ls
    Y(1) = 0
    If j2 = 1 Then
      X(2) = ls:      Y(2) = j * (d2 * 0.5)
      X(3) = ls + c: Y(3) = j * (d * 0.5)
      X(7) = ls + c: Y(7) = j * h1
    Else
      X(2) = ls: Y(2) = j * (d * 0.5)
      X(7) = ls: Y(7) = j * h1
    End If
    
    X(4) = ls + H - c: Y(4) = j * (d * 0.5)
    X(5) = ls + H:      Y(5) = j * (d2 * 0.5)
    X(6) = ls + H:      Y(6) = 0

    X(8) = ls + H - c: Y(8) = j * h1
    xc2 = ls + l:       yc2 = j * (d * 0.5 - l1)

    xcbl = ls + rb: ycbl = 0
    xcbp = ls + H - rb: ycbp = 0
    ycml = j * ((d * 0.5 - h1) / 2 + h1)

    If j2 = 1 Then
      iDocument2D.ksLineSeg X(1), Y(1), X(2), Y(2), 1
      iDocument2D.ksLineSeg X(2), Y(2), X(3), Y(3), 1
      iDocument2D.ksLineSeg X(3), Y(3), X(4), Y(4), 1
      iDocument2D.ksLineSeg X(4), Y(4), X(5), Y(5), 1
      iDocument2D.ksLineSeg X(5), Y(5), X(6), Y(6), 1
      iDocument2D.ksLineSeg X(7), Y(7), X(8), Y(8), 1
      iDocument2D.ksArcByPoint xcbl, ycbl, rb, X(1), Y(1), X(7), Y(7), -j, 1
      iDocument2D.ksArcByPoint xcbp, ycbp, rb, X(6), Y(6), X(8), Y(8), j, 1
      iDocument2D.ksArcBy3Points ls + c * 0.5, (d * 0.5 - (d - d2) / 4) * j, _
                                 ls, ycml, X(7), Y(7), 1
      iDocument2D.ksArcBy3Points ls + H - c * 0.5, (d * 0.5 - (d - d2) / 4) * j, ls + H, _
                                 ycml, X(8), Y(8), 1
    Else
     iDocument2D.ksLineSeg X(1), Y(1), X(2), Y(2), 1
     iDocument2D.ksLineSeg X(2), Y(2), X(4), Y(4), 1
     iDocument2D.ksLineSeg X(4), Y(4), X(5), Y(5), 1
     iDocument2D.ksLineSeg X(5), Y(5), X(6), Y(6), 1
     iDocument2D.ksLineSeg X(7), Y(7), X(8), Y(8), 1
     iDocument2D.ksArcByPoint xcbp, ycbp, rb, X(6), Y(6), X(8), Y(8), j, 1
     iDocument2D.ksArcBy3Points ls + H - c * 0.5, (d * 0.5 - (d - d2) / 4) * j, _
                                ls + H, ycml, X(8), Y(8), 1

    End If

    If j1 = 1 Then
     iDocument2D.ksCircle xc2, yc2, d1 * 0.5, 1
     iDocument2D.ksLineSeg xc2 - 2, yc2, xc2 + 2, yc2, 2
     iDocument2D.ksLineSeg xc2, yc2 - 2, xc2, yc2 + 2, 2
    End If
  End If

End Sub

' отрисовка гайки
Sub gayka_k_side(ByVal ls As Double, ByVal s As Double, ByVal d As Double, ByVal d2 As Double, _
                 ByVal H As Double, ByVal j As Integer, ByVal j2 As Integer)
  Dim math As Object ' ksMathematic2D
  Set math = iKompasObject.GetMathematic2D
  If Not math Is Nothing Then
    Dim X As Double: Dim Y As Double
    Dim x2 As Double: Dim y2 As Double
    ' j2 = 1 исполнение 1   j2 = 2    упрощенное
    Dim c As Integer
    c = (d - d2) / 2 * math.ksTanD(30)
    Y = j * s * 0.5
    If j2 = 1 Then
      X = ls + c
      iDocument2D.ksLineSeg ls, 0, ls, j * d2 * 0.5, 1
      iDocument2D.ksLineSeg ls, j * d2 * 0.5, X, Y, 1
      iDocument2D.ksArcBy3Points ls + c, j * (s * 0.5), ls, _
                                 s * 0.25 * j, ls + c, 0, 1
    Else
      X = ls
      iDocument2D.ksLineSeg X, 0, X, Y, 1
    End If
    
    If j2 = 3 Then
      x2 = ls + H
      y2 = Y
    Else
      x2 = ls + H - c
      y2 = j * d2 * 0.5
    End If
    
    iDocument2D.ksLineSeg X, Y, x2, Y, 1
    If j2 <> 3 Then
      iDocument2D.ksLineSeg x2, Y, ls + H, y2, 1
      iDocument2D.ksArcBy3Points ls + H - c, j * (s * 0.5), ls + H, s * 0.25 * j, _
                                 ls + H - c, 0, 1
    End If
    iDocument2D.ksLineSeg ls + H, y2, ls + H, 0, 1
    If j > 0 Then
      iDocument2D.ksLineSeg X, 0, x2, 0, 1
    End If
  End If
End Sub

' отрисовка гайки
Sub gayka_k_y(ls As Double, j As Integer)
  Dim math As Object ' ksMathematic2D
  Set math = iKompasObject.GetMathematic2D
  If Not math Is Nothing Then
    Dim h1 As Double
    tmp.d = tmp.s / math.ksCosD(30)

    h1 = tmp.d * 0.5 * math.ksSinD(30)
    Dim p1 As Double: Dim p2 As Double
    p1 = j * tmp.d * 0.5
    p2 = s + tmp.H
    iDocument2D.ksLineSeg ls, 0, ls, p1, 1
    iDocument2D.ksLineSeg ls, p1, p2, p1, 1
    iDocument2D.ksLineSeg p2, p1, p2, 0, 1
    iDocument2D.ksLineSeg ls, j * h1, p2, j * h1, 1
  End If
End Sub

' отрисовка гайки
Sub gayka_p_k(j As Integer)
  Dim math As Object ' ksMathematic2D
  Set math = iKompasObject.GetMathematic2D
  If Not math Is Nothing Then
    Dim c1 As Double: Dim c2 As Double
    c1 = 0
    c2 = 0
    Dim X As Double: Dim x1 As Double: Dim x2 As Double: Dim x3 As Double
    Dim y2 As Double: Dim y3 As Double
    X = 0
    Dim c As Double: Dim Y As Double
    c = (tmp.d - tmp.d2) / 2 * math.ksTanD(30)
    If tmp.perform = 0 And tmp.simple = 0 Then
      Y = tmp.d2 * 0.5 * j
    Else
      Y = tmp.d * 0.5 * j
    End If
    
    iDocument2D.ksLineSeg 0, 0, 0, Y, 1

    If tmp.perform = 0 And tmp.simple = 0 Then
      X = c
      iDocument2D.ksLineSeg 0, Y, X, j * (tmp.d * 0.5), 1
    End If
    
    Dim dd As Double
    dd = tmp.dr - 2 * 0.54 * tmp.p

    If tmp.simple = 0 Then
      x3 = tmp.H - c
      y3 = j * tmp.d2 * 0.5
      y2 = j * tmp.da * 0.5
    Else
      x3 = tmp.H
      y3 = j * tmp.d * 0.5
      y2 = j * dd * 0.5
    End If

    iDocument2D.ksLineSeg X, j * tmp.d * 0.5, x3, j * tmp.d * 0.5, 1
    If tmp.simple = 0 Then
      iDocument2D.ksLineSeg x3, j * tmp.d * 0.5, tmp.H, y3, 1
    End If
      
    iDocument2D.ksLineSeg tmp.H, y3, tmp.H, 0, 1

    x1 = tmp.H
    x2 = x1
    If tmp.simple = 0 Then
      c1 = (tmp.da - dd) * 0.5
      c2 = (tmp.da - tmp.dr) * 0.5
      If tmp.perform = 0 Then
        x2 = x2 - c2
      End If
    End If

    If tmp.perform = 0 And tmp.simple = 0 Then
      x1 = x1 - c1
      iDocument2D.ksLineSeg tmp.H, j * tmp.da * 0.5, x1, j * 0.5 * dd, 1
      iDocument2D.ksLineSeg x1, j * dd * 0.5, x1, 0, 1
    End If

    iDocument2D.ksLineSeg x1, j * 0.5 * dd, c1, j * 0.5 * dd, 1

    If tmp.simple = 0 Then
      iDocument2D.ksLineSeg c1, j * 0.5 * dd, 0, j * 0.5 * tmp.da, 1
      iDocument2D.ksLineSeg c1, j * dd * 0.5, c1, 0, 1
    End If

    iDocument2D.ksHatch 0, tmp.hatchAng, tmp.hatchStep, 0, 0, 0
      iDocument2D.ksLineSeg 0, y2, 0, Y, 1
      If tmp.perform = 0 And tmp.simple = 0 Then
        iDocument2D.ksLineSeg 0, Y, X, j * (tmp.d * 0.5), 1
        iDocument2D.ksLineSeg tmp.H, y3, tmp.H, j * tmp.da * 0.5, 1
        iDocument2D.ksLineSeg tmp.H, j * tmp.da * 0.5, x1, j * 0.5 * dd, 1
      Else
        iDocument2D.ksLineSeg tmp.H, y3, tmp.H, j * dd * 0.5, 1
      End If
      
      iDocument2D.ksLineSeg X, j * (tmp.d * 0.5), x3, j * tmp.d * 0.5, 1
      If tmp.simple = 0 Then
        iDocument2D.ksLineSeg x3, j * tmp.d * 0.5, tmp.H, y3, 1
        iDocument2D.ksLineSeg c1, j * 0.5 * dd, 0, j * 0.5 * tmp.da, 1
      End If

      iDocument2D.ksLineSeg x1, j * 0.5 * dd, c1, j * 0.5 * dd, 1
      
    iDocument2D.ksEndObj
    
    iDocument2D.ksLineSeg c2, j * 0.5 * tmp.dr, x2, j * 0.5 * tmp.dr, 2
  End If
End Sub

' отрисовка гайки
Sub gayka_sverhu()
  Dim math As Object ' ksMathematic2D
  Set math = iKompasObject.GetMathematic2D
  If Not math Is Nothing Then
    s = tmp.s * 0.5
    d = s / math.ksCosD(30)
    dd = tmp.dr - 2 * 0.54 * tmp.p
    h1 = d * math.ksSinD(30)

    iDocument2D.ksLineSeg -s, h1, 0, d, 1
    iDocument2D.ksLineSeg 0, d, s, h1, 1
    iDocument2D.ksLineSeg s, h1, s, -h1, 1
    iDocument2D.ksLineSeg s, -h1, 0, -d, 1
    iDocument2D.ksLineSeg 0, -d, -s, -h1, 1
    iDocument2D.ksLineSeg -s, -h1, -s, h1, 1

    If tmp.simple = 0 Then
      iDocument2D.ksCircle 0, 0, tmp.d2 * 0.5, 1
    End If

    iDocument2D.ksCircle 0, 0, dd * 0.5, 1
    Dim rad As Double: Dim x1 As Double: Dim y1 As Double
    rad = tmp.dr * 0.5
    x1 = rad * math.ksSinD(15)
    y1 = rad * math.ksCosD(15)
    iDocument2D.ksArcByPoint 0, 0, rad, x1, y1, y1, -x1, 1, 2

    If tmp.axis_off = 0 Then
      If d >= 6 Then
        iDocument2D.ksLineSeg -3 - s, 0, s + 3, 0, 3
        iDocument2D.ksLineSeg 0, -3 - d, 0, 3 + d, 3
      Else
        iDocument2D.ksLineSeg -1 - s, 0, s + 1, 0, 3
        iDocument2D.ksLineSeg 0, -1 - d, 0, 1 + d, 3
      End If
    End If
  
  End If
End Sub

'----------------------------------------------------------------------------------------------
' отрисовать позиционную линию выноски
' уже проверено , что объект спецификации есть
' Функцию нужно запускать вне Cursor и Placement
'----------------------------------------------------------------------------------------------
Sub DrawPosLeader(spcObj As Long, ByVal iSpc As Object)
  Dim info As Object ' ksRequestInfo
  Set info = iKompasObject.GetParamStruct(ko_RequestInfo)
  Dim posLeader As Long

  If Not info Is Nothing Then
    info.init
    Dim flag As Boolean
    flag = False
    posLeader = 0
    Dim x1 As Double
    Dim y1 As Double
    Do
      info.commandsString = "!Подключить_существующую !Создать_новую_линию_выноски"
      Dim prompt As String
      info.prompt = "Укажите линию выноски"
      Dim j1 As Integer
      j1 = iDocument2D.ksCursor(info, x1, y1, Nothing)
      
      Dim menu As String
      Select Case j1
        Case 2: ' Создать новую линию выноски
          posLeader = iDocument2D.ksCreateViewObject(POSLEADER_OBJ)
          flag = False
        Case 1: ' Подключить существующую
          info.commandsString = menu
          If iDocument2D.ksCursor(info, x1, y1, Nothing) Then
            posLeader = iDocument2D.ksFindObj(x1, y1, 100)    ' величина стороны окошка-ловушки с центром x,y
            If posLeader = 0 And iDocument2D.ksGetObjParam(posLeader, Nothing, 0) = POSLEADER_OBJ Then
              iKompasObject.ksError menu
              posLeader = 0
              flag = True
            Else
              flag = False
            End If
          Else
            flag = False
          End If
        Case -1:
          posLeater = iDocument2D.ksFindObj(x1, y1, 100)        ' величина стороны окошка-ловушки с центром x,y
          If Not posLeader And Not iDocument2D.ksGetObjParam(posLeater, Nothing, 0) = POSLEADER_OBJ Then
            iKompasObject.ksError "Ошибка! Объект не позиционная линия выноски!"
            posLeader = 0
            flag = True
          Else
            flag = False
          End If
        End Select
    Loop While flag

    ' линия выноски есть, подключим ее к объекту спецификации
    If posLeader > 0 Then
      ' ввойдем в режим редактирования объекта спецификации
      If iSpc.ksSpcObjectEdit(spcObj) Then
        ' подключим линию выноски
        iSpc.ksSpcIncludeReference posLeader, True
        ' закроем объект спецификации
        iSpc.ksSpcObjectEnd
      End If
    End If
  End If
End Sub

Function IsSpcObjCreate() As Boolean
  IsSpcObjCreate = True
End Function

' объект спецификации
Function DrawSpcObj(geom As Long) As Boolean
  Dim iSpc As Object ' ksSpecification
  Set iSpc = iDocument2D.GetSpecification

  If Not iSpc Is Nothing And IsSpcObjCreate Then
    If iKompasObject.ksReturnResult = etError10 Then   '  10  "Ошибка! Вырожденный объект"
      iKompasObject.ksResultNULL
      DrawSpcObj = False
      Exit Function
    End If

    spcObj(0) = EditSpcObj(spcObj(0), geom)
    If par.flagAttr = 0 And spcObj(0) > 0 Then
      Dim count As Integer
      For i = 0 To countObj - 1
        If spcObj(i) Then
          ' ввойдем в режим редактирования объекта спецификации
          If iSpc.ksSpcObjectEdit(spcObj(i)) Then
            ' очистим геометрию, чтобы не удалялась в месте с объектом
            iSpc.ksSpcIncludeReference 0, 0
            ' закроем объект спецификации
            iSpc.ksSpcObjectEnd
          End If
          iDocument2D.ksDeleteObj spcObj(i)
          spcObj(i) = 0
        End If
      Next i
    End If
  End If

  If spcObj(0) > 0 Then
    DrawSpcObj = True
  Else
    DrawSpcObj = False
  End If
End Function

' создание или редактирование объекта спецификации
Function EditSpcObj(spcObj As Long, ByVal geom As Long) As Long
  Dim iSpc As Object ' ksSpecification
  Set iSpc = iDocument2D.GetSpecification()
  
  Dim bufPar As Object ' ksUserParam
  Set bufPar = iKompasObject.GetParamStruct(ko_UserParam)
  
  Dim item As Object ' ksLtVariant
  Set item = iKompasObject.GetParamStruct(ko_LtVariant)
  
  Dim arr As Object ' ksDynamicArray
  Set arr = iKompasObject.GetDynamicArray(LTVARIANT_ARR)
   
  If Not iSpc Is Nothing And Not bufPar Is Nothing And Not item Is Nothing And _
     Not arr Is Nothing Then
    bufPar.init
    item.init
    bufPar.SetUserArray arr
    If flagMode = 0 And par.flagAttr = 0 Then
      EditSpcObj = 0
      Exit Function
    End If

    If flagMode > 0 Then
      spcObj = iSpc.ksGetSpcObjForGeomWithLimit("", 0, geom, 0, 1, STANDART_SECTION, 297327484710#)
      If par.flagAttr = 0 Then
        EditSpcObj = spcObj
        Exit Function
      End If

      If spcObj > 0 Then
        If iSpc.ksSpcObjectEdit(spcObj) = 0 Then
          spcObj = 0
        End If
      End If
    End If

    Dim flMode As Long
    flMode = spcObj
    Dim create As Boolean
    If flMode = 0 Then
      create = CBool(iSpc.ksSpcObjectCreate("", 0, STANDART_SECTION, 0, 297327484710#, 0))
    End If
    
    ' создаем объект спецификации для умолчательногостиля СП
    If flMode > 0 Or create Then
      arr.ksAddArrayItem -1, item
      ' исполнение
      If tmp.perform = 1 Then
        iSpc.ksSpcVisible SPC_NAME, 2, 0
      Else
        item.uIntVal = 2
        arr.ksSetArrayItem 0, item
        iSpc.ksSpcVisible SPC_NAME, 2, 1
        iSpc.ksSpcChangeValue SPC_NAME, 2, bufPar, UINT_ATTR_TYPE
      End If

      ' изменим диаметр
      item.floatVal = tmp.dr
      arr.ksSetArrayItem 0, item
      iSpc.ksSpcChangeValue SPC_NAME, 4, bufPar, FLOAT_ATTR_TYPE

      ' отследим мелкий шаг
      If tmp.pitch = 0 Then ' выключить шаг и его разделитель
        iSpc.ksSpcVisible SPC_NAME, 5, 0
        iSpc.ksSpcVisible SPC_NAME, 6, 0 ' щаг
      Else
        iSpc.ksSpcVisible SPC_NAME, 5, 1
        iSpc.ksSpcVisible SPC_NAME, 6, 1 ' щаг
        item.floatVal = tmp.p
        arr.ksSetArrayItem 0, item
        spcDoc.ksSpcChangeValue SPC_NAME, 6, bufPar, FLOAT_ATTR_TYPE
      End If

      ' выключим поле допуска
      If flMode = 0 Then
        iSpc.ksSpcVisible SPC_NAME, 7, 0
        ' выключим класс прочности
        iSpc.ksSpcVisible SPC_NAME, 8, 0
        ' выключим материал
        iSpc.ksSpcVisible SPC_NAME, 9, 0
        ' выключим покрытие
        iSpc.ksSpcVisible SPC_NAME, 10, 0
      End If
        
      ' изменим ГОСТ
      item.uIntVal = tmp.gost
        
      arr.ksSetArrayItem 0, item
      iSpc.ksSpcChangeValue SPC_NAME, 12, bufPar, UINT_ATTR_TYPE
      Dim massa As Single
      Select Case tmp.indexMassa
        Case 0: massa = tmp.massa
        Case 1: massa = 0.356 * tmp.massa
        Case 2: massa = 1.08 * tmp.massa
      End Select
      
      iSpc.ksSpcMassa CStr(massa) ' масса детали

      ' подключим геометрию
      If geom > 0 Then
        iSpc.ksSpcIncludeReference geom, SPC_CLEAR_GEOM
      End If

      EditSpcObj = iSpc.ksSpcObjectEnd
      Exit Function
    End If
  End If
  
  EditSpcObj = 0
End Function

' инициализация параметров пользователя
Sub InitUserParamTmp()
  If Not paramTmp Is Nothing Then
    Dim item As Object ' ksLtVariant
    Set item = iKompasObject.GetParamStruct(ko_LtVariant)
    Dim arr As Object  ' ksDynamicArray
    Set arr = iKompasObject.GetDynamicArray(LTVARIANT_ARR)
    If (Not item Is Nothing) And (Not arr Is Nothing) Then
      paramTmp.init
      paramTmp.SetUserArray arr
      item.init
      item.floatVal = tmp.dr       ' 0 - dr
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.p        ' 1 - p1
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.p        ' 2 - p2
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.s        ' 3 - s
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.d        ' 4 - D
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.da       ' 5 - da
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.H        ' 6 - h
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.d2       ' 7 - d2
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.massa    ' 8 - m
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.s        ' 9 - s1
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.d        ' 10 - D1
      arr.ksAddArrayItem -1, item
      item.floatVal = tmp.massa    ' 11 - m1
      arr.ksAddArrayItem -1, item
    End If
  End If
End Sub

Sub GetUserParamTmp()
  If Not paramTmp Is Nothing Then
    Dim item As Object  ' ksLtVariant
    Dim item1 As Object ' ksLtVariant
    Dim arr As Object   ' ksDynamicArray
    Set item = iKompasObject.GetParamStruct(ko_LtVariant)
    Set item1 = iKompasObject.GetParamStruct(ko_LtVariant)
    Set arr = paramTmp.GetUserArray()
    If (Not item Is Nothing) And (Not item1 Is Nothing) And (Not arr Is Nothing) _
       And arr.ksGetArrayCount() >= 12 Then
      item.init
      arr.ksGetArrayItem 0, item  ' dr
      tmp.dr = item.floatVal

      arr.ksGetArrayItem 5, item  ' da
      tmp.da = item.floatVal

      arr.ksGetArrayItem 6, item  ' h
      tmp.H = item.floatVal

      arr.ksGetArrayItem 7, item  ' d2
      tmp.d2 = item.floatVal

      arr.ksGetArrayItem 1, item  ' p1
      arr.ksGetArrayItem 2, item1 ' p2
      If tmp.pitch = 1 Then
        tmp.p = item1.floatVal
      Else
        tmp.p = item.floatVal
      End If

      If Abs(item1.floatVal - item.floatVal) < 0.001 Then
        tmp.pitch_off = 1
      Else
        tmp.pitch_off = 0
      End If

      arr.ksGetArrayItem 9, item1 ' s1
      If tmp.key_s_on = 1 And Abs(item1.floatVal) > 0.001 Then
        tmp.key_s_gray = 1
      Else
        tmp.key_s_gray = 0
        tmp.key_s = 0
      End If

      If tmp.key_s_on = 1 And tmp.key_s = 1 Then
        tmp.s = item1.floatVal       ' размер под ключ
        arr.ksGetArrayItem 10, item1 ' D1
        tmp.d = item1.floatVal       ' диаметр описанной окружности
        arr.ksGetArrayItem 11, item1 ' m1
        tmp.massa = item1.floatVal
      Else
        arr.ksGetArrayItem 3, item1  ' s
        tmp.s = item1.floatVal       ' размер под ключ
        arr.ksGetArrayItem 4, item1  ' D
        tmp.d = item1.floatVal       ' диаметр описанной окружности
        arr.ksGetArrayItem 8, item1  ' m
        tmp.massa = item1.floatVal
      End If
    End If
  End If
End Sub

' подключиться к базе данных
Function ConnectDB_(ByVal bd As Long, ByVal name As String) As Boolean
  Dim buf As String
  If GetFullName(name, buf) Then
    ConnectDB_ = data.ksConnectDB(base.bg, buf)
  Else
    ConnectDB_ = data.ksConnectDB(base.bg, name)
  End If
End Function

' получить полное имя файла
Function GetFullName(name As String, buf As String) As Boolean
  Dim path As String
  path = iKompasObject.ksSystemPath(sptLIBS_FILES)
  path = path + "Load\" + name
  Dim fso As New FileSystemObject
  If fso.FileExists(path) Then
    GetFullName = True
    buf = path
  Else
    path = App.path
    path = path + "\Load\" + name
    If fso.FileExists(path) Then
      GetFullName = True
      buf = path
    Else
      path = App.path
      path = path + "\" + name
      If fso.FileExists(path) Then
        GetFullName = True
        buf = path
      Else
        GetFullName = False
      End If
    End If
  End If
End Function

' открыть базу данных
Function OpenGaykaBase() As Boolean
  InitUserParamTmp
  OpenGaykaBase = False
  If Not data Is Nothing Then
    base.bg = data.ksCreateDB("TXT_DB")   ' TXT_DB

    If ConnectDB_(base.bg, "5915.loa") Then ' 5915.loa
      base.rg = data.ksRelation(base.bg)
        data.ksRFloat ("dr")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
        data.ksRFloat ("")
      data.ksEndRelation
      If data.ksDoStatement(base.bg, base.rg, "") Then   ' TXT_ALL
        OpenGaykaBase = True
      End If
    End If
  End If
End Function

Sub CloseGaykaBase() ' закрыть базу данных
  If base.bg <> 0 Then
    data.ksDeleteDB base.bg
  End If
End Sub

'-------------------------------------------------------------------------------
'  Читать параметры гайки по диаметру
'  возвращает 1 - успех 0 - не найдено записи , ошибка связи с БД
' ---
Function ReadGaykaBase(d As Single) As Boolean
  Dim s As String
  If d > 0 Then
    s = "dr=" & Str(d)     ' dr=%.0f
  Else
    s = "dr=" & Str(tmp.d) ' dr=%.0f
  End If
  
  If data.ksCondition(base.bg, base.rg, s) = 1 Then
    Dim i As Integer
    i = data.ksReadRecord(base.bg, base.rg, paramTmp)
    If i > 0 Then
      GetUserParamTmp
      ReadGaykaBase = True
    End If
  Else
    ReadGaykaBase = False
  End If
End Function

Public Sub init() ' инициализация параметров структуры гайки
    tmp.gost = 5915
    tmp.hatchAng = 45
    tmp.hatchStep = 2
    tmp.dr = 20
    tmp.p = 2.5
    tmp.ver = 1
    tmp.indexMassa = 0
    tmp.s = 30
    tmp.d = 33
    tmp.da = 21.6
    tmp.H = 16
    tmp.d2 = 27.7
    tmp.Class = 2      'класс точности
    tmp.perform = 0
    tmp.axis_off = 0
    tmp.simple = 0
    tmp.massa = 71.44
End Sub

' инициализация объекта класса
Private Sub Class_Initialize()
  Set Param = iKompasObject.GetParamStruct(ko_UserParam)
  Set paramTmp = iKompasObject.GetParamStruct(ko_UserParam)
  Set data = iKompasObject.DataBaseObject()

  refMacr = 0
  flagMode = 0
  countObj = 1
  
  InitUserParam

  If iDocument2D.ksEditMacroMode > 0 And iDocument2D.ksGetMacroParam(0, Param) > 0 Then
    GetUserParam ' инициализация из макропараметров
    tmp.ver = 1
    tmp.key_s_on = 1
    tmp.koef_mat_on = 1
  Else ' инициализация по умолчанию
    par.drawType = ID_VID
    par.ang = 0
    par.flagAttr = 0
    init ' инициализация параметров структуры гайки
  End If
End Sub