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 iDocument3D As Object   'ksDocument3D

' GetLibraryName
Public Function GetLibraryName() As String
  GetLibraryName = ",   "
End Function

' ExternalMenuItem
Public Function ExternalMenuItem(ByVal number As Integer, itemType As Integer, command As Integer) As String
  itemType = 1 'MENUITEM'
  
  Select Case number
    Case 1
      ExternalMenuItem = "  "
      command = 1
    Case 2
      ExternalMenuItem = "    "
      command = 2
    Case 3
      ExternalMenuItem = " ,   "
      command = 3
'    Case 4
'      ExternalMenuItem = "   "
'      command = 4
    Case 4
      ExternalMenuItem = " ,    ,      -"
      command = 4
    Case 5
      ExternalMenuItem = "   "
      command = 5
    Case 6
      itemType = 3 'ENDMENU'
      ExternalMenuItem = ""
      command = -1
  End Select
End Function

'   
Sub ConstrAxisOperations()
  Dim part As Object                              '  
  Set part = iDocument3D.GetPart(pNew_Part)       '  
  
  If Not part Is Nothing Then                     '   
    Dim entitySketch As Object                    '  3D-
    Set entitySketch = part.NewEntity(o3d_sketch) '   
    
    If Not entitySketch Is Nothing Then           '  3D- 
      Dim sketchDef As Object                     '   
      Set sketchDef = entitySketch.GetDefinition  '     
      
      If Not sketchDef Is Nothing Then            '    
        Dim basePlane As Object                   '  3D-
        Set basePlane = part.GetDefaultEntity(o3d_planeXOY) '     XOY
        
        If Not basePlane Is Nothing Then          '  
          sketchDef.SetPlane basePlane            '   XOY   
          Set basePlane = Nothing                 '  
        End If                                    '
        
        entitySketch.Create                       '  
        Dim sketchEdit As Object                  '    ksDocument2D
        Set sketchEdit = sketchDef.BeginEdit      '    
        
        If Not sketchEdit Is Nothing Then
          sketchEdit.ksCircle 20, 0, 10, 1        '  
          sketchEdit.ksLineSeg 0, 0, 0, 5, 3      '   ()
          sketchDef.EndEdit                       '   
          Set sketchEdit = Nothing                '  
        End If
        
        Set sketchDef = Nothing                   '  
      End If                                      '
      
      Dim entityRotate As Object                  '  3D-
      Set entityRotate = part.NewEntity(o3d_baseRotated) '   
      
      If Not entityRotate Is Nothing Then
        Dim rotateDef As Object                   '     
        Set rotateDef = entityRotate.GetDefinition '     
        
        If Not rotateDef Is Nothing Then
          Dim rotproperty As Object               '   
          Set rotproperty = rotateDef.RotatedParam '   
          
          If Not rotproperty Is Nothing Then
            rotproperty.direction = dtBoth          '    
            rotproperty.toroidShape = False            '
            Set rotproperty = Nothing             '  
          End If
          
'         rotateDef.TorShapeType false
'         rotateDef.DirectionType dtNormal        '  
          rotateDef.SetThinParam True, dtBoth, 1, 1 '     
          rotateDef.SetSideParam True, 180        '
          rotateDef.SetSketch entitySketch        '   
          entityRotate.Create                     '  
          Set rotateDef = Nothing                 '  
        End If
        
        Dim entityAxisOperation As Object         '   
        Set entityAxisOperation = part.NewEntity(o3d_axisOperation) '  
        
        If Not entityAxisOperation Is Nothing Then
          Dim axisOperation As Object             '    
          Set axisOperation = entityAxisOperation.GetDefinition '     
          
          If Not axisOperation Is Nothing Then
            axisOperation.SetOperation entityRotate '  
            entityAxisOperation.Create            '  
            Set axisOperation = Nothing           '  
          End If
          
          Set entityAxisOperation = Nothing       '  
        End If
        
        iKompasObject.ksMessage (" ")  '
        Set entityRotate = Nothing                '  
      End If
      
      Set entitySketch = Nothing                  '  
    End If                                        '
    
    Set part = Nothing                            '  
  End If

