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
Dim doc As Object 'ksDocument2D
Sub WalkFromView(doc As Object) ' хождение по виду
  ' в текущем документе и виде создадим итератор для хождения по всем элементам
  Dim obj As Long
  Dim count As Integer
  count = 0
  Dim iIter As Object ' ksIterator
  Set iIter = iKompasObject.GetIterator
  iIter.ksCreateIterator ALL_OBJ, 0
  If iIter.reference Then
    obj = iIter.ksMoveIterator("F")
    If doc.ksExistObj(obj) Then
      Do
        doc.ksLightObj obj, 1
        count = count + 1
        iKompasObject.ksMessage "номер = " & count
        doc.ksLightObj obj, 0
        obj = iIter.ksMoveIterator("N")
      Loop Until doc.ksExistObj(obj) = 0
    End If
  End If
End Sub
Sub UserLightObj(obj As Long, c As Boolean, count As Integer, doc As Object)   ' подсветка элемента
  doc.ksLightObj obj, 1
  If c Then
    iKompasObject.ksMessage "номер макро= " & count
  Else
    iKompasObject.ksMessage "номер объекта= " & count
  End If
  doc.ksLightObj obj, 0
End Sub
Sub WalkFromMacro(doc As Object) ' хождение по макроэлементу
  ' в текущем документе и виде создадим итератор для хождения по макроэлементам
  Dim obj As Long, macro As Long
  Dim count As Integer, count1 As Integer
  count = 0
  count1 = 0
  Dim iIter As Object ' ksIterator
  Set iIter = iKompasObject.GetIterator
  iIter.ksCreateIterator MACRO_OBJ, 0
  If iIter.reference Then
    macro = iIter.ksMoveIterator("F")
    If doc.ksExistObj(macro) Then
      Do
        count = count + 1
        UserLightObj macro, True, count, doc ' подсветим макроэлемент
        Dim iIter2 As Object ' ksIterator
        Set iIter2 = iKompasObject.GetIterator ' создаем итератор для хождения по макроэлементу
        iIter2.ksCreateIterator ALL_OBJ, macro
        If iIter2.reference Then
          obj = iIter2.ksMoveIterator("F")
          If doc.ksExistObj(obj) Then
            Do
              count1 = count1 + 1
              UserLightObj obj, False, count, doc ' подсветим объек макроэлемента
              obj = iIter2.ksMoveIterator("N")
            Loop Until doc.ksExistObj(obj) = 0
          End If
        End If
        macro = iIter.ksMoveIterator("N")
      Loop Until doc.ksExistObj(macro) = 0
    End If
  End If
  If count = 0 Then
    iKompasObject.ksError "Макроэлементы в документе отсутствуют"
  End If
End Sub


