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
' step3 - 

' 1.    - WorkDocument
' 2.               - DrawView
' 3.               - DrawLayer
' 4.             - DrawGroup
' 5.      - WorkNameGroup
' 6.            - DrawLineSeg
' 7.               - DrawArc
' 8.              - DrawLine
' 9.         - DrawCircle
' 10.             - DrawPoint
' 11. Bezier-   - DrawBezier
' 12.         - DrawHatch
' 13.             - DrawText

Public Kompas As Kompas6API5.Application      '  KompasObject

'   

Sub WorkDocument(doc As Kompas6API5.Document2D)
  
  Dim docPar As Kompas6API5.DocumentParam     '  ksDocumentParam
  '   
  Set docPar = Kompas.GetParamStruct(ko_DocumentParam)
  
  If Not docPar Is Nothing Then               '  
    
    docPar.Init                               ' 
    docPar.FileName = "c:\2.cdw"              '    
    docPar.comment = "create document"        '   
    docPar.author = "user"                    '  
    docPar.regime = 0                         '  ( 0 - , 1 -  )
    docPar.Type = 1                           '   ( 0 - , 1 -   )
    
    Dim sheet As Kompas6API5.SheetPar         '  ksSheetPar
    Set sheet = docPar.GetLayoutParam         '   
    
    If Not sheet Is Nothing Then              '  
    
      sheet.shtType = 1                       '        (      )
      sheet.layoutName = ""                   '   ,
      
      Dim standart As Kompas6API5.StandartSheet '  ksStandartSheet
      Set standart = sheet.GetSheetParam()    '    
      
      If Not standart Is Nothing Then         '  
      
        standart.Format = 3                   '   0( 0 ) ... 4( 4 )
        standart.multiply = 1                 '  
        standart.direct = 0                   '   ( 0 -   , 1 -   )
        
        '  : ,  3,       1
        If doc.ksCreateDocument(docPar) Then
        
          Dim view As Kompas6API5.ViewParam   '  ksViewParam
          '   
          Set view = Kompas.GetParamStruct(ko_ViewParam)
          
          If Not view Is Nothing Then         '  
          
            view.x = 10                       '   
            view.y = 20
            view.angle = 45                   '   
            view.scale_ = 0.5                 '  
            view.COLOR = RGB(10, 20, 10)      '     
            view.state = stACTIVE             '  
            view.Name = "user view"           '  
            
            Dim number As Long
            number = 2
            
            '       2,  0.5,   45 
            doc.ksCreateSheetView view, number
            
            doc.ksLayer 5                     '     5
            
            doc.ksLineSeg 20, 10, 40, 10, 1   '  
            doc.ksLineSeg 40, 10, 40, 30, 1
            doc.ksLineSeg 40, 30, 20, 30, 1
            doc.ksLineSeg 20, 30, 20, 10, 1
            
            Kompas.ksMessage ""
            
            '   
            doc.ksGetObjParam doc.reference, docPar, ALLPARAM
            
            Kompas.ksMessage "type = " & docPar.Type & " f = " & standart.Format & " m = " & standart.multiply & _
                             " d = " & standart.direct
                        
            Kompas.ksMessage "  : " & docPar.FileName
            Kompas.ksMessage " : " & docPar.comment
            Kompas.ksMessage " : " & docPar.author
            
            doc.ksSaveDocument ""             '  
            doc.ksCloseDocument               '  
          End If
        End If
      End If
    End If
  End If

End Sub

'  

