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
|