VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Class1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Dim iKompasObject As Object 'KompasObject
Sub DrawLinDim(doc As Object) ' Линейный размер
  Dim iParam As Object ' ksLDimParam
  Set iParam = iKompasObject.GetParamStruct(ko_LDimParam)
  If Not iParam Is Nothing Then
    Dim idPar As Object ' ksDimDrawingParam
    Set idPar = iParam.GetDPar()
    If Not idPar Is Nothing Then
      idPar.Init
      idPar.textPos = 10
      idPar.textBase = 2
      idPar.pt1 = 2
      idPar.pt2 = 2
      idPar.ang = -30
      idPar.lenght = 20
    End If
    
    Dim isPar As Object ' ksLDimSourceParam
    Set isPar = iParam.GetSPar()
    If Not isPar Is Nothing Then
      isPar.Init
      isPar.X1 = 50
      isPar.Y1 = 50
      isPar.X2 = 70
      isPar.Y2 = 60
      isPar.dx = 0
      isPar.dy = -20
      isPar.basePoint = 1
    End If
    
    Dim itPar As Object ' ksDimTextParam
    Set itPar = iParam.GetTPar()
    If Not itPar Is Nothing Then
      itPar.Init 0
      itPar.SetBitFlagValue AUTONOMINAL, True
      itPar.SetBitFlagValue PREFIX, True
      itPar.SetBitFlagValue DEVIATION, True
      itPar.SetBitFlagValue UNIT, True
      itPar.SetBitFlagValue SUFFIX, True
      itPar.sign = 0
      
      Dim istr As Object ' ksChar255
      Set istr = iKompasObject.GetParamStruct(ko_Char255)
      Dim iarrText As Object ' ksDynamicArray
      Set iarrText = itPar.GetTextArr()
      If Not iarrText Is Nothing Then
        istr.Str = "prefix"
        iarrText.ksAddArrayItem -1, istr
  
        istr.Str = "+0,5"
        iarrText.ksAddArrayItem -1, istr
  
        istr.Str = "-0,5"
        iarrText.ksAddArrayItem -1, istr
  
        istr.Str = "mm"
        iarrText.ksAddArrayItem -1, istr
  
        istr.Str = "pp&04ww&01oo"
        iarrText.ksAddArrayItem -1, istr
      End If
    End If
    Dim obj As Long
    obj = doc.ksLinDimension(iParam)
  End If

  If obj Then
    doc.ksGetObjParam obj, iParam, ALLPARAM
    isPar.X2 = 50
    isPar.Y2 = 60
    iKompasObject.ksMessage "Поменяем параметры"
    doc.ksSetObjParam obj, iParam, ALLPARAM
  End If
End Sub

Sub DrawAngDim(doc As Object)
  Dim iaDim As Object ' ksADimParam
  Set iaDim = iKompasObject.GetParamStruct(ko_ADimParam)
  If Not iaDim Is Nothing Then
    
    Dim itPar As Object ' ksDimTextParam
    Set itPar = iaDim.GetTPar()
    itPar.Init True
      
    Dim itextLine As Object
    Set itextLine = iKompasObject.GetParamStruct(ko_TextLineParam)
    itextLine.Init
      
    Dim itextItem As Object ' ksTextItemParam
    Set itextItem = iKompasObject.GetParamStruct(ko_TextItemParam)
    itextItem.Init
    itextItem.s = "Угловой размер"
  
    Dim iFont As Object ' ksTextItemFont
    Set iFont = itextItem.GetItemFont()
    iFont.Init
    iFont.HEIGHT = 5
    iFont.ksu = 1
    iFont.FontName = "GOST type A"
    iFont.SetBitVectorValue NEW_LINE, True
  
    Dim iArr As Object ' ksDynamicArray
    Set iArr = itextLine.GetTextItemArr()
    iArr.ksAddArrayItem -1, itextItem
  
    Dim iArr1 As Object ' ksDynamicArray
    Set iArr1 = itPar.GetTextArr()
    iArr1.ksAddArrayItem -1, itextLine
  
    Dim isPar As Object ' ksADimSourceParam
    Set isPar = iaDim.GetSPar()
    isPar.Init
    isPar.rad = 50
      
    Dim idPar As Object ' ksDimDrawingParam
    Set idPar = iaDim.GetDPar()
    idPar.Init
  
    Dim obj As Long
    obj = doc.ksAngDimension(iaDim)
  End If
  
  If obj Then
    doc.ksGetObjParam obj, iaDim, ALLPARAM
    Dim isPar2 As Object ' ksADimSourceParam
    Set isPar2 = iaDim.GetSPar()
    isPar2.Init
    isPar2.rad = 100
    iKompasObject.ksMessage "Поменяем параметры"
    doc.ksSetObjParam obj, iaDim, ALLPARAM
  End If
