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 = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

'--------------------------------------------------------------------------------------
'
'
'-------------------------------------------------------------------------------------
Private 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

Private 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


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



Const ID_VID = 1
Const ID_SIDEVID = 2
Const ID_TOPVID = 3
Const ID_VIDSEC = 4

' название колонок для спецификации
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

' Контролы панели свойств
Const DIAM_ID = 10001        ' Комбобокс диаметров резьбы
Const VIEWSIDE_ID = 10002    ' Кнопки отображения
Const PERFORMANCE_ID = 10003 ' Кнопки исполнений
Const SIMPLES_ID = 10004     ' Кнопки упрощений
Const ADD_PARAM_ID = 10005   ' Кнопки доп. параметров
Const SPC_CHECK_ID = 10006   ' Чекбокс объекта сп
Const ANGLE_HATCH_ID = 10007 ' угол штриховки
Const STEP_HATCH_ID = 10008  ' шаг штриховки
Const PARAMS_ID = 10009      ' список параметров
Const VIEW_BOX_ID = 10010    ' окно просмотра
'Const STR_EDIT_ID = 10011    '
'Const STR_LIST_ID = 10012    '

' Кнопки панели свойств
Const BASE_VIEW = 2001       ' Главный вид
Const LEFT_VIEW = 2002       ' Вид слева
Const TOP_VIEW = 2003        ' Вид сверху
Const SEC_VIEW = 2004        ' Вид\разрез
Const PERF1_VIEW = 2005      ' Исполнение 1
Const PERF2_VIEW = 2006      ' Исполнение 2
Const SIMPLE_VIEW = 2007     ' Упрошено
Const DRAW_AXIS = 2008       ' Рисовать ось
Const ADDSTEP_BUTT = 2009    ' Мелкий шаг
Const KEY_BUTT = 2010        ' Доп. размер под ключ


'-------------------------------------------------------------------------------------
'
'
'-------------------------------------------------------------------------------------
' базовые параметры
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 WithEvents hatchPar  As HatchControl
Attribute hatchPar.VB_VarHelpID = -1
Private WithEvents iUserCtrl As KompasAPI7.PropertyUserControl
Attribute iUserCtrl.VB_VarHelpID = -1
Public WithEvents iProcParam As KompasAPI7.processParam
Attribute iProcParam.VB_VarHelpID = -1
Private iDiamEdit As KompasAPI7.PropertyList
Private iViewButt As KompasAPI7.PropertyMultiButton
Private iPerfButt As KompasAPI7.PropertyMultiButton
Private iSimpButt As KompasAPI7.PropertyMultiButton
Private iAddButt As KompasAPI7.PropertyMultiButton
Private iSpcCheck As KompasAPI7.PropertyCheckBox
Private iAngleEdit As KompasAPI7.PropertyEdit
Private iStepEdit As KompasAPI7.PropertyEdit
Private phantom As Kompas6API5.ksPhantom
'Private iTestStringEdit As KompasAPI7.PropertyEdit
'Private iTestStringList As KompasAPI7.PropertyList




' инициализация
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

' Функция обратной связи, вызываемая из 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 -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

' процесс вставки гайки в модель
Sub Draw()
  par.typeSwitch = False
  
  Set phantom = iKompasObject.GetParamStruct(ko_Phantom)
  If Not phantom Is Nothing Then
    phantom.init
    phantom.phantom = 1
    Dim t1 As Object ' ksType1
    Set t1 = phantom.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.dynamic = 1
              
              ' указываем адрес обратной функции для Placement
              info.SetCallBackP "CALLBACKPROCPLACEMENT", 0, Me
              j = iDocument2D.ksPlacementEx(info, X, Y, ang, phantom, iProcParam)
  
              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
          
          CloseGaykaBase ' закрытие базы
          
          Set iDiamEdit = Nothing
          Set iViewButt = Nothing
          Set iPerfButt = Nothing
          Set iSimpButt = Nothing
          Set iAddButt = Nothing
          Set iSpcCheck = Nothing
          Set iAngleEdit = Nothing
          Set iStepEdit = Nothing
          Set iUserCtrl = Nothing
          Set iProcParam = Nothing
          Set iTestStringEdit = Nothing
          Set iTestStringList = Nothing
        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
  MacroElementParam = False
  
  If Not iKomApp Is Nothing Then
    OpenGaykaBase
    
    Set iProcParam = iKomApp.CreateProcessParam
    iProcParam.Caption = "Гайка ГОСТ 5915-70"
    iProcParam.SpecToolbar = pnEnterEscCreateHelp
        
    Dim iTabs As KompasAPI7.PropertyTabs
    Set iTabs = iProcParam.PropertyTabs
    
    Dim iTab As KompasAPI7.PropertyTab
    Set iTab = iTabs.Add("Параметры гайки")
    
    Dim iCtrls As KompasAPI7.PropertyControls
    Set iCtrls = iTab.PropertyControls
    