Sub WalkFromDoc(doc As Object)              ' хождение по документам
  Dim pDoc As Long
  Dim idocPar As Object ' ksDocumentParam
  Set idocPar = iKompasObject.GetParamStruct(ko_DocumentParam)
  
  If Not idocPar Is Nothing Then
    idocPar.Init
    idocPar.comment = "create document"
    idocPar.author = "Misha"
    idocPar.regime = 0
    idocPar.Type = 1
    
    Dim isheetPar As Object ' ksSheetPar
    Set isheetPar = idocPar.GetLayoutParam
    isheetPar.shtType = lt_DocSheetStandart
  
    Dim istSheet As Object ' ksStandartSheet
    Set istSheet = isheetPar.GetSheetParam
    If Not isheetPar Is Nothing And Not istSheet Is Nothing Then
      isheetPar.Init
      istSheet.Init
      
      isheetPar.layoutName = ""
      isheetPar.shtType = 1
      istSheet.Format = 3
      istSheet.multiply = 1
      istSheet.direct = 0
  
      idocPar.FileName = "a.cdw"
      doc.ksCreateDocument idocPar
      idocPar.FileName = "b.cdw"
      doc.ksCreateDocument idocPar
      idocPar.FileName = "c.cdw"
      doc.ksCreateDocument idocPar
  
      Dim count As Integer
      Dim iIter As Object ' ksIterator
      Set iIter = iKompasObject.GetIterator
      iIter.ksCreateIterator DOCUMENT_OBJ, 0  ' создаем итератор для хождения по документам
      If iIter.reference Then
        pDoc = iIter.ksMoveIterator("F")
        If pDoc Then
          Do
            doc.reference = pDoc
            If doc.ksSetObjParam(pDoc, Nothing, DOCUMENT_STATE) Then  ' активизируем документ pDoc
              count = count + 1
              Dim iviewPar As Object ' ksViewParam
              Set iviewPar = iKompasObject.GetParamStruct(ko_ViewParam)
              If Not iviewPar Is Nothing Then
                iviewPar.Init
                Dim number As Long
                number = count
                iviewPar.x = 10
                iviewPar.y = 20
                iviewPar.scale_ = 1
                iviewPar.angle = 0
                iviewPar.COLOR = RGB(10, 20, 10)
                iviewPar.state = stACTIVE
                iviewPar.Name = "user view"
    
                doc.ksCreateSheetView iviewPar, number ' создадим вид в документе
                doc.ksLayer count  ' откроем слой
                Select Case count
                  Case 1
                    doc.ksLineSeg 20, 10, 40, 10, 1  ' в первом документе создадим отрезок
                  Case 2
                    doc.ksCircle 50, 50, 20, 1  ' во втором документе создадим окружность
                  Case 3
                    doc.ksArcByAngle 50, 50, 20, 45, 135, 1, 1 ' в третьем документе создадим  дугу
                End Select
                iKompasObject.ksMessage "документ " & count
              End If
            End If
            pDoc = iIter.ksMoveIterator("N")
          Loop Until pDoc = 0
        End If
      End If
    End If
  End If
End Sub


Sub WalkViewDoc(doc As Object) ' хождение по видам
  Dim idocPar As Object ' ksDocumentParam
  Set idocPar = iKompasObject.GetParamStruct(ko_DocumentParam)
  If Not idocPar Is Nothing Then
    idocPar.Init
    idocPar.comment = "create document"
    idocPar.author = "Misha"
    idocPar.regime = 0
    idocPar.Type = 1
    
    Dim isheetPar As Object ' ksSheetPar
    Set isheetPar = idocPar.GetLayoutParam
    Dim istSheet As Object ' ksStandartSheet
    Set istSheet = isheetPar.GetSheetParam()
    If Not isheetPar Is Nothing And Not istSheet Is Nothing Then
      isheetPar.Init
      istSheet.Init
      
      isheetPar.layoutName = ""
      isheetPar.shtType = 1
      istSheet.Format = 3
      istSheet.multiply = 1
      istSheet.direct = 0
    
      idocPar.FileName = "a.cdw"
      doc.ksCreateDocument idocPar
      
      ' создадим 5 видов
      Dim iviewPar As Object ' ksViewParam
      Set iviewPar = iKompasObject.GetParamStruct(ko_ViewParam)
      If Not iviewPar Is Nothing Then
        For i = 0 To 5
            iviewPar.Init
        
            Dim number As Long
            number = 0
            iviewPar.x = 10
            iviewPar.y = 20
            iviewPar.scale_ = 1
            iviewPar.angle = 0
            iviewPar.COLOR = RGB(10, 20, 10)
            iviewPar.state = stACTIVE
            iviewPar.Name = "user view"
        
            doc.ksCreateSheetView iviewPar, number ' создадим вид в документе
            ' number = number + 1
        Next
      End If
    
      Dim pView As Long
      Dim count As Integer
      Dim iIter As Object ' ksIterator
      Set iIter = iKompasObject.GetIterator
      iIter.ksCreateIterator VIEW_OBJ, 0 ' создадим итератор для навигации по видам в документе
      If iIter.reference Then
        pView = iIter.ksMoveIterator("F")
        If pView Then
          Do
            Dim state As Long
            state = stCURRENT
            Dim ivar As Object
            Set ivar = iKompasObject.GetParamStruct(ko_LtVariant)
            If Not ivar Is Nothing Then
              ivar.Init
              
              ivar.intVal = stCURRENT
              If doc.ksSetObjParam(pView, ivar, VIEW_LAYER_STATE) Then
                Select Case count
                  Case 1:
                    doc.ksLineSeg 20, 20, 40, 20, 1
                  Case 2:
                    doc.ksCircle 40, 20, 30, 1
                  Case 3:
                    doc.ksArcByAngle 50, 50, 20, 45, 135, 1, 1
                  Case 4:
                    doc.ksMtr 40, 0, 0, 1, 1
                    doc.ksLineSeg 10, 10, 30, 30, 1
                    doc.ksLineSeg 30, 30, 60, 10, 1
                    doc.ksLineSeg 60, 10, 10, 10, 1
                    doc.ksDeleteMtr
                  Case 5:
                    doc.ksCircle 30, 30, 20, 1
                    doc.ksCircle 30, 30, 10, 1
                    doc.ksHatch 0, 45, 2, 0, 0, 0
                      doc.ksCircle 30, 30, 20, 1
                      doc.ksCircle 30, 30, 10, 1
                    doc.ksEndObj
                End Select
              End If
              count = count + 1
            End If
            pView = iIter.ksMoveIterator("N")
          Loop Until pView = 0
        End If
      End If
    End If
  End If
