home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BUG 11
/
BUGCD1998_02.ISO
/
aplic
/
turbocad
/
tcw.z
/
Extrude.bas
< prev
next >
Wrap
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