End Sub
Sub DrawRough(doc As Object)
  Dim iroughPar As Object ' ksRoughParam
  Set iroughPar = iKompasObject.GetParamStruct(ko_RoughParam)
  Dim irPar As Object ' ksRoughPar
  Set irPar = iroughPar.GetrPar()
  Dim ishPar As Object ' ksShelfPar
  Set ishPar = iroughPar.GetshPar()
  Dim istr As Object ' ksChar255
  Set istr = iKompasObject.GetParamStruct(ko_Char255)
  If Not iroughPar Is Nothing And Not irPar Is Nothing And Not ishPar Is Nothing And Not istr Is Nothing Then
    irPar.Init
    ishPar.Init
    istr.Init

    ' заполним параметры текста шероховатости
    irPar.Style = 0
    irPar.Type = 0
    irPar.around = 0
    irPar.x = 50
    irPar.y = 50
    irPar.ang = 90
    irPar.cText0 = 2
    irPar.cText1 = 2
    irPar.cText2 = 2
    irPar.cText3 = 1

    ' режим, когда тексты задаются массивом строк символов
    Dim iptext As Object ' ksDynamicArray
    Set iptext = irPar.GetpText
    istr.Str = "1"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "2"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "3"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "4"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "5"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "6"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "7"
    iptext.ksAddArrayItem -1, istr

    ' параметры выносной полки
    ishPar.psh = 0     ' полки нет
    ishPar.ang = 130   ' угол наклона ножки
    ishPar.length = 20 ' длина ножки

    Dim obj As Long
    obj = doc.ksRough(iroughPar)

    If obj Then
      doc.ksGetObjParam obj, iroughPar, ALLPARAM
      irPar.ang = 100
      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam obj, iroughPar, ALLPARAM
    End If
  End If