Sub DrawView(doc As Kompas6API5.Document2D)
  Dim par As Kompas6API5.ViewParam            '  ksViewParam
  '   
  Set par = Kompas.GetParamStruct(ko_ViewParam)
  
  If Not par Is Nothing Then                  '  
  
    Dim number As Long
    number = 5                                '  
    
    par.Init                                  ' 
    par.x = 10                                '   
    par.y = 20
    par.scale_ = 0.5                          '  
    par.angle = 45                            '   
    par.COLOR = RGB(10, 20, 10)               '     
    par.state = stACTIVE                      '  
    par.Name = "user view"                    '  

    Dim v As Long
    v = doc.ksCreateSheetView(par, number)    '     5,  0.5,   45 .
    number = doc.ksGetViewNumber(v)           '   
    Kompas.ksMessage " : ref = " & v & " number = " & number
    
    '   , type -   ( 0 -  , 1 -  )
    Dim gr As Long
    gr = doc.ksNewGroup(0)
      doc.ksLineSeg 20, 10, 20, 30, 1
      doc.ksLineSeg 20, 30, 40, 30, 1
      doc.ksLineSeg 40, 30, 40, 10, 1
      doc.ksLineSeg 40, 10, 20, 10, 1
    doc.ksEndGroup                            '    

    doc.ksAddObjGroup gr, v                   '    
    Kompas.ksMessage "   "
'    Kompas.ksMessageBoxResult
    
    Dim p As Long
    p = doc.ksLineSeg(10, 10, 30, 30, 0)      '  
    doc.ksAddObjGroup gr, p                   '     

    Kompas.ksMessage "   "
'    Kompas.ksMessageBoxResult

    doc.ksRotateObj gr, 0, 0, -45             '    -45    ( 0, 0 )

    par.Init                                  ' 
    doc.ksGetObjParam v, par, ALLPARAM        '   a

    Kompas.ksMessage "x =" & par.x & " y = " & par.y & " angl = " & par.angle _
                      & " name = " & par.Name & " st = " & par.state

    doc.ksOpenView 0                          '     (  0 )
    
    '     :  
    Dim var As Kompas6API5.LtVariant          '  ksLtVariant
    '      
    Set var = Kompas.GetParamStruct(ko_LtVariant)
    
    If Not var Is Nothing Then                '  
    
      var.Init                                ' 
      var.intVal = stREADONLY                 '    (   )
      doc.ksSetObjParam v, var, VIEW_LAYER_STATE
      Set var = Nothing
    End If
    
    Set par = Nothing
  End If
End Sub

'  

Sub DrawLayer(doc As Kompas6API5.Document2D)
  Dim n As Long                               '    
  If Kompas.ksReadInt("  ", 1, 0, 255, n) = 0 Then
    Exit Sub
  End If
  
  '   ,     
  ' ,   .   
  Dim lay As Long
  lay = doc.ksLayer(n)                        '  ,   
  
  doc.ksMtr 20, 15, 0, 1, 1                   '    ( 20   OX, 15   OY )
    doc.ksLineSeg -10, 0, 10, 0, 1
    doc.ksLineSeg 10, 0, 10, 20, 1
    doc.ksLineSeg 10, 20, -10, 20, 1
    doc.ksLineSeg -10, 20, -10, 0, 1
  doc.ksDeleteMtr                             '    

  doc.ksLightObj lay, 1                       '  

  '         
  Dim n1 As Integer
  n1 = doc.ksGetLayerNumber(lay)
  Dim l As Long
  l = doc.ksGetLayerReference(n1)

  Kompas.ksMessage "n = " & n & " n1 = " & n1 & " layer = " & lay & " l = " & l

  doc.ksLightObj lay, 0                       '   
  
  '       
  Dim par As Kompas6API5.LayerParam                   '  ksLayerParam
  Set par = Kompas.GetParamStruct(ko_LayerParam)      '   
  
  Dim par1 As Kompas6API5.LayerParam                  '  ksLayerParam
  Set par1 = Kompas.GetParamStruct(ko_LayerParam)     '   
  
  If Not par Is Nothing And Not par1 Is Nothing Then  '  
    par.Init                                          ' 
    par1.Init                                         ' 
    
    par.COLOR = RGB(0, 255, 0)                '     
    par.state = stACTIVE                      '  
    par.Name = ""                      '  

    '   
    If Not doc.ksSetObjParam(l, par, ALLPARAM) Then
      Kompas.ksMessageBoxResult               '      
    Else
      doc.ksGetObjParam l, par1, ALLPARAM     '   
      Kompas.ksMessage "col = " & par.COLOR & " col1 = " & par1.COLOR & " name = " _
                       & par.Name & " name1 = " & par1.Name
    End If
    
    doc.ksLayer 0                             '   0  
    
    '    (   )
    Dim var As Kompas6API5.LtVariant          '  ksLtVariant
    '      
    Set var = Kompas.GetParamStruct(ko_LtVariant)
    
    If Not var Is Nothing Then                '  
    
      var.Init                                ' 
      var.intVal = stACTIVE                   '    (   )
      doc.ksSetObjParam l, var, VIEW_LAYER_STATE
      
      Set var = Nothing
    End If
    
    Set par = Nothing
    Set par1 = Nothing
  End If
