Specific method for parametric drawing programs

The hard part of coding parametric drawing program whether in lisp or VBA is managing the large number of points. The program turns into many lines of hard to read data apparently randomly named. A sketch has to be made with points labeled and equations or formulas entered. It all might make sense during the coding, but probably won’t a few weeks later when a change has to be made even if the sketch(s) is found. It won’t be obvious how the points are calculated or why lines are drawn from pt7 to pt21 to pt3. There is no one right way but I have recently worked on both lisp and vba programs and have some specific but not comprehensive suggestions. This is a special theory for creating the xy data but not a general theory for the entire program.

There are two basic ways to manage your drawing subroutine. It can accept points or xy data. Try both ways. Both methods need xy data.

In Lisp I use Visual Lisp objects rather than the “command” method. The object method can draw directly in to a block definition, and it can directly change the layer property. It requires a point object, but that can be created and passed as a parameter or the xy data can be passed and the point created in the subroutine.

For lisp I made a point creation routine and passed points to the subroutine which runs the Addline method.

(defun pt ( x y ) (vlax-3d-point x y 0))

In a very simple box example this gets called as

(setq pt1 (pt 0 0) pt2 (pt L 0) pt3 (pt L W) pt4 (pt 0 W))

Then the line routine would be

(defun linep (pt1 pt2 obj lyr / lineobj)
(setq lineobj (vla-AddLine obj pt1 pt2))
(vla-put-layer lineobj lyr) )

And be called as

(linep pt1 pt2 ms "hidden")

Or you could pass xy data

(defun line (x1 y1 x2 y2 obj lyr / pt1 pt2 lineobj)
(setq pt1 (vlax-3d-point x1 y1 0)
pt2 (vlax-3d-point x2 y2 0))
(setq lineobj (vla-AddLine obj pt1 pt2))
(vla-put-layer lineobj lyr) )

In VBA every variable has to be declared previous to use, so you might lean towards passing xy data. Assume you want to draw a notched rectangle and make it a polyline. You make a sub specifically for this purpose. After setting the xy data coordinates, any six vertex closed polyline can be drawn with

Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)

Sub p6_box(p1 As Double, p2 As Double, p3 As Double, p4 As Double, p5 As Double, p6 As Double, _
p7 As Double, p8 As Double, p9 As Double, p10 As Double, p11 As Double, p12 As Double)

Dim objent As AcadLWPolyline
Dim pt(0 To 11) As Double
pt(0) = p1: pt(1) = p2
pt(2) = p3: pt(3) = p4
pt(4) = p5: pt(5) = p6
pt(6) = p7: pt(7) = p8
pt(8) = p9: pt(9) = p10
pt(10) = p11: pt(11) = p12
Set objent = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
objent.Closed = True
Set obj_Acad_Entity = objent
End Sub

This makes no sense without a sketch but the sub p6_box can draw any closed polyline with 6 points configured any way you need it.


Our notched box is L X W with an A X B notch, drawn with the lower left corner at 0,0. There are 3 X coordinates and 3 Y coordinates.
X1=0 , X2=L-B , X3=L
Y1=0 , Y2=A , Y3=W

You can turn this box around any way you wish, move the notch to the middle, put a hole in the middle. Just label xy coordinates as needed in order from the origin. This is how you organize your xy data without duplication in a straightforward way. Sometimes its convenient to also label points, sometimes its not required, but the xy data must always be figured from the parameters as the first step.

In VBA we would probably draw in counterclockwise order.

Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)

Now it should make sense. The xydata starts at the origin. Subroutines can be written so declared point variables are not required, or required. If you have a lot of sub-routines, just declare your x1, x2, etc as public to avoid re-declaring.

In programming 101 they strongly suggest that your subroutines be simple and single purpose. Just about every autocad parametric program I have seen or written has been a mess at the actual geometry creation level. For instance in this example, the parameters A and B, L and W may need to have complicated formulas behind them. Put those upstream of the actual sub-routine that draws the geometry. Make the geometry creation as simple as possible. Pass the actual parameters if possible, do not develop them. Interface is top down thinking, but geometry is bottom up.
Such as

Sub draw_notch_box(W As Double, L As Double, A As Double, B As Double)
x1 = 0
x2 = L - B
x3 = L
y1 = 0
y2 = A
y3 = W
Call p6_box(x1, y1, x2, y1, x2, y2, x3, y2, x3, y3, x1, y3)
End Sub

You will be able to read that next year if you remember that xy data starts at the origin.


First Daisy


Spirals are drawn as either individual lines or a connected polyline. A polyline in autocad vba requires an array of points in the form (x1,y1,x2,y2,x3…). This is constructed with a loop that runs once for each point and adds an x and y value to an array each time through the loop. The polyline is drawn outside the loop with a single statement.

