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 DrawTransform(doc As Object) ' трансформация объекта по матрице
  ' трансформация  рабочей группы
  doc.ksMtr -30, -30, 0, 1, 1
  Dim ref As Long
  ref = doc.ksNewGroup(0)
  doc.ksLineSeg 30, 30, 60, 30, 1
  doc.ksLineSeg 60, 30, 60, 60, 1
  doc.ksLineSeg 60, 60, 30, 60, 1
  doc.ksLineSeg 30, 60, 30, 30, 1
  doc.ksHatch 0, 45, 2, 0, 0, 0
    doc.ksLineSeg 30, 30, 60, 30, 1
    doc.ksLineSeg 60, 30, 60, 60, 1
    doc.ksLineSeg 60, 60, 30, 60, 1
    doc.ksLineSeg 30, 60, 30, 30, 1
  doc.ksEndObj
  doc.ksEndGroup
  doc.ksDeleteMtr

  iKompasObject.ksMessage "создали матрицу 20, 20, 45, 2"

  doc.ksMtr 20, 20, 45, 2, 2
  doc.ksTransformObj ref
  doc.ksDeleteMtr

  iKompasObject.ksMessageBoxResult
  iKompasObject.ksMessage "вернем обратно"

  doc.ksMtr -20, -20, 0, 1, 1
  doc.ksTransformObj ref
  doc.ksDeleteMtr

  doc.ksMtr 0, 0, 0, 0.5, 0.5
  doc.ksTransformObj ref
  doc.ksDeleteMtr

  doc.ksMtr 0, 0, -45, 1, 1
  doc.ksTransformObj ref
  doc.ksDeleteMtr
End Sub
       
Sub DrawCopy(doc As Object)  ' копирование объекта
  Dim iPar As Object
  Set iPar = iKompasObject.GetParamStruct(ko_ViewParam)

  If Not iPar Is Nothing Then
    iPar.Init
    iPar.x = 20
    iPar.y = 60
    iPar.scale_ = 1
    iPar.COLOR = RGB(10, 20, 10)
    iPar.state = stACTIVE
    iPar.Name = "user view"

    Dim number As Long
    number = 5
    ' создали вид
    Dim v As Long
    v = doc.ksCreateSheetView(iPar, number)
    ' создали слой
    doc.ksLayer 5

    doc.ksLineSeg 20, 10, 20, 30, 1
    doc.ksLineSeg 20, 30, 40, 30, 1
    doc.ksLineSeg 40, 30, 40, 10, 1
    doc.ksLineSeg 40, 10, 20, 10, 1

    ' копируем вид ( для вида точки задаются в листовых координатах )
    doc.ksCopyObj v, 20, 60, 40, 80, 1, 0
  End If
End Sub
Sub DrawSymmetry(doc As Object)   ' симметрия объекта
  Dim grp As Long
  grp = doc.ksNewGroup(0)
    doc.ksLineSeg 20, 10, 20, 30, 1
    doc.ksLineSeg 20, 30, 40, 30, 1
    doc.ksLineSeg 40, 30, 40, 10, 1
    doc.ksLineSeg 40, 10, 20, 10, 1
  doc.ksEndGroup

  doc.ksSymmetryObj grp, 40, 10, 40, 20, "1"