End Sub

'   

Sub DrawGroup(doc As Kompas6API5.Document2D)
  
  Dim p1 As Long
  p1 = doc.ksLineSeg(10, 10, 20, 10, 0)       '  
  Dim p2 As Long
  p2 = doc.ksLineSeg(10, 10, 10, 20, 0)       '  

  Dim gr1 As Long
  gr1 = doc.ksNewGroup(0)                     '      1
  doc.ksEndGroup

  Dim gr2 As Long
  gr2 = doc.ksNewGroup(0)                     '      2
  doc.ksEndGroup

  doc.ksAddObjGroup gr1, p1                   '      
  doc.ksAddObjGroup gr1, p2                   '      

  doc.ksAddObjGroup gr2, p1                   '      
  doc.ksAddObjGroup gr2, p2                   '      

  Kompas.ksMessage " "

  doc.ksMoveObj gr1, 10, 0                    '     10 
  Kompas.ksMessage "   10 "

  doc.ksRotateObj gr2, 20, 10, 45             '     45 
  Kompas.ksMessage "   45 "

  doc.ksRotateObj gr2, 20, 10, -45            '     -45 
  Kompas.ksMessage "   -45 "

  doc.ksMoveObj gr1, -10, 0                   '     -10 
  Kompas.ksMessage "   -10 "

  doc.ksClearGroup gr2, False                 '   2 (     )
  doc.ksDeleteObj gr2                         '    2

  Kompas.ksMessage " gr1"
  doc.ksLightObj gr1, 1                       '   

  Kompas.ksMessage " gr1"
  doc.ksLightObj gr1, 0                       '    

  Kompas.ksMessage " p1"
  doc.ksLightObj p1, 1                        '   
  Kompas.ksMessage " p1"
  doc.ksLightObj p1, 0                        '    

  doc.ksDeleteObj gr1                         '   1(    )
  Kompas.ksMessageBoxResult                   '  
End Sub

'     

Sub WorkNameGroup(doc As Kompas6API5.Document2D)
  Dim gr As Long
  Dim p As Long
  
  '   , type -   ( 0 -  , 1 -  )
  gr = doc.ksNewGroup(0)
    p = doc.ksLineSeg(20, 20, 40, 20, 1)
    doc.ksLineSeg 40, 20, 40, 40, 1
    doc.ksLineSeg 40, 40, 20, 40, 1
    doc.ksLineSeg 20, 40, 20, 20, 1
  doc.ksEndGroup                              '    
  
  '        
  '        
  '          
  '     ,    
  ' - (  ).
  If doc.ksSaveGroup(gr, "group1") = 0 Then
    Exit Sub                                  '     -   
  End If
  
  Dim gr1 As Long
  gr1 = doc.ksGetGroup("group1")              '     
  
  If gr1 = 0 Then                             '    -   
    Exit Sub
  End If
  
  Dim c As Long
  c = doc.ksCircle(30, 30, 10, 1)             '  
  doc.ksAddObjGroup gr1, c                    '     
  
  doc.ksLightObj gr1, 1                       '  
  Kompas.ksMessage "    "
  doc.ksLightObj gr1, 0                       '    
  
  doc.ksExcludeObjGroup gr1, p                '    
  
  doc.ksLightObj gr1, 1                       '  
  Kompas.ksMessage "    "
  doc.ksLightObj gr1, 0                       '    
End Sub

'  