End Sub

'     
'  ,   
Sub ConstrAxis2PointOrEdge(ax2Point As Boolean)
  Dim part As Object                              '  
  Set part = iDocument3D.GetPart(pNew_Part)       '  
  
  If Not part Is Nothing Then                     '   
    Dim entitySketch As Object                    '  3D-
    Set entitySketch = part.NewEntity(o3d_sketch) '   
    
    If Not entitySketch Is Nothing Then           '  3D- 
      Dim sketchDef As Object                     '   
      Set sketchDef = entitySketch.GetDefinition  '     
      
      If Not sketchDef Is Nothing Then            '    
        Dim basePlane As Object                   '  3D-
        Set basePlane = part.GetDefaultEntity(o3d_planeXOY) '     XOY
        
        If Not basePlane Is Nothing Then          '  
          sketchDef.SetPlane basePlane            '   XOY   
          Set basePlane = Nothing                 '  
        End If                                    '
        
        entitySketch.Create                       '  
        Dim sketchEdit As Object                  '    ksDocument2D
        Set sketchEdit = sketchDef.BeginEdit      '    
        
        If Not sketchEdit Is Nothing Then
          '    - 
          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                       '   
          Set sketchEdit = Nothing                '  
        End If
        
        Set sketchDef = Nothing                   '  
      End If                                      '
      
      Dim entityExtr As Object                    '
      Set entityExtr = part.NewEntity(o3d_baseExtrusion) '
      If Not entityExtr Is Nothing Then           '
        Dim extrusionDef As Object                '     
        Set extrusionDef = entityExtr.GetDefinition '      
        
        If Not extrusionDef Is Nothing Then
          extrusionDef.directionType = dtNormal   '  
          extrusionDef.SetSideParam True, etBlind, 20, 0, False
          extrusionDef.SetThinParam True, dtBoth, 20, 20 '     
          extrusionDef.SetSketch entitySketch     '   
          entityExtr.Create                       '  
          Set extrusionDef = Nothing              '  
        End If
        
        Set entityExtr = Nothing                  '  
      End If
            
      Set entitySketch = Nothing                  '  
    End If                                        '
    
    Dim entityColl As Object                      '    3D-
    Dim collType As Integer
    If ax2Point Then
      collType = o3d_vertex
    Else
      collType = o3d_edge
    End If
    
    Set entityColl = part.EntityCollection(collType) '     
    If Not entityColl Is Nothing And entityColl.GetCount > 1 Then
      If ax2Point Then
        '     
        Dim entityAxis2Point As Object              '  3D-
        Set entityAxis2Point = part.NewEntity(o3d_axis2Points) '      
              
        If Not entityAxis2Point Is Nothing Then
          Dim axis2Point As Object                  '      
          Set axis2Point = entityAxis2Point.GetDefinition '       
          
          If Not axis2Point Is Nothing Then
            axis2Point.SetPoint 1, entityColl.GetByIndex(0)
            axis2Point.SetPoint 2, entityColl.GetByIndex(entityColl.GetCount - 1)
            entityAxis2Point.Create
            iKompasObject.ksMessage ("   ")
            Set axis2Point = Nothing                '  
          End If
          
          Set entityAxis2Point = Nothing            '  
        End If
      Else
        '    
        Dim entityAxisEdge As Object                '  3D-
        Set entityAxisEdge = part.NewEntity(o3d_axisEdge) '   -   
        
        If Not entityAxisEdge Is Nothing Then
          Dim axisEdge As Object                    '
          Set axisEdge = entityAxisEdge.GetDefinition '
          
          If Not axisEdge Is Nothing Then
            axisEdge.SetEdge entityColl.GetByIndex(0)
            entityAxisEdge.Create
            Set axisEdge = Nothing                  '  
          End If
          
          Set entityAxisEdge = Nothing              '  
        End If
        iKompasObject.ksMessage ("  ")
  
        '     
        Dim entityAxisEdge2 As Object                '  3D-
        Set entityAxisEdge2 = part.NewEntity(o3d_axisEdge) '   -   
        
        If Not entityAxisEdge2 Is Nothing Then
          Dim axisEdge2 As Object                    '
          Set axisEdge2 = entityAxisEdge2.GetDefinition() '
          
          If Not axisEdge2 Is Nothing Then
            axisEdge2.SetEdge entityColl.GetByIndex(1)
            entityAxisEdge2.Create
            Set axisEdge = Nothing                  '  
          End If
          
          Set entityAxisEdge2 = Nothing              '  
        End If
        iKompasObject.ksMessage ("   ")
      End If
      
      Set entityColl = Nothing                    '  
    End If
    
    Set part = Nothing                            '  
  End If
  