End Sub
Sub DrawLeader(doc As Object)
  Dim ilead As Object ' ksLeaderParam
  Set ilead = iKompasObject.GetParamStruct(ko_LeaderParam)
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont
  Dim itMathPoint As Object ' ksMathPointParam
  Set itMathPoint = iKompasObject.GetParamStruct(ko_MathPointParam)
  If Not ilead Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing And Not itMathPoint Is Nothing Then
    ilead.Init
    itLinePar.Init
    iItemPar.Init
    itFont.Init
    itMathPoint.Init

    itFont.SetBitVectorValue NEW_LINE, True
    itLinePar.Style = 0

    Dim iptext As Object
    Set iptext = ilead.GetpTextline

    Dim iTextItemArr As Object
    Set iTextItemArr = itLinePar.GetTextItemArr
    iItemPar.s = "1"
    iTextItemArr.ksAddArrayItem -1, iItemPar
    iptext.ksAddArrayItem -1, itLinePar

    iTextItemArr.ksClearArray
    iItemPar.s = "2"
    iTextItemArr.ksAddArrayItem -1, iItemPar
    iptext.ksAddArrayItem -1, itLinePar

    iTextItemArr.ksClearArray
    iItemPar.s = "3"
    iTextItemArr.ksAddArrayItem -1, iItemPar
    iptext.ksAddArrayItem -1, itLinePar
        
    Dim ipPolyLin As Object ' ksDynamicArray
    Set ipPolyLin = ilead.GetpPolyline
    Dim ipMathPoint As Object ' ksDynamicArray
    Set ipMathPoint = iKompasObject.GetDynamicArray(POINT_ARR)
    If Not ipMathPoint Is Nothing And Not ipPolyLin Is Nothing Then
      itMathPoint.x = 10
      itMathPoint.y = 10
  
      ipMathPoint.ksAddArrayItem -1, itMathPoint
      ipPolyLin.ksAddArrayItem -1, ipMathPoint
  
      itMathPoint.x = 30
      itMathPoint.y = 10
      ipMathPoint.ksClearArray
      ipMathPoint.ksAddArrayItem -1, itMathPoint
      ipPolyLin.ksAddArrayItem -1, ipMathPoint
  
      ilead.SetpPolyline ipPolyLin
    End If
    
    ' заполним параметры
    ilead.x = 50 ' координаты базовой точки ( начало полки )
    ilead.y = 50
    ilead.arrowType = 1 ' тип стрелки
    ilead.dirX = 1  ' направление полки по X (1 -вправо -1-влево)
    ilead.signType = 0 ' тип знака
    ilead.around = 0 ' знак обработки по контуру 0-выключен 1- включен
    ilead.cText0 = 1 ' количество строк текста над полкой 0- текст отсутствует
    ilead.cText1 = 1 ' количество строк текста под полкой 0- текст отсутствует
    ilead.cText2 = 0 ' количество строк текста над ножкой (не более 1 строки)0- текст отсутствует
    ilead.cText3 = 1 ' количество строк текста под ножкой (не более 1 строки)0- текст отсутствует

    Dim obj As Long
    obj = doc.ksLeader(ilead)
    If obj Then
      doc.ksGetObjParam obj, ilead, ALLPARAM
      ilead.x = 100
      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam obj, ilead, ALLPARAM
    End If
  End If
End Sub
Sub DrawPosLeader(doc As Object)
  Dim ilead As Object ' ksPosLeaderParam
  Set ilead = iKompasObject.GetParamStruct(ko_PosLeaderParam)
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont()
  Dim itMathPoint As Object ' ksMathPointParam
  Set itMathPoint = iKompasObject.GetParamStruct(ko_MathPointParam)
  If Not ilead Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing And Not itMathPoint Is Nothing Then
    ilead.Init
    itLinePar.Init
    iItemPar.Init
    itFont.Init
    itMathPoint.Init

    'ilead.Style = INDICATIN_TEXT_LINE_ARR
    itFont.SetBitVectorValue NEW_LINE, True
    itLinePar.Style = 0
    Dim iptext As Object ' ksDynamicArray
    Set iptext = ilead.GetpTextline()
    Dim iTextItemArr As Object ' ksDynamicArray
    Set iTextItemArr = itLinePar.GetTextItemArr()
    
    iItemPar.s = "1"
    iTextItemArr.ksAddArrayItem -1, iItemPar
    iptext.ksAddArrayItem -1, itLinePar

    Dim ipPolyLin As Object ' ksDynamicArray
    Set ipPolyLin = ilead.GetpPolyline
    Dim ipMathPoint As Object ' ksDynamicArray
    Set ipMathPoint = iKompasObject.GetDynamicArray(POINT_ARR)

    If Not ipPolyLin Is Nothing And Not ipMathPoint Is Nothing Then
      itMathPoint.x = 10
      itMathPoint.y = 10
  
      ipMathPoint.ksAddArrayItem -1, itMathPoint
      ipPolyLin.ksAddArrayItem -1, ipMathPoint
  
      itMathPoint.x = 30
      itMathPoint.y = 10
      ipMathPoint.ksClearArray
      ipMathPoint.ksAddArrayItem -1, itMathPoint
      ipPolyLin.ksAddArrayItem -1, ipMathPoint
  
      ilead.SetpPolyline ipPolyLin
    End If
    
    ' заполним параметры
    ilead.x = 50 ' координаты базовой точки ( начало полки )
    ilead.y = 50
    ilead.arrowType = 1
    ilead.dirX = -1

    Dim obj As Long
    obj = doc.ksPositionLeader(ilead)
    If obj Then
      doc.ksGetObjParam obj, ilead, ALLPARAM
      ilead.x = 100
      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam obj, ilead, ALLPARAM
    End If
  End If
