A non-trivial VBA parametric project requires some structure to re-use standard techniques and a guide drawing to be made with user parameters identified that specifies the point values to be drawn. This sample project is a sheet metal frame that would be used to cap a hole. There are only two parts, top/bottom and side, but they are drawn both in front assembly and laid out flat before bending, so there are 4 basic drawing sub-routines. The drawing subroutines create geometry. Their only other job is to initialize bounding box variables so the calling program has the option to move into assembly, block, and/or rotate.

The parts are always drawn with lower left corner at or near 0,0. The master drawing is created manually before the programming is started. If carefully done, and revised until it works as needed, it will make the programming much easier.

Give each project its own module. It solves naming issues if each project is given a simple project ID, then prefix all the subs with the ID. The draw subs are at the bottom and the controlling program at the top. The draw subs are completed first, all in a similar manner. Again it makes programming much simpler if all the controlling sketches are laid out consistently and thoroughly. The only variables passed are the user variables. Calculations are made in the drawing sub. The sketches should be consistent – variable D1 in one sketch is the same value D1 in another sketch.

```
Sub B1_chan_top_bent(A As Double, D As Double, E As Double)
Dim pt As Variant
Dim A1 As Double, A2 As Double
A1 = A + D + D
A2 = A + D

'bounding box pt_ll and pt_ur are global vars
Call initpt(pt_ll, -1, -1, 0)
Call initpt(pt_ur, A1 + 2, D + 2, 0)

pt = Array(0, E, D, E, D, 0, _
A2, 0, A2, E, A1, E, _
A1, D, 0, D)
Call draw_array(pt)

Call line(D, E, A2, E)

'each drawing sub re-sets current layer to 0
Update
End Sub

Sub B1_chan_side_bent(B As Double, D As Double, E As Double)
Dim pt As Variant
Dim B1 As Double
B1 = B + E + E

'bounding box
Call initpt(pt_ll, -1, -1, 0)
Call initpt(pt_ur, B1 + 2, D + 2, 0)

pt = Array(0, 0, B1, 0, B1, D, 0, D)
Call draw_array(pt)

Call line(0, E, B1, E)

Update
End Sub

Sub B1_chan_top_flat(A As Double, C As Double, D As Double, E As Double)
Dim pt As Variant
Dim A1 As Double, A2 As Double, C1 As Double, C2 As Double, D1 As Double
A1 = A + D + D
A2 = A + D
D1 = D - E
C1 = C + D1
C2 = C + D1 + D1

'bounding box
Call initpt(pt_ll, -1, -1, 0)
Call initpt(pt_ur, A1 + 2, C2 + 2, 0)

pt = Array(0, 0, A1, 0, A1, D1, _
A2, D1, A2, C1, A1, C1, _
A1, C2, 0, C2, 0, C1, _
D, C1, D, D1, 0, D1)
Call draw_array(pt)

Call line(D, D1, A2, D1)
Call line(D, C1, A2, C1)

Update
End Sub

Sub B1_chan_side_flat(B As Double, C As Double, D As Double, E As Double)
Dim pt As Variant
Dim B1 As Double, C1 As Double, C2 As Double, D1 As Double
B1 = B + E + E
D1 = D - E
C1 = C + D1
C2 = C + D1 + D1

'bounding box
Call initpt(pt_ll, -1, -1, 0)
Call initpt(pt_ur, B1 + 2, C2 + 2, 0)

'outside box
pt = Array(0, 0, B1, 0, B1, C2, 0, C2)
Call draw_array(pt)

Call line(0, D1, B1, D1)
Call line(0, C1, B1, C1)

Update
End Sub
```

These can be called in any order. In this project i call the bent pieces first. I block them, then move them to an assembly position, using an arbitrary location (K, K). The side piece is drawn horizontal, so it is first rotated and moved about the same point. Again these points are located first on the sketches. The parts are blocked with a sub that accepts the bounding box coordinates, a name and a point for insert point. That routine works with any similar project. It creates a selection set using the bounding box, creates the block with name and insert point, adds the selection set entities to the block, erases the original entities and finally inserts the block. It assigns the block to a global var so the calling program can move it. These routines are in their own module shared by multiple projects.