The spiral consisting of individual lines is drawn with a loop that runs once for each line. It stores values for two points x1,y1 and x2,y2 each time through the loop. It draws one line segment inside the loop each time through.

The fermat spiral is sometimes used to draw plant simulations using a bit of geometry at each node rather than a straight line. Instead of calling the line subroutine, any other geometry can be called inside the loop. These are sometimes called daisies or sunflowers.

Sub fermat_spiral_daisy1()
'R = B A^1/2
Call init_polar
Dim B As Double, C As Double
Dim i As Integer
Dim numlines As Integer
Dim R1 As Double, R2 As Double
Dim A1 As Integer, A2 As Integer
Dim A1_rad As Double, A2_rad As Double
Dim X1 As Double, X2 As Double
Dim Y1 As Double, Y2 As Double

B = frm_polar.txt_b8.Value
C = 0.5

numlines = (Amax - Amin) / A_inc 'num of lines

For i = 1 To numlines
A1 = Amin + ((i - 1) * A_inc)
A2 = Amin + (i * A_inc)

A1_rad = deg2rad(A1)
A2_rad = deg2rad(A2)

'this is the function
R1 = B * (A1_rad ^ C)
R2 = B * (A2_rad ^ C)

X1 = R1 * Cos(A1_rad)
Y1 = R1 * Sin(A1_rad)
X2 = R2 * Cos(A2_rad)
Y2 = R2 * Sin(A2_rad)

'this would be the regular spiral
'Call line(X1, Y1, X2, Y2)

 Call polygon3(R2, A2)

Next i

End Sub

Sub polygon3(R As Double, A As Integer)
Call connect_acad

Dim X As Double, Y As Double
Dim plineobj As AcadLWPolyline
Dim pt() As Double
Dim t As Integer, numpts As Integer

numpts = 7
ReDim pt(1 To numpts * 2) 'to store both x and y for one pt

Dim AA As Double
Dim RR As Integer
RR = 3

For t = 1 To 7
AA = 2 * pi * t / 6 + deg2rad(A)

X = RR * Cos(AA) + R * Cos(A)
Y = RR * Sin(AA) + R * Sin(A)
pt(t * 2 - 1) = X: pt(t * 2) = Y
Next t

Set plineobj = acadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(pt)
plineobj.Closed = True
End Sub

Polar Coordinates



in process

Sub star_polygon()
Call connect_acad

Dim i As Integer, m As Integer
Dim R1 As Double, R2 As Double
Dim A1 As Integer, A2 As Integer
Dim n As Integer 'number of line segments

R1 = 50
R2 = 50
n = 11
m = 7
For i = 1 To n
A1 = 360 * (i - 1) * m / n
A2 = 360 * i * m / n

Call line_polar(R1, A1, R2, A2)

End Sub

Sub spiral_1()
Call connect_acad

Dim i As Integer
Dim R1 As Double, R2 As Double
Dim A1 As Integer, A2 As Integer

Dim A_min As Integer 'start in degrees
Dim A_max As Integer 'finish in degrees
Dim A_inc As Integer 'degree increment
Dim n As Integer 'number of line segments

A_min = 0
A_max = 1800
A_inc = 3
n = (A_max - A_min) / A_inc  'number of line segments
For i = 1 To n
A1 = A_min + ((i - 1) * A_inc)
A2 = A_min + (i * A_inc)
R1 = 0.125 * A1
R2 = 0.125 * A2
Call line_polar(R1, A1, R2, A2)

End Sub

Sub line_polar(R1 As Double, A1 As Integer, R2 As Double, A2 As Integer)
'a POLAR line wrapper to draw a line with one line of code
'A1 and A2 are input in degrees integer only for now
Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double

pt1(0) = R1 * Cos(deg2rad(A1))
pt1(1) = R1 * Sin(deg2rad(A1))
pt1(2) = 0

pt2(0) = R2 * Cos(deg2rad(A2))
pt2(1) = R2 * Sin(deg2rad(A2))
pt2(2) = 0

Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2)
End Sub

Function deg2rad(deg As Integer) As Double
deg2rad = deg * pi / 180
End Function


Cartesian Graphing

Locating points on a plane using a horizontal and vertical number line, giving each point a location with two numbers, then drawing lines between points, is called graphing with the Cartesian coordinate system. It is a link between algebra and geometry. Its named for Rene Descartes (“I think therefore I am”) who developed one of the first ideas along this line about 1637. Autocad is a Cartesian coordinate graphing system, although normally the lines are not input with algebraic equations.

Two more additions to our function library before we begin with a polar coordinate system.



Sub add_sin(a As Double, b As Double, c As Double, d As Double)
'Xmin, Xmax, X_inc already set
'Y = Sin(a * X) + Sin(b * X) + Sin(c * X) + d
Dim X As Double, Y As Double
Dim plineobj As AcadLWPolyline
Dim pt() As Double
Dim i As Integer, numpts As Integer