'    Set iTestStringEdit = iCtrls.Add(ksControlEditStr)
'    iTestStringEdit.name = "Тест строкового редактора"
'    iTestStringEdit.Id = STR_EDIT_ID
'    iTestStringEdit.Width = 17
'    iTestStringEdit.Value = "Пробная строка"
'    Set iTestStringList = iCtrls.Add(ksControlListStr)
'    iTestStringList.name = "Тест строкового списка"
'    iTestStringList.Id = STR_LIST_ID
'    iTestStringList.Sort = False
'    iTestStringList.Width = 7
'    iTestStringList.Add ("Строка 1")
'    iTestStringList.Add ("Строка 2")
'    iTestStringList.Add ("Строка 3")
'    iTestStringList.Add ("Строка 4")
'    iTestStringList.Value = "Строка 2"
    
    ' Диаметр резьбы
    Set iDiamEdit = iCtrls.Add(ksControlListReal)
    iDiamEdit.name = "&Диаметр"
    iDiamEdit.Id = DIAM_ID
    iDiamEdit.NameVisibility = ksNameAlwaysVisible
    iDiamEdit.Sort = False
    iDiamEdit.Width = 7
    iDiamEdit.ReadOnly = True
    iDiamEdit.Hint = "Диаметр резьбы"
    iDiamEdit.Tips = "Диаметр резьбы"

    ' заполним список диаметров
    Dim item As Kompas6API5.ksLtVariant
    Set item = iKompasObject.GetParamStruct(ko_LtVariant)
    Dim arr As Kompas6API5.ksDynamicArray
    Set arr = paramTmp.GetUserArray()
    If (Not item Is Nothing) And (Not arr Is Nothing) Then
      Dim i As Integer
      i = 1
      Do While i
        i = data.ksReadRecord(base.bg, base.rg, paramTmp)

        If i > 0 Then
          arr.ksGetArrayItem 0, item
          iDiamEdit.Add (item.floatVal)
        End If
      Loop
    End If

    iDiamEdit.Value = tmp.dr    ' выделим текущий диаметр гайки

    ' Разделитель
    Dim sep As KompasAPI7.PropertySeparator
    Set sep = iCtrls.Add(ksControlSeparator)
    sep.name = "Отображение"
    sep.SeparatorType = ksSeparatorDownName
    Set sep = Nothing

    Set iViewButt = iCtrls.Add(ksControlMultiButton)
    iViewButt.Id = VIEWSIDE_ID  ' Кнопки отображения
    iViewButt.name = "&Вид отображения"
    iViewButt.Tips = "Вид отображения"
    iViewButt.Hint = "Вид отображения гайки"
    iViewButt.ButtonsType = ksRadioButton
    iViewButt.NameVisibility = ksNameVerticalVisible
    ' при отладке App.hInstance указывает на VB а не на библиотеку, поэтому
    ' битмапы достаем из файлов, для этого их нужно положить тудаже где лежит
    ' собранный dll, в конечном приложении можно оставить идентификаторы чтобы
    ' битмапы брались из ресурсов библиотеки
    iViewButt.ResModule = App.hInstance

    Dim fullPath As String
    If GetFullName("G_view.bmp", fullPath) Then
      iViewButt.AddButton BASE_VIEW, fullPath     ' Главный вид
    Else
      iViewButt.AddButton BASE_VIEW, BASE_VIEW    ' Главный вид
    End If

    If GetFullName("G_left.bmp", fullPath) Then
      iViewButt.AddButton LEFT_VIEW, fullPath     ' Вид слева
    Else
      iViewButt.AddButton LEFT_VIEW, LEFT_VIEW    ' Вид слева
    End If

    If GetFullName("G_top.bmp", fullPath) Then
      iViewButt.AddButton TOP_VIEW, fullPath      ' Вид сверху
    Else
      iViewButt.AddButton TOP_VIEW, TOP_VIEW      ' Вид сверху
    End If

    If GetFullName("G_sec.bmp", fullPath) Then
      iViewButt.AddButton SEC_VIEW, fullPath      ' Вид\разрез
    Else
      iViewButt.AddButton SEC_VIEW, SEC_VIEW      ' Вид\разрез
    End If

    Select Case par.drawType ' выделим текущий вид
      Case ID_VID:     iViewButt.ButtonChecked(BASE_VIEW) = True ' главный вид
      Case ID_SIDEVID: iViewButt.ButtonChecked(LEFT_VIEW) = True ' вид сбоку
      Case ID_TOPVID:  iViewButt.ButtonChecked(TOP_VIEW) = True  ' вид сверху
      Case ID_VIDSEC:  iViewButt.ButtonChecked(SEC_VIEW) = True  ' главный вид \ разрез
    End Select

    iViewButt.ButtonTips(BASE_VIEW) = "Главный вид"
    iViewButt.ButtonHint(BASE_VIEW) = "Главный вид отображения Гайки"
    iViewButt.ButtonTips(LEFT_VIEW) = "Вид сбоку"
    iViewButt.ButtonTips(TOP_VIEW) = "Вид сверху"
    iViewButt.ButtonTips(SEC_VIEW) = "Вид\разрез"

    ' Кнопки исполнений
    Set iPerfButt = iCtrls.Add(ksControlMultiButton)
    iPerfButt.Id = PERFORMANCE_ID
    iPerfButt.name = "&Исполнение"
    iPerfButt.ButtonsType = ksRadioButton
    iPerfButt.NameVisibility = ksNameVerticalVisible
    iPerfButt.ResModule = App.hInstance
    iPerfButt.Hint = "Выбор исполнения"
    iPerfButt.Tips = "Исполнение"

    If GetFullName("G_i1.bmp", fullPath) Then
      iPerfButt.AddButton PERF1_VIEW, fullPath      ' Исполнение 1
    Else
      iPerfButt.AddButton PERF1_VIEW, PERF1_VIEW    ' Исполнение 1
    End If

    If GetFullName("G_i2.bmp", fullPath) Then
      iPerfButt.AddButton PERF2_VIEW, fullPath      ' Исполнение 2
    Else
      iPerfButt.AddButton PERF2_VIEW, PERF2_VIEW    ' Исполнение 2
    End If

    If tmp.perform Then ' выделим исполнение
      iPerfButt.ButtonChecked(PERF2_VIEW) = True ' исполнение 2
    Else
      iPerfButt.ButtonChecked(PERF1_VIEW) = True ' исполнение 1
    End If

    iPerfButt.ButtonTips(PERF1_VIEW) = "Исполнение 1"
    iPerfButt.ButtonTips(PERF2_VIEW) = "Исполнение 2"

    ' Кнопки упрощений
    Set iSimpButt = iCtrls.Add(ksControlMultiButton)
    iSimpButt.Id = SIMPLES_ID
    iSimpButt.name = "&Упрощения"
    iSimpButt.ButtonsType = ksCheckButton
    iSimpButt.NameVisibility = ksNameVerticalVisible
    iSimpButt.ResModule = App.hInstance
    iSimpButt.Hint = "Упрощения отображения гайки"
    iSimpButt.Tips = "Упрощения отображения"

    If GetFullName("G_simple.bmp", fullPath) Then
      iSimpButt.AddButton SIMPLE_VIEW, fullPath       ' Упрошено
    Else
      iSimpButt.AddButton SIMPLE_VIEW, SIMPLE_VIEW    ' Упрошено
    End If

    If GetFullName("G_osx_on.bmp", fullPath) Then
      iSimpButt.AddButton DRAW_AXIS, fullPath         ' Рисовать ось
    Else
      iSimpButt.AddButton DRAW_AXIS, DRAW_AXIS        ' Рисовать ось
    End If

    If tmp.simple Then
      iSimpButt.ButtonChecked(SIMPLE_VIEW) = True ' Упрошено
    End If

    If tmp.axis_off = 0 Then
      iSimpButt.ButtonChecked(DRAW_AXIS) = True ' Рисовать ось
    End If

    iSimpButt.ButtonTips(SIMPLE_VIEW) = "Упрошено"
    iSimpButt.ButtonTips(DRAW_AXIS) = "Рисовать ось"

    ' Разделитель
    Set sep = iCtrls.Add(ksControlSeparator)
    sep.SeparatorType = ksSeparatorDownName
    Set sep = Nothing

    ' Кнопки доп. параметров
    Set iAddButt = iCtrls.Add(ksControlMultiButton)
    iAddButt.Id = ADD_PARAM_ID
    iAddButt.name = "Дополнительные па&раметры"
    iAddButt.ButtonsType = ksCheckButton
    iAddButt.NameVisibility = ksNameVerticalVisible
    iAddButt.ResModule = App.hInstance
    iAddButt.Hint = "Дополнительные параметры"
    iAddButt.Tips = "Дополнительные параметры"

    If GetFullName("G_step.bmp", fullPath) Then
      iAddButt.AddButton ADDSTEP_BUTT, fullPath      ' Мелкий шаг
    Else
      iAddButt.AddButton ADDSTEP_BUTT, ADDSTEP_BUTT  ' Мелкий шаг
    End If

    If GetFullName("G_key.bmp", fullPath) Then
      iAddButt.AddButton KEY_BUTT, fullPath          ' Доп. размер под ключ
    Else
      iAddButt.AddButton KEY_BUTT, KEY_BUTT          ' Доп. размер под ключ
    End If

    If tmp.pitch Then
      iAddButt.ButtonChecked(ADDSTEP_BUTT) = True
    End If

    If tmp.key_s Then
      iAddButt.ButtonChecked(KEY_BUTT) = True
    End If

    iAddButt.ButtonTips(ADDSTEP_BUTT) = "Мелкий шаг"
    iAddButt.ButtonTips(KEY_BUTT) = "Дополнительный размер под ключ"

    ' Чекбокс объекта сп
    Set iSpcCheck = iCtrls.Add(ksControlCheckBox)
    iSpcCheck.Id = SPC_CHECK_ID
    iSpcCheck.name = "&Создать объект спецификации"
    iSpcCheck.Value = par.flagAttr
    iSpcCheck.Hint = "Создать объект спецификации"
    iSpcCheck.Tips = "Создать объект спецификации"

    Set iUserCtrl = iCtrls.Add(ksControlUser)
    iUserCtrl.SetOCXControl "HatchControl1.HatchControl"
    iUserCtrl.Id = 10011
    iUserCtrl.name = "&Тест OCX"
    iUserCtrl.Width = 200
    iUserCtrl.HEIGHT = 200

    ' Разделитель
    Set sep = iCtrls.Add(ksControlSeparator)
    sep.name = "Параметры штриховки"
    sep.SeparatorType = ksSeparatorDownName
    Set sep = Nothing

    ' угол штриховки
    Set iAngleEdit = iCtrls.Add(ksControlEditReal)
    iAngleEdit.Id = ANGLE_HATCH_ID
    iAngleEdit.name = "У&гол, гр"
    iAngleEdit.NameVisibility = ksNameAlwaysVisible
    iAngleEdit.Width = 7
    iAngleEdit.Value = tmp.hatchAng
    iAngleEdit.Enable = par.drawType = ID_VIDSEC
    iAngleEdit.Hint = "Угол штриховки"
    iAngleEdit.Tips = "Угол"

    ' шаг штриховки
    Set iStepEdit = iCtrls.Add(ksControlEditReal)
    iStepEdit.Id = STEP_HATCH_ID
    iStepEdit.name = "&Шаг, мм"
    iStepEdit.NameVisibility = ksNameAlwaysVisible
    iStepEdit.Width = 7
    iStepEdit.Value = tmp.hatchStep
    iStepEdit.Enable = par.drawType = ID_VIDSEC
    iStepEdit.Hint = "Шаг штриховки"
    iStepEdit.Tips = "Шаг"

