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 iDocument2D As Object 'ksDocument2D
Dim iMathematic2D As Object 'ksMathematic2D
Dim iDocument3D As Object 'ksDocument3D

' удалить все объекты из текущего эскиза
Sub ClearCurrentSketch(sketchEdit As Object)    ' ksDocument2D
  ' создаим итератор и удалим все существующие объекты в эскизе
  Dim iter As Object ' ksIterator
  Set iter = iKompasObject.GetIterator
  If Not iter Is Nothing Then
    If iter.ksCreateIterator(ALL_OBJ, 0) Then
      Dim ref As Long
      ref = iter.ksMoveIterator("F") ' сместить указатель на первый элемент в списке
      If ref Then
        Do
          If sketchEdit.ksExistObj(ref) Then
            sketchEdit.ksDeleteObj ref      ' если объект существует удалить его
          End If
          
        ref = iter.ksMoveIterator("N")
        Loop While ref
      End If
     
      iter.ksDeleteIterator ' удалим итератор
    End If
  End If
End Sub

' Операции выдавливания
Sub CreateExtrusion()
  iKompasObject.ksMessage "Операции выдавливания"
  Dim part As Object ' ksPart
  Set part = iDocument3D.GetPart(pNew_Part) ' новый компонент
  If Not part Is Nothing Then
    Dim entitySketch As Object ' ksEntity
    Set entitySketch = part.NewEntity(o3d_sketch)
    If Not entitySketch Is Nothing Then
      ' интерфейс свойств эскиза
      Dim sketchDef As Object ' ksSketchDefinition
      Set sketchDef = entitySketch.GetDefinition()
      If Not sketchDef Is Nothing Then
        ' получим интерфейс базовой плоскости XOY
        Dim basePlane As Object ' ksEntity
        Set basePlane = part.GetDefaultEntity(o3d_planeXOY)
        sketchDef.SetPlane basePlane ' установим плоскость XOY базовой для эскиза
        sketchDef.angle = 45         ' угол поворота эскиза
        entitySketch.Create          ' создадим эскиз

        ' интерфейс редактора эскиза
        Dim sketchEdit As Object ' ksDocument2D
        Set sketchEdit = sketchDef.BeginEdit()
          ' введем новый эскиз - квадрат
          sketchEdit.ksLineSeg 50, 50, -50, 50, 1
          sketchEdit.ksLineSeg 50, -50, -50, -50, 1
          sketchEdit.ksLineSeg 50, -50, 50, 50, 1
          sketchEdit.ksLineSeg -50, -50, -50, 50, 1
        sketchDef.EndEdit   ' завершение редактирования эскиза
  
        Dim entityExtr As Object ' ksEntity
        Set entityExtr = part.NewEntity(o3d_baseExtrusion)
        If Not entityExtr Is Nothing Then
          ' интерфейс свойств базовой операции выдавливания
          Dim extrusionDef As Object ' ksBaseExtrusionDefinition
          Set extrusionDef = entityExtr.GetDefinition ' интерфейс базовой операции выдавливания
          If Not extrusionDef Is Nothing Then
            extrusionDef.directionType = dtNormal            ' направление выдавливания
            extrusionDef.SetSideParam True, etBlind, 200, 0, False
            extrusionDef.SetThinParam True, dtBoth, 10, 10   ' тонкая стенка в два направления
            extrusionDef.SetSketch entitySketch              ' эскиз операции выдавливания
            entityExtr.Create                                ' создать операцию

            iKompasObject.ksMessage "Изменим параметры операции выдавливания"

            extrusionDef.SetSideParam False, etBlind, 150, 0, False
            extrusionDef.directionType = dtBoth  ' направление выдавливания
            entityExtr.Update                    ' обновить параметры

            iKompasObject.ksMessage "Поменяем эскиз"

            Dim sketchEdit2 As Object ' ksDocument2D
            Set sketchEdit2 = sketchDef.BeginEdit

            ' создадим итератор и удалим все существующие объекты в эскизе
            ClearCurrentSketch sketchEdit2
            ' введем в эскиз окружность
            sketchEdit2.ksCircle 0, 0, 100, 1

            sketchDef.EndEdit   ' завершение редактирования эскиза
            entitySketch.Update ' обновить параметры эскиза
            entityExtr.Update   ' обновить параметры операции выдавливания

            iKompasObject.ksMessage "Приклеем выдавливанием"

            ' создадим новый эскиз
            Dim entitySketch3 As Object ' ksEntity
            Set entitySketch3 = part.NewEntity(o3d_sketch)
            If Not entitySketch3 Is Nothing Then
              ' интерфейс свойств эскиза
              Dim sketchDef3 As Object ' ksSketchDefinition
              Set sketchDef3 = entitySketch3.GetDefinition
              If Not sketchDef3 Is Nothing Then
                sketchDef3.SetPlane basePlane ' установим плоскость
                sketchDef3.angle = 45         ' повернем эскиз на 45 град.
                entitySketch3.Create          ' создадим эскиз

                ' интерфейс редактора эскиза
                Dim sketchEdit3 As Object ' ksDocument2D
                Set sketchEdit3 = sketchDef3.BeginEdit
                  sketchEdit3.ksCircle 0, 0, 150, 1
                sketchDef3.EndEdit ' завершение редактирования эскиза

                ' приклеим выдавливанием
                Dim entityBossExtr As Object ' ksEntity
                Set entityBossExtr = part.NewEntity(o3d_bossExtrusion)
                If Not entityBossExtr Is Nothing Then
                  Dim bossExtrDef As Object ' ksBossExtrusionDefinition
                  Set bossExtrDef = entityBossExtr.GetDefinition
                  If Not bossExtrDef Is Nothing Then
                    Dim extrProp As Object ' ksExtrusionProperty
                    Set extrProp = bossExtrDef.ExtrusionParam ' интерфейс структуры параметров выдавливания

                    Dim tninProp As Object
                    Set thinProp = bossExtrDef.ThinParam ' интерфейс структуры параметров тонкой стенки
                    If (Not extrProp Is Nothing) And (Not thinProp Is Nothing) Then
                      bossExtrDef.SetSketch entitySketch3 ' эскиз операции выдавливания

                      extrProp.direction = dtNormal       ' направление выдавливания (прямое)
                      extrProp.typeNormal = etBlind       ' тип выдавливания ( строго на глубину )
                      extrProp.depthNormal = 100          ' глубина выдавливания

                      thinProp.thin = False               ' без тонкой стенки

                      entityBossExtr.Create               ' создадим операцию
                    End If
                  End If
                End If

                ' создадим новый эскиз
                Dim entitySketch4 As Object ' ksEntity
                Set entitySketch4 = part.NewEntity(o3d_sketch)
                If Not entitySketch4 Is Nothing Then
                  ' интерфейс свойств эскиза
                  Dim sketchDef4 As Object ' ksSketchDefinition
                  Set sketchDef4 = entitySketch4.GetDefinition
                  If Not sketchDef4 Is Nothing Then
                    sketchDef4.SetPlane basePlane ' установим плоскость
                    sketchDef4.angle = 45         ' повернем эскиз на 45 град.
                    entitySketch4.Create          ' создадим эскиз

                    ' интерфейс редактора эскиза
                    Dim sketchEdit4 As Object ' ksDocument2D
                    Set sketchEdit4 = sketchDef4.BeginEdit
                      ' введем новый эскиз - квадрат
                      sketchEdit4.ksLineSeg 50, 50, -50, 50, 1
                      sketchEdit4.ksLineSeg 50, -50, -50, -50, 1

                      sketchEdit4.ksLineSeg 50, -50, 50, 50, 1
                      sketchEdit4.ksLineSeg -50, -50, -50, 50, 1
                    sketchDef4.EndEdit ' завершение редактирования эскиза
                  End If
                End If

                ' вырежим выдавливанием
                Dim entityCutExtr As Object ' ksEntity
                Set entityCutExtr = part.NewEntity(o3d_cutExtrusion)
                If entityCutExtr Is Nothing Then
                  Dim cutExtrDef As Object ' ksCutExtrusionDefinition
                  Set cutExtrDef = entityCutExtr.GetDefinition
                  If Not cutExtrDef Is Nothing Then
                    cutExtrDef.SetSketch entitySketch4 ' установим эскиз операции
                    cutExtrDef.directionType = dtReverse
                    cutExtrDef.SetSideParam false,  etBlind, 50, 0, false
                    cutExtrDef.SetThinParam False, 0, 0, 0
                  End If
                End If

                entityCutExtr.Create ' создадим операцию вырезание выдавливанием

              End If
            End If
          End If
        End If
      End If
    End If
  End If