End Sub
Sub EditTolerance(doc As Object)    ' просмотр допуска формы
  ' редактирование допуска формы
  Dim pObj As Long

  Dim iInfo As Object
  Set iInfo = iKompasObject.GetParamStruct(ko_RequestInfo)
  
  If Not iInfo Is Nothing Then
    Dim x As Double
    Dim y As Double
    iInfo.prompt = "Укажите допуск формы"
    Dim j As Long
    j = doc.ksCursor(iInfo, x, y, Nothing)
    If j Then
      pObj = doc.ksFindObj(x, y, 1000000)
      If j And doc.ksExistObj(pObj) Then
        ' узнаем тип объекта
        Dim typeObj As Integer
        typeObj = doc.ksGetObjParam(pObj, Nothing, 0)      ' указатель на графический объект
        If typeObj = TOLERANCE_OBJ Then
          Dim numb As Long
          Dim buf As String
          ' открыть допуск формы для редактирования
          doc.ksOpenTolerance pObj
          Dim iPar As Object
          Set iPar = iKompasObject.GetParamStruct(ko_ToleranceParam)
          If Not iPar Is Nothing Then
            ' параметры допуска формы
            doc.ksGetObjParam pObj, iPar, ALLPARAM
            iKompasObject.ksMessage "базовая точка = " & iPar.tBase & " стиль = " & iPar.Style & " расположение " & iPar.Type & " x = " & iPar.x & " y = " & iPar.y
            Dim iPar2 As Object
            Set iPar2 = iKompasObject.GetParamStruct(ko_TextLineParam)
            If Not iPar2 Is Nothing Then
              iPar2.Init
              ' в цикле будем брать все существующие ячейки
              Do While (doc.ksGetToleranceColumnText(numb, iPar2))
                iKompasObject.ksMessage "номер = " & numb & " стиль = " & iPar2.Style
                Dim iArrpTextItem As Object ' ksDynamicArray
                Set iArrpTextItem = iPar2.GetTextItemArr
                Dim iItem As Object ' ksTextItemParam
                Set iItem = iKompasObject.GetParamStruct(ko_TextItemParam)
                If Not iArrpTextItem Is Nothing And Not iItem Is Nothing Then
                  iItem.Init
                  For j = 0 To iArrpTextItem.ksGetArrayCount - 1
                    iArrpTextItem.ksGetArrayItem j, iItem
                    Dim iTextItemFont As Object ' ksTextItemFont
                    Set iTextItemFont = iItem.GetItemFont
                    If iItem.Type Then
                      iKompasObject.ksMessage "компонента = " & j & " тип = " & iItem.Type & " номер спецзнака = " & iItem.iSNumb
                    Else
                      iKompasObject.ksMessage "компонента = " & j & " h = " & iTextItemFont.HEIGHT & " s = " & iItem.s & " fontName = " & iTextItemFont.FontName & " битвектор = " & iTextItemFont.bitVector
                    End If
                    iItem.s = "Допуск формы"
                    iArrpTextItem.ksSetArrayItem j, iItem
                  Next
                  doc.ksSetToleranceColumnText numb, iPar2
                  iArrpTextItem.ksDeleteArray  ' удалим массив компонент
                End If
              Loop
              ' заменим параметры
              iPar.x = iPar.x + 10
              iPar.y = iPar.y + 10
              doc.ksSetObjParam pObj, iPar, ALLPARAM
              doc.ksEndObj ' закрыли объект "допуск формы"
            End If
          End If
        Else
          iKompasObject.ksError "это не допуск формы"
        End If
      Else
        iKompasObject.ksError "нет объекта"
      End If
    End If
  End If
End Sub
Sub EditTolerance1(doc As Object)     ' редактирование допуска формы

