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