End Sub

'    
'Sub ConstrAxisConeface()
'  Dim part As Object                              '  
'  Set part = iDocument3D.GetPart(pNew_Part)       '  
'
'  If Not part Is Nothing Then                     '   
'    Dim entitySketch As Object                    '  3D-
'    Set entitySketch = part.NewEntity(o3d_sketch) '   
'
'    If Not entitySketch Is Nothing Then           '  3D- 
'      Dim sketchDef As Object                     '   
'      Set sketchDef = entitySketch.GetDefinition  '     
'
'      If Not sketchDef Is Nothing Then            '    
'        Dim basePlane As Object                   '  3D-
'        Set basePlane = part.GetDefaultEntity(o3d_planeXOY) '     XOY
'
'        If Not basePlane Is Nothing Then          '  
'          sketchDef.SetPlane basePlane            '   XOY   
'          Set basePlane = Nothing                 '  
'        End If                                    '
'
'        entitySketch.Create                       '  
'        Dim sketchEdit As Object                  '    ksDocument2D
'        Set sketchEdit = sketchDef.BeginEdit      '    
'
'        If Not sketchEdit Is Nothing Then
'          sketchEdit.ksCircle 0, 0, 50, 1
'          sketchDef.EndEdit                       '   
'          Set sketchEdit = Nothing                '  
'        End If
'
'        Set sketchDef = Nothing                   '  
'      End If                                      '
'
'      Dim entityExtr As Object                    '
'      Set entityExtr = part.NewEntity(o3d_baseExtrusion) '
'      If Not entityExtr Is Nothing Then           '
'        Dim extrusionDef As Object                '     
'        Set extrusionDef = entityExtr.GetDefinition '      
'
'        If Not extrusionDef Is Nothing Then
'          extrusionDef.directionType = dtNormal   '  
'          extrusionDef.SetSideParam True, etBlind, 20, 30, False
'          extrusionDef.SetThinParam True, dtBoth, 10, 10 '     
'          extrusionDef.SetSketch entitySketch     '   
'          entityExtr.Create                       '  
'          Set extrusionDef = Nothing              '  
'        End If
'
'        Set entityExtr = Nothing                  '  
'      End If
'
'      Set entitySketch = Nothing                  '  
'    End If                                        '
'
'    Dim entityColl As Object                      '    3D-
'    Set entityColl = part.EntityCollection(o3d_face) '     
'
'    If Not entityColl Is Nothing Then
'      Dim entityConFace As Object
'
'      Dim i As Integer
'      Dim count As Integer
'      count = entityColl.GetCount
'      For i = 0 To count
'        Set entityConFace = entityColl.GetByIndex(i)
'        If Not entityConFace Is Nothing Then
'          Dim face As Object
'          Set face = entityConFace.GetDefinition
'          If Not face Is Nothing Then
'            If Not face.IsConic Then              '    ,    
'              Set entityConFace = Nothing
'            Else
'              Exit For
'            End If
'          End If
'        End If
'      Next i
'
'      '     
'      If Not entityConFace Is Nothing Then
'        Dim entityAxisConFace As Object
'        Set entityAxisConFace = part.NewEntity(o3d_axisConeFace)
'        If Not entityAxisConFace Is Nothing Then
'
'          Dim axisConFace As Object
'          Set axisConFace = entityAxisConFace.GetDefinition
'          If Not axisConFace Is Nothing Then
'
'            axisConFace.SetFace entityConFace
'            entityAxisConFace.Create
'            Set axisConFace = Nothing
'          End If
'
'          Set entityAxisConFace = Nothing
'        End If
'        iKompasObject.ksMessage "   "
'        Set entityConFace = Nothing
'      End If
'
'    End If
'
'    Set part = Nothing                            '  
'  End If
'
'End Sub