End Sub
Sub DrawBrandLeader(doc As Object)
  Dim ilead As Object ' ksBrandLeaderParam
  Set ilead = iKompasObject.GetParamStruct(ko_BrandLeaderParam)
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont()
  Dim istr As Object ' ksChar255
  Set istr = iKompasObject.GetParamStruct(ko_Char255)
  Dim itMathPoint As Object ' ksMathPointParam
  Set itMathPoint = iKompasObject.GetParamStruct(ko_MathPointParam)
  If Not ilead Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing And Not itMathPoint Is Nothing Then
    ilead.Init
    itLinePar.Init
    iItemPar.Init
    itFont.Init
    itMathPoint.Init
    istr.Init

    ilead.cText0 = 1
    Dim iptext As Object ' ksDynamicArray
    Set iptext = ilead.GetpTextline()
    istr.Str = "1"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "2"
    iptext.ksAddArrayItem -1, istr
    istr.Str = "3"
    iptext.ksAddArrayItem -1, istr

    Dim ipPolyLin As Object ' ksDynamicArray
    Set ipPolyLin = ilead.GetpPolyline()
    Dim ipMathPoint As Object ' ksDynamicArray
    Set ipMathPoint = iKompasObject.GetDynamicArray(POINT_ARR)

    itMathPoint.x = 10
    itMathPoint.y = 10

    ipMathPoint.ksAddArrayItem -1, itMathPoint
    ipPolyLin.ksAddArrayItem -1, ipMathPoint

    itMathPoint.x = 30
    itMathPoint.y = 10
    ipMathPoint.ksClearArray
    ipMathPoint.ksAddArrayItem -1, itMathPoint
    ipPolyLin.ksAddArrayItem -1, ipMathPoint

    ' заполним параметры
    ilead.x = 50 ' координаты базовой точки ( начало полки )
    ilead.y = 50
    ilead.arrowType = 1
    ilead.dirX = -1
    ilead.cText0 = 1
    ilead.cText1 = 1
    ilead.cText2 = 1
        
    Dim obj As Long
    obj = doc.ksBrandLeader(ilead)
    If obj Then
      doc.ksGetObjParam obj, ilead, ALLPARAM
      ilead.x = 100
      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam obj, ilead, ALLPARAM
    End If
  End If