End Sub
Sub EditTable(doc As Object)      ' просмотр таблицы
  ' редактирование таблицы
  Dim pObj As Long
  Dim iInfo As Object
  Set iInfo = iKompasObject.GetParamStruct(ko_RequestInfo)
  If Not iInfo Is Nothing Then
    Dim x As Double
    Dim y As Double
    iInfo.prompt = "Укажите таблицу"
    ' взять таблицу на чертеже
    Dim j As Long
    j = doc.ksCursor(iInfo, x, y, Nothing)
    If j Then
      pObj = doc.ksFindObj(x, y, 100000)
      If j And doc.ksExistObj(pObj) Then
        ' узнаем тип объекта
        Dim typeObj As Integer
        typeObj = doc.ksGetObjParam(pObj, Nothing, 0)      ' указатель на графический объект
        ' проверить полученный объкет  - таблица
        If typeObj = TABLE_OBJ Then
          Dim numb As Long
          ' открыть таблицу для редактирования
          doc.ksOpenTable pObj
          Dim iPar As Object ' ksTextParam
          Set iPar = iKompasObject.GetParamStruct(ko_TextParam)
          If Not iPar Is Nothing Then
            iPar.Init
            ' в цикле будем брать все существующие ячейки
            Do While ((doc.ksGetTableColumnText(numb, iPar)))
              iKompasObject.ksMessage "numb = " & numb
              Dim iArrpLineText As Object ' ksDynamicArray
              Set iArrpLineText = iPar.GetTextLineArr
              Dim iItemLineText As Object ' ksTextLineParam
              Set iItemLineText = iKompasObject.GetParamStruct(ko_TextLineParam)
              If Not iItemLineText Is Nothing And Not iArrpLineText Is Nothing Then
                iItemLineText.Init
                For i = 0 To iArrpLineText.ksGetArrayCount - 1
                  iArrpLineText.ksGetArrayItem i, iItemLineText
                  iKompasObject.ksMessage "i = " & i & " style = " & iItemLineText.Style
                  Dim iArrpTextItem As Object
                  Set iArrpTextItem = iItemLineText.GetTextItemArr
                  Dim iItem As Object
                  Set iItem = iKompasObject.GetParamStruct(ko_TextItemParam)
                  iItem.Init
                  If Not iItem Is Nothing And Not iArrpTextItem Is Nothing Then
                    For j = 0 To iArrpTextItem.ksGetArrayCount - 1
                      iArrpTextItem.ksGetArrayItem j, iItem
                      Dim iTextItemFont As Object ' ksTextItemFont
                      Set iTextItemFont = iItem.GetItemFont
                      If iItem.Type Then
                        iKompasObject.ksMessage "компонента = " & j & " тип = " & iItem.Type & " номер спецзнака = " & iItem.GetISNumb
                      Else
                        iKompasObject.ksMessage "компонента = " & j & " h = " & iTextItemFont.HEIGHT & " s = " & iItem.s & " fontName = " & iTextItemFont.FontName & " битвектор = " & iTextItemFont.bitVector
                      End If
                    Next
                    iArrpTextItem.ksDeleteArray  ' очистим массив компонент
                  End If
                Next
                ' очистим массив текстовых строк
                iArrpLineText.ksDeleteArray
              End If
            Loop
            ' берем ячейку 2
            doc.ksColumnNumber 2
            doc.ksText 0, 0, 0, 5, 1, 0, "вторая ячейка"
  
            doc.ksDivideTableItem 3, 1, 2
            doc.ksColumnNumber 4
            doc.ksText 0, 0, 0, 5, 1, 0, "4"
  
            doc.ksEndObj ' закрыли объект "таблица"
          End If
        Else
          iKompasObject.ksError "это не таблица"
        End If
      Else
        iKompasObject.ksError "нет объекта"
      End If
    End If
  End If
End Sub
Sub EditTable1(doc As Object)       ' редактирование таблицы

End Sub
Sub EditStamp(doc As Object)        ' взять тексты граф и редактировать штамп
  Dim iStamp As Object ' ksStamp
  Set iStamp = doc.GetStamp()
  If Not iStamp Is Nothing And iStamp.ksOpenStamp Then
    Dim numb As Long
    ' в цикле будем брать все существующие графы
    Dim iArr As Object ' ksDynamicArray
    Set iArr = iStamp.ksGetStampColumnText(numb)
    Do While Not iArr Is Nothing 'numb
      iKompasObject.ksMessage "numb = " & numb
      Dim iArrpLineText As Object ' ksDynamicArray
      Set iArrpLineText = iKompasObject.GetDynamicArray(TEXT_LINE_ARR)
      Dim iItemLineText As Object ' ksTextLineParam
      Set iItemLineText = iKompasObject.GetParamStruct(ko_TextLineParam)
      iItemLineText.Init
      If Not iItemLineText Is Nothing And Not iArrpLineText Is Nothing And Not iArr Is Nothing Then
        Dim count As Integer
        count = iArr.ksGetArrayCount
        For i = 0 To count - 1 'iArr.ksGetArrayCount - 1
          iArr.ksGetArrayItem i, iItemLineText
          iKompasObject.ksMessage "номер ячейки = " & i & " стиль = " & iItemLineText.Style
          Dim iArrpTextItem As Object ' ksDynamicArray
          Set iArrpTextItem = iItemLineText.GetTextItemArr
          Dim iItem As Object
          Set iItem = iKompasObject.GetParamStruct(ko_TextItemParam)
          iItem.Init
          If Not iArrpTextItem Is Nothing And Not iItem Is Nothing Then
            For j = 0 To iArrpTextItem.ksGetArrayCount - 1
              iArrpTextItem.ksGetArrayItem j, iItem
              Dim iTextItemFont As Object ' ksTextItemFont
              Set iTextItemFont = iItem.GetItemFont
              iKompasObject.ksMessage "компонента = " & j & " h = " & iTextItemFont.HEIGHT & " s = " & iItem.s & " fontName = " & iTextItemFont.FontName
            Next
            iArrpTextItem.ksDeleteArray  ' очистим массив компонент
          End If
        Next
        ' очистим массив текстовых строк
        iArrpLineText.ksDeleteArray
        iArr.ksDeleteArray
      End If
      Set iArr = iStamp.ksGetStampColumnText(numb)
    Loop
    ' заменим  графу 2
    doc.ksColumnNumber 2
    Dim iItem2 As Object ' ksTextItemParam
    Set iItem2 = iKompasObject.GetParamStruct(ko_TextItemParam)
    iItem2.Init
    Dim iItemFont As Object ' ksTextItemFont
    Set iItemFont = iItem2.GetItemFont()
    If Not iItem2 Is Nothing And Not iItemFont Is Nothing Then
      iItemFont.GetBitVectorValue NEW_LINE ', True
      iItem2.s = "графа 2"
      doc.ksTextLine iItem2
    End If
    iStamp.ksCloseStamp
  Else
    iKompasObject.ksError "Штамп не найден"
  End If