End Sub

' Операции вращения
Sub OperationRotated()
  Dim iPart As Object 'ksPart
  Set iPart = iDocument3D.GetPart(pNew_Part)
  
  If Not iPart Is Nothing Then
    
    Dim iEntitySketch As Object 'ksEntity
    Set iEntitySketch = iPart.NewEntity(o3d_sketch)
    
    If Not iEntitySketch Is Nothing Then
      ' интерфейс свойств эскиза
      Dim isketchDef As Object 'ksSketchDefinition
      Set isketchDef = iEntitySketch.GetDefinition()
      
      If Not isketchDef Is Nothing Then
        ' получим интерфейс базовой плоскости XOY
        Dim iBasePlane As Object 'ksEntity
        Set iBasePlane = iPart.GetDefaultEntity(o3d_planeXOY)
        
        If Not iBasePlane Is Nothing Then
          isketchDef.SetPlane iBasePlane 'установим плоскость XOY базовой для эскиза
          iEntitySketch.Create           'создадим эскиз
          
          'интерфейс редактора эскиза
          Dim isketchEdit As Object 'ksDocument2D
          Set isketchEdit = isketchDef.BeginEdit
          
          If Not isketchEdit Is Nothing Then
            isketchEdit.ksArcByAngle 0, 0, 20, -90, 90, 1, 1
            isketchEdit.ksLineSeg 0, -20, 0, 20, 3
            isketchDef.EndEdit                   'завершение редактирования эскиза
          End If
          
          Dim iEntityRotate As Object 'ksEntity
          Set iEntityRotate = iPart.NewEntity(o3d_baseRotated)
          
          If Not iEntityRotate Is Nothing Then
            
            Dim iRotateDef As Object 'ksBaseRotatedDefinition
            Set iRotateDef = iEntityRotate.GetDefinition
            
            If Not iRotateDef Is Nothing Then
              
              Dim iRotproperty As Object 'ksRotatedProperty
              Set iRotproperty = iRotateDef.RotatedParam
              
              If Not iRotproperty Is Nothing Then
                iRotproperty.direction = dtBoth
                iRotproperty.toroidShape = False
              End If
              
              iRotateDef.SetThinParam True, dtBoth, 1, 1 'тонкая стенка в два направления
              iRotateDef.SetSideParam True, 180
              iRotateDef.SetSketch iEntitySketch        ' эскиз операции вращения
              
              iEntitySketch.Update
              iEntityRotate.Update    ' обновить параметры операции вращения
              
            End If
          End If
        End If
      End If
    End If
    iKompasObject.ksMessage "Базовая операция вращения"
  
    Dim iEntitySketch2 As Object 'ksEntity
    Set iEntitySketch2 = iPart.NewEntity(o3d_sketch)
    
    If Not iEntitySketch2 Is Nothing Then
      ' интерфейс свойств эскиза
      Dim iSketchDef2 As Object 'ksSketchDefinition
      Set iSketchDef2 = iEntitySketch2.GetDefinition()
      
      If Not iSketchDef2 Is Nothing Then
        ' получим интерфейс базовой плоскости XOY
        Dim iBasePlane2 As Object 'ksEntity
        Set iBasePlane2 = iPart.GetDefaultEntity(o3d_planeXOY)
        
        If Not iBasePlane2 Is Nothing Then
          iSketchDef2.SetPlane iBasePlane2 'установим плоскость XOY базовой для эскиза
          iEntitySketch2.Create           'создадим эскиз
          
          'интерфейс редактора эскиза
          Dim iSketchEdit2 As Object 'ksDocument2D
          Set iSketchEdit2 = iSketchDef2.BeginEdit
          
          If Not iSketchEdit2 Is Nothing Then
            iSketchEdit2.ksArcByAngle 15, 0, 10, -90, 90, 1, 1
            iSketchEdit2.ksLineSeg 15, -10, 15, 10, 3
            iSketchDef2.EndEdit                   'завершение редактирования эскиза
          End If
          
          Dim iEntityBossRotate As Object 'ksEntity
          Set iEntityBossRotate = iPart.NewEntity(o3d_bossRotated)
          
          If Not iEntityBossRotate Is Nothing Then
            
            Dim iBossRotateDef As Object 'ksBossRotatedDefinition
            Set iBossRotateDef = iEntityBossRotate.GetDefinition
            
            If Not iBossRotateDef Is Nothing Then
              
              iBossRotateDef.directionType = dtNormal
              iBossRotateDef.SetSideParam True, 360
              iBossRotateDef.SetSketch iEntitySketch2           ' эскиз операции приклеивания вращением
              iEntityBossRotate.Create                          ' создать операцию

              iSketchDef2.EndEdit                       ' создать операцию
              iEntitySketch2.Update    ' обновить параметры эскиза
              iEntityBossRotate.Update    ' обновить параметры операции вращения
            End If
          End If
        End If
      End If
    End If
    iKompasObject.ksMessage "Операция приклеивания вращением"

    Dim iEntitySketch3 As Object 'ksEntity
    Set iEntitySketch3 = iPart.NewEntity(o3d_sketch)
    
    If Not iEntitySketch3 Is Nothing Then
      ' интерфейс свойств эскиза
      Dim iSketchDef3 As Object 'ksSketchDefinition
      Set iSketchDef3 = iEntitySketch3.GetDefinition()
      
      If Not iSketchDef3 Is Nothing Then
        ' получим интерфейс базовой плоскости XOY
        Dim iBasePlane3 As Object 'ksEntity
        Set iBasePlane3 = iPart.GetDefaultEntity(o3d_planeXOY)
        
        If Not iBasePlane2 Is Nothing Then
          iSketchDef3.SetPlane iBasePlane3 'установим плоскость XOY базовой для эскиза
          iEntitySketch3.Create           'создадим эскиз
          
          'интерфейс редактора эскиза
          Dim iSketchEdit3 As Object 'ksDocument2D
          Set iSketchEdit3 = iSketchDef3.BeginEdit
          
          If Not iSketchEdit3 Is Nothing Then
            iSketchEdit3.ksArcByAngle 20, 0, 20, 90, 270, 1, 1
            iSketchEdit3.ksLineSeg 20, -20, 20, 20, 3
            iSketchDef3.EndEdit                   'завершение редактирования эскиза
          End If
          
          Dim iEntityCutRotate As Object 'ksEntity
          Set iEntityCutRotate = iPart.NewEntity(o3d_cutRotated)
          
          If Not iEntityCutRotate Is Nothing Then
                                          
            Dim iCutRotateDef As Object 'ksCutRotatedDefinition
            Set iCutRotateDef = iEntityCutRotate.GetDefinition
            
            If Not iCutRotateDef Is Nothing Then
              
              iCutRotateDef.directionType = dtNormal
              iCutRotateDef.SetSideParam True, 90
              iCutRotateDef.SetThinParam True, dtBoth, 5, 7    ' тонкая стенка в два направления
              iCutRotateDef.SetSketch iEntitySketch3           ' эскиз операции вырезания вращением
              iEntityCutRotate.Create                          ' создать операцию

              iEntitySketch3.Update     ' обновить параметры эскиза
              iEntityCutRotate.Update    ' обновить параметры операции вращения
            End If
          End If
        End If
      End If
    End If
    iKompasObject.ksMessage "Операция вырезания вращением"
  End If
