Viewports and Dimension Scales

Often times its nice to create a drawing package where all the geometry and dimension and text are drawn in model space and want to make different layout tabs showing all the different geometries in the model space. We want all the text and dimensions to be the same size throughout all the print pages. This can be done through annotative dimensions and text or through changing the ‘dim scale overall’. In this example I’m going to show the ‘dim scale overall’ method so that the text is correct size for a 11×17 printout.

The example also goes through how to create the following:

  • new layers
  • block objects
  • block references
  • ordinate dimensions
  • circle objects
  • diametric dimensions
  • new layout tab
  • viewport
  • looping through each item in a block

Correct text and dim size in the printable area
Incorrect text and dim size in the printable area
The custom scale is created by using GetBoundingBox method on the BlockReference object
The dim scale overall is just the reciprocal of the veiwport custom scale
Option Explicit
Dim acadApp As Object
Dim acadDoc As Object
Dim ACLayout As AcadLayout
Dim bar_height As Double
Dim bar_hole_dia As Double
Dim basepoint(0 To 2) As Double
Dim center(0 To 2) As Double
Dim circleObj As AcadCircle
Dim definingPoint(0 To 2) As Double
Dim dimObjDiametric As AcadDimDiametric
Dim dimObjOrdinate As AcadDimOrdinate
Dim DimScaleViewPort As Double
Dim dt As String
Dim holepnt(0 To 2) As Double
Dim insertionPoint(0 To 2) As Double
Dim leaderEndPoint(0 To 2) As Double
Dim leaderlength As Double
Dim maxExtBlock1 As Variant
Dim minExtBlock1 As Variant
Dim objblock As AcadBlock
Dim objBlockRef As AcadBlockReference
Dim objlayer As AcadLayer
Dim oEnt2 As AcadEntity
Dim plineObjLW_a As AcadLWPolyline
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim pviewportObj As AcadPViewport
Dim TRfabLen As Double
Dim vertices() As Double
Dim vpHeight As Double
Dim vpWidth As Double
Dim objdrawingobject As AcadEntity
Dim objss As AcadSelectionSet
Dim iblockname As String

Sub Example_ScaleDimensionObjects()

    'retreive the active autocad document
    Set acadApp = GetObject(, "AutoCAD.Application")
    Set acadDoc = acadApp.ActiveDocument
    
    'remove all drawn objects and layout 605
    On Error Resume Next
    acadDoc.Layouts.Item("605").Delete
    On Error GoTo 0
    acadDoc.ActiveSpace = acModelSpace
    Set objss = acadDoc.SelectionSets.Add("ToErase1")
    objss.Select acSelectionSetAll
    On Error Resume Next
    For Each objdrawingobject In objss
        objdrawingobject.Erase
    Next
    objss.Delete
    acadDoc.Regen acAllViewports
    
    'create an object block
    dt = Format(CStr(Now), "mm-dd_hh-mm-ss")
    iblockname = "TRbarBlock" & dt
    basepoint(0) = 0: basepoint(1) = 0
    Set objblock = acadDoc.Blocks.Add(basepoint, iblockname)
    
    'create layers
    Set objlayer = acadDoc.Layers.Add("HMT Text And Dimensions")
    objlayer.Color = 6
    Set objlayer = acadDoc.Layers.Add("HMT Object Solid")
    objlayer.Color = 4
    Set objlayer = acadDoc.Layers.Add("viewport")
    objlayer.Color = 3
    acadDoc.ActiveLayer = acadDoc.Layers("HMT Text and Dimensions")
    
    'create the rectangle
    bar_height = 36
    TRfabLen = 48
    ReDim vertices(7)
    vertices(0) = 0: vertices(1) = 0
    vertices(2) = TRfabLen: vertices(3) = 0
    vertices(4) = TRfabLen: vertices(5) = -bar_height
    vertices(6) = 0: vertices(7) = -bar_height
    Set plineObjLW_a = objblock.AddLightWeightPolyline(vertices)
    plineObjLW_a.Closed = True
    plineObjLW_a.Layer = "HMT Object Solid"
    
    'add the ordinate dimesnions
    definingPoint(0) = 0#: definingPoint(1) = 0#
    leaderEndPoint(0) = 0#: leaderEndPoint(1) = 2#
    Set dimObjOrdinate = objblock.AddDimOrdinate(definingPoint, leaderEndPoint, 5#)
    definingPoint(0) = 0#: definingPoint(1) = 0#
    leaderEndPoint(0) = -2#: leaderEndPoint(1) = 0#
    Set dimObjOrdinate = objblock.AddDimOrdinate(definingPoint, leaderEndPoint, 0)
    definingPoint(0) = 0#: definingPoint(1) = -bar_height
    leaderEndPoint(0) = -2#: leaderEndPoint(1) = -bar_height
    Set dimObjOrdinate = objblock.AddDimOrdinate(definingPoint, leaderEndPoint, 0)
    definingPoint(0) = TRfabLen: definingPoint(1) = 0#
    leaderEndPoint(0) = TRfabLen: leaderEndPoint(1) = 2
    Set dimObjOrdinate = objblock.AddDimOrdinate(definingPoint, leaderEndPoint, 5#)

    'add the center hole
    holepnt(0) = TRfabLen / 2
    holepnt(1) = -bar_height / 2
    bar_hole_dia = 5
    Set circleObj = objblock.AddCircle(holepnt, bar_hole_dia / 2)
    circleObj.Layer = "HMT Object Solid"
    
    'add the diametric dimension
    point1(0) = -0.342 * bar_hole_dia / 2: point1(1) = 0.939 * bar_hole_dia / 2
    point2(0) = 0.342 * bar_hole_dia / 2: point2(1) = -0.939 * bar_hole_dia / 2
    leaderlength = 5#
    Set dimObjDiametric = objblock.AddDimDiametric(point2, point1, leaderlength)
    dimObjDiametric.TextOverride = "<&gt;\PHOLE THRU\P(1 PLACE)"
    point1(0) = 0: point1(1) = 0
    dimObjDiametric.Move point1, holepnt
    
    'insert the block reference and find the extents of the block
    insertionPoint(0) = -50:  insertionPoint(1) = 50
    Set objBlockRef = acadDoc.ModelSpace.InsertBlock(insertionPoint, iblockname, 1, 1, 1, 0)
    objBlockRef.GetBoundingBox minExtBlock1, maxExtBlock1
    minExtBlock1(0) = minExtBlock1(0) - 25
    maxExtBlock1(0) = maxExtBlock1(0) + 25
    
    'add the layout 605
    Set ACLayout = acadDoc.Layouts.Add(605)
    acadDoc.ActiveLayout = ACLayout
    
    'add the viewport
    center(0) = 8.32: center(1) = 5.32
    vpWidth = 16.5
    vpHeight = 10.5
    Set pviewportObj = acadDoc.PaperSpace.AddPViewport(center, vpWidth, vpHeight)
    pviewportObj.Layer = "viewport"
    pviewportObj.Display True
    acadDoc.MSpace = True
    acadDoc.Application.ZoomWindow minExtBlock1, maxExtBlock1
    acadDoc.MSpace = False
    pviewportObj.DisplayLocked = True
    acadDoc.Regen acAllViewports
    
    'scale the dimensions to match the viewport
    DimScaleViewPort = 1 / pviewportObj.CustomScale
    For Each oEnt2 In acadDoc.Blocks(iblockname)
        oEnt2.scalefactor = DimScaleViewPort
    Next oEnt2
    objBlockRef.Explode
    objBlockRef.Delete
    acadDoc.Application.ZoomExtents
    
End Sub

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s