Sub DrawLineSeg(doc As Kompas6API5.Document2D)
  '  
  '    ( 30   OX, 25   OY,   45  )
  doc.ksMtr 30, 20, 45, 1, 1
  Dim p As Long                               '   
  p = doc.ksLineSeg(30, 20, 60, 20, 1)        '  

  doc.ksDeleteMtr                             '    
  
  '   
  Dim par As Kompas6API5.LineSegParam         '  ksLineSegParam
  '   
  Set par = Kompas.GetParamStruct(ko_LineSegParam)
  
  If Not par Is Nothing Then                  '  
    Dim t As Integer
    t = doc.ksGetObjParam(p, par, ALLPARAM)   '   

    Kompas.ksMessage "t = " & t & " x1 = " & par.X1 & " y1 = " & par.Y1 & " x2 = " & par.X2 _
                     & " y2 = " & par.Y2 & " tl = " & par.Style

    '   
    par.X1 = 0                                '   
    par.Y1 = 0
    par.X2 = 30                               '   
    par.Y2 = 60
    par.Style = 2                             '  

    '   
    If doc.ksSetObjParam(p, par, ALLPARAM) Then
      Kompas.ksMessage " "
    Else
      Kompas.ksMessageBoxResult               '      
    End If
    
    Set par = Nothing
  End If
End Sub

'  

Sub DrawArc(doc As Kompas6API5.Document2D)
  '  
  doc.ksMtr 10, 10, 0, 1, 1                   '    ( 10   OX, 10   OY )
    Dim p As Long
    p = doc.ksArcByAngle(30, 20, 20, 45, 135, 1, 1) '    
  doc.ksDeleteMtr                             '    

  '      
  Dim par As Kompas6API5.ArcByAngleParam      '  ksArcByAngleParam
  '      ,   
  Set par = Kompas.GetParamStruct(ko_ArcByAngleParam)
  
  Dim par1 As Kompas6API5.ArcByPointParam     '  ksArcByPointParam
  '     
  Set par1 = Kompas.GetParamStruct(ko_ArcByPointParam)
  
  If Not par Is Nothing And Not par1 Is Nothing Then '  
    Dim t As Integer
    t = doc.ksGetObjParam(p, par, ALLPARAM)   '   

    Kompas.ksMessage "t = " & t & " xc = " & par.xc & " yc = " & par.yc & " rad = " & par.rad & _
                     " a1 = " & par.ang1 & " a2 = " & par.ang2 & " napr = " & par.Dir & " tl = " & par.Style

    '     
    par1.xc = 40                              '   
    par1.yc = 30
    par1.rad = 10                             ' 
    par1.Dir = 1                              '   
    par1.Style = 2                            ' C 
    par1.X1 = 50                              '   
    par1.Y1 = 30
    par1.X2 = 40                              '   
    par1.Y2 = 20

    If doc.ksSetObjParam(p, par1, 1) Then     '   
      Kompas.ksMessage " "
    Else
      Kompas.ksMessageBoxResult               '      
    End If
    
    Set par = Nothing
    Set par1 = Nothing
  End If
End Sub

'   

Sub DrawLine(doc As Kompas6API5.Document2D)
  doc.ksMtr 0, 0, 45, 1, 1                    '    (   45  )
    Dim p As Long
    p = doc.ksLine(30, 20, 0)                 '   
  doc.ksDeleteMtr                             '    

  '    
  Dim par As Kompas6API5.LineParam            '  ksLineParam
  '    
  Set par = Kompas.GetParamStruct(ko_LineParam)
  
  If Not par Is Nothing Then                  '  
    par.Init                                  ' 
    
    Dim t As Integer
    t = doc.ksGetObjParam(p, par, ALLPARAM)   '    
    Kompas.ksMessage "t = " & t & " x = " & par.x & " y = " & par.y & " alf = " & par.angle

    '    
    par.x = 0                                 '  
    par.y = 0
    par.angle = 90                            '   

    If doc.ksSetObjParam(p, par, ALLPARAM) Then '    
      Kompas.ksMessage " "
    Else
      Kompas.ksMessageBoxResult               '      
    End If
    
    Set par = Nothing
  End If