End Sub
Sub DrawMarkerLeader(doc As Object)
  Dim ilead As Object ' ko_MarkerLeaderParam
  Set ilead = iKompasObject.GetParamStruct(ko_MarkerLeaderParam)
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont()
  Dim istr As Object ' ksChar255
  Set istr = iKompasObject.GetParamStruct(ko_Char255)
  Dim itMathPoint As Object ' ksMathPointParam
  Set itMathPoint = iKompasObject.GetParamStruct(ko_MathPointParam)
  If Not ilead Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing And Not itMathPoint Is Nothing Then
    ilead.Init
    itLinePar.Init
    iItemPar.Init
    itFont.Init
    itMathPoint.Init
    istr.Init

    ilead.cText0 = 1
    ilead.style1 = 0

    Dim ipCharArr As Object ' ksDynamicArray
    Set ipCharArr = ilead.GetpTextline()
    istr.Str = "1"
    ipCharArr.ksAddArrayItem -1, istr
    istr.Str = "2"
    ipCharArr.ksAddArrayItem -1, istr
    istr.Str = "3"
    ipCharArr.ksAddArrayItem -1, istr
        
    Dim ipPolyLin As Object ' ksDynamicArray
    Set ipPolyLin = ilead.GetpPolyline()
    Dim ipMathPoint As Object ' ksDynamicArray
    Set ipMathPoint = iKompasObject.GetDynamicArray(POINT_ARR)

    itMathPoint.x = 10
    itMathPoint.y = 10

    ipMathPoint.ksAddArrayItem -1, itMathPoint
    ipPolyLin.ksAddArrayItem -1, ipMathPoint

    itMathPoint.x = 30
    itMathPoint.y = 10
    ipMathPoint.ksClearArray
    ipMathPoint.ksAddArrayItem -1, itMathPoint
    ipPolyLin.ksAddArrayItem -1, ipMathPoint

    ' заполним параметры
    ilead.x = 50 ' координаты базовой точки ( начало полки )
    ilead.y = 50
    ilead.arrowType = 1
    ilead.cText0 = 1
    ilead.cText1 = 1
    ilead.cText2 = 1

    Dim obj As Long
    obj = doc.ksMarkerLeader(ilead)
    If obj Then
      doc.ksGetObjParam obj, ilead, ALLPARAM
      ilead.x = 100
      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam obj, ilead, ALLPARAM
    End If
  End If
End Sub
Sub DrawBase(doc As Object)
  Dim iPar As Object ' ksBaseParam
  Set iPar = iKompasObject.GetParamStruct(ko_BaseParam)
  If Not iPar Is Nothing Then
    iPar.Style = 0
    iPar.Type = False ' строка
    iPar.X1 = 10
    iPar.Y1 = 10
    iPar.X2 = 30
    iPar.Y2 = 40
    iPar.Str = "Это база"
    Dim bas As Long
    bas = doc.ksBase(iPar)
    iPar.Init
    If bas Then
      doc.ksGetObjParam bas, iPar, ALLPARAM
      iPar.X2 = -30
      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam bas, iPar, ALLPARAM
    End If
  End If
End Sub
Sub DrawCutLine(doc As Object)
  Dim icut As Object ' ko_CutLineParam
  Set icut = iKompasObject.GetParamStruct(ko_CutLineParam)
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont()
  Dim itMathPoint As Object ' ksMathPointParam
  Set itMathPoint = iKompasObject.GetParamStruct(ko_MathPointParam)
  If Not icut Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing And Not itMathPoint Is Nothing Then
    icut.Init
    itLinePar.Init
    iItemPar.Init
    itFont.Init
    itMathPoint.Init
    
    icut.Type = 0
    icut.X1 = 30
    icut.Y1 = 65
    icut.X2 = 95
    icut.Y2 = 15
    icut.Right = 1
    icut.Str = "A$;1$"
    Dim ipMathPoint As Object ' ksDynamicArray
    Set ipMathPoint = icut.GetpMathPoint()

    itMathPoint.x = 50
    itMathPoint.y = 50

    ipMathPoint.ksAddArrayItem -1, itMathPoint

    itMathPoint.x = 50
    itMathPoint.y = 30

    ipMathPoint.ksAddArrayItem -1, itMathPoint

    itMathPoint.x = 80
    itMathPoint.y = 30

    ipMathPoint.ksAddArrayItem -1, itMathPoint
        
    Dim obj As Long
    obj = doc.ksCutLine(icut)
    If obj Then
      doc.ksGetObjParam obj, icut, ALLPARAM
      Dim ipMathPoint2 As Object ' ksDynamicArray
      Set ipMathPoint2 = icut.GetpMathPoint()
      ipMathPoint.ksClearArray

      itMathPoint.x = 30
      itMathPoint.y = 50

      ipMathPoint2.ksAddArrayItem -1, itMathPoint

      itMathPoint.x = 30
      itMathPoint.y = 30

      ipMathPoint2.ksAddArrayItem -1, itMathPoint

      itMathPoint.x = 80
      itMathPoint.y = 30

      ipMathPoint2.ksAddArrayItem -1, itMathPoint

      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam obj, icut, ALLPARAM
    End If
  End If