'   ,          
Sub CreateConstrElem()
  Dim part As Object                              '  
  Set part = iDocument3D.GetPart(pNew_Part)       '  
  
  If Not part Is Nothing Then                     '   
    Dim entity As Object
    Set entity = part.NewEntity(o3d_planeOffset)
    If Not entity Is Nothing Then
      '    
      Dim offsetDef As Object
      Set offsetDef = entity.GetDefinition
      If Not offsetDef Is Nothing Then
        offsetDef.offset = 150                    '    
        Dim basePlane As Object
        Set basePlane = part.GetDefaultEntity(o3d_planeXOY)
        basePlane.Name = "XOY"                      '   
        basePlane.Update                          '  
      
        offsetDef.SetPlane basePlane              '  
        offsetDef.direction = False               '     
        entity.Name = " "       '    
        entity.Create                             '   
        
        iKompasObject.ksMessage "   "
     
        offsetDef.offset = 50                     '     
        Set basePlane = Nothing
        '    
        Set basePlane = part.GetDefaultEntity(o3d_planeYOZ)
        basePlane.Name = "YOZ"
        basePlane.Update                          '  

        offsetDef.direction = True                '      
        offsetDef.SetPlane basePlane
        entity.Update                             '  

        Set basePlane = Nothing
        '    
        Set basePlane = part.GetDefaultEntity(o3d_planeXOY)
        basePlane.Name = "XOY"
        
        iKompasObject.ksMessage "    "

        '     
        Dim entityAxis As Object
        Set entityAxis = part.NewEntity(o3d_axis2Planes)
        If Not entityAxis Is Nothing Then
          Dim axis2PlanesDef As Object
          Set axis2PlanesDef = entityAxis.GetDefinition
          If Not axis2PlanesDef Is Nothing Then
            axis2PlanesDef.SetPlane 1, entity         '   1
            axis2PlanesDef.SetPlane 2, basePlane      '   2
            entityAxis.Name = "   " '   
            entityAxis.Create                      '  

            iKompasObject.ksMessage "       "
            
            Set basePlane = Nothing
            '    
            Set basePlane = part.GetDefaultEntity(o3d_planeXOZ)
            basePlane.Name = "XOZ"
            
            axis2PlanesDef.SetPlane 2, basePlane     '   2
            entityAxis.Update

            iKompasObject.ksMessage "      \n     45"

            Dim entityAnglePlane As Object
            Set entityAnglePlane = part.NewEntity(o3d_planeAngle)
            If Not entityAnglePlane Is Nothing Then
              '        
              Dim planeAngleDef As Object
              Set planeAngleDef = entityAnglePlane.GetDefinition
              If Not planeAngleDef Is Nothing Then
                planeAngleDef.angle = 45             '     
                planeAngleDef.SetPlane entity        '  
                planeAngleDef.SetAxis entityAxis     '  
                entityAnglePlane.Name = "     "
                entityAnglePlane.Create              '    

                iKompasObject.ksMessage "    "

                planeAngleDef.SetPlane basePlane     '  
                entityAnglePlane.Update              '   
              End If
            End If
          End If
        End If
        
        Set offsetDef = Nothing                            '  
      End If
      
      Set entity = Nothing                            '  
    End If
    
    Set part = Nothing                            '  
  End If