End Sub

'  

Sub DrawCircle(doc As Kompas6API5.Document2D)
  doc.ksMtr 0, 0, 0, 2, 2                     '    (  2:1 )
    Dim p As Long
    p = doc.ksCircle(30, 20, 10, 1)           '  
  doc.ksDeleteMtr                             '    

  '   
  Dim par As Kompas6API5.CircleParam          '  ksCircleParam
  '   
  Set par = Kompas.GetParamStruct(ko_CircleParam)
  
  If Not par Is Nothing Then                  '  
    Dim t As Integer
    t = doc.ksGetObjParam(p, par, ALLPARAM)   '   
    Kompas.ksMessage "t = " & t & " xc = " & par.xc & " yc = " & par.yc & " rad = " & par.rad & _
                     " tl = " & par.Style

    '   
    par.xc = 0                                '   
    par.yc = 0
    par.rad = 20                              '  
    par.Style = 2                             ' C 
    
    If doc.ksSetObjParam(p, par, ALLPARAM) Then '   
      Kompas.ksMessage " "
    Else
      Kompas.ksMessageBoxResult               '      
    End If
    
    Set par = Nothing
  End If
End Sub

' C 

Sub DrawPoint(doc As Kompas6API5.Document2D)
  ' C  
  ' 0-, 1-, 2--, 3-, 4-, 5-, 6-,
  ' 7- 

  doc.ksMtr 10, 10, 0, 1, 1                   '    ( 10   OX, 10   OY )
    Dim p As Long
    p = doc.ksPoint(30, 40, 0)                '  
    
    doc.ksPoint 40, 40, 1
    doc.ksPoint 50, 40, 2
    doc.ksPoint 60, 40, 3
    doc.ksPoint 70, 40, 4
    doc.ksPoint 80, 40, 5
    doc.ksPoint 90, 40, 6
    doc.ksPoint 100, 40, 7
  doc.ksDeleteMtr                             '    

  '   
  Dim par As Kompas6API5.PointParam           '  ksPointParam
  '   
  Set par = Kompas.GetParamStruct(ko_PointParam)
  
  If Not par Is Nothing Then                  '  
    Dim t As Integer
    t = doc.ksGetObjParam(p, par, ALLPARAM)   '   
    Kompas.ksMessage "t = " & t & " x = " & par.x & " y = " & par.y & " style = " & par.Style

    '   
    par.x = 20                                '  
    par.y = 30
    par.Style = 7                             ' C  

    If doc.ksSetObjParam(p, par, ALLPARAM) Then '   
      Kompas.ksMessage " "
    Else
      Kompas.ksMessageBoxResult               '      
    End If
    
    Set par = Nothing
  End If
End Sub

'  Bezier 