End Sub
Sub DrawDiamDim(doc As Object)
  Dim cir As Long
  cir = doc.ksCircle(100, 100, 50, 1)
  Dim iaDim As Object ' ksRDimParam
  Set iaDim = iKompasObject.GetParamStruct(ko_RDimParam)
  Dim itPar As Object ' ksDimTextParam
  Set itPar = iaDim.GetTPar()
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont()
  
  If Not iaDim Is Nothing And Not itPar Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing Then
    itPar.Init True
    itLinePar.Init
    iItemPar.Init
    itFont.Init
  
    itPar.SetBitFlagValue AUTONOMINAL, True
    itPar.sign = 1
  
    itFont.HEIGHT = 5
    itFont.ksu = 1
    itFont.FontName = "GOST type A"
    itFont.SetBitVectorValue NEW_LINE, True
  
    Dim iArr As Object ' ksDynamicArray
    Set iArr = itLinePar.GetTextItemArr
    iArr.ksAddArrayItem -1, iItemPar
  
    Dim iArr2 As Object ' ksDynamicArray
    Set iArr2 = itPar.GetTextArr()
    iArr2.ksAddArrayItem -1, itLinePar
  
    Dim isPar As Object ' ksRDimSourceParam
    Set isPar = iaDim.GetSPar()
    isPar.Init
    isPar.xc = 100
    isPar.yc = 100
    isPar.rad = 50
      
    Dim idPar As Object ' ksDimDrawingParam
    Set idPar = iaDim.GetDPar()
    idPar.Init
  
    Dim obj As Long
    obj = doc.ksDiamDimension(iaDim)
  End If
  If obj Then
    doc.ksGetObjParam obj, iaDim, ALLPARAM
    Dim isPar2 As Object ' ksRDimSourceParam
    Set isPar2 = iaDim.GetSPar()
    isPar2.rad = 100
    iKompasObject.ksMessage "Поменяем параметры"
    doc.ksDeleteObj cir
    doc.ksCircle 100, 100, 100, 1
    doc.ksSetObjParam obj, iaDim, ALLPARAM
  End If
End Sub
Sub DrawRadDimt(doc As Object)
  Dim cir As Long
  cir = doc.ksCircle(100, 100, 50, 1)
  Dim iaDim As Object ' ksRDimParam
  Set iaDim = iKompasObject.GetParamStruct(ko_RDimParam)
  Dim itPar As Object ' ksDimTextParam
  Set itPar = iaDim.GetTPar()
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont()
  If Not iaDim Is Nothing And Not itPar Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing Then
    itPar.Init True
    itLinePar.Init
    iItemPar.Init
    itFont.Init
  
    itPar.SetBitFlagValue AUTONOMINAL, True
    itPar.sign = 1
    
    itFont.HEIGHT = 5
    itFont.ksu = 1
    itFont.FontName = "GOST type A"
    itFont.SetBitVectorValue NEW_LINE, True
  
    Dim iArr As Object ' ksDynamicArray
    Set iArr = itLinePar.GetTextItemArr
    Dim iArr2 As Object ' ksDynamicArray
    Set iArr2 = itPar.GetTextArr()
    Dim isPar As Object ' ksRDimSourceParam
    Set isPar = iaDim.GetSPar()
    Dim idPar As Object ' ksDimDrawingParam
    Set idPar = iaDim.GetDPar()
    If Not iArr Is Nothing And Not iArr2 Is Nothing And Not isPar Is Nothing And Not idPar Is Nothing Then
      isPar.Init
      idPar.Init
      
      iArr.ksAddArrayItem -1, iItemPar
      iArr2.ksAddArrayItem -1, itLinePar
    
      isPar.xc = 100
      isPar.yc = 100
      isPar.rad = 50
    End If
    
    Dim obj As Long
    obj = doc.ksRadDimension(iaDim)
  End If
  If obj Then
    doc.ksGetObjParam obj, iaDim, ALLPARAM
    Dim isPar2 As Object ' ksRDimSourceParam
    Set isPar2 = iaDim.GetSPar()
    isPar.rad = 100
    iKompasObject.ksMessage "Поменяем параметры"
    doc.ksDeleteObj (cir)
    doc.ksCircle 100, 100, 100, 1
    doc.ksSetObjParam obj, iaDim, ALLPARAM
  End If