End Sub
      
'    
Sub constrPlane3Point()
  Dim part As Object                              '  
  Set part = iDocument3D.GetPart(pNew_Part)       '  
  
  If Not part Is Nothing Then                     '   
    Dim entitySketch As Object                    '  3D-
    Set entitySketch = part.NewEntity(o3d_sketch) '   
    
    If Not entitySketch Is Nothing Then           '  3D- 
      Dim sketchDef As Object                     '   
      Set sketchDef = entitySketch.GetDefinition  '     
      
      If Not sketchDef Is Nothing Then            '    
        Dim basePlane As Object                   '  3D-
        Set basePlane = part.GetDefaultEntity(o3d_planeXOY) '     XOY
        
        If Not basePlane Is Nothing Then          '  
          sketchDef.SetPlane basePlane            '   XOY   
          Set basePlane = Nothing                 '  
        End If                                    '
        
        entitySketch.Create                       '  
        Dim sketchEdit As Object                  '    ksDocument2D
        Set sketchEdit = sketchDef.BeginEdit      '    
        
        If Not sketchEdit Is Nothing Then
          '    - 
          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                       '   
          Set sketchEdit = Nothing                '  
        End If
        
        Set sketchDef = Nothing                   '  
      End If                                      '
      
      Dim entityExtr As Object                    '
      Set entityExtr = part.NewEntity(o3d_baseExtrusion) '
      If Not entityExtr Is Nothing Then           '
        Dim extrusionDef As Object                '     
        Set extrusionDef = entityExtr.GetDefinition '      
        
        If Not extrusionDef Is Nothing Then
          extrusionDef.directionType = dtNormal   '  
          extrusionDef.SetSideParam True, etBlind, 20, 30, False
          extrusionDef.SetThinParam True, dtBoth, 10, 10 '     
          extrusionDef.SetSketch entitySketch     '   
          entityExtr.Create                       '  
          Set extrusionDef = Nothing              '  
        End If
        
        Set entityExtr = Nothing                  '  
      End If
            
      Set entitySketch = Nothing                  '  
    End If                                        '
    
    Dim entityColl As Object                      '    3D-
    Set entityColl = part.EntityCollection(o3d_vertex) '   
    If Not entityColl Is Nothing And entityColl.GetCount > 2 Then
      
      '    
      Dim entityConstrPlane3Point As Object
      Set entityConstrPlane3Point = part.NewEntity(o3d_plane3Points)
      If Not entityConstrPlane3Point Is Nothing Then
        Dim constrPlane3Point As Object
        Set constrPlane3Point = entityConstrPlane3Point.GetDefinition
        If Not constrPlane3Point Is Nothing Then
          constrPlane3Point.SetPoint 1, entityColl.GetByIndex(0)
          constrPlane3Point.SetPoint 2, entityColl.GetByIndex(1)
          constrPlane3Point.SetPoint 3, entityColl.GetByIndex(2)
          entityConstrPlane3Point.Create
          Set constrPlane3Point = Nothing
        End If
        Set constrPlane3Point = Nothing
      End If
      iKompasObject.ksMessage "   "
            
      Set entityColl = Nothing                    '  
    End If
    
    Set part = Nothing                            '  
  End If
  
End Sub


' 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
  
  Select Case command
    Case 1
      ConstrAxisOperations           '   
    Case 2
      ConstrAxis2PointOrEdge (True)  '     
    Case 3
      ConstrAxis2PointOrEdge (False) '  ,   
'    Case 4
'      ConstrAxisConeface             '    
    Case 4
      CreateConstrElem               '   ,          
    Case 5
      constrPlane3Point              '    
  End Select
  
  iKompasObject.ksMessageBoxResult
  
End Sub


