BUG 11/BUGCD1998_02.ISO/aplic/turbocad/tcw.z/Extrude.bas

BASIC Source File | 1997-05-05 | 5KB | 235 lines

' This sample program is to illustrate how to use Enable to access to 3D capabilities
' of the TurboCAD 3.0 drawing database.
'
' I step though all selected graphics and clone them at a Z offset. I also panel the
' gap between the two copies with solid rectangles. This code currently only works well
' for multilines. To see cool effects, draw some text and explode it twice. (Once gets
' you a group of solid filled multilines. Twice ungroups them into individual multilines.)
' Select the multilines and run this script. After this you may want to try applying
' my ZSORT.BAS for even better effects.
'
' Author    : Mike Cartwright, Tamara Cartwright
' Date        : 11/26/95, 03/10/97
'


' DBAPI Constants
Global Const BrushSolid = 1
Global Const DM_NORMAL  = 1
Global Const GK_ARC     = 2
Global Const GK_GRAPHIC = 11
Global Const GF_NORMAL  = 1
Global Const VF_PENDOWN = 1
Global Const NULL         = 0
Global Const DM_USEGDM  = 0

' Result is a global variable returned by each page to tell the
' state machine which button was pressed :
Dim Result As Long

Global Const CancelID = 1
Global Const CreateID = 2

Dim ZOffset      As Double



Sub main


    Dim dActive  As Long
    Dim gCount as Long
    Dim gChild as Long
    Dim gNew as Long
    Dim gFacet as Long

    Dim vChild as Long
    Dim lv as Long
    Dim rgb As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long

    Dim vflags As Long
    Dim vCount As Long
    Dim Pendown As Long

    Dim x as Double
    Dim y as Double
    Dim z as Double

    Dim xp as Double
    Dim yp as Double
    Dim zp as Double

    Dim zo as Double

    ZOffset = 1

    OffsetDlg

    if Result = CreateID Then



     ' Check for valid drawing
     dActive    = TCWDrawingActive ()
       If dActive = NULL Then
          MsgBox "Program requires active drawing. Open any drawing and try again."
          ' Terminate the program
          Stop
       End If

     gCount = TCWSelectionCount()
     if gCount = 0 Then
        MsgBox "Need to select at least one graphic before running program."
        Stop
     End if

     'Get first selected graphic
     i = 0
     gChild = TCWSelectionAt(i)

     i = i +1
     vCount = 0

     TCWUndoRecordStart dActive, "Extrude"

       while (gChild <> NULL)
        gNew = TCWGraphicCreate( GK_GRAPHIC, "" )
        rgb = TCWGraphicPropertyGet(gChild, "PenColor")

        ' Color is set as R, G, B
        'r = rgb mod 256
        'g = (rgb / 256) mod 256
        'b = rgb / 65536

        vCount = TCWVertexCount(gChild)
          vChild = TCWVertexAt(gChild, 0)

        ' Unlikely value
        zp = -4242

        while (vChild <> NULL)

           'vflags = GetVFlags(vChild)
         'If vflags is odd then the pen is down
         'Pendown = vflags mod 2

         x = TCWGetX(vChild)
         y = TCWGetY(vChild)
         z = TCWGetZ(vChild)

         zo = z + ZOffset

         TCWGraphicXYZAdd gNew, x, y, zo

         if vCount/2 = 0 Then
            lv = TCWVertexAt(gNew, vCount)
            TCWPendown lv, 0
         End If

         vCount = vCount + 1


         ' This happens every time except the first
         If zp <> -4242 and (vCount/2) <> 0 Then
            gFacet = TCWGraphicCreate( GK_GRAPHIC, "")
            res = TCWGraphicPropertySet(gFacet, "PenColor", rgb)
            'SetPenColorG gFacet, r, g, b

            TCWGraphicXYZAdd gFacet, x, y, z
            TCWGraphicXYZAdd gFacet, xp, yp, zp
            zo = zp + ZOffset
            TCWGraphicXYZAdd gFacet, xp, yp, zo
            zo = z + ZOffset
            TCWGraphicXYZAdd gFacet, x, y, zo
            TCWGraphicXYZAdd gFacet, x, y, z

            TCWGraphicClose gFacet

            ' Fill Pattern is a style. We know that style 1 is always solid
            'GraphicSetBrushStyle gFacet, BrushSolid
            res = TCWGraphicPropertySet(gFacet, "BrushSytle", BrushSolid)

            ' Add the black background of the pad to the pad group
            TCWGraphicAppend NULL, gFacet

            TCWGraphicDraw gFacet, 0
            TCWUndoRecordAddGraphic dActive, gFacet

         End If

         xp = x
         yp = y
         zp = z

         vChild = TCWVertexAt(gChild, vCount)
        wend

        if vCount > 1 Then
           ' SetPenColorG gNew, r, g, b
           res = TCWGraphicPropertySet(gNew, "PenColor", &H00FF0000)
           'SetPenColorG gNew, 255, 0, 0

           TCWGraphicClose gNew, 1

           ' Fill Pattern is a style. We know that style 1 is always solid
           res = TCWGraphicPropertySet(gNew, "BrushStyle", BrushSolid)

           'GraphicSetBrushStyle gNew, BrushSolid

           ' Add the black background of the pad to the pad group
           TCWGraphicAppend NULL, gNew

           TCWGraphicDraw gNew, 0

           TCWUndoRecordAddGraphic dActive, gNew
       Else
           TCWGraphicDispose gNew
       End If

       gChild = TCWSelectionAt(i)
      wend

      TCWUndoRecordEnd dActive

   end if

End Sub


Sub OffsetDlg ()

    Begin Dialog OffsetDialog 31, 32, 185, 96, "Extrude Script"

        PushButton 24,  79, 35, 14, "Cancel"             ' Button 2

        PushButton 144, 79, 35, 14, "&Finish"            ' Button 4
        GroupBox 1, 75, 183, 0, ""

        GroupBox 10, 12, 82, 48, "Offset"
        Text      14, 21, 74, 30, "In World Units in the Z direction:"
        TextBox  14, 42, 50, 12, .dz
    End Dialog

    Dim Dlg1 As OffsetDialog

    Do
        Dlg1.dz = ZOffset
        Result = Dialog(Dlg1)
        ZOffset = Dlg1.dz

        If Result = CancelID Then
            Exit Do
        End If

        If ZOffset > -1000 And ZOffset < 1000 Then
            Exit Do
        End If

        MsgBox "Try a realistic offset value"

    Loop
End Sub