End Sub
Sub DrawRadBreakDimt(doc As Object)
  Dim cir As Long
  cir = doc.ksCircle(100, 100, 50, 1)
  Dim iaDim As Object ' ksRBreakDimParam
  Set iaDim = iKompasObject.GetParamStruct(ko_RBreakDimParam)
  Dim itPar As Object ' ksDimTextParam
  Set itPar = iaDim.GetTPar
  Dim itLinePar As Object ' ksTextLineParam
  Set itLinePar = iKompasObject.GetParamStruct(ko_TextLineParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object ' ksTextItemFont
  Set itFont = iItemPar.GetItemFont
  If Not iaDim Is Nothing And Not itPar Is Nothing And Not itLinePar Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing Then
    itPar.Init True
    itLinePar.Init
    iItemPar.Init
    itFont.Init
    
    itPar.SetBitFlagValue AUTONOMINAL, True
    itPar.sign = 1
  
    itFont.Init
    itFont.HEIGHT = 5
    itFont.ksu = 1
    itFont.FontName = "GOST type A"
    itFont.SetBitVectorValue NEW_LINE, True
  
    Dim iArr As Object ' ksDynamicArray
    Set iArr = itLinePar.GetTextItemArr()
    Dim iArr2 As Object ' ksDynamicArray
    Set iArr2 = itPar.GetTextArr()
    Dim isPar As Object ' ksRDimSourceParam
    Set isPar = iaDim.GetSPar()
    Dim idPar As Object ' ksRBreakDrawingParam
    Set idPar = iaDim.GetDPar()
    If Not iArr Is Nothing And Not iArr2 Is Nothing And Not isPar Is Nothing And Not idPar Is Nothing Then
      isPar.Init
      idPar.Init
      
      iArr.ksAddArrayItem -1, iItemPar
      iArr2.ksAddArrayItem -1, itLinePar
    
      isPar.xc = 100
      isPar.yc = 100
      isPar.rad = 50
        
      idPar.ang = 0
      idPar.pb = 30
      idPar.pt = 1
    End If
    
    Dim obj As Long
    obj = doc.ksRadBreakDimension(iaDim)
  End If
  
  If obj Then
    doc.ksGetObjParam obj, iaDim, ALLPARAM
    Dim isPar2 As Object ' ksRDimSourceParam
    Set isPar2 = iaDim.GetSPar()
    isPar2.rad = 100
    iKompasObject.ksMessage "Поменяем параметры"
    doc.ksDeleteObj (cir)
    doc.ksCircle 100, 100, 100, 1
    doc.ksSetObjParam obj, iaDim, ALLPARAM
  End If
End Sub
Sub DrawViewPointer(doc As Object)
  Dim iviewPoint As Object ' ksViewPointerParam
  Set iviewPoint = iKompasObject.GetParamStruct(ko_ViewPointerParam)
  Dim iItemPar As Object ' ksTextItemParam
  Set iItemPar = iKompasObject.GetParamStruct(ko_TextItemParam)
  Dim itFont As Object '
  Set itFont = iItemPar.GetItemFont()
  If Not iviewPoint Is Nothing And Not iItemPar Is Nothing And Not itFont Is Nothing Then
    iviewPoint.Init
    iItemPar.Init
    itFont.Init

    iviewPoint.X1 = 55
    iviewPoint.Y1 = 50
    iviewPoint.X2 = 40
    iviewPoint.Y2 = 50
    iviewPoint.xt = 40
    iviewPoint.yt = 52
    iviewPoint.Type = 0
    iviewPoint.Str = "стрелка"

    Dim p As Long
    obj = doc.ksViewPointer(iviewPoint)
    If obj Then
      doc.ksGetObjParam obj, iviewPoint, ALLPARAM
      iviewPoint.Type = 0
      iviewPoint.Str = "стрелка вида"
      iKompasObject.ksMessage "Поменяем параметры"
      doc.ksSetObjParam obj, iviewPoint, ALLPARAM
    End If
  End If
End Sub

' GetLibraryName

Public Function GetLibraryName() As String
  GetLibraryName = "Размеры и другие технологические объекты"
End Function

' ExternalMenuItem

Public Function ExternalMenuItem(ByVal number As Integer, itemType As Integer, command As Integer) As String
  itemType = 1 'MENUITEM'
  
  Select Case number
    Case 1
      ExternalMenuItem = "Линейный размер"
      command = 1
    Case 2
      ExternalMenuItem = "Угловой  размер"
      command = 2
    Case 3
      ExternalMenuItem = "Шероховатость"
      command = 3
    Case 4
      ExternalMenuItem = "Линия выноски"
      command = 4
    Case 5
      ExternalMenuItem = "Позиционная линия выноски"
      command = 5
    Case 6
      ExternalMenuItem = "Клеймение"
      command = 6
    Case 7
      ExternalMenuItem = "Маркирование"
      command = 7
    Case 8
      ExternalMenuItem = "Обозначение базы"
      command = 8
    Case 9
      ExternalMenuItem = "Линия разреза/cечения"
      command = 9
    Case 10
      ExternalMenuItem = "Диаметральный размер"
      command = 10
    Case 11
      ExternalMenuItem = "Радиальный размер"
      command = 11
    Case 12
      ExternalMenuItem = "Радиальный размер с изломом"
      command = 12
    Case 13
      ExternalMenuItem = "Стрелка вида"
      command = 13
    Case 14
      itemType = 3 'ENDMENU'
      ExternalMenuItem = ""
      command = -1
  End Select
End Function

' ExternalRunCommand

Public Sub ExternalRunCommand(ByVal command As Integer, ByVal mode As Integer, ByVal Kompas As Object)
  Set iKompasObject = Kompas
  
  If iKompasObject Is Nothing Then
    Exit Sub
  End If
  
  Dim iDocument2D As Object 'ksDocument2D
  Set iDocument2D = iKompasObject.ActiveDocument2D
  
  If iDocument2D Is Nothing Then
    Exit Sub
  End If
  
Select Case command
    Case 1
      DrawLinDim iDocument2D          ' Линейный размер
    Case 2
      DrawAngDim iDocument2D          ' Угловой  размер
    Case 3
      DrawRough iDocument2D           ' Шероховатость
    Case 4
      DrawLeader iDocument2D          ' Линия выноски
    Case 5
      DrawPosLeader iDocument2D       ' Позиционная линия выноски
    Case 6
      DrawBrandLeader iDocument2D     ' Клеймение
    Case 7
      DrawMarkerLeader iDocument2D    ' Маркирование
    Case 8
      DrawBase iDocument2D            ' Обозначение базы
    Case 9
      DrawCutLine iDocument2D         ' Линия разреза/cечения
    Case 10
      DrawDiamDim iDocument2D         ' Диаметральный размер
    Case 11
      DrawRadDimt iDocument2D         ' Радиальный размер
    Case 12
      DrawRadBreakDimt iDocument2D    ' Радиальный размер с изломом
    Case 13
      DrawViewPointer iDocument2D     ' Стрелка вида
  End Select
  
  iKompasObject.ksMessageBoxResult
  
End Sub