End Sub
Sub GetTextTT(doc As Object)         ' получить текст ТТ
  ' получим указатель на технические трбования
  Dim pTT As Long
  pTT = doc.ksGetReferenceDocumentPart(1)
  Dim iTechnicalDemandParam As Object ' ksTechnicalDemandParam
  Set iTechnicalDemandParam = iKompasObject.GetParamStruct(ko_TechnicalDemandParam)
  If pTT And Not iTechnicalDemandParam Is Nothing Then
    iTechnicalDemandParam.Init
    ' получим параметры описания ТТ
    doc.ksGetObjParam pTT, iTechnicalDemandParam, TECHNICAL_DEMAND_PAR
    Dim ipGab As Object ' ksDynamicArray
    Set ipGab = iTechnicalDemandParam.GetPGab
    Dim count As Integer
    count = ipGab.ksGetArrayCount
    iKompasObject.ksMessage "стиль = " & iTechnicalDemandParam.Style & " число страниц  TT = " & count
    ' создадим массив текстовых строк
    Dim ipTextLine As Object
    Set ipTextLine = iKompasObject.GetDynamicArray(TEXT_LINE_ARR)
    ' пройдемся по листам ТТ и получим текст
    For i = 0 To count - 1
      doc.ksGetObjParam pTT, ipTextLine, i
      Dim iItemLineText As Object
      Set iItemLineText = iKompasObject.GetParamStruct(ko_TextLineParam)
      If Not iItemLineText Is Nothing Then
        iItemLineText.Init
        Dim count1 As Integer
        count1 = ipTextLine.ksGetArrayCount
        For i1 = 0 To count1 - 1
          ipTextLine.ksGetArrayItem i1, iItemLineText
          iKompasObject.ksMessage "компонента = " & i1 & " style = " & iItemLineText.Style
          Dim iArrpTextItem As Object ' ksDynamicArray
          Set iArrpTextItem = iItemLineText.GetTextItemArr
          Dim iItem As Object
          Set iItem = iKompasObject.GetParamStruct(ko_TextItemParam)
          If Not iItem Is Nothing And Not iArrpTextItem Is Nothing Then
            iItem.Init
            Dim count2 As Integer
            count2 = iArrpTextItem.ksGetArrayCount
            For j = 0 To count2 - 1
              iArrpTextItem.ksGetArrayItem j, iItem
              Dim iTextItemFont As Object ' ksTextItemFont
              Set iTextItemFont = iItem.GetItemFont
              iKompasObject.ksMessage "компонента = " & j & " h = " & iTextItemFont.HEIGHT & " s = " & iItem.s & " fontName = " & iTextItemFont.FontName
            Next
            iArrpTextItem.ksDeleteArray ' очистим массив компонент
          End If
        Next
      End If
    Next
    ipTextLine.ksDeleteArray ' очистим массив текстовых строк
  Else
    iKompasObject.ksError "Технических требований нет"
  End If
