Personal Computer World 2002 March/PCWMAR02.iso/software/turbocad/v8trial/TurboCADv8ProfessionalNoReg.exe/Data.Cab/F42055_modTitleBlock.bas

BASIC Source File | 2001-10-16 | 5.1 KB | 166 lines

Attribute VB_Name = "modTitleBlock"
'******************************************************************'
'*                                                                *'
'*                      TurboCAD for Windows                      *'
'*                   Copyright (c) 1993 - 2001                    *'
'*             International Microcomputer Software, Inc.         *'
'*                            (IMSI)                              *'
'*                      All rights reserved.                      *'
'*                                                                *'
'******************************************************************'

Option Explicit

Sub SetTitleBlock()

'Code in this listing does several things:
'First, we get a reference to the active drawing object, then we set its
'drawing mode to Paper Space (Paper Space and Model Space will be discussed
'in Chapter 5), then we define paper size, calculate and draw border
'rectangle within defined paper space and margins, then draw the title box
'within the border rectangle (as a table), and then fill two cells of the
'title box table with simple text: "Design By" and "Project".

'Set up error handler
  On Error GoTo SetTitleBlock_Err

'Declare and set major TurboCAD objects
  Dim ActDr As Drawing
  Dim Grs As Graphics
  Dim Gr As Graphic
  Dim Vi As View

'Get active drawing object
  Set ActDr = ActiveDrawing

'Set active drawing space: Paper Space = 0, Model Space = 1
  ActDr.Properties("TileMode") = 0

'Get graphics collection of the active drawing
  Set Grs = ActDr.Graphics

'Set measurement units for the current drawing space to inches
  ActDr.Properties("PaperLinearUnitName") = "in"

'Declare variables to hold paper size data
  Dim PSetUp As PageSetup
  Dim SpaceUnits$, UnitScale#
  Dim PaperWidth#, PaperHeight#

'Read property (we set it to inches ealier in the code)
    SpaceUnits = ActDr.Properties("PaperLinearUnitName")

'Read paper size properties (we don't need to do that, it's just an illustration)
    Set PSetUp = ActDr.PageSetup
    PaperWidth = PSetUp.SheetWidth
    PaperHeight = PSetUp.SheetHeight

'Set paper size
    PaperWidth = 12#
    PaperHeight = 10#

'Define scaling rate depending on measurement units specified by user
'(in our case we programmtically set 'PaperLinearUnitName' to inches û
'see code above).We need to convert user measurement units to millimiters
'(TurboCAD's internal measurement units)
    If SpaceUnits = "mm" Then UnitScale = 1
    If SpaceUnits = "cm" Then UnitScale = 10
    If SpaceUnits = "m" Then UnitScale = 100
    If SpaceUnits = "in" Or SpaceUnits = """" Then UnitScale = 25.4
    If SpaceUnits = "ft" Or SpaceUnits = "'" Then UnitScale = 25.4 * 12

    PSetUp.SheetWidth = PaperWidth * UnitScale
    PSetUp.SheetHeight = PaperHeight * UnitScale

'Calculate rectangle for the frame based on defined paper size including margins
  Dim LeftMargin#, RightMargin#, TopMargin#, BottomMargin#
  Dim xLeft#, xRight#, yBottom#, yTop#
    LeftMargin = 1
    RightMargin = 0.5
    TopMargin = 0.5
    BottomMargin = 0.5

    xLeft = LeftMargin
    xRight = PaperWidth - RightMargin
    yBottom = BottomMargin
    yTop = PaperHeight - TopMargin

'Draw frame
    Set Gr = Grs.Add(imsiPolyline)
    With Gr.Vertices
        .Add xLeft, yBottom, 0
        .Add xRight, yBottom, 0
        .Add xRight, yTop, 0
        .Add xLeft, yTop, 0
        .AddClose
    End With
    Gr.Properties("PenWidth") = 0.01
    Gr.Draw

'Draw Title Box (as a table)
  Dim GrTable As Graphic
  Dim hTable#, wTable#
  Dim xL#, xR#, yB#, yT#, xMid#, yMid#

    hTable = 1
    wTable = 6

    xL = xRight - wTable
    xR = xL + wTable
    yB = yBottom
    yT = yB + hTable
    xMid = (xL + xR) / 2
    yMid = (yB + yT) / 2

    Set GrTable = Grs.Add(imsiPolyline)
    With GrTable.Vertices
        .Add xL, yB, 0
        .Add xR, yB, 0
        .Add xR, yT, 0
        .Add xL, yT, 0
        .Add xL, yB, 0
        .Add xL, yMid, 0, False
        .Add xR, yMid, 0
        .Add xMid, yB, 0, False
        .Add xMid, yT, 0
    End With
    GrTable.Properties("PenWidth") = 0.01
    GrTable.Draw

'Add text to table
  Dim GrText As Graphic
  Dim InputString$

    InputString = "Design By"
    Set GrText = Grs.AddText(InputString, (xL + xMid) / 2, yT, 0, hTable / 2, , , , 2)
    InputString = "Project"
    Set GrText = Grs.AddText(InputString, (xMid + xR) / 2, yT, 0, hTable / 2, , , , 2)

'Get actiev view of the active drawingà
  Set Vi = ActDr.Views(0)
'à and fit drawing to screen
  Vi.ZoomToExtents

SetTitleBlock_Exit:

'Destroy TurboCAD objects
    Set ActDr = Nothing
    Set Grs = Nothing
    Set PSetUp = Nothing
    Set Gr = Nothing
    Set GrTable = Nothing
    Set GrText = Nothing
    Set Vi = Nothing

    Exit Sub

SetTitleBlock_Err:
    If Err.Number <> 0 Then
       MsgBox "Error " & Err.Number & " in Sub 'SetTitleBlock'" & _
       vbLf & vbLf & Err.Description
       Resume SetTitleBlock_Exit
    End If
End Sub