Usage :

Select your Drawing Sheet type first, then the Drawing Size, select a Scale and then the OK button and away you go.

To use your own template drawings in this routine, please refer to the Readme file which is included within the downloadable drawing sheet zip file. (The download link is at the bottom of this page )

Option Explicit

'------------------------------------------------

Private Sub cmdCancel_Click()
End
End Sub

'-------------------------------------------------

Private Sub cmdOk_Click()

'declare variables
Dim acadApp As Object
Dim acadDoc As Object
Dim doc As Object
Dim templateFileName As String
Dim DrgSheet As String
Dim DrgSize As String
Dim newLimits(0 To 3) As Double
Dim sc As Double
Dim oldTextStyle As Object
Dim Blockref As Object
Dim InsertionPoint(0 To 2) As Double
Dim Mspace As Object
Dim Insertsheet As String

'hide the dialogue box
Me.Hide

'set a reference to the AutoCAD Application
Set acadApp = GetObject(, "AutoCAD.Application")

    'if there is an error
    If Err Then
    
        'inform user
        MsgBox Err.Description
    
        'exit application
        Exit Sub
    
    End If

'set reference to active document
Set acadDoc = acadApp.ActiveDocument

'if the current drawing is not saved
If Not acadDoc.Saved Then

    'ask the user what he wants to do
    If MsgBox("    OK to Save Drawing?", 4) = vbNo Then
    
    'if No end application
    End
    
    Else

        'if Yes save the drawing
        acadDoc.Save
        
    End If

End If

'get the scale and convert to double
sc = CDbl(TextBox1.Text)

'if this button selected
If Opt1.Value = True Then

    'set first letter of drawing sheet
    DrgSheet = "E"
    
    'set the relevant template file
    templateFileName = "acadeng.dwt"
    
    'open new drawing with selected template file
    Set doc = acadDoc.New(templateFileName)
    
End If

If Opt2.Value = True Then
    DrgSheet = "A"
    templateFileName = "acadarch.dwt"
    Set doc = acadDoc.New(templateFileName)
End If

If Opt3.Value = True Then
    DrgSheet = "EL"
    templateFileName = "acadelec.dwt"
    Set doc = acadDoc.New(templateFileName)
End If

If Opt4.Value = True Then
    DrgSheet = "B"
    templateFileName = "acadblank.dwt"
    Set doc = acadDoc.New(templateFileName)
End If

'get the item selected from list box
Select Case ListBox1.ListIndex

'if the index is 0 (first item)
Case 0

    'set the drawing size
    DrgSize = "A0"
    
    'set the limits
    newLimits(0) = 0#
    newLimits(1) = 0#
    newLimits(2) = 1189# * sc
    newLimits(3) = 841# * sc
    
    'get the current text style
    Set oldTextStyle = acadDoc.ActiveTextStyle
    
Case 1
    DrgSize = "A1"
    newLimits(0) = 0#
    newLimits(1) = 0#
    newLimits(2) = 841# * sc
    newLimits(3) = 594# * sc
    Set oldTextStyle = acadDoc.ActiveTextStyle
Case 2
    DrgSize = "A2"
    newLimits(0) = 0#
    newLimits(1) = 0#
    newLimits(2) = 594# * sc
    newLimits(3) = 420# * sc
    Set oldTextStyle = acadDoc.ActiveTextStyle
Case 3
    DrgSize = "A3"
    newLimits(0) = 0#
    newLimits(1) = 0#
    newLimits(2) = 420# * sc
    newLimits(3) = 297# * sc
    Set oldTextStyle = acadDoc.ActiveTextStyle
Case 4
    DrgSize = "A4"
    newLimits(0) = 0#
    newLimits(1) = 0#
    newLimits(2) = 297# * sc
    newLimits(3) = 210# * sc
    Set oldTextStyle = acadDoc.ActiveTextStyle
End Select

'set drawing limits
acadDoc.Limits = newLimits

'zoom to extents
ZoomExtents

'set Ltscale
Call acadDoc.SetVariable("Ltscale", sc * 10)

'set Dimscale
Call acadDoc.SetVariable("Dimscale", sc)

'store scale in Userr1 for later use
Call acadDoc.SetVariable("Userr1", sc)

'set Regenmode
Call acadDoc.SetVariable("Regenmode", 1)

'set Tilemode
Call acadDoc.SetVariable("Tilemode", 1)

'set Text Height
oldTextStyle.Height = 3.5 * sc

'String Drawing Sheet Name Together
Insertsheet = DrgSheet & DrgSize

'set the insertion point
InsertionPoint(0) = 0
InsertionPoint(1) = 0
InsertionPoint(2) = 0

'get reference to Model Space
Set Mspace = acadDoc.ModelSpace

'Insert the drawing sheet
Set Blockref = Mspace.InsertBlock(InsertionPoint, Insertsheet, sc, sc, sc, 0)

End

End Sub

'-------------------------------------------------

Private Sub ListBox1_Click()
TextBox1.SetFocus
End Sub

'--------------------------------------------------

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cmdOk_Click
End Sub

'--------------------------------------------------

Private Sub Opt1_Click()
TextBox1.SetFocus
End Sub

'--------------------------------------------------

Private Sub Opt2_Click()
TextBox1.SetFocus
End Sub

'--------------------------------------------------

Private Sub Opt3_Click()
TextBox1.SetFocus
End Sub

'--------------------------------------------------

Private Sub Opt4_Click()
TextBox1.SetFocus
End Sub

'--------------------------------------------------

Private Sub UserForm_Initialize()

'Populate the List Box
ListBox1.AddItem "A0 - 1189 x 841"
ListBox1.AddItem "A1 -  841 x 594"
ListBox1.AddItem "A2 -  594 x 420"
ListBox1.AddItem "A3 -  420 x 297"
ListBox1.AddItem "A4 -  297 x 210"
ListBox1.ListIndex = 0

End Sub