End Sub
Sub WalkGroup(doc As Object) ' хождение по именнованным и рабочим группам
  Dim pNameGrp As Long
  Dim count As Integer
  count = 0
  Dim iIter As Object ' ksIterator
  Set iIter = iKompasObject.GetIterator
  iIter.ksCreateIterator NAME_GROUP_OBJ, 0 ' создадим итератор для движения по именнованным группам в документе
  If iIter.reference Then
    pNameGrp = iIter.ksMoveIterator("F")
    If pNameGrp Then
      Do
        doc.ksLightObj pNameGrp, 1 ' подсветим группу
        count = count + 1
        iKompasObject.ksMessage "номер = " & count
        doc.ksLightObj pNameGrp, 0   ' снимем подсветку
        pNameGrp = iIter.ksMoveIterator("N")
      Loop Until pNameGrp = 0
    End If
  End If
  iIter.ksDeleteIterator
  ' все именнованные группы ложатся в массив рабочих групп
  doc.ksNewGroup 0
    doc.ksCircle 30, 30, 20, 1
    doc.ksCircle 30, 30, 10, 1
    doc.ksHatch 0, 45, 2, 0, 0, 0
      doc.ksCircle 30, 30, 20, 1
      doc.ksCircle 30, 30, 10, 1
    doc.ksEndObj
  doc.ksEndGroup

  ' создать итератор по рабочим группам
  count = 0
  Dim pWorkGrp As Long
  iIter.ksCreateIterator WORK_GROUP_OBJ, 0 ' создадим итератор для движения по именнованным группам в документе
  If iIter.reference Then
    pWorkGrp = iIter.ksMoveIterator("F")
    If pWorkGrp Then
      Do
        doc.ksLightObj pWorkGrp, 1 ' подсветим группу
        count = count + 1
        iKompasObject.ksMessage "номер = " & count
        doc.ksLightObj pWorkGrp, 0 ' снимем подсветку
        pWorkGrp = iIter.ksMoveIterator("N")
      Loop Until pWorkGrp = 0
    End If
  End If
End Sub