End Sub
Sub ChangeTechnicalDemand(doc As Object)   ' редактирование TT
  Dim ref As Long
  ref = doc.ksGetReferenceDocumentPart(1)
  Dim iPar As Object ' ksTechnicalDemandParam
  Set iPar = iKompasObject.GetParamStruct(ko_TechnicalDemandParam)
  If doc.ksGetObjParam(ref, iPar, TECHNICAL_DEMAND_PAR) Then
    iKompasObject.ksMessage "число строк TT = " & iPar.strCount
    doc.ksOpenTechnicalDemand iPar.GetPGab, iPar.Style
    Dim iParLine As Object ' ksTextLineParam
    Set iParLine = iKompasObject.GetParamStruct(ko_TextLineParam)
    If Not iParLine Is Nothing Then
      Dim count As Integer
      count = iPar.strCount
      For i = 0 To count - 1
        doc.ksGetObjParam ref, iParLine, TT_FIRST_STR + i
        Dim iParItem As Object ' ksTextItemParam
        Set iParItem = iKompasObject.GetParamStruct(ko_TextItemParam)
        Dim iArr As Object ' ksDynamicArray
        Set iArr = iParLine.GetTextItemArr
        If Not iParItem Is Nothing And Not iArr Is Nothing Then
          Dim count1 As Integer
          count1 = iArr.ksGetArrayCount
          For j = 0 To count1 - 1
            iArr.ksGetArrayItem j, iParItem
            iKompasObject.ksMessage iParItem.s
            iParItem.s = "" & i + 1 & "-я строка"
            iArr.ksSetArrayItem j, iParItem
          Next
        End If
        doc.ksSetObjParam ref, iParLine, TT_FIRST_STR + i
      Next
    End If
    doc.ksCloseTechnicalDemand
  End If
End Sub
Sub ShowInsertFragment(doc As Object)    ' вставка фрагмента
  ' char libName[250];
  Dim res As Long
  res = 1
  ' выберем  библиотеку фрагментов
  Dim libName As String
  Dim buf As String
  libName = iKompasObject.ksChoiceFile("*.lfr", "Библиотки фрагментов(*.lfr)|*.lfr|Все файлы (*.*)|*.*|", 1)
  If Len(libName) Then
    Do While res
      ' выбрать фрагмент в библиотеке фрагментов
      Dim iFr As Object
      Set iFr = iKompasObject.GetFragmentLibrary
      If Not iFr Is Nothing Then
        buf = iFr.ksChoiceFragmentFromLib(libName, res)
        If Len(buf) And res Then
          ' выделим имя вставки
          Dim x As Double, y As Double
          ' подготовим структуры фанома и запросов для Placement
          Dim iRub As Object ' ksPhantom
          Set iRub = iKompasObject.GetParamStruct(ko_Phantom)
          If Not iRub Is Nothing Then
            iRub.Init
            Dim iType As Object
            iRub.phantom = 1
            Set iType = iRub.GetPhantomParam
            If Not iType Is Nothing Then
              iType.Init
              iType.scale_ = 1
              Dim iFragment As Object ' ksFragment
              Set iFragment = doc.GetFragment
              If Not iFragment Is Nothing Then
                ' создадим описание  всавки фрагментов
                Dim pDefFrg As Long
                pDefFrg = iFragment.ksFragmentDefinition(buf, "Вставка фрагмента", 1)
                If pDefFrg Then
                  ' во временную группу положим вставку фрагмента, взятую из библиотеки фрагментов
                  iType.gr = doc.ksNewGroup(1)
                    Dim iPar As Object ' ksPlacementParam
                    Set iPar = iKompasObject.GetParamStruct(ko_PlacementParam)
                    If Not iPar Is Nothing Then
                      iPar.Init
                      iPar.scale_ = 1
                      Dim p As Long
                      p = iFragment.ksInsertFragment(pDefFrg, 0, iPar)
                    End If
                  doc.ksEndGroup
                  Dim j As Integer
                  j = 1
                  Do While j
                    iType.angle = 0
                    Dim ang As Double
                    ang = iType.angle
                    j = doc.ksPlacement(Nothing, x, y, ang, iRub)
                    If j Then
                      doc.ksCopyObj p, 0, 0, x, y, 1, ang
                      ' iType.angle
                    End If
                  Loop
                  doc.ksDeleteObj iType.gr
                End If
                Else
                  iKompasObject.ksError "Ошибка создания описания вставки фрагмента"
              End If
            End If
          End If
        End If
        Else
          iKompasObject.ksError "Имя вставки не определено"
      End If
    Loop
  End If