Sub DrawBezier(doc As Kompas6API5.Document2D)
  ' 1.    ( 0 -  , 1 -  )
  ' 2. C  ( 1 - , 2 - , 3 - , 4 - ,
  '    5 - , 6 - , 7 -    ,
  '    8 -  , 9 -  , 10 -  ,
  '    11 - ,    )
  doc.ksBezier 0, 1                           '  Bezier 
    doc.ksPoint 0, 0, 0                       '     
    doc.ksPoint 20, 20, 0
    doc.ksPoint 50, 10, 0
    doc.ksPoint 70, 20, 0
    doc.ksPoint 100, 0, 0
  Dim p As Long
  p = doc.ksEndObj                            '  EndObj       
  
  '   Bezier 
  Dim pPar As Kompas6API5.MathPointParam      '  ksMathPointParam
  '    
  Set pPar = Kompas.GetParamStruct(ko_MathPointParam)
  
  Dim par As Kompas6API5.BezierParam          '  ksBezierParam
  '    
  Set par = Kompas.GetParamStruct(ko_BezierParam)
  
  If Not pPar Is Nothing And Not par Is Nothing Then '  
    par.Init                                  ' 
    
    Dim arr As Kompas6API5.DynamicArray       '  ksDynamicArray
    Set arr = par.GetMathPointArr             '     .

    If Not arr Is Nothing Then                '  
      Dim t As Integer
      t = doc.ksGetObjParam(p, par, ALLPARAM) '   Bezier 

      Dim count As Integer
      count = arr.ksGetArrayCount             '    
      Kompas.ksMessage "t = " & t & " count = " & count & " close = " & par.closed & " tl = " & par.Style

      '    
      Dim i As Integer
      For i = 0 To count - 1                  '     
        arr.ksGetArrayItem i, pPar            '    
        Kompas.ksMessage "x[" & i & "] = " & pPar.x & " y[" & i & "] = " & pPar.y
      Next

      '    
      arr.ksClearArray                        '       
      
      '      
      pPar.x = 0                              '  
      pPar.y = 0
      arr.ksAddArrayItem -1, pPar             '    ,     
      pPar.x = 20                             '  
      pPar.y = 20
      arr.ksAddArrayItem -1, pPar             '    ,     
      pPar.x = 50                             '  
      pPar.y = 10
      arr.ksAddArrayItem -1, pPar             '    ,     
      pPar.x = 70                             '  
      pPar.y = 20
      arr.ksAddArrayItem -1, pPar             '    ,     
      pPar.x = 100                            '  
      pPar.y = 0
      arr.ksAddArrayItem -1, pPar             '    ,     
      pPar.x = 50                             '  
      pPar.y = -50
      arr.ksAddArrayItem -1, pPar             '    ,     

      par.Style = 2                           ' C 
      par.closed = 1                          '    ( 0 -  , 1 -  )

      If doc.ksSetObjParam(p, par, ALLPARAM) Then '   Bezier 
        Kompas.ksMessage " "
      Else
        Kompas.ksMessageBoxResult             '      
      End If
      
      arr.ksDeleteArray                       '     
      Set arr = Nothing
    End If
    
    Set pPar = Nothing
    Set par = Nothing
  End If
End Sub

'  

Sub DrawHatch(doc As Kompas6API5.Document2D)
  '   
  doc.ksMtr 30, 20, 0, 0.5, 0.5               '    ( 30   OX, 20   OY,  1:2 )
    doc.ksLineSeg 20, 30, 70, 30, 2           '  
    doc.ksLineSeg 70, 30, 70, 80, 2
    doc.ksLineSeg 70, 80, 20, 80, 2
    doc.ksLineSeg 20, 80, 20, 30, 2
  
    '   ksHatch
    ' 1.   ( 0 - , 1 - , 2 - , 3 -  ,
    '     4 - , 5 - , 6 - , 7 - , 8 -  ,
    '     9 -  , 10 -  , 11 - ,
    '     12 -  , 13 -    , 14 -  )
    ' 2.  
    ' 3.  
    ' 4.    ( 0 -    )
    ' 5, 6.  
    If doc.ksHatch(0, 45, 2, 0, 0, 0) Then    '  
      doc.ksLineSeg 20, 30, 70, 30, 2         '     
      doc.ksLineSeg 70, 30, 70, 80, 2
      doc.ksLineSeg 70, 80, 20, 80, 2
      doc.ksLineSeg 20, 80, 20, 30, 2
      Dim p As Long
      p = doc.ksEndObj                        '  EndObj     
    Else
      Kompas.ksMessageBoxResult               '  
    End If
    
  doc.ksDeleteMtr                             '    

  '   
  Dim par As Kompas6API5.HatchParam           '  ksHatchParam
  '   
  Set par = Kompas.GetParamStruct(ko_HatchParam)
  
  If Not par Is Nothing Then                  '  
    par.Init                                  ' 
    
    Dim t As Integer
    t = doc.ksGetObjParam(p, par, ALLPARAM)   '   
    Kompas.ksMessage "t = " & t & " tip = " & par.Style & " angl = " & par.ang & _
                     " shag = " & par.Step & " width = " & par.Width & _
                     " x0 = " & par.x & " y0 = " & par.y
    
    doc.ksMtr 0, 0, 0, 2, 2                   '    (  2:1 )
      '   
      par.x = 0.8
      '   
      If doc.ksSetObjParam(p, par, ALLPARAM) Then
        Kompas.ksMessage " "
      Else
        Kompas.ksMessageBoxResult             '      
      End If
    doc.ksDeleteMtr                           '    

    Set par = Nothing
  End If