Sub WalkLayer(doc As Object) ' хождение по слоям
  Dim idocPar As Object ' ksDocumentParam
  Set idocPar = iKompasObject.GetParamStruct(ko_DocumentParam)
  
  If Not idocPar Is Nothing Then
    idocPar.Init
    idocPar.comment = "create document"
    idocPar.author = "Misha"
    idocPar.regime = 0
    idocPar.Type = 1
    Dim isheetPar As Object ' ksSheetPar
    Set isheetPar = idocPar.GetLayoutParam
    Dim istSheet As Object ' ksStandartSheet
    Set istSheet = isheetPar.GetSheetParam()
    If Not isheetPar Is Nothing And Not istSheet Is Nothing Then
      isheetPar.Init
      istSheet.Init
      
      isheetPar.layoutName = ""
      isheetPar.shtType = 1
      istSheet.Format = 3
      istSheet.multiply = 1
      istSheet.direct = 0
    
      idocPar.FileName = "a.cdw"
      doc.ksCreateDocument idocPar
      
      ' создадим 5 слоев
      For i = 0 To 5
        doc.ksLayer i
        doc.ksCircle 30, 30, 5 + i * 10, 1
      Next
  
      Dim pLayer As Long
      Dim iIter As Object ' ksIterator
      Set iIter = iKompasObject.GetIterator
      iIter.ksCreateIterator LAYER_OBJ, 0 ' создаем итератор по слоям
      If iIter.reference Then
        pLayer = iIter.ksMoveIterator("F")
        count = 0
        If pLayer Then
          Do
            doc.ksLightObj pLayer, 1 ' подсветим группу
            iKompasObject.ksMessage "номер = " & count
            doc.ksLightObj pLayer, 0 ' снимем подсветку
            count = count + 1
            pLayer = iIter.ksMoveIterator("N")
          Loop Until pLayer = 0
        End If
      End If
    End If
  End If
End Sub


Sub WalkFromGroup(doc As Object) ' хождение по группе
  doc.ksMtr 20, 10, 0, 1, 1
  Dim pGrp As Long
  pGrp = doc.ksNewGroup(0)
    doc.ksLineSeg 10, 50, 50, 50, 1
    doc.ksLineSeg 10, 10, 50, 10, 1
    doc.ksLineSeg 10, 10, 10, 50, 1
    doc.ksLineSeg 50, 10, 50, 50, 1
    doc.ksCircle 30, 30, 20, 1
    doc.ksCircle 30, 30, 10, 1
    doc.ksHatch 0, 45, 2, 0, 0, 0
      doc.ksCircle 30, 30, 20, 1
      doc.ksCircle 30, 30, 10, 1
    doc.ksEndObj
  doc.ksEndGroup
  doc.ksDeleteMtr
  
  Dim obj As Long
  Dim iIter As Object ' ksIterator
  Set iIter = iKompasObject.GetIterator()
  iIter.ksCreateIterator ALL_OBJ, pGrp ' создать итератор для хождения по группе
  If iIter.reference Then
    obj = iIter.ksMoveIterator("F")
    Dim coutn As Integer
    count = 0
    If doc.ksExistObj(obj) Then
      Do
        doc.ksLightObj obj, 1
        count = count + 1
        iKompasObject.ksMessage "номер = " & count
        doc.ksLightObj obj, 0
        obj = iIter.ksMoveIterator("N")
      Loop Until doc.ksExistObj(obj) = 0
    End If
  End If
End Sub


Sub WalkFromDocWithAttr(doc As Object) ' хождение по элементам документа с определенным атрибутом
  Dim iattr As Object ' ksAttributeObject
  Set iattr = iKompasObject.GetAttributeObject()
  If Not iattr Is Nothing Then

    Dim pObj As Long, pAttr As Long
    Dim iIter As Object ' ksIterator
    Set iIter = iKompasObject.GetIterator
    iIter.ksCreateAttrIterator 0, 10, 0, 0, 0, 0 ' создадим итератор для поиска объектов по ключу 10
    If iIter.reference Then
      pAttr = iIter.ksMoveAttrIterator("F", pObj)
      Dim count As Integer
      count = 0
      Dim rowsCount As Long, columnsCount As Long
      If doc.ksExistObj(pObj) Then
        Do
          doc.ksLightObj pObj, 1
          count = count + 1
          ' узнаем количество строк и колонок
          If iattr.ksGetAttrTabInfo(pAttr, rowsCount, columnsCount) Then
            iKompasObject.ksMessage "номер = " & count & "rowsCount = " & rowsCount & "columnsCount = " & columnsCount
          Else
            iKompasObject.ksMessageBoxResult ' неудачное завершение - выдадим результат работы нашей функции
          End If
          doc.ksLightObj pObj, 0
          pAttr = iIter.ksMoveAttrIterator("N", pObj)
        Loop Until doc.ksExistObj(pObj) = 0
      End If
    End If
  End If