End Sub


Sub EditFragmentLibrary(doc As Object)     ' работа с библиотекой фрагментов
  'char libName[250];
  ' char buf [250];
  ' выберем  библиотеку фрагментов
  ' выберем  библиотеку фрагментов
  Dim libName As String
  Dim buf As String
  libName = iKompasObject.ksChoiceFile("*.lfr", "Библиотки фрагментов(*.lfr)|*.lfr|Все файлы (*.*)|*.*|", 1)
  If Len(libName) Then
    Dim iInfo As Object ' ksRequestInfo
    Set iInfo = iKompasObject.GetParamStruct(ko_RequestInfo)
    Dim iFr As Object ' ksFragmentLibrary
    Set iFr = iKompasObject.GetFragmentLibrary
    If Not iInfo Is Nothing And Not iFr Is Nothing Then
      iInfo.Init
      iInfo.commandsString = "!Новый_фрагмент !Редактировать_фрагмент !Удалить_фрагмент "
      Dim j As Integer, typeEdit As Integer
      Dim nameFrg As String
      ' CString /*string*/ nameFrg;
      Do While j + 1
        j = doc.ksCommandWindow(iInfo)
        Select Case j
          Case 1  ' Новый_фрагмент
            buf = iKompasObject.ksReadString("Введите имя нового фрагмента", "")
            If Len(buf) Then
              nameFrg = libName
              'if ( buf[0] != '|' )
              '  nameFrg += "|";
              nameFrg = nameFrg & "|" & buf
              typeEdit = 2 ' запустить на редактирование
            Else
              typeEdit = 0
            End If
          Case 2  ' Редактировать_фрагмент
            ' выберем имя файла фрагмента
            Dim res As Long
            buf = iFr.ksChoiceFragmentFromLib(libName, res)
            If res And Len(buf) Then
              nameFrg = buf
              typeEdit = j ' 2- запустить на редактирование, 3-удалить ;
            Else
              typeEdit = 0
            End If
          Case 3  ' Удалить_фрагмент
            ' выберем имя файла фрагмента
            Dim res2 As Long
            buf = iFr.ksChoiceFragmentFromLib(libName, res2)
            If res2 And Len(buf) Then
              nameFrg = buf
              typeEdit = j ' 2- запустить на редактирование, 3-удалить ;
            Else
              typeEdit = 0
            End If
        End Select
        If j > 0 And typeEdit And Not iFr Is Nothing Then
          res = iFr.ksFragmentLibraryOperation(nameFrg, typeEdit)
          If res Then
            If typeEdit = 2 Then
              iFr.ksFragmentLibraryOperation nameFrg, 4
              ' редактируем фрагмент из библиотеки
              doc.ksText 0, 100, 0, 5, 1, 0, "Редактируем фрагмент из библиотеки"
              doc.ksLineSeg 0, 100, 110, 100, 1
              ' редактируем фрагмент в интерактивном режиме
              ' после выбора в меню "Сервис" команды "Закончить редактирование фрагмента",
              ' возвращаемся в библиотеку
              iKompasObject.ksSystemControlStart "Закончить редактирование фрагмента"
              iFr.ksFragmentLibraryOperation nameFrg, 0
            End If
          End If
          Else
            iKompasObject.ksMessageBoxResult
      End If
      Loop
    End If
  End If
