home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F41302_modExtrudeText.bas < prev    next >
Encoding:
BASIC Source File  |  2001-10-16  |  6.4 KB  |  165 lines
  1. Attribute VB_Name = "modExtrudeText"
  2. '******************************************************************'
  3. '*                                                                *'
  4. '*                      TurboCAD for Windows                      *'
  5. '*                   Copyright (c) 1993 - 2001                    *'
  6. '*             International Microcomputer Software, Inc.         *'
  7. '*                            (IMSI)                              *'
  8. '*                      All rights reserved.                      *'
  9. '*                                                                *'
  10. '******************************************************************'
  11.  
  12. 'All variables must be declared
  13. Option Explicit
  14.  
  15. 'Useful constant for rotations that need to be specified in radians
  16. Const Pi# = 3.14159
  17.  
  18. 'Text string to create
  19. Const Text As String = "Hello, 3D World!"
  20.  
  21. 'Height of text in world units
  22. Const TextHeight# = 0.8
  23.  
  24. 'Angle to draw text at (45 degrees)
  25. Const TextAngle# = 45 * (Pi / 180)
  26.  
  27. 'CountCosmetics
  28. 'Report how many child graphics are cosmetic
  29. Private Function CountCosmetics(ByVal gr As Graphic)
  30.     Dim cCosmetic As Long
  31.     cCosmetic = 0
  32.     With gr.Graphics
  33.         Dim count As Long
  34.         count = .count
  35.         Dim i As Long
  36.         For i = 0 To count - 1
  37.             If .Item(i).Cosmetic Then cCosmetic = cCosmetic + 1
  38.         Next
  39.     End With
  40.     CountCosmetics = cCosmetic
  41. End Function
  42.  
  43. 'DebugGraphicInfo
  44. 'Just dump some information into the Visual Basic Immediate Window
  45. Private Sub DebugGraphicInfo(ByVal Name As String, ByVal gr As Graphic)
  46.     Debug.Print Name & ": type = "; gr.Type
  47.     Debug.Print " with " & gr.Vertices.count & " vertices"
  48.     Debug.Print "  and " & gr.Graphics.count & " child graphics (" & _
  49.         CountCosmetics(gr) & " cosmetic)"
  50. End Sub
  51.  
  52. 'CreateExtrudedText
  53. 'Example to demonstrate the use of TEXT and TCW40EXTRUDE graphic subtypes
  54. 'Steps in the macro:
  55. 'Step 1. Create and position a flexible text TEXT graphic
  56. 'Step 2. Explode the TEXT graphic into individual letters
  57. 'Step 3. Create an extrusion of each letter, varying the extrusion height and color
  58. 'Make it Public, in case you want to re-use this
  59. Public Sub CreateExtrudedText()
  60.  
  61.     'Graphics collection that we create text and extrusions with
  62.     Dim Grs As Graphics
  63.     Set Grs = ActiveDrawing.Graphics
  64.     
  65.     'Step 1. Create and position a flexible TEXT graphic
  66.     'AddText method takes string, starting point X, Y, Z, and height
  67.     Dim GrText As Graphic
  68.     Set GrText = Grs.AddText(Text, 0, 0, 0, TextHeight)
  69.     DebugGraphicInfo "GrText created", GrText
  70.     
  71.     'Set the newly created TEXT graphic to "Flexible" type
  72.     'Flexible text is described by polygons
  73.     GrText.Properties("TextMode") = 3 'TextMode 3 = Flexible
  74.     
  75.     'Get TEXT graphic's center from it's bounding box
  76.     Dim xc#, yc#, zc#
  77.     With GrText.CalcBoundingBox
  78.         xc = (.Max.X + .Min.X) / 2
  79.         yc = (.Max.Y + .Min.Y) / 2
  80.         zc = (.Max.Z + .Min.Z) / 2
  81.     End With
  82.     
  83.     'Rotate the TEXT graphic 45 degrees about the Z axis
  84.     'RotateAxis method takes angle, axis, and center of rotation
  85.     GrText.RotateAxis TextAngle, 0, 0, 1, xc, yc, zc
  86.     
  87.     'Translate the TEXT graphic so that the center of the graphic is at 5, 5, 0
  88.     Dim x0#, y0#, z0#
  89.     x0 = 5: y0 = 5: z0 = 0
  90.     GrText.MoveRelative x0 - xc, y0 - yc, z0 - zc
  91.     
  92.     'Step 2. Explode the TEXT graphic into individual letters
  93.     'Exploding a flexible TEXT graphic returns a GraphicSet containing
  94.     'only one graphic: a Group of graphics.
  95.     
  96.     'Explode method returns a GraphicSet; we take the first and only one (index 0).
  97.     'GrExplode is a group object
  98.     Dim GrExplode As Graphic
  99.     Set GrExplode = GrText.Explode(0)
  100.     DebugGraphicInfo "GrExplode created", GrExplode
  101.     
  102.     'Explode the group and get a GraphicSet, in which each graphic
  103.     'is a polyline (with possible pen up segments) representing an individual letter.
  104.     Dim GrSet As GraphicSet
  105.     Set GrSet = GrExplode.Explode
  106.     
  107.     'Step 3. Create an extrusion of each letter, varying the extrusion height and color
  108.     With GrSet
  109.     
  110.         'Get the size of the GraphicSet
  111.         Dim GrSetCount As Long
  112.         GrSetCount = .count
  113.         
  114.         'Go through each letter in the GraphicSet
  115.         Dim i As Long
  116.         For i = 0 To GrSetCount - 1
  117.         
  118.             'GrSect is a letter graphic left from the explosion
  119.             Dim GrSect As Graphic
  120.             Set GrSect = .Item(i)
  121.             DebugGraphicInfo "GrSect(" & i & ") from set", GrSect
  122.             
  123.             'Deselect it; Explode always selects the result of the explosion
  124.             GrSect.Properties("Selected") = 0
  125.         
  126.             'Create an extrusion
  127.             'Add method takes RegenMethod optional parameter to create a Regen graphic
  128.             Dim GrExtrude As Graphic
  129.             Set GrExtrude = Grs.Add(RegenMethod:="TCW40EXTRUDE")
  130.             DebugGraphicInfo "GrExtrude(" & i & ") created", GrExtrude
  131.             
  132.             'Make the extrusion graphic transparent
  133.             GrExtrude.Properties("Solid") = 0
  134.             
  135.             'Give it one of the 16 "basic" colors
  136.             'See the VBA documentation for QBColor...
  137.             GrExtrude.Properties("PenColor") = QBColor(i + 1)
  138.             
  139.             'Take the letter graphic out of the drawing...
  140.             Grs.Remove GrSect.Index
  141.             
  142.             '...and make it the child of the extrusion
  143.             GrExtrude.Graphics.AddGraphic GrSect
  144.             DebugGraphicInfo "GrExtrude(" & i & ") with base graphic", GrExtrude
  145.             
  146.             'Now add the extrusion vector origin (first vertex)
  147.             GrExtrude.Vertices.Add 0, 0, 0
  148.             
  149.             'And extrusion vector end point (second vertex)
  150.             Dim ExtrusionZ#
  151.             ExtrusionZ = (i + 1) * TextHeight / 4
  152.             GrExtrude.Vertices.Add 0, 0, ExtrusionZ
  153.             DebugGraphicInfo "GrExtrude(" & i & ") before Update", GrExtrude
  154.             
  155.             'Force the Regen to generate the 3D polygons correctly
  156.             'The Update command will also add a third vertex and the cosmetic graphics
  157.             GrExtrude.Update
  158.             DebugGraphicInfo "GrExtrude(" & i & ") after Update", GrExtrude
  159.               
  160.             'And draw the 3D letter on the view now
  161.             GrExtrude.Draw
  162.         Next
  163.     End With
  164. End Sub
  165.