End Sub
Sub WalkFromObjWithAttr(doc As Object) ' хождение по атрибутам объекта
  Dim x As Double, y As Double
  Dim j As Integer
  Dim pObj As Long
  Dim iinfo As Object ' ksRequestInfo
  Set iinfo = iKompasObject.GetParamStruct(ko_RequestInfo)
  Dim iattr As Object ' ksAttributeObject
  Set iattr = iKompasObject.GetAttributeObject()
  If Not iinfo Is Nothing And Not iattr Is Nothing Then
    iinfo.Init
  
    iinfo.prompt = "Укажите объект"
    Do
      j = doc.ksCursor(iinfo, x, y, Nothing)
      If j Then
        pObj = doc.ksFindObj(x, y, 1000000#)
        If doc.ksExistObj(pObj) Then
          Dim count As Integer
          count = 0
          Dim rowsCount As Long, columnsCount As Long
          doc.ksLightObj pObj, 1
  
          Dim pAttr As Long
          Dim iIter As Object ' ksIterator
          Set iIter = iKompasObject.GetIterator
          Dim iterat As Long
          iterat = iIter.ksCreateAttrIterator(pObj, 10, 0, 0, 0, 0)   ' создадим итератор для поиска объектов по ключу 10
          If iIter.reference Then
            Dim ref As Long
            pAttr = iIter.ksMoveAttrIterator("F", ref)
            If pAttr Then
              Do
                count = count + 1
                ' узнаем количество строк и колонок
                If iattr.ksGetAttrTabInfo(pAttr, rowsCount, columnsCount) Then
                  iKompasObject.ksMessage "номер = " & count & "rowsCount = " & rowsCount & "columnsCount = " & columnsCount
                Else
                  iKompasObject.ksMessageBoxResult ' неудачное завершение - выдадим результат работы нашей функции
                End If
                pAttr = iIter.ksMoveAttrIterator("N", ref)
              Loop Until pAttr = 0
            End If
          End If
          doc.ksLightObj pObj, 0
        End If
      End If
    Loop Until j = 0
  End If
End Sub



' GetLibraryName

Public Function GetLibraryName() As String
  GetLibraryName = "Hавигация по модели"
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 = "Xождение по виду"
      command = 1
    Case 2
      ExternalMenuItem = "Xождение по макроэлементу"
      command = 2
    Case 3
      ExternalMenuItem = "Xождение по документам"
      command = 3
    Case 4
      ExternalMenuItem = "Xождение по видам"
      command = 4
    Case 5
      ExternalMenuItem = "Xождение по группам"
      command = 5
    Case 6
      ExternalMenuItem = "Xождение по слоям"
      command = 6
    Case 7
      ExternalMenuItem = "Xождение по группе"
      command = 7
    Case 8
      ExternalMenuItem = "Xождение по элементам с атрибутом"
      command = 8
    Case 9
      ExternalMenuItem = "Xождение по атрибутам объекта"
      command = 9
    Case 10
      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 doc As Object 'ksDocument2D
  Set doc = iKompasObject.Document2D
  If doc Is Nothing Then
    Exit Sub
  End If
  
  If command = 3 Then
    WalkFromDoc doc                    ' Xождение по документам
  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
      WalkFromView iDocument2D         ' Xождение по виду
    Case 2
      WalkFromMacro iDocument2D        ' Xождение по макроэлементу
    Case 4
      WalkViewDoc iDocument2D          ' Xождение по видам
    Case 5
      WalkGroup iDocument2D            ' Xождение по группам
    Case 6
      WalkLayer iDocument2D            ' Xождение по слоям
    Case 7
      WalkFromGroup iDocument2D        ' Xождение по группе
    Case 8
      WalkFromDocWithAttr iDocument2D  ' Xождение по элементам с атрибутом
    Case 9
      WalkFromObjWithAttr iDocument2D  ' Xождение по атрибутам объекта
  End Select
  
  iKompasObject.ksMessageBoxResult
  
End Sub