'Const PARAMS_ID = 10009      ' список параметров
'Const VIEW_BOX_ID = 10010    ' окно просмотра

'    Set hatchPar = CreateObject("HatchControl1.HatchControl")
'    hatchPar.AngleEditValue = "10"
    
    MacroElementParam = True
    
    Set iCtrls = Nothing
    Set iTab = Nothing
    Set iTabs = Nothing
  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
        iSpc.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 = Left(path, InStrRev(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


Private Sub hatchPar_AngleChange()
  MsgBox "Изменили угол"
End Sub

Private Sub hatchPar_StepChange()
  MsgBox "Изменили шаг"
End Sub

Private Function iProcParam_ChangeControlValue(ByVal control As KompasAPI7.IPropertyControl) As Boolean
  Dim redrawPhantom As Boolean
  redrawPhantom = False
  
  Select Case control.Id
    Case DIAM_ID                       ' Комбобокс диаметров резьбы
      Dim val As Single
      val = control.Value
      tmp.dr = val                     ' Установим диаметр гайке
      ReadGaykaBase val                ' Прочитаем новые параметры из базы
      redrawPhantom = True             ' перерисовать фантом
      
    Case SPC_CHECK_ID                  ' Чекбокс объекта сп
      par.flagAttr = iSpcCheck.Value
    
    Case ANGLE_HATCH_ID                ' угол штриховки
      tmp.hatchAng = iAngleEdit.Value
      redrawPhantom = True             ' перерисовать фантом
      
    Case STEP_HATCH_ID                 ' шаг штриховки
      tmp.hatchStep = iStepEdit.Value
      redrawPhantom = True             ' перерисовать фантом
    
'    Case STR_EDIT_ID
'      iKompasObject.ksMessage iTestStringEdit.Value
'
'    Case STR_LIST_ID
'      iKompasObject.ksMessage iTestStringList.Value
  End Select
  
  If redrawPhantom Then
    RedrawPhantomProc
  End If
End Function

Private Function iProcParam_ControlCommand(ByVal control As KompasAPI7.IPropertyControl, ByVal buttonID As Long) As Boolean
  Dim redrawPhantom As Boolean
  redrawPhantom = False
  
  Select Case control.Id
    Case VIEWSIDE_ID                  ' Кнопки отображения
      If buttonID = BASE_VIEW Then    ' главный вид
        par.drawType = ID_VID
        iAngleEdit.Enable = False
        iStepEdit.Enable = False
      End If
      
      If buttonID = LEFT_VIEW Then    ' вид сбоку
        par.drawType = ID_SIDEVID
        iAngleEdit.Enable = False
        iStepEdit.Enable = False
      End If
      
      If buttonID = TOP_VIEW Then     ' вид сверху
        par.drawType = ID_TOPVID
        iAngleEdit.Enable = False
        iStepEdit.Enable = False
      End If
      
      If buttonID = SEC_VIEW Then     ' вид \ разрез
        par.drawType = ID_VIDSEC
        iAngleEdit.Enable = True
        iStepEdit.Enable = True
      End If
      redrawPhantom = True            ' перерисовать фантом
      
    Case PERFORMANCE_ID               ' Кнопки исполнений
      If buttonID = PERF2_VIEW Then   ' исполнение 2
        tmp.perform = 1
      Else
        tmp.perform = 0               ' исполнение 1
      End If
      
      redrawPhantom = True            ' перерисовать фантом
      
    Case SIMPLES_ID                   ' Кнопки упрощений
      If buttonID = SIMPLE_VIEW Then  ' Упрошено
        tmp.simple = iSimpButt.ButtonChecked(SIMPLE_VIEW)
        redrawPhantom = True          ' перерисовать фантом
      End If
      
      If buttonID = DRAW_AXIS Then    ' Рисовать ось
        If iSimpButt.ButtonChecked(DRAW_AXIS) Then
          tmp.axis_off = 0
        Else
          tmp.axis_off = 1
        End If
        redrawPhantom = True          ' перерисовать фантом
      End If
      
    Case ADD_PARAM_ID                 ' Кнопки доп. параметров
      If buttonID = ADDSTEP_BUTT Then ' Мелкий шаг
        tmp.pitch = iAddButt.ButtonChecked(ADDSTEP_BUTT)
      End If
      
      If buttonID = KEY_BUTT Then     ' Доп. размер под ключ
        tmp.key_s = iAddButt.ButtonChecked(KEY_BUTT)
      End If
      
  End Select
  
  If redrawPhantom Then
    RedrawPhantomProc
  End If

End Function

Private Sub RedrawPhantomProc()
  Dim pt1 As Kompas6API5.ksType1
  Set pt1 = phantom.GetPhantomParam
  Dim gr As Long
  GetGroup gr           ' новая геометрия
  pt1.gr = gr
  
  iDocument2D.ksChangeObjectInLibRequest Nothing, phantom
End Sub

Private Function iUserCtrl_CreateOCX(ByVal iOcx As Object) As Boolean
  Set hatchPar = iOcx
End Function

Private Function iUserCtrl_DestroyOCX() As Boolean
  Set hatchPar = Nothing
End Function