home *** CD-ROM | disk | FTP | other *** search
/ BUG 11 / BUGCD1998_02.ISO / aplic / turbocad / tcw.z / Extrude.bas < prev    next >
BASIC Source File  |  1997-05-05  |  5KB  |  235 lines

  1. ' This sample program is to illustrate how to use Enable to access to 3D capabilities
  2. ' of the TurboCAD 3.0 drawing database.
  3. '
  4. ' I step though all selected graphics and clone them at a Z offset. I also panel the
  5. ' gap between the two copies with solid rectangles. This code currently only works well
  6. ' for multilines. To see cool effects, draw some text and explode it twice. (Once gets
  7. ' you a group of solid filled multilines. Twice ungroups them into individual multilines.)
  8. ' Select the multilines and run this script. After this you may want to try applying
  9. ' my ZSORT.BAS for even better effects.
  10. '
  11. ' Author    : Mike Cartwright, Tamara Cartwright
  12. ' Date        : 11/26/95, 03/10/97
  13. '
  14.  
  15.  
  16. ' DBAPI Constants
  17. Global Const BrushSolid = 1
  18. Global Const DM_NORMAL  = 1
  19. Global Const GK_ARC     = 2
  20. Global Const GK_GRAPHIC = 11
  21. Global Const GF_NORMAL  = 1
  22. Global Const VF_PENDOWN = 1
  23. Global Const NULL         = 0
  24. Global Const DM_USEGDM  = 0
  25.  
  26. ' Result is a global variable returned by each page to tell the
  27. ' state machine which button was pressed :
  28. Dim Result As Long
  29.  
  30. Global Const CancelID = 1
  31. Global Const CreateID = 2
  32.  
  33. Dim ZOffset      As Double
  34.  
  35.  
  36.  
  37. Sub main
  38.  
  39.  
  40.     Dim dActive  As Long
  41.     Dim gCount as Long
  42.     Dim gChild as Long
  43.     Dim gNew as Long
  44.     Dim gFacet as Long
  45.  
  46.     Dim vChild as Long
  47.     Dim lv as Long
  48.     Dim rgb As Long
  49.     Dim r As Long
  50.     Dim g As Long
  51.     Dim b As Long
  52.  
  53.     Dim vflags As Long
  54.     Dim vCount As Long
  55.     Dim Pendown As Long
  56.  
  57.     Dim x as Double
  58.     Dim y as Double
  59.     Dim z as Double
  60.  
  61.     Dim xp as Double
  62.     Dim yp as Double
  63.     Dim zp as Double
  64.  
  65.     Dim zo as Double
  66.  
  67.     ZOffset = 1
  68.  
  69.     OffsetDlg
  70.  
  71.     if Result = CreateID Then
  72.  
  73.     
  74.        
  75.      ' Check for valid drawing 
  76.      dActive    = TCWDrawingActive ()  
  77.        If dActive = NULL Then
  78.           MsgBox "Program requires active drawing. Open any drawing and try again."
  79.           ' Terminate the program
  80.           Stop
  81.        End If
  82.            
  83.      gCount = TCWSelectionCount()
  84.      if gCount = 0 Then
  85.         MsgBox "Need to select at least one graphic before running program."
  86.         Stop
  87.      End if
  88.  
  89.      'Get first selected graphic
  90.      i = 0
  91.      gChild = TCWSelectionAt(i)
  92.     
  93.      i = i +1
  94.      vCount = 0
  95.  
  96.      TCWUndoRecordStart dActive, "Extrude"
  97.         
  98.        while (gChild <> NULL)     
  99.         gNew = TCWGraphicCreate( GK_GRAPHIC, "" )
  100.         rgb = TCWGraphicPropertyGet(gChild, "PenColor")
  101.  
  102.         ' Color is set as R, G, B
  103.         'r = rgb mod 256
  104.         'g = (rgb / 256) mod 256
  105.         'b = rgb / 65536
  106.  
  107.         vCount = TCWVertexCount(gChild)
  108.           vChild = TCWVertexAt(gChild, 0)
  109.             
  110.         ' Unlikely value
  111.         zp = -4242        
  112.  
  113.         while (vChild <> NULL)     
  114.  
  115.            'vflags = GetVFlags(vChild)
  116.          'If vflags is odd then the pen is down
  117.          'Pendown = vflags mod 2
  118.  
  119.          x = TCWGetX(vChild)
  120.          y = TCWGetY(vChild)
  121.          z = TCWGetZ(vChild)
  122.  
  123.          zo = z + ZOffset
  124.  
  125.          TCWGraphicXYZAdd gNew, x, y, zo
  126.  
  127.          if vCount/2 = 0 Then
  128.             lv = TCWVertexAt(gNew, vCount)
  129.             TCWPendown lv, 0
  130.          End If
  131.  
  132.          vCount = vCount + 1
  133.                 
  134.                 
  135.          ' This happens every time except the first
  136.          If zp <> -4242 and (vCount/2) <> 0 Then
  137.             gFacet = TCWGraphicCreate( GK_GRAPHIC, "")
  138.             res = TCWGraphicPropertySet(gFacet, "PenColor", rgb)
  139.             'SetPenColorG gFacet, r, g, b
  140.  
  141.             TCWGraphicXYZAdd gFacet, x, y, z
  142.             TCWGraphicXYZAdd gFacet, xp, yp, zp
  143.             zo = zp + ZOffset
  144.             TCWGraphicXYZAdd gFacet, xp, yp, zo
  145.             zo = z + ZOffset
  146.             TCWGraphicXYZAdd gFacet, x, y, zo
  147.             TCWGraphicXYZAdd gFacet, x, y, z
  148.                                         
  149.             TCWGraphicClose gFacet
  150.             
  151.             ' Fill Pattern is a style. We know that style 1 is always solid
  152.             'GraphicSetBrushStyle gFacet, BrushSolid
  153.             res = TCWGraphicPropertySet(gFacet, "BrushSytle", BrushSolid)
  154.  
  155.             ' Add the black background of the pad to the pad group
  156.             TCWGraphicAppend NULL, gFacet
  157.  
  158.             TCWGraphicDraw gFacet, 0                
  159.             TCWUndoRecordAddGraphic dActive, gFacet
  160.  
  161.          End If
  162.  
  163.          xp = x
  164.          yp = y
  165.          zp = z
  166.         
  167.          vChild = TCWVertexAt(gChild, vCount)
  168.         wend
  169.  
  170.         if vCount > 1 Then
  171.            ' SetPenColorG gNew, r, g, b
  172.            res = TCWGraphicPropertySet(gNew, "PenColor", &H00FF0000)
  173.            'SetPenColorG gNew, 255, 0, 0
  174.  
  175.            TCWGraphicClose gNew, 1
  176.                         
  177.            ' Fill Pattern is a style. We know that style 1 is always solid
  178.            res = TCWGraphicPropertySet(gNew, "BrushStyle", BrushSolid)
  179.  
  180.            'GraphicSetBrushStyle gNew, BrushSolid
  181.  
  182.            ' Add the black background of the pad to the pad group
  183.            TCWGraphicAppend NULL, gNew
  184.  
  185.            TCWGraphicDraw gNew, 0
  186.                 
  187.            TCWUndoRecordAddGraphic dActive, gNew
  188.        Else
  189.            TCWGraphicDispose gNew
  190.        End If
  191.  
  192.        gChild = TCWSelectionAt(i)
  193.       wend
  194.  
  195.       TCWUndoRecordEnd dActive
  196.       
  197.    end if
  198.  
  199. End Sub
  200.  
  201.  
  202. Sub OffsetDlg ()
  203.     
  204.     Begin Dialog OffsetDialog 31, 32, 185, 96, "Extrude Script"
  205.  
  206.         PushButton 24,  79, 35, 14, "Cancel"             ' Button 2
  207.  
  208.         PushButton 144, 79, 35, 14, "&Finish"            ' Button 4
  209.         GroupBox 1, 75, 183, 0, ""
  210.  
  211.         GroupBox 10, 12, 82, 48, "Offset"
  212.         Text      14, 21, 74, 30, "In World Units in the Z direction:"
  213.         TextBox  14, 42, 50, 12, .dz
  214.     End Dialog    
  215.  
  216.     Dim Dlg1 As OffsetDialog
  217.  
  218.     Do
  219.         Dlg1.dz = ZOffset
  220.         Result = Dialog(Dlg1)
  221.         ZOffset = Dlg1.dz
  222.  
  223.         If Result = CancelID Then
  224.             Exit Do
  225.         End If
  226.  
  227.         If ZOffset > -1000 And ZOffset < 1000 Then
  228.             Exit Do
  229.         End If
  230.         
  231.         MsgBox "Try a realistic offset value"
  232.         
  233.     Loop
  234. End Sub
  235.