VBA Steel Project
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