End Sub
Sub ShowInsertFragment1(doc As Object)      ' вставка фрагмента россыпью
  Dim frwName As String
  Dim iFr As Object ' ksFragment
  Set iFr = doc.GetFragment
  If Not iFr Is Nothing Then
    ' выберем  фрагмент
    frwName = iKompasObject.ksChoiceFile("*.frw", "фрагменты(*.frw)|*.frw|Все файлы (*.*)|*.*|", 1)
    If Len(frwName) Then
      Dim x As Double, y As Double
      ' подготовим структуры фанома и запросов для Placement
      Dim iRub As Object ' ksPhantom
      Set iRub = iKompasObject.GetParamStruct(ko_Phantom)
      If Not iRub Is Nothing Then
        iRub.Init
        iRub.phantom = 1
        Dim iType As Object ' ksType1
        Set iType = iRub.GetPhantomParam
        If Not iType Is Nothing Then
          iType.Init
          iType.scale_ = 1
          ' во временную группу положим вставку фрагмента, взятую из библиотеки фрагментов
          Dim iPar As Object ' ksPlacementParam
          Set iPar = iKompasObject.GetParamStruct(ko_PlacementParam)
          If Not iPar Is Nothing Then
            iPar.Init
            iPar.scale_ = 1
            Dim j As Integer
            j = 1
            Do While j
              ' если нужно вставить несколько фрагментов, группу лучше порождать новую,
              ' так как вместе с геометрией могут придти атрибуты, объекты спецификации, стили,
              ' которые связаны с геометрией. При простом копировании группы эта связь будет потеряна.
              iType.gr = iFr.ksReadFragmentToGroup(frwName, 0, iPar)
              If iType.gr Then
                Dim ang As Double
                ang = iType.angle
                j = doc.ksPlacement(Nothing, x, y, ang, iRub)
                If j Then
                  ' сдвигаем группу
'                  doc.ksCopyObj p, 0, 0, x, y, 1, ang
                  doc.ksMoveObj iType.gr, x, y
                  If ang > 0.001 Then
                    doc.ksRotateObj iType.gr, x, y, ang
                  End If
                  ' ставим группу в модель
                  doc.ksStoreTmpGroup iType.gr
                  doc.ksClearGroup iType.gr, True
                  doc.ksDeleteObj iType.gr
                End If
              Else
                If iType.gr Then
                  doc.ksDeleteObj iType.gr
                End If
                j = 0
              End If
            Loop
          End If
        End If
      End If
    End If
  End If
End Sub


Public Sub ExtractFromListBox() 'hControl As Long)

'Dim sBuf As String * 50
'Dim cBuf As Long

'cBuf = "12 34 56"
'sBuf = String$(cBuf + 1, "t")
'iKompasObject.ksError sBuf

'Dim s As String
's = "helpmeplease"
'iKompasObject.ksError s
's = s & "z"
'For i = 1 To 20
'  iKompasObject.ksError s(i) 'MidB(s, i)
'Next
'Dim arrArgVal As String
'arrArgVal = "qwert"
'sBuf = lstrcat(s, arrArgVal)
'iKompasObject.ksError sBuf
'For i = 1 To UBound(arrArgVal) - 1 Step 2
'iKompasObject.ksMessage arrArgVal(i)
'            strSQL = strSQL & Trim$(Right$(arrArgVal(i), _
'                Len(arrArgVal(i)) - 3)) & ","
'Next
        
'Dim z As String
'z = "qwert"
'Dim x As String
'x = "asdfg"
'Dim res As String
'res = lstrcat(z, x)
'iKompasObject.ksMessage z

'Dim k As Long
'InStr 1, "qwert", "w", res

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 = "Tрансформация объекта"
      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 = "Вставка фрагмента из библиотеки фрагментов"
      command = 9
    Case 10
      ExternalMenuItem = "Работа с библиотекой фрагментов"
      command = 10
    Case 11
      ExternalMenuItem = "Вставка фрагмента россыпью"
      command = 11
    Case 12
      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
      DrawTransform iDocument2D          ' трансформация объекта по матрице
    Case 2
      DrawCopy iDocument2D               ' копирование объекта
    Case 3
      DrawSymmetry iDocument2D           ' симметрия объекта
    Case 4
      EditTolerance iDocument2D          ' просмотр допуска формы
    Case 5
      EditTable iDocument2D              ' просмотр таблицы
    Case 6
      EditStamp iDocument2D              ' взять тексты граф и редактировать штамп
    Case 7
      GetTextTT iDocument2D              ' получить текст ТТ
    Case 8
      ChangeTechnicalDemand iDocument2D  ' редактирование TT
    Case 9
      ShowInsertFragment iDocument2D     ' вставка фрагмента
    Case 10
      EditFragmentLibrary iDocument2D    ' работа с библиотекой фрагментов
    Case 11
      ShowInsertFragment1 iDocument2D    ' вставка фрагмента россыпью
  End Select
  
  iKompasObject.ksMessageBoxResult
  
End Sub