End Sub

' Операции по сечениям
Sub OperationLoft()
  Dim iPart As Object 'ksPart
  Set iPart = iDocument3D.GetPart(pNew_Part)
  
  If Not iPart Is Nothing Then
    
    Dim iEntitySketch As Object 'ksEntity
    Set iEntitySketch = iPart.NewEntity(o3d_sketch)
    
    If Not iEntitySketch Is Nothing Then
      ' интерфейс свойств эскиза
      Dim isketchDef As Object 'ksSketchDefinition
      Set isketchDef = iEntitySketch.GetDefinition()
      
      If Not isketchDef Is Nothing Then
        ' получим интерфейс базовой плоскости XOY
        Dim iBasePlane As Object 'ksEntity
        Set iBasePlane = iPart.GetDefaultEntity(o3d_planeXOY)
        
        If Not iBasePlane Is Nothing Then
          isketchDef.SetPlane iBasePlane 'установим плоскость XOY базовой для эскиза
          iEntitySketch.Create           'создадим эскиз
          iEntitySketch.Hidden = True
          
          'интерфейс редактора эскиза
          Dim isketchEdit As Object 'ksDocument2D
          Set isketchEdit = isketchDef.BeginEdit
          
          If Not isketchEdit Is Nothing Then
            isketchEdit.ksCircle 0, 0, 4.5, 1
            isketchDef.EndEdit                   'завершение редактирования эскиза
          End If
          
          ' создадим смещенную плоскость, а в ней эскиз
          Dim iEntityOffsetPlane As Object 'ksEntity
          Set iEntityOffsetPlane = iPart.NewEntity(o3d_planeOffset)
          Dim iEntitySketch2 As Object 'ksEntity
          Set iEntitySketch2 = iPart.NewEntity(o3d_sketch)
          
          If Not iEntityOffsetPlane Is Nothing And Not iEntitySketch2 Is Nothing Then
          
            Dim iOffsetDef As Object ' ksConstrPlaneOffsetDefinition
            Set iOffsetDef = iEntityOffsetPlane.GetDefinition()
            
            If Not iOffsetDef Is Nothing Then
              iOffsetDef.offset = 30 ' расстояние от базовой плоскости
              Dim iBasePlane2 As Object ' ksEntity
              Set iBasePlane2 = iPart.GetDefaultEntity(o3d_planeXOY)
              
              If Not iBasePlane2 Is Nothing Then
                iBasePlane2.Name = "Смещенная плоскость"
                iBasePlane2.Update ' обновить параметры
              End If
              
              iOffsetDef.SetPlane iBasePlane2 ' базовая плоскость
              iEntityOffsetPlane.Name = "Смещенная плоскость"  ' имя для смещенной плоскости
              iEntityOffsetPlane.Hidden = True
              iEntityOffsetPlane.Create ' создать смещенную плоскость
              
              Dim iSketchDef2 As Object ' ksSketchDefinition
              Set iSketchDef2 = iEntitySketch2.GetDefinition()
              
              If Not iSketchDef2 Is Nothing Then
                iSketchDef2.SetPlane iEntityOffsetPlane ' установим плоскость XOY базовой для эскиза
              End If
              
              iEntitySketch2.Create ' создадим эскиз
              
              ' интерфейс редактора эскиза
              Dim iSketchEdit2 As Object ' ksDocument2D
              Set iSketchEdit2 = iSketchDef2.BeginEdit()
              
              If Not iSketchEdit2 Is Nothing Then
                iSketchEdit2.ksCircle 0, 0, 8, 1
              End If
              
              iSketchDef2.EndEdit ' завершение редактирования эскиза
            End If
          End If
  
          ' создадим смещенную плоскость, а в ней эскиз
          Dim iEntityOffsetPlane2 As Object 'ksEntity
          Set iEntityOffsetPlane2 = iPart.NewEntity(o3d_planeOffset)
          Dim iEntitySketch3 As Object 'ksEntity
          Set iEntitySketch3 = iPart.NewEntity(o3d_sketch)
          
          If Not iEntityOffsetPlane2 Is Nothing And Not iEntitySketch3 Is Nothing Then
          
            Dim iOffsetDef2 As Object ' ksConstrPlaneOffsetDefinition
            Set iOffsetDef2 = iEntityOffsetPlane2.GetDefinition()
            
            If Not iOffsetDef2 Is Nothing Then
              iOffsetDef2.offset = 60 ' расстояние от базовой плоскости
              Dim iBasePlane3 As Object ' ksEntity
              Set iBasePlane3 = iPart.GetDefaultEntity(o3d_planeXOY)
              
              If Not iBasePlane3 Is Nothing Then
                iBasePlane3.Name = "Смещенная плоскость"
                iBasePlane3.Update ' обновить параметры
              End If
              
              iOffsetDef2.SetPlane iBasePlane3 ' базовая плоскость
              iEntityOffsetPlane2.Name = "Смещенная плоскость"  ' имя для смещенной плоскости
              iEntityOffsetPlane2.Hidden = True
              iEntityOffsetPlane2.Create ' создать смещенную плоскость
              
              Dim iSketchDef3 As Object ' ksSketchDefinition
              Set iSketchDef3 = iEntitySketch3.GetDefinition()
              
              If Not iSketchDef3 Is Nothing Then
                iSketchDef3.SetPlane iEntityOffsetPlane2 ' установим плоскость XOY базовой для эскиза
              End If
              
              iEntitySketch3.Create ' создадим эскиз
              
              ' интерфейс редактора эскиза
              Dim iSketchEdit3 As Object ' ksDocument2D
              Set iSketchEdit3 = iSketchDef3.BeginEdit()
              
              If Not iSketchEdit3 Is Nothing Then
                iSketchEdit3.ksCircle 0, 0, 1.5, 1
              End If
              
              iSketchDef3.EndEdit ' завершение редактирования эскиза
            End If
          End If
          
          ' создадим базовую операцию по сечениям
          Dim iEntityBaseLoft As Object ' ksEntity
          Set iEntityBaseLoft = iPart.NewEntity(o3d_baseLoft)
          
          If Not iEntityBaseLoft Is Nothing Then
            
            Dim iBaseLoft As Object ' ksBaseLoftDefinition
            Set iBaseLoft = iEntityBaseLoft.GetDefinition()
            
            If Not iBaseLoft Is Nothing Then
              
              Dim iEntCol As Object ' ksEntityCollection
              Set iEntCol = iBaseLoft.Sketchs()
              
              If Not iEntCol Is Nothing Then
                iEntCol.Add iEntitySketch
                iEntCol.Add iEntitySketch2
                iEntCol.Add iEntitySketch3
              End If
              
              iEntityBaseLoft.Name = "Ручка"
              iEntityBaseLoft.SetAdvancedColor 12345678, 0.8, 0.8, 0.8, 0.8, 1, 0.8
              iEntityBaseLoft.Create ' создать операцию
            End If
          End If
          iKompasObject.ksMessage "Базовая операция по сечениям"
        
          ' создадим смещенную плоскость, а в ней эскиз
          Dim ientitySketch7 As Object ' ksEntity
          Set ientitySketch7 = iPart.NewEntity(o3d_sketch)
          If Not ientitySketch7 Is Nothing Then
            ' интерфейс свойств смещенной плоскости
            Dim sketchDef As Object ' ksSketchDefinition
            Set sketchDef = ientitySketch7.GetDefinition()
            If Not sketchDef Is Nothing Then
              sketchDef.SetPlane iEntityOffsetPlane2  ' установим плоскость XOY базовой для эскиза
              ientitySketch7.Create           ' создадим эскиз
      
              ' интерфейс редактора эскиза
              Dim sketchEdit As Object ' ksDocument2D
              Set sketchEdit = sketchDef.BeginEdit()
                sketchEdit.ksCircle 0, 0, 1.5, 1
              sketchDef.EndEdit                   ' завершение редактирования эскиза
            End If
          End If

          ' создадим смещенную плоскость, а в ней эскиз
          Dim iEntityOffsetPlane3 As Object 'ksEntity
          Set iEntityOffsetPlane3 = iPart.NewEntity(o3d_planeOffset)
          Dim iEntitySketch4 As Object 'ksEntity
          Set iEntitySketch4 = iPart.NewEntity(o3d_sketch)
          
          If Not iEntityOffsetPlane3 Is Nothing And Not iEntitySketch4 Is Nothing Then
          
            Dim iOffsetDef3 As Object ' ksConstrPlaneOffsetDefinition
            Set iOffsetDef3 = iEntityOffsetPlane3.GetDefinition()
            
            If Not iOffsetDef3 Is Nothing Then
              iOffsetDef3.offset = 120 ' расстояние от базовой плоскости
              Dim iBasePlane4 As Object ' ksEntity
              Set iBasePlane4 = iPart.GetDefaultEntity(o3d_planeXOY)
              
              If Not iBasePlane4 Is Nothing Then
                iBasePlane4.Name = "Смещенная плоскость"
                iBasePlane4.Update ' обновить параметры
              End If
              
              iOffsetDef3.SetPlane iBasePlane4 ' базовая плоскость
              iEntityOffsetPlane3.Name = "Смещенная плоскость"  ' имя для смещенной плоскости
              iEntityOffsetPlane3.Hidden = True
              iEntityOffsetPlane3.Create ' создать смещенную плоскость
              
              Dim iSketchDef4 As Object ' ksSketchDefinition
              Set iSketchDef4 = iEntitySketch4.GetDefinition()
              
              If Not iSketchDef4 Is Nothing Then
                iSketchDef4.SetPlane iEntityOffsetPlane3 ' установим плоскость XOY базовой для эскиза
              End If
              
              iEntitySketch4.Create ' создадим эскиз
              
              ' интерфейс редактора эскиза
              Dim iSketchEdit4 As Object ' ksDocument2D
              Set iSketchEdit4 = iSketchDef4.BeginEdit()
              
              If Not iSketchEdit4 Is Nothing Then
                iSketchEdit4.ksCircle 0, 0, 1.8, 1
              End If
              
              iSketchDef4.EndEdit ' завершение редактирования эскиза
            End If
          End If
          
          ' создадим операцию приклеивания по сечениям
          Dim iEntityBossLoft As Object ' ksEntity
          Set iEntityBossLoft = iPart.NewEntity(o3d_bossLoft)
          
          If Not iEntityBossLoft Is Nothing Then
          
            Dim iBossLoft As Object ' ksBossLoftDefinition
            Set iBossLoft = iEntityBossLoft.GetDefinition()
            
            If Not iBossLoft Is Nothing Then
            
              Dim iEntCol2 As Object
              Set iEntCol2 = iBossLoft.Sketchs()
              
              If Not iEntCol2 Is Nothing Then
                iEntCol2.Add ientitySketch7
                iEntCol2.Add iEntitySketch4
              End If
              
              iEntityBossLoft.Name = "Цивьё"
              iEntityBossLoft.SetAdvancedColor 1234567890, 0.8, 0.8, 0.8, 0.8, 1, 0.8
              iEntityBossLoft.Create ' создать операцию
            End If
          End If
          iKompasObject.ksMessage "Операция приклеивание по сечениям"
        
          ' создадим эскиз в уже созданной смещенной плоскости
          Dim iEntitySketch5 As Object ' ksEntity
          Set iEntitySketch5 = iPart.NewEntity(o3d_sketch)
          
          If Not iEntitySketch5 Is Nothing Then
            
            Dim iSketchDef5 As Object ' ksSketchDefinition
            Set iSketchDef5 = iEntitySketch5.GetDefinition()
            
            If Not iSketchDef5 Is Nothing Then
              iSketchDef5.SetPlane iEntityOffsetPlane3 ' установим плоскость XOY базовой для эскиза
              iEntitySketch5.Create
              
              ' интерфейс редактора эскиза
              Dim iSketchEdit5 As Object ' ksDocument2D
              Set iSketchEdit5 = iSketchDef5.BeginEdit()
              
              If Not iSketchEdit5 Is Nothing Then
              
                Dim iRecPar As Object ' ksRectangleParam
                Set iRecPar = iKompasObject.GetParamStruct(ko_RectangleParam)
                iRecPar.Init
                
                If Not iRecPar Is Nothing Then
                  iRecPar.x = -1.8
                  iRecPar.y = -0.4
                  iRecPar.HEIGHT = 0.8
                  iRecPar.Width = 3.6
                  iRecPar.Style = 1
                End If
                
                iSketchEdit5.ksRectangle iRecPar, 0
                iSketchDef5.EndEdit                   ' завершение редактирования эскиза
              End If
            End If
          End If

          ' создадим смещенную плоскость, а в ней эскиз
          Dim iEntityOffsetPlane4 As Object 'ksEntity
          Set iEntityOffsetPlane4 = iPart.NewEntity(o3d_planeOffset)
          Dim iEntitySketch6 As Object 'ksEntity
          Set iEntitySketch6 = iPart.NewEntity(o3d_sketch)
          
          If Not iEntityOffsetPlane4 Is Nothing And Not iEntitySketch6 Is Nothing Then
          
            Dim iOffsetDef4 As Object ' ksConstrPlaneOffsetDefinition
            Set iOffsetDef4 = iEntityOffsetPlane4.GetDefinition()
            
            If Not iOffsetDef4 Is Nothing Then
              iOffsetDef4.offset = 110 ' расстояние от базовой плоскости
              Dim iBasePlane5 As Object ' ksEntity
              Set iBasePlane5 = iPart.GetDefaultEntity(o3d_planeXOY)
              
              If Not iBasePlane5 Is Nothing Then
                iBasePlane5.Name = "Смещенная плоскость"
                iBasePlane5.Update ' обновить параметры
              End If
              
              iOffsetDef4.SetPlane iBasePlane5 ' базовая плоскость
              iEntityOffsetPlane4.Name = "Смещенная плоскость"  ' имя для смещенной плоскости
              iEntityOffsetPlane4.Hidden = True
              iEntityOffsetPlane4.Create ' создать смещенную плоскость
              
              Dim iSketchDef6 As Object ' ksSketchDefinition
              Set iSketchDef6 = iEntitySketch6.GetDefinition()
              
              If Not iSketchDef6 Is Nothing Then
                iSketchDef6.SetPlane iEntityOffsetPlane4 ' установим плоскость XOY базовой для эскиза
              End If
              
              iEntitySketch6.Create ' создадим эскиз
              
              ' интерфейс редактора эскиза
              Dim iSketchEdit6 As Object ' ksDocument2D
              Set iSketchEdit6 = iSketchDef6.BeginEdit()
              
              If Not iSketchEdit6 Is Nothing Then
              
                Dim iRecPar2 As Object ' ksRectangleParam
                Set iRecPar2 = iKompasObject.GetParamStruct(ko_RectangleParam)
                iRecPar2.Init
                
                If Not iRecPar2 Is Nothing Then
                  iRecPar2.x = -1.8
                  iRecPar2.y = -1.8
                  iRecPar2.HEIGHT = 3.6
                  iRecPar2.Width = 3.6
                  iRecPar2.Style = 1
                End If
                
                iSketchEdit6.ksRectangle iRecPar2, 0
              End If
              
              iSketchDef6.EndEdit ' завершение редактирования эскиза
            End If
          End If
        
          ' создадим операцию вырезания по сечениям
          Dim iEntityCutLoft As Object ' ksEntity
          Set iEntityCutLoft = iPart.NewEntity(o3d_cutLoft)
          
          If Not iEntityCutLoft Is Nothing Then
            
            Dim iCutLoft As Object ' ksCutLoftDefinition
            Set iCutLoft = iEntityCutLoft.GetDefinition()
            
            If Not iCutLoft Is Nothing Then
            
              Dim iEntCol3 As Object
              Set iEntCol3 = iCutLoft.Sketchs()
              
              If Not iEntCol3 Is Nothing Then
                iEntCol3.Add iEntitySketch5
                iEntCol3.Add iEntitySketch6
              End If
              
              iCutLoft.SetThinParam True, dtNormal, 3, 0
              iEntityCutLoft.Name = "Рабочая поверхность"
              iEntityCutLoft.SetAdvancedColor 1234, 0.8, 0.8, 0.8, 0.8, 1, 0.8
              iEntityCutLoft.Create
            End If
          End If
          iKompasObject.ksMessage "Операция вырезания по сечениям"
        End If
      End If
    End If
  End If