numpts = (Xmax - Xmin) / X_inc
numpts = numpts + 1
ReDim pt(1 To numpts * 2)

For i = 1 To numpts
X = Xmin + ((i - 1) * X_inc)
Y = Sin(a * X) + Sin(b * X) + Sin(c * X) + d
pt(i * 2 - 1) = X: pt(i * 2) = Y
Next i

Set plineobj = acadDoc.ModelSpace.AddLightWeightPolyline(pt)
strLabel = "Y= Sin " & a & "X + Sin " & b & "X + Sin " & c & "X + " & d
End Sub



Sub exp_curve(Xmin As Double, Xmax As Double, a As Double, X_inc As Double)
'y = a^x
Dim X As Double, Y As Double
Dim plineobj As AcadLWPolyline
Dim pt() As Double
Dim i As Integer, numpts As Integer

numpts = (Xmax - Xmin) / X_inc 'number of line segments
numpts = numpts + 1  'one more pt than line segment
ReDim pt(1 To numpts * 2) 'store x and y for one pt

For i = 1 To numpts
X = Xmin + ((i - 1) * X_inc)
Y = a ^ X
pt(i * 2 - 1) = X: pt(i * 2) = Y
Next i

Set plineobj = acadApp.ActiveDocument.ModelSpace.AddLightWeightPolyline(pt)
strLabel = "Y= " & a & "^X"
End Sub

Form of forms


There will not be a limit to how many function types we could possibly program, and it does not feel like there is going to be a single universal input form or program to run them, so we will use an index form to manage them.

The main form will be a switch board into the equation forms and the axis form, but also will set the layer color and lineweight, text style, and background color. Being able to change these easily will improve the screenshots.

Main Form – contains the button links to other forms, and the settings.
XY-Axis Form – strictly for drawing the axis
Graph1 and Trig1 forms contain the draw sub-routines. they can be expanded and more added.



Layers control colors, linetypes and lineweights. Everything is on a layer.

The layer collection and layer object conform to the general object structure. in fact it would be an interesting exercise to write a generic structure description where the collection and item names could be interchanged with other types of entities.

To set a reference to an existing class_object use the Item property of the collection. Use either the string name or the index number. All collections are zero-based. The count property of the collection is one-based. To add a new class_object, use the Add property of the collection. If you reference with Item to an object that does not exist, you will receive “Key not found” error. If you add a class_object that already exists, you get a reference to the existing object.

You can iterate through the collection with
For Each class_object in collection

For i= 0 to collection.count – 1
Set class_object = collection.Item(i)


Dim objlayers As AcadLayers
Dim objlayer As AcadLayer
Set objlayers = acadDoc.Layers
Set objlayer = objlayers.Item(“ABC”) ‘error if does not exist
Set objlayer = objlayers.Item(1)
Set objlayer = objlayers.Add(“ABC”) ‘returns reference if already exists

The new layer needs to be current for new entities to adopt its property. The ActiveLayer property of the drawing object is used.
Acaddoc.ActiveLayer = acadDoc.Layers.Item(“ABC”)
Acaddoc.ActiveLayer = objlayer

Application – Documents – Document – Layers – Layer

The Layers collection contains all the Layer objects in the drawing.
Layers collection – AcadLayers
Methods – Add Item
Properties – Count

Layer object – AcadLayer
Method – Delete
Properties – Used, Name, LayerOn, Freeze, Lock, TrueColor, Linetype,
Lineweight, PlotStyleName, Plottable, Description

Sub testnewlayer()
Call newlayer("AAA", 1, acLnWt035)
End Sub

Sub newlayer(strname As String, intcolor As Integer, lineweight As Integer)
Call connect_acad

Dim objlayers As AcadLayers
Dim objlayer As AcadLayer
Set objlayers = acadDoc.Layers

Set objlayer = objlayers.Add(strname)
    objlayer.Color = intcolor
  'note color is not currently a listed item in documentation but still works
    objlayer.lineweight = lineweight
    'acadDoc.ActiveLayer = acadDoc.Layers.Item(strname)
     acadDoc.ActiveLayer = objlayer

'default values of a new layer
'objlayer.Used = True
'objlayer.Name = "ABC"
'objlayer.LayerOn = True
'objlayer.Freeze = False
'objlayer.Lock = False
'objlayer.Color = 7 'this is the old 255 color method no longer documented 
'debug.print objlayer.TrueColor returns- object doesnt support this property or method
'debug.print objlayer.Color returns an integer you can use to read or set color
'objlayer.LineType = "Continuous"
'objlayer.LineWeight = -3
'objlayer.PlotStyleName = "Color_7"
'objlayer.Plottable = True
'objlayer.Description = ""

End Sub