VBA Steel Project

by Kenny Ramage

This is a sample VBA routine written for AutoCAD Rel 14. This application will parametrically draw metric structural steel sections and is intended as an aid towards a better understanding of VBA and AutoCAD.

Download the code for this application here : VBA Steel Project (28 Kb)

Usage

Unzip the files VbaSteel.dvb and VbaSteel.lsp to any directory in your AutoCAD search path. Type (load "vbasteel") at the command prompt. Type "vbasteel" to run the application.

The Source Code

Private Sub cmdCancel1_Click()
Me.Hide
UserForm2.Show
 
End Sub
 
Private Sub cmdOK1_Click()
 
Const PI = 3.141592654
'define PI as constant
 
Dim Height As Double
Dim Width As Double
Dim t1 As Double
Dim t2 As Double
Dim r1 As Double
Dim acadApp As Object
Dim acadDoc As Object
Dim acadUtil As Object
Dim inPnt As Variant
Dim North As Variant
Dim South As Variant
Dim West As Variant
Dim East As Variant
'declare variables
 
 
West = (PI * (180# / 180#))
'convert 180 degrees to radians
North = (PI * (90# / 180#))
'convert 90 degrees to radians
East = 0
'convert 0 degrees to radians
South = (PI * (270# / 180#))
'convert 270 degrees to radians
 
NL = Chr(13) & Chr(10)
'define New Line
prompt1 = NL & "Insertion Point: "
'define prompt
 
Set acadApp = GetObject(, "AutoCAD.Application")
'get reference to AutoCAD
 
Set acadDoc = acadApp.ActiveDocument
'get reference to Drawing
 
Set acadUtil = acadDoc.Utility
'get reference to Utility Object
 
Me.Hide
'hide the dialogue
 
Select Case ListBox1.ListIndex
'use the select case function to retrieve
'section choosen in list box
 
Case 0
'if case index = 0
 
    Height = 152.4
    'set height
    
    Width = 152.4
    'set width
    
    t1 = 6.1
    'set web thickness
    
    t2 = 6.8
    'set flange thickness
    
    r1 = 7.6
    'set root radius
    
Case 1
    Height = 157.5
    Width = 152.9
    t1 = 6.6
    t2 = 6.4
    r1 = 7.6
Case 2
    Height = 161.8
    Width = 154.4
    t1 = 8.1
    t2 = 11.5
    r1 = 7.6
Case 3
    Height = 203.2
    Width = 203.2
    t1 = 7.3
    t2 = 11#
    r1 = 10.2
Case 4
    Height = 206.2
    Width = 203.9
    t1 = 8#
    t2 = 12.5
    r1 = 10.2
Case 5
    Height = 209.6
    Width = 205.2
    t1 = 9.3
    t2 = 14.2
    r1 = 10.2
End Select
'end select case
 
inPnt = acadUtil.GetPoint(, prompt1)
'get the insertion point
 
 
Dim inPntv(0 To 2) As Double
'declare point variable
 
For i = 0 To 2
'convert x, y & z from variables to doubles
    inPntv(i) = inPnt(i)
Next
Dim pt1 As Variant
'declare variants
 
pt1 = acadUtil.PolarPoint(inPntv, East, t1 / 2)
'use polar function to calculate point
 
Dim pt1v(0 To 2) As Double
For i = 0 To 2
   pt1v(i) = pt1(i)
Next
Dim pt2 As Variant
pt2 = acadUtil.PolarPoint(pt1v, North, (Height - t2 - t2) / 2)
 
Dim pt2v(0 To 2) As Double
For i = 0 To 2
   pt2v(i) = pt2(i)
Next
Dim pt2a As Variant
Dim pt2b As Variant
Dim pt3 As Variant
pt2a = acadUtil.PolarPoint(pt2v, South, r1)
pt2b = acadUtil.PolarPoint(pt2v, East, r1)
pt3 = acadUtil.PolarPoint(pt2v, East, (Width - t1) / 2)
 
 
Dim pt3v(0 To 2) As Double
For i = 0 To 2
   pt3v(i) = pt3(i)
Next
Dim pt4 As Variant
pt4 = acadUtil.PolarPoint(pt3v, North, t2)
 
Dim pt4v(0 To 2) As Double
For i = 0 To 2
   pt4v(i) = pt4(i)
Next
Dim pt5 As Variant
pt5 = acadUtil.PolarPoint(pt4v, West, Width)
 
Dim pt5v(0 To 2) As Double
For i = 0 To 2
   pt5v(i) = pt5(i)
Next
Dim pt6 As Variant
pt6 = acadUtil.PolarPoint(pt5v, South, t2)
 
Dim pt6v(0 To 2) As Double
For i = 0 To 2
   pt6v(i) = pt6(i)
Next
Dim pt7 As Variant
pt7 = acadUtil.PolarPoint(pt6v, East, (Width - t1) / 2)
 
Dim pt7v(0 To 2) As Double
For i = 0 To 2
   pt7v(i) = pt7(i)
Next
Dim pt7a As Variant
Dim pt7b As Variant
Dim pt8 As Variant
pt7a = acadUtil.PolarPoint(pt7v, West, r1)
pt7b = acadUtil.PolarPoint(pt7v, South, r1)
pt8 = acadUtil.PolarPoint(pt7v, South, Height - t2 - t2)
 
Dim pt8v(0 To 2) As Double
For i = 0 To 2
   pt8v(i) = pt8(i)
Next
Dim pt8a As Variant
Dim pt8b As Variant
Dim pt9 As Variant
pt8a = acadUtil.PolarPoint(pt8v, North, r1)
pt8b = acadUtil.PolarPoint(pt8v, West, r1)
pt9 = acadUtil.PolarPoint(pt8v, West, (Width - t1) / 2)
 
Dim pt9v(0 To 2) As Double
For i = 0 To 2
   pt9v(i) = pt9(i)
Next
Dim pt10 As Variant
pt10 = acadUtil.PolarPoint(pt9v, South, t2)
 
Dim pt10v(0 To 2) As Double
For i = 0 To 2
   pt10v(i) = pt10(i)
Next
Dim pt11 As Variant
pt11 = acadUtil.PolarPoint(pt10v, East, Width)
 
Dim pt11v(0 To 2) As Double
For i = 0 To 2
   pt11v(i) = pt11(i)
Next
Dim pt12 As Variant
pt12 = acadUtil.PolarPoint(pt11v, North, t2)
 
Dim pt12v(0 To 2) As Double
For i = 0 To 2
   pt12v(i) = pt12(i)
Next
Dim pt13 As Variant
pt13 = acadUtil.PolarPoint(pt12v, West, (Width - t1) / 2)
 
Dim pt13v(0 To 2) As Double
For i = 0 To 2
   pt13v(i) = pt13(i)
Next
Dim pt13a As Variant
Dim pt13b As Variant
pt13a = acadUtil.PolarPoint(pt13v, East, r1)
pt13b = acadUtil.PolarPoint(pt13v, North, r1)
 
 
Dim moSpace As Object
'declare model space object
 
Set moSpace = acadDoc.ModelSpace
'get the model space object
 
Dim lwpolyObj As Object
'declare the light weight polyline object
 
Dim ptArray(0 To 35) As Double
'declare the array of doubles
 
ptArray(0) = pt1(0)
'set the array points
ptArray(1) = pt1(1)
ptArray(2) = pt2a(0)
ptArray(3) = pt2a(1)
ptArray(4) = pt2b(0)
ptArray(5) = pt2b(1)
ptArray(6) = pt3(0)
ptArray(7) = pt3(1)
ptArray(8) = pt4(0)
ptArray(9) = pt4(1)
ptArray(10) = pt5(0)
ptArray(11) = pt5(1)
ptArray(12) = pt6(0)
ptArray(13) = pt6(1)
ptArray(14) = pt7a(0)
ptArray(15) = pt7a(1)
ptArray(16) = pt7b(0)
ptArray(17) = pt7b(1)
ptArray(18) = pt8a(0)
ptArray(19) = pt8a(1)
ptArray(20) = pt8b(0)
ptArray(21) = pt8b(1)
ptArray(22) = pt9(0)
ptArray(23) = pt9(1)
ptArray(24) = pt10(0)
ptArray(25) = pt10(1)
ptArray(26) = pt11(0)
ptArray(27) = pt11(1)
ptArray(28) = pt12(0)
ptArray(29) = pt12(1)
ptArray(30) = pt13a(0)
ptArray(31) = pt13a(1)
ptArray(32) = pt13b(0)
ptArray(33) = pt13b(1)
ptArray(34) = pt1(0)
ptArray(35) = pt1(1)
 
Set lwpolyObj = moSpace.AddLightWeightPolyline(ptArray)
'draw the beam
 
Dim newBulge As Double
'declare the bulge (Radius)
 
newBulge = 0 - (Tan(1.570796327 / 4))
'Calculate the bulge (radius)
 
Call lwpolyObj.SetBulge(1, newBulge)
'radius vertice number 1
 
Call lwpolyObj.SetBulge(7, newBulge)
'radius vertice number 7
 
Call lwpolyObj.SetBulge(9, newBulge)
'radius vertice number 9
 
Call lwpolyObj.SetBulge(15, newBulge)
'radius vertice number 15
 
Rot = CDbl(Txb1.Text)
'get the rotation angle and convert
'to double
 
Rot1 = PI * (Rot / 180)
'convert to radians
 
 
Call lwpolyObj.Rotate(inPntv, Rot1)
'rotate the beam
 
 
End Sub
 
Private Sub ListBox1_Click()
Txb1.SetFocus
End Sub
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
cmdOK1_Click
End Sub
 
Private Sub UserForm_Click()
 
 
End Sub
 
Private Sub UserForm_Initialize()
 
'add the beam sizes to the list box
ListBox1.AddItem "152x152x23"
ListBox1.AddItem "152x152x30"
ListBox1.AddItem "152x152x37"
ListBox1.AddItem "203x203x46"
ListBox1.AddItem "203x203x52"
ListBox1.AddItem "203x203x60"
ListBox1.ListIndex = 0
 
End Sub

Visual Basic for Applications (VBA)

• VBA Tutorials
• VBA Applications
• VBA Tips'n'Tricks

AfraLISP Archive

‘Hey, what's happened to AfraLISP?’ If you've visited our site before, you'll notice some big changes. We're currently revamping the entire site to bring you updated tutorials and a better user experience. However, if there's something you can't find, the AfraLISP Archive contains a full copy of the original site as originally created by Kenny Ramage.

AutoLISP Learning Resources

• Lee Mac - AutoLISP Tutorials and Programmes
• Draftsperson.net - AutoLISP Tutorials
• Jeffery P Sanders - AutoLISP Tutorials
• Ron Leigh - AutoLISP Tutorials
• Pixel Graphics Inc. - AutoLISP Tutorials
• A'CAD Solutions - AutoLISP Tutorial
• CAD Digest - AutoLISP Tutorials

Online Books

• The ABC's of AutoLISP
• The Visual LISP Developer's Bible

AutoLISP Forums

• CADTutor
• Autodesk Discussion Groups
• Autodesk User Group International (AUGI)
• The Swamp