```Sub make_ss_blk(pt_ll() As Double, pt_ur() As Double, strblkname As String, pt_insert() As Double)
'creates new ss, adds items to it with a crossing window
'creates new block, adds ss to blk with counting loop
'deletes original entities and inserts the block
'creates an object reference to the block objpersistent for moving/rotating

Dim i As Integer

objss.Select acSelectionSetCrossing, pt_ll, pt_ur

' make_blk(objss, strblkname, pt_insert)
On Error Resume Next
objBlock.Delete
On Error GoTo 0

ReDim Obj(0 To objss.Count - 1) As AcadObject
'Copy each object selected in the block
For i = 0 To objss.Count - 1
Set Obj(i) = objss(i)
Next i

objss.Erase
objss.Delete

Set objpersistent = acadDoc.ModelSpace.InsertBlock(pt_insert, strblkname, 1, 1, 1, 0)

End Sub

On Error Resume Next
If "" = strname Then
Exit Sub
End If

objss.Delete
If objss Is Nothing Then
MsgBox "unable to add " & strname
Else
End If
End Sub
```

The main calling program will vary depending on interface. Here is the basic one with variable values called out near the top.

```
Option Explicit
'ProjID B1
'Project Name - Inside Cap Channel
'ProjDesc - to cap existing hole
'a b c d e

Public Const Pi As Double = 3.14159265359
Public Const halfPI = Pi / 2

Public pt0(0 To 2) As Double
Public pt_ll(0 To 2) As Double
Public pt_ur(0 To 2) As Double

Sub B1_draw_inside_cap_chan_assy()

Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim K As Double
K = 50
Call init_part

'assy vars
Dim A As Double, B As Double, C As Double, D As Double, E As Double
'A is X, B is Y, C is ID THK, D is BENT FLG, E is GA

A = 24
B = 36
C = 4.125
D = 2.5
E = 0.125

Call B1_chan_top_bent(A, D, E)
Call make_ss_blk(pt_ll, pt_ur, "B1_chan_top", pt0)
Call initpt(pt1, A / 2 + D, 0, 0)
Call initpt(pt2, K, K + B / 2, 0)
objpersistent.Move pt1, pt2

Call B1_chan_side_bent(B, D, E)
Call make_ss_blk(pt_ll, pt_ur, "B1_chan_side", pt0)
Call initpt(pt1, B / 2 + E, 0, 0)
Call initpt(pt2, K + A / 2, K, 0)
objpersistent.Rotate pt1, -halfPI
objpersistent.Move pt1, pt2

Call B1_chan_top_flat(A, C, D, E)
objss.Select acSelectionSetWindow, pt_ll, pt_ur

Call initpt(pt2, 0, 48, 0)
For Each objent In objss
objent.Move pt0, pt2
Next

Call B1_chan_side_flat(B, C, D, E)
objss.Select acSelectionSetWindow, pt_ll, pt_ur

Call initpt(pt2, 0, 24, 0)
For Each objent In objss
objent.Move pt0, pt2
Next

Call initpt(pt2, K, K, 0)
Call cap_chan_sect(C + (2 * E), D, E)
objpersistent.Move pt0, pt2

Update
End Sub
```

This creates –

The section view is a straightforward drawing sub

```Sub cap_chan_sect(C As Double, D As Double, E As Double)
Dim pt As Variant
Call initpt(pt_ll, -1, -1, 0)
Call initpt(pt_ur, D + 2, C + 2, 0)

pt = Array(0, 0, D, 0, D, E, E, E, E, C - E, D, C - E, D, C, 0, C)
Call draw_array(pt)

Update
End Sub
```

The init-part sub is simply because i like to be able to run programs in a completely new blank drawing. it creates layers, but also makes the initial connection between excel VBA code and autocad.

```Sub init_part()
Call initpt(pt0, 0, 0, 0)