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.


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

The Text Object

Graphical entities in autocad vba are added with the add### methods which are members of AcadModelSpace, AcadPaperSpace, and AcadBlock.
The object browser shows AcadModelSpace has two members (actually has about 75 add-somethings)

Addtext(string, insertpt, height as double).
AddMText(insertpt, width as double, string)

Simple text is the old style and MText is the new full featured object. The insertion pt is the familiar array of 3 doubles. MText width refers to the box the entire text is within.

To place these in ModelSpace, we establish a link to the current document
Call connect_acad
which gives us the global Acaddoc which is

In the Object Browser, find AcadModelSpace, then right click on its members AddText and AddMText, choose Help, and you get the autocad help with code example with the very least steps to create a text object.

you must declare the correct object, set up the variables, and add text.

Dim textObj As AcadText
Dim MTextObj As AcadMText
Set textObj = ThisDrawing.ModelSpace.AddText(textString, insertionPoint, height)
Set MTextObj = ThisDrawing.ModelSpace.AddMText(corner, width, text)

in our case since we are running code from excel not inside autocad
Set textObj = AcadDoc.ModelSpace.AddText(textString, insertionPoint, height)
Set MTextObj = AcadDoc.ModelSpace.AddMText(corner, width, text)

The text will come in with the current style. The insert pt for text is lower left ( look up the justify option in the text command and the TextJustify readonly variable if you want to change that). The corner variable in the Mtext argument list is the top left corner of the box. It is the std 3 pt variable array of doubles.

For our application – we are going to add an option to label the graph with the equation. We dont want to add similar code to all our concise routines, but the only place to create a string showing the equation being graphed is in the equation sub. We will create a global string variable and when the equation runs we will fill the variable. The variable will still be available as long as the form is open. The user if he wishes can add the label with a button after the graph is made. To get the text location, we will use the bounding property of a block. our block is the axis. our test wont be too sophisticated – we will take the first block we find that has an insertion point at 0,0. We will use the 4 corners of the axis bounding box as a demonstration at this time, placing plain text and mtext. We will be interested in MText as it will have more options to format our equation, though the vba string variable may be a limitation.
We will create some public variables to hold the text locations and height, and a global pt0 at the origin so we dont have to set up when needed.

Public pt_LL(0 To 2) As Double
Public pt_LR(0 To 2) As Double
Public pt_UR(0 To 2) As Double
Public pt_UL(0 To 2) As Double
Public pt0(0 To 2) As Double
Public label_height As Double

Sub set_pt0()
'public variable pt0 is always the origin
pt0(0) = 0: pt0(1) = 0: pt0(2) = 0
End Sub

Sub bigger_label()
label_height = label_height * 1.25
Call label_graph
End Sub

Sub smaller_label()
label_height = label_height * 0.75
Call label_graph
End Sub

Sub label_graph()
'example program to place equation labels at the four corners of the graph
'uses text and mtext
Dim i As Integer
Dim s_set As AcadSelectionSet

If strLabel  "" Then
MsgBox "strlabel not initialized"
Exit Sub
End If

'sets the four axis boundary pts to use as text inserts
Call get_axis_extents

If pt_LL(0) = 0 Then
MsgBox "did not find an axis"
Exit Sub
End If

If label_height = 0 Then
label_height = 0.5
End If

On Error Resume Next
Set s_set = acadDoc.SelectionSets.Item("graph_labels")
Debug.Print "s_set.count = " & s_set.Count

'if an autocad entity is in s_set but erased thru gui then s_set.erase restores entity
'the fix is to iterate through the set with error reporting off
i = s_set.Count
Do While i > 0
i = i - 1 'because ss index is zero based

On Error GoTo 0

Call add_ss("graph_labels")
Set s_set = acadDoc.SelectionSets.Item("graph_labels")
 Dim textObj1 As AcadText, textObj2 As AcadText
 Set textObj1 = acadDoc.ModelSpace.AddText(strLabel, pt_LL, label_height)
 s_set.Select acSelectionSetLast
 Set textObj2 = acadDoc.ModelSpace.AddText(strLabel, pt_LR, label_height)
 s_set.Select acSelectionSetLast
 textObj2.Alignment = acAlignmentBottomRight
 textObj2.TextAlignmentPoint = pt_LR
 Dim MTextObj1 As AcadMText, MTextObj2 As AcadMText
 Dim width As Double
 width = 20 * label_height
 Set MTextObj1 = acadDoc.ModelSpace.AddMText(pt_UL, width, strLabel)
 s_set.Select acSelectionSetLast
 Set MTextObj2 = acadDoc.ModelSpace.AddMText(pt_UR, width, strLabel)
 s_set.Select acSelectionSetLast
 MTextObj1.height = label_height
 MTextObj2.height = label_height
 MTextObj2.AttachmentPoint = acAttachmentPointTopRight
 MTextObj2.insertionPoint = pt_UR

End Sub

Sub get_axis_extents()
Dim blockRef As AcadBlockReference
Dim entity As AcadEntity

'the only purpose is to retrieve a block reference inserted at 0,0
'then retrieve its bounding box
'and set global point variables to the 4 corners
'zoom to bounds

'use this as a test if a block was found and the point set
pt_LL(0) = 0

For Each entity In acadDoc.ModelSpace
        If TypeOf entity Is AcadBlockReference Then
            Set blockRef = entity
                If blockRef.insertionPoint(0) = 0 And _
                   blockRef.insertionPoint(1) = 0 Then
                 Exit For
                Set blockRef = Nothing
              End If
        End If
    If Not blockRef Is Nothing Then
        Debug.Print blockRef.Name
        Dim minExt As Variant, maxExt As Variant
        blockRef.GetBoundingBox minExt, maxExt
        Debug.Print minExt(0) & ", " & minExt(1) & ", " & minExt(2)
        Debug.Print maxExt(0) & ", " & maxExt(1) & ", " & maxExt(2)
        pt_LL(0) = minExt(0): pt_LL(1) = minExt(1): pt_LL(2) = 0
        pt_LR(0) = maxExt(0): pt_LR(1) = minExt(1): pt_LR(2) = 0
        pt_UR(0) = maxExt(0): pt_UR(1) = maxExt(1): pt_UR(2) = 0
        pt_UL(0) = minExt(0): pt_UL(1) = maxExt(1): pt_UL(2) = 0
        acadApp.ZoomWindow minExt, maxExt
        acadApp.ZoomScaled 0.9, acZoomScaledRelative
    End If