End Sub

'   

Sub PrintPar1(par2 As Kompas6API5.TextLineParam, par3 As Kompas6API5.TextItemParam, arr2 As Kompas6API5.DynamicArray)
  Dim font As Kompas6API5.TextItemFont        '  ksTextItemFont
  
  Kompas.ksMessage "style = " & par2.Style    ' 

  Dim count As Integer
  count = arr2.ksGetArrayCount                '   
  Dim j As Integer
  
  For j = 0 To count - 1                      '    
    arr2.ksGetArrayItem j, par3               '    
    
    Set font = par3.GetItemFont               '     .
    If Not font Is Nothing Then               '   
      Kompas.ksMessage "j = " & j & " h = " & font.HEIGHT & " s = " & par3.s & _
                       " fontName = " & font.FontName
      Set font = Nothing
    End If
  Next
  Kompas.ksMessageBoxResult                   '  
End Sub

' 

Sub DrawText(doc As Kompas6API5.Document2D)
  Dim par As Kompas6API5.ParagraphParam       '  ksParagraphParam
  '   
  Set par = Kompas.GetParamStruct(ko_ParagraphParam)
  
  Dim par1 As Kompas6API5.TextParam           '  ksTextParam
  Set par1 = Kompas.GetParamStruct(ko_TextParam) '  
  
  Dim par2 As Kompas6API5.TextLineParam       '  ksTextLineParam
  Set par2 = Kompas.GetParamStruct(ko_TextLineParam) '   
  
  Dim par3 As Kompas6API5.TextItemParam       '  ksTextItemParam
  Set par3 = Kompas.GetParamStruct(ko_TextItemParam) '    .
  
  Dim itemParam As Kompas6API5.TextItemParam '  ksTextItemParam
  Set itemParam = Kompas.GetParamStruct(ko_TextItemParam) '    .
    
  Dim p As Long
  If Not par Is Nothing And Not par1 Is Nothing And Not par2 Is Nothing _
     And Not par3 Is Nothing And Not itemParam Is Nothing Then '  
    par1.Init                                 ' 
    par2.Init                                 ' 
    par3.Init                                 ' 
    par.Init                                  ' 
    itemParam.Init                            ' 
    
    par.x = 30                                '    
    par.y = 30
    par.HEIGHT = 25                           '   
    par.Width = 20                            '   

    Dim itemFont As Kompas6API5.TextItemFont  '  ksTextItemFont
    Set itemFont = itemParam.GetItemFont      '     .

    If Not itemFont Is Nothing Then           '  
      itemFont.Init                           ' 
      
      doc.ksParagraph par                     '      

      '   
      itemFont.SetBitVectorValue NEW_LINE, True '  
      itemParam.s = "111"                     '  
      doc.ksTextLine itemParam                '    

      itemFont.Init                           ' 
      itemFont.SetBitVectorValue NUMERATOR, True ' , ,  
      itemFont.SetBitVectorValue ITALIC_ON, True '  1.5    
      itemParam.s = "55"                      '  
      doc.ksTextLine itemParam                '  

      itemFont.Init                           ' 
      itemFont.SetBitVectorValue DENOMINATOR, True ' , 
      itemParam.s = "77"                      '  
      doc.ksTextLine itemParam                '  

      itemFont.Init                           ' 
      itemFont.SetBitVectorValue END_FRACTION, True '  ,
      itemFont.SetBitVectorValue BOLD_OFF, True     '  ,
      itemFont.SetBitVectorValue ITALIC_OFF, True   '  
      itemParam.s = "4444"                    '  
      doc.ksTextLine itemParam                '   
      
      Set itemFont = Nothing
      
      '     EndObj,     
      p = doc.ksEndObj
    End If

    '         :
    Dim arr1 As Kompas6API5.DynamicArray      '  ksDynamicArray
    Set arr1 = par1.GetTextLineArr            '   
    
    Dim arr2 As Kompas6API5.DynamicArray      '  ksDynamicArray
    Set arr2 = par2.GetTextItemArr            '    
    
    If Not arr1 Is Nothing And Not arr2 Is Nothing Then '  
      doc.ksGetObjParam p, par2, 0            '   1 -  (  0 )

      PrintPar1 par2, par3, arr2              '   

      If Kompas.ksYesNo("   ?") Then
        '     ITALIC  BOLD   
        arr2.ksGetArrayItem 0, par3
        
        Dim font As Kompas6API5.TextItemFont  '  ksTextItemFont
        Set font = par3.GetItemFont           '     .
        If Not font Is Nothing Then           '  
          font.SetBitVectorValue BOLD_OFF, True   '  
          font.SetBitVectorValue ITALIC_OFF, True '  
          font.COLOR = RGB(0, 255, 0)         '   - 
          
          arr2.ksSetArrayItem 0, par3         '   
          doc.ksSetObjParam p, par2, 0        '     
          doc.ksGetObjParam p, par2, 0        '   1-  (  0 )
          PrintPar1 par2, par3, arr2          '   
          
          Set font = Nothing
        End If
      End If
      
      Set arr1 = Nothing
      Set arr2 = Nothing
    End If
    
    Set par = Nothing
    Set par1 = Nothing
    Set par2 = Nothing
    Set par3 = Nothing
    Set itemParam = Nothing
  End If
