AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

AutoLisp/VBA Drawing Setup II

Welcome to the Dark Side!!

Just to be different, instead of using drawing files, this time we are going to use drawing template files within our setup routine.
As well as that, just to show off, we are going to make our dialog a wee bit more colorful than the boring old AutoLisp dialog. (eat your hearts out Lispers.)
Okay, here's a preview of what our dialog will look like on completion :

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 )

 

As for the AutoLisp version, you can customise this program to your little hearts desire.

Right, let's have a look at a wee bit of coding. Fire up AutoCAD and open a new Project in the Visual Basic Editor.
First you need to insert a new UserForm keeping the default name. (UserForm1)
Now add the following controls, naming them as shown :

  • Button - "cmdOk"
  • Button - "cmdCancel"
  • Frame containing 4 Option Buttons - "Opt1", "Opt2", "Opt3" and "Opt4".
  • Listbox - "Listbox1"
  • Edit Box - "Textbox1"

Now add the following coding under General Declarations :

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

Next, you need to add a new Module.
Then add this coding :

Sub VbaSetup()
UserForm1.Show
End Sub

Save your project as "VbaSetup.dvb", then run the macro "VbaSetup."
The dialog should appear in all it's glory. Congratulations!
Quick, call your colleagues, call your boss, in fact, call all your friends and family to come and have a look and what you've done. Who's a clever boy then? (sorry, or girl.)


To download the AutoLisp and VBA source coding, just click here.

To download the drawings sheets and template files, click here


 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website