AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

VBA Steel Project (28 Kb)

Drawing Export

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.

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
 
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