End Sub

'   

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

'    -      

Public Sub ExternalRunCommand(ByVal command As Integer, ByVal mode As Integer, ByVal kompas_ As Kompas6API5.Application)
  Set Kompas = kompas_                        '   
  Dim doc As Kompas6API5.Document2D           '  ksDocument2D
    
  '   2D 
  If command = 1 Then                         '   1
    Set doc = Kompas.Document2D               '    2D 
  Else                                        '   
    Set doc = Kompas.ActiveDocument2D         '    2D 
  End If
  
  Select Case command
    Case 1                                    ' C 
      WorkDocument doc
    Case 2
      DrawView doc                            ' 
    Case 3
      DrawLayer doc                           ' 
    Case 4
      DrawGroup doc                           ' 
    Case 5
      WorkNameGroup doc                       '  
    Case 6
      DrawLineSeg doc                         ' 
    Case 7
      DrawArc doc                             ' 
    Case 8
      DrawLine doc                            ' 
    Case 9
      DrawCircle doc                          ' 
    Case 10
      DrawPoint doc                           ' 
    Case 11
      DrawBezier doc                          ' Bezier-
    Case 12
      DrawHatch doc                           ' 
    Case 13
      DrawText doc                            ' 
  End Select
End Sub

'   

Public Function ExternalMenuItem(ByVal number As Integer, itemType As Integer, command As Integer) As String
    itemType = 3 '"ENDMENU"'
    ExternalMenuItem = ""
    command = -1

    Select Case number
        Case 1                                '  1 -  
            itemType = 1 'MENUITEM'
            ExternalMenuItem = " "
            command = 1
        Case 2                                '  2 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 2
        Case 3                                '  3 - C
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "C"
            command = 3
        Case 4                                '  4 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 4
        Case 5                                '  5 -  
            itemType = 1 'MENUITEM'
            ExternalMenuItem = " "
            command = 5
        Case 6                                '  6 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 6
        Case 7                                '  7 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 7
        Case 8                                '  8 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 8
        Case 9                                '  9 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 9
        Case 10                               '  10 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 10
        Case 11                               '  11 - Bezier-
            itemType = 1 'MENUITEM'
            ExternalMenuItem = "Bezier-"
            command = 11
        Case 12                               '  12 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 12
        Case 13                               '  13 - 
            itemType = 1 'MENUITEM'
            ExternalMenuItem = ""
            command = 13
        Case 14                               '   
            itemType = 3 '"ENDMENU"'
            ExternalMenuItem = ""
            command = -1
    End Select
End Function