End Sub

' Создание фаски и скругления
Sub CreateFilletAndChamfer()
  Dim iPart As Object 'ksPart
  Set iPart = iDocument3D.GetPart(pNew_Part)
  
  If Not iPart Is Nothing Then
    
    Dim iEntitySketch As Object 'ksEntity
    Set iEntitySketch = iPart.NewEntity(o3d_sketch)
    
    If Not iEntitySketch Is Nothing Then
      ' интерфейс свойств эскиза
      Dim isketchDef As Object 'ksSketchDefinition
      Set isketchDef = iEntitySketch.GetDefinition()
      
      If Not isketchDef Is Nothing Then
        ' получим интерфейс базовой плоскости XOY
        Dim iBasePlane As Object 'ksEntity
        Set iBasePlane = iPart.GetDefaultEntity(o3d_planeXOY)
        
        If Not iBasePlane Is Nothing Then
          isketchDef.SetPlane iBasePlane 'установим плоскость XOY базовой для эскиза
          iEntitySketch.Create           'создадим эскиз
          
          'интерфейс редактора эскиза
          Dim isketchEdit As Object 'ksDocument2D
          Set isketchEdit = isketchDef.BeginEdit
          
          If Not isketchEdit Is Nothing Then
            ' введем новый эскиз - квадрат
            isketchEdit.ksLineSeg 50, 50, -50, 50, 1
            isketchEdit.ksLineSeg 50, -50, -50, -50, 1

            isketchEdit.ksLineSeg 50, -50, 50, 50, 1
            isketchEdit.ksLineSeg -50, -50, -50, 50, 1
            isketchDef.EndEdit                   'завершение редактирования эскиза
          End If
  
          Dim iEntityExtr As Object ' ksEntity
          Set iEntityExtr = iPart.NewEntity(o3d_baseExtrusion)
          
          If Not iEntityExtr Is Nothing Then
          'If Not iEntityExtr Is Nothing Then ' интерфейс свойств базовой операции выдавливания
            
            Dim iExtrusionDef As Object ' ksBaseExtrusionDefinition
            Set iExtrusionDef = iEntityExtr.GetDefinition() ' интерфейс базовой операции выдавливания
            
            If Not iExtrusionDef Is Nothing Then
              iExtrusionDef.directionType = dtNormal    ' направление выдавливания
              iExtrusionDef.SetSideParam True, etBlind, 100, 0, False
              iExtrusionDef.SetThinParam False, 0, 0, 0 ' без тонкой стенки
              iExtrusionDef.SetSketch iEntitySketch ' эскиз операции выдавливания
              
              iEntityExtr.Create ' создать операцию
              
              Dim iCollect As Object ' ksEntityCollection
              Set iCollect = iPart.EntityCollection(o3d_face)
              
              If Not iCollect Is Nothing And iCollect.SelectByPoint(0, 0, 0) And iCollect.GetCount() Then
                iKompasObject.ksMessage "Создание скругления"
                
                Dim iEntityFillet As Object ' ksEntity
                Set iEntityFillet = iPart.NewEntity(o3d_fillet)
                
                If Not iEntityFillet Is Nothing Then
                  
                  Dim iFilletDef As Object ' ksFilletDefinition
                  Set iFilletDef = iEntityFillet.GetDefinition()
                  
                  If Not iFilletDef Is Nothing Then
                    iFilletDef.radius = 10 ' радиус скругления
                    iFilletDef.tangent = False ' продолжить по касательной
                    
                    Dim iArr As Object ' ksEntityCollection
                    Set iArr = iFilletDef.Array() ' динамический массив объектов
                    
                    If Not iArr Is Nothing Then
                      For i = 0 To iArr.GetCount
                        iArr.Add iCollect.GetByIndex(i)
                        iEntityFillet.Create
                      Next
                    End If
                  End If
                End If
              End If
            
              Dim iCollect2 As Object ' ksEntityCollection
              Set iCollect2 = iPart.EntityCollection(o3d_face)
              
              If Not iCollect2 Is Nothing And iCollect2.SelectByPoint(0, 0, 100) And iCollect2.GetCount Then
                iKompasObject.ksMessage "Создание фаски"
                
                Dim iEntityChamfer As Object ' ksEntity
                Set iEntityChamfer = iPart.NewEntity(o3d_chamfer)
                
                If Not iEntityChamfer Is Nothing Then
                  
                  Dim iChamferDef As Object ' ksChamferDefinition
                  Set iChamferDef = iEntityChamfer.GetDefinition()
                  
                  If Not iChamferDef Is Nothing Then
                    iChamferDef.SetChamferParam True, 10, 10
                    iChamferDef.tangent = False ' продолжить по касательной
                    
                    Dim iArr2 As Object ' ksEntityCollection
                    Set iArr2 = iChamferDef.Array() ' динамический массив объектов
                    
                    If Not iArr2 Is Nothing Then
                      For i = 0 To iArr2.GetCount
                        iArr2.Add iCollect2.GetByIndex(i)
                        iEntityChamfer.Create
                      Next
                    End If
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    End If
  End If
End Sub

' GetLibraryName

Public Function GetLibraryName() As String
  GetLibraryName = "Объекты 3D"
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
      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
  
  Set iDocument3D = iKompasObject.ActiveDocument3D
  
  If iDocument3D Is Nothing Then
    Exit Sub
  End If
  
  'Set iMathematic2D = iKompasObject.GetMathematic2D
  
  'If iMathematic2D Is Nothing Then
  '  Exit Sub
  'End If
  
  Select Case command
    Case 1
      CreateExtrusion        ' Операции выдавливания
    Case 2
      OperationRotated       ' Операции вращения
    Case 3
      OperationLoft          ' Оперции по сечениям
    Case 4
      CreateFilletAndChamfer ' Создание фаски и скругления
  End Select
  
  iKompasObject.ksMessageBoxResult
  
End Sub