AutoLisp 2.5

about 1986 R.C. Bradlee published a Xeroxed page book “Programming Autocad” which featured the Autolisp command set as of autocad version 2.5. Selection Sets had just been added. Entity names could be retrieved and properties modified but new entitities had to be added with the Command function (command “Line” pnt1 …). This would be a good starter section for learning the language, not overwhelming but not trivial. Some or most of the links seem to paste in from the Autodesk 2017 help reference. I rearranged and edited the entries into my own idea of fuzzy categories. A disclaimer – this is not an official list of Lisp 2.5 but just my reconstruction. Some functions i left out either inadvertently, or i assume they are obsolete, or simply i dont see a need for them.

Descriptions below all belong to Autodesk. Here is there notice cut / pasted from their help page.

Except where otherwise noted, this (Autodesk) work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License.  Please see the Autodesk Creative Commons FAQ for more information.

Math and booleans are first and easiest to master.

+ (add)  (+ [number number …]) Returns the sum of all numbers
– (subtract)  (- [number number …]) Subtracts the second and following numbers from the first and returns the difference
* (multiply)  (* [number number …]) Returns the product of all numbers
/ (divide)  (/ [number number …]) Divides the first number by the product of the remaining numbers and returns the quotient
1+ (increment)  (1+ number) Returns the argument increased by 1 (incremented)
1- (decrement)  (1- number) Returns the argument reduced by 1 (decremented)
abs  (abs number) Returns the absolute value of the argument
atan  (atan num1 [num2]) Returns the arctangent of a number in radians
cos  (cos ang) Returns the cosine of an angle expressed in radians
exp  (exp number) Returns the constant e (a real) raised to a specified power (the natural antilog)
expt  (expt base power) Returns a number raised to a specified power
fix  (fix number) Returns the conversion of a real into the nearest smaller integer
float  (float number) Returns the conversion of a number into a real
gcd  (gcd int1 int2) Returns the greatest common denominator of two integers
log  (log number) Returns the natural log of a number as a real
max  (max [number number …]) Returns the largest of the numbers given
min  (min [number number …]) Returns the smallest of the numbers given
rem  (rem [num1 num2 …]) Divides the first number by the second, and returns the remainder
sin  (sin ang) Returns the sine of an angle as a real expressed in radians
sqrt  (sqrt number) Returns the square root of a number as a real
~ (bitwise NOT)  (~ int) Returns the bitwise NOT (1’s complement) of the argument
logand  (logand [int int …]) Returns the result of the logical bitwise AND of a list of integers
logior  (logior [int int …]) Returns the result of the logical bitwise inclusive OR of a list of integers
lsh  (lsh [int numbits]) Returns the logical bitwise shift of an integer by a specified number of bits
atom  (atom item) Verifies that an item is an atom
boundp  (boundp sym) Verifies whether a value is bound to a symbol
listp  (listp item) Verifies that an item is a list
not  (not item) Verifies that an item evaluates to nil
null  (null item) Verifies that an item is bound to nil
numberp  (numberp item) Verifies that an item is a real or an integer
minusp  (minusp number) Verifies that a number is negative
zerop  (zerop number) Verifies that a number evaluates to zero
= (equal to)  (= numstr [numstr …]) Returns T if all arguments are numerically equal, and returns nil otherwise
/= (not Equal to)  (/= numstr [numstr …]) Returns T if the arguments are not numerically equal, and nil if the arguments are numerically equal
> (greater than)  (< numstr [numstr …]) Returns T if each argument is numerically less than the argument to its right, and returns nil otherwise
>= (greater than or equal to)  (<= numstr [numstr …]) Returns T if each argument is numerically less than or equal to the argument to its right, and returns nil otherwise
< (less than)  (> numstr [numstr …]) Returns T if each argument is numerically greater than the argument to its right, and returns nil otherwise
<= (less than or equal to)  (>= numstr [numstr …]) Returns T if each argument is numerically greater than or equal to the argument to its right, and returns nil otherwise
and  (and [expr …]) Returns the logical AND of a list of expressions
boole  (boole func int1 [int2 …]) Serves as a general bitwise Boolean function
eq  (eq expr1 expr2) Determines whether two expressions are identical
equal  (equal expr1 expr2 [fuzz]) Determines whether two expressions are equal
or  (or [expr …]) Returns the logical OR of a list of expressions
angtos  (angtos angle [mode [precision]]) Converts an angular value in radians into a string
ascii  (ascii string) Returns the conversion of the first character of a string into its ASCII character code (an integer)
atof  (atof string) Returns the conversion of a string into a real
atoi  (atoi string) Returns the conversion of a string into an integer
chr  (chr integer) Returns the conversion of an integer representing an ASCII character code into a single-character string
itoa  (itoa int) Returns the conversion of an integer into a string
rtos  (rtos number [mode [precision]]) Converts a number into a string

Lists and Loops contain the core LIST Processing commands

type  (type item) Returns the type of a specified item
eval  (eval expr) Returns the result of evaluating an AutoLISP expression
quote  (quote expr) Returns an expression without evaluating it
repeat  (repeat int [expr …]) Evaluates each expression a specified number of times, and returns the value of the last expression
while  (while testexpr [expr …]) Evaluates a test expression, and if it is not nil, evaluates other expressions; repeats this process until the test expression evaluates to nil
if  (if testexpr thenexpr [elseexpr]) Conditionally evaluates expressions
cond  (cond [(test result …) …]) Serves as the primary conditional function for AutoLISP
foreach  (foreach name lst [expr …]) Evaluates expressions for all members of a list
progn  (progn [expr …]) Evaluates each expression sequentially, and returns the value of the last expression
command  (command [arguments] …) Executes an AutoCAD command
defun  (defun sym ([arguments] [/variables …]) expr … ) Defines a function
setq  (setq sym1 expr1 [sym2 expr2 …]) Sets the value of a symbol or symbols to associated expressions
getvar  (getvar “varname”) Retrieves the value of an AutoCAD system variable
setvar  (setvar “varname” value) Sets an AutoCAD system variable to a specified value
load  (load filename [onfailure]) Evaluates the AutoLISP expressions in a file
*error*  (*error* string) A user-definable error-handling function
list  (list [expr …]) Takes any number of expressions and combines them into one list
length  (length lst) Returns an integer indicating the number of elements in a list
last  (last lst) Returns the last element in a list
nth  (nth n lst) Returns the nth element of a list
reverse  (reverse lst) Returns a list with its elements reversed
car  (car lst) Returns the first element of a list
cdr  (cdr lst) Returns the specified list, except for the first element of the list
caddr 
cadr 
cons  (cons new-first-element lst) The basic list constructor
append  (append lst …) Takes any number of lists and runs them together as one list
member  (member expr lst) Searches a list for an occurrence of an expression and returns the remainder of the list, starting with the first occurrence of the expression
assoc  (assoc item alist) Searches an association list for an element and returns that association list entry
apply  (apply function lst) Passes a list of arguments to a specified function
mapcar  (mapcar function list1 … listn) Returns a list of the result of executing a function with the individual elements of a list or lists supplied as arguments to the function
lambda  (lambda arguments expr …) Defines an anonymous function

 

Strings and File I/O are pretty straighforward

read  (read [string]) Returns the first list or atom obtained from a string
strcat  (strcat [string1 [string2 …]) Returns a string that is the concatenation of multiple strings
strlen  (strlen [string …]) Returns an integer that is the number of characters in a string
substr  (substr string start [length]) Returns a substring of a string
vl-string-subst  (vl-string-subst new-str pattern string [start-pos]) Substitutes one string for another, within a string
open  (open filename mode) Opens a file for access by the AutoLISP I/O functions
read-char  (read-char [file-desc]) Returns the decimal ASCII code representing the character read from the keyboard input buffer or from an open file
read-line  (read-line [file-desc]) Reads a string from the keyboard or from an open file
write-char  (write-char num [file-desc]) Writes one character to the screen or to an open file
write-line  (write-line string [file-desc]) Writes a string to the screen or to an open file
close  (close file-desc) Closes an open file

 

The last category is Autocad graphic interfacing commands. ( I am leaving out a few things I think may be less useful or obsolete or inadvertently)

angle  (angle pt1 pt2) Returns an angle in radians of a line defined by two endpoints
distance  (distance pt1 pt2) Returns the 3D distance between two points
inters  (inters pt1 pt2 pt3 pt4 [onseg]) Finds the intersection of two lines
osnap  (osnap pt mode) Returns a 3D point that is the result of applying an Object Snap mode to a specified point
polar  (polar pt ang dist) Returns the UCS 3D point at a specified angle and distance from a point
getangle  (getangle [pt] [msg]) Pauses for user input of an angle, and returns that angle in radians
getdist  (getdist [pt] [msg]) Pauses for user input of a distance
getint  (getint [msg]) Pauses for user input of an integer, and returns that integer
getorient  (getorient [pt] [msg]) Pauses for user input of an angle, and returns that angle in radians
getpoint  (getpoint [pt] [msg]) Pauses for user input of a point, and returns that point
getreal  (getreal [msg]) Pauses for user input of a real number, and returns that real number
getstring  (getstring [cr] [msg]) Pauses for user input of a string, and returns that string
entsel  (entsel [msg]) Prompts the user to select a single object (entity) by specifying a point
entdel  (entdel ename) Deletes objects (entities) or restores previously deleted objects
entget  (entget ename [applist]) Retrieves an object’s definition data
entlast  (entlast) Returns the name of the last non-deleted main object in the drawing
entmod  (entmod elist) Modifies the definition data of an object
entnext  (entnext [ename]) Returns the name of the next object in the drawing
entupd  (entupd ename) Updates the screen image of an object
ssadd  (ssadd [ename [ss]]) Adds an object (entity) to a selection set, or creates a new selection set
ssdel  (ssdel ename ss) Deletes an object (entity) from a selection set
ssget  (ssget [mode] [pt1 [pt2]] [pt-list] [filter-list]) Prompts the user to select objects (entities), and returns a selection set
sslength  (sslength ss) Returns an integer containing the number of objects (entities) in a selection set
ssmemb  (ssmemb ename ss) Tests whether an object (entity) is a member of a selection set
ssname  (ssname ss index) Returns the object (entity) name of the indexed element of a selection set
grread  (grread [track] [allkeys [curtype]]) Reads values from any of the AutoCAD input devices
grclear 
graphscr  (graphscr) Displays the AutoCAD graphics screen
grdraw  (grdraw from to color [highlight]) Draws a vector between two points, in the current viewport
grtext  (grtext [box text [highlight]]) Writes text to the status line or to screen menu areas
menucmd  (menucmd string) Issues menu commands, or sets and retrieves menu item status
prin1  (prin1 [expr [file-desc]]) Prints an expression to the command line or writes an expression to an open file
princ  (princ [expr [file-desc]]) Prints an expression to the command line, or writes an expression to an open file
print  (print [expr [file-desc]]) Prints an expression to the command line, or writes an expression to an open file
prompt  (prompt msg) Displays a string on your screen’s prompt area
redraw  (redraw [ename [mode]]) Redraws the current viewport or a specified object (entity) in the current viewport
terpri  (terpri) Prints a newline to the Command line

 

Advertisements

Autocad Help System for Lisp and VBA (ActiveX)

I have found the front end pages for Autocad programming languages VBA (ActiveX) and Lisp (Visual Lisp). Here is my big suggestion. You can copy and paste an entire page of links into Excel and the links transfer. Use Excel to collate and organize Autodesk help bookmarks.

Autodesk splits both subjects into two groups – what they call a Guide which would be teaching text and a Reference which is a page by page Index. Visual Lisp is traditional Autocad Lisp plus ActiveX. So if you are looking for Visual Lisp help, you need to include the ActiveX references in your reading list.

As of 2017, Autodesk has returned “Developer Documentation” to its front end for Autocad 2017 help,
http://help.autodesk.com/view/ACD/2017/ENU/

Following that link brings you to this page to be bookmarked,
http://help.autodesk.com/view/ACD/2017/ENU/?home=homepage_dev

If you copy and paste that page into excel, the links all transfer without any additional work. Here i have marked with asterisk the 5 critical pages.
2017-02-22_2

you can then make tabs for guide and reference for both lisp and activeX. In a few minutes you have an upper level table of contents in a single file. as you explore the pages using the live links you can make notes or mark as read. you can make a reference to the entire page at the top of your excel sheet. Pages come in formatted with good links, you might have to reset column width and row height for entire sheet.

2017-02-22_3

If you are looking for Visual Lisp code, it is in the ActiveX reference. Both groups ActiveX and Lisp have an Object Model page, but the Lisp page is not live, just a picture. The Object Model page for ActiveX has live links. You do not need to paste that page into Excel, but it also pastes with live links, and you never have to go looking for it. You can have the Object Model with links in your spread sheet. Regardless how you access it, it is a very valuable tool.

As an example of its usefulness, say you want to know how to draw a circle with Visual Lisp.

2017-02-22_4

Click on the Circle object. It takes you to Circle Object ActiveX help page. Which has the properties and methods of the object that is a circle, but it does not have the tool to draw a circle. The Addcircle is a method of ModelSpace, PaperSpace and Block. Click on ModelSpace, scroll down to the methods, and click on AddCircle. there you find the code to draw a circle in both VBA and Lisp. Code that you can paste into your VBA module or Lisp editor.

http://help.autodesk.com/view/ACD/2017/ENU/?guid=GUID-18ADF171-166F-4FF0-8ED6-5F83153A5649#GUID-18ADF171-166F-4FF0-8ED6-5F83153A5649

http://help.autodesk.com/view/ACD/2017/ENU/?guid=GUID-837C702F-91A7-445B-8713-3099B94664BE

the object model –

http://help.autodesk.com/view/ACD/2017/ENU/?guid=GUID-A809CD71-4655-44E2-B674-1FE200B9FE30

2017-02-22_6

* EDIT – unfortunately the ActiveX Reference page links did NOT copy from www into Excel. *
The other pages, lisp guide and reference, activex guide, and activex model links do work in excel.

and finally, autocad 2017 still installs two activex chm files on your hard drive with installation, the Guide and the Reference. You can also link to those.

2017-02-22_7

Autocad Ellipse

The Ellipse

2017-01-26_1

Autocad has an ellipse object. The AddEllipse method takes a center point, a second point which is the end of the major axis, and a factor autodesk calls RadiusRatio, which is just b / a. This is not the same thing as Eccentricity which is c / a, though similar but inverse and they both must be less than 1. I have not seen RadiusRatio in a math book. RadiusRatio gives a circle if it is equal to 1. If it is greater than 1 it throws an error. Eccentricity is a math term and gives a circle when it is zero. If it were 1 i believe the ellipse would collapse to a straight line.

To create an autocad vba ellipse with vertical axis, make the second point, MajorAxis, vertical above the center point. Autocad gives no indication where the Focus is. It has to be calculated from the values of A and B.

2017-01-26_2

Sub init_frm_ellipse()
a = frm_Ellipse.txt_a1
b = frm_Ellipse.txt_b1
End Sub

Sub horz_new_ellipse()
'AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a relative point off the center, not an absolute point
Call connect_acad
Call init_frm_ellipse

Dim obj_ellipse As AcadEllipse
Dim ptctr(0 To 2) As Double
Dim pta(0 To 2) As Double
Call initpt(ptctr, 0, 0, 0)
Call initpt(pta, a, 0, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ptctr, pta, b / a)
obj_ellipse.Update
End Sub

Sub vert_new_ellipse()
Call connect_acad
Call init_frm_ellipse

Dim obj_ellipse As AcadEllipse
Dim ptctr(0 To 2) As Double
Dim pta(0 To 2) As Double
Call initpt(ptctr, 0, 0, 0)
Call initpt(pta, 0, a, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ptctr, pta, b / a)
obj_ellipse.Update
End Sub

The autodesk method advantage is that by specifying a center, then a relative point from the center for the end of the major axis, the ellipse can be turned to any angle. With some simple trig we can accept input in degrees and calculate the major axis vertex.

2017-01-27_1

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

Sub init_frm_ellipse()
a = frm_Ellipse.txt_a1
b = frm_Ellipse.txt_b1
c = frm_Ellipse.txt_c1
End Sub

Sub new_ellipse()
'AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a point, not a length
Call connect_acad
Call init_frm_ellipse

Dim obj_ellipse As AcadEllipse
Dim ptctr(0 To 2) As Double
Dim pta(0 To 2) As Double
Dim x1 As Double, y1 As Double

x1 = a * Cos(deg2rad(c))
y1 = a * Sin(deg2rad(c))

Call initpt(ptctr, 0, 0, 0)
Call initpt(pta, x1, y1, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ptctr, pta, b / a)
obj_ellipse.Update
End Sub

we can move the ellipse off the center. The input for AddEllipse does not require an absolute point for MajorAxis. It takes a point relative to the center.

2017-01-28_1

Drawing the ellipse is straightforward. calculating the focus and end points to mark them requires some trig to accomodate the angled axes.


Sub new_ellipse()
'takes input from the form
'a major axis
'b minor axis
'd degree of major axis
'h and k, xy values for center of ellipse
'converts input to
'autocad method AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a point relative from the center, not an absolute point
Call connect_acad
Call init_frm_ellipse ' gets the values from the form
Dim obj_ellipse As AcadEllipse
Dim obj_point As AcadPoint

Dim ctr(0 To 2) As Double
Dim pt_a(0 To 2) As Double
Dim x1 As Double, y1 As Double

x1 = a * Cos(deg2rad(d))
y1 = a * Sin(deg2rad(d))

Call initpt(ctr, h, k, 0)
Call initpt(pt_a, x1, y1, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ctr, pt_a, b / a)
obj_ellipse.Update

'to plot points
Dim pt_a1(0 To 2) As Double
Dim pt_a2(0 To 2) As Double
Dim pt_b1(0 To 2) As Double
Dim pt_b2(0 To 2) As Double
Dim pt_f1(0 To 2) As Double
Dim pt_f2(0 To 2) As Double

Dim fx1 As Double, fy1 As Double, fx2 As Double, fy2 As Double
Dim ax1 As Double, ay1 As Double, ax2 As Double, ay2 As Double
Dim bx1 As Double, by1 As Double, bx2 As Double, by2 As Double

'c is the focal distance from ctr
c = (a ^ 2 - b ^ 2) ^ 0.5
fx1 = h + c * Cos(deg2rad(d))
fy1 = k + c * Sin(deg2rad(d))
fx2 = h - c * Cos(deg2rad(d))
fy2 = k - c * Sin(deg2rad(d))

bx1 = h + b * Cos(deg2rad(d + 90))
by1 = k + b * Sin(deg2rad(d + 90))

bx2 = h - b * Cos(deg2rad(d + 90))
by2 = k - b * Sin(deg2rad(d + 90))

ax1 = h + a * Cos(deg2rad(d))
ay1 = k + a * Sin(deg2rad(d))

ax2 = h - a * Cos(deg2rad(d))
ay2 = k - a * Sin(deg2rad(d))

Call initpt(pt_a1, ax1, ay1, 0)
Call initpt(pt_a2, ax2, ay2, 0)
Call initpt(pt_b1, bx1, by1, 0)
Call initpt(pt_b2, bx2, by2, 0)
Call initpt(pt_f1, fx1, fy1, 0)
Call initpt(pt_f2, fx2, fy2, 0)

Set obj_point = acadDoc.ModelSpace.AddPoint(ctr)

Set obj_point = acadDoc.ModelSpace.AddPoint(pt_a1)
Set obj_point = acadDoc.ModelSpace.AddPoint(pt_a2)

Set obj_point = acadDoc.ModelSpace.AddPoint(pt_b1)
Set obj_point = acadDoc.ModelSpace.AddPoint(pt_b2)

Set obj_point = acadDoc.ModelSpace.AddPoint(pt_f1)
Set obj_point = acadDoc.ModelSpace.AddPoint(pt_f2)
Update

End Sub

In astronomy, planets orbit around the sun in ellipses with the sun at one focus. To draw these orbits we need to input the different numbers but always draw one focus, the sun, at the origin.

2017-01-27_2

orbits of the nine planets (simplified with major axes aligned, no inclination). The sun and all planets are drawn full size, but the distances of the orbits are so vast they are not seen. this is much more fun to do yourself to zoom around and get a feel for the distance than to look at a screenshot.

the astronomy book gives the half major axis in (x 10^6 km), Orbital Eccentricity, and planet radius in km. those are the inputs. The value for Uranus caused Long and Double variable types to overflow but i had no issues using Currency data type. don’t base your senior thesis on this, i dont have supervision. it gives a visually correct orbit for pluto that it actually crosses inside neptune’s orbit because of pluto’s higher eccentricity. there are other 3D factors i do not take into consideration, inclination – ellipse tilt – and two other twists in 3D space. so neptune and pluto can never collide.

2017-01-27_3

Public Const xkm As Currency = 1000000

Sub solar_system()
Call connect_acad
'testCall planetary_ellipse(6, 0.5, 1)

Dim pt0(0 To 2) As Double
Call initpt(pt0, 0, 0, 0)

Dim obj_sphere As Acad3DSolid
'this is the sun
Set obj_sphere = acadDoc.ModelSpace.AddSphere(pt0, 696000)

'mercury
Call planetary_ellipse(57.9 * xkm, 0.206, 2440)

'venus
Call planetary_ellipse(108.2 * xkm, 0.007, 6052)

'earth
Call planetary_ellipse(149.6 * xkm, 0.017, 6378)

'mars
Call planetary_ellipse(227.9 * xkm, 0.093, 3397)

'jupiter
Call planetary_ellipse(778.4 * xkm, 0.048, 71492)

'saturn
Call planetary_ellipse(1427 * xkm, 0.054, 60268)

'too large
'uranus
Call planetary_ellipse(2871 * xkm, 0.047, 25559)

'neptune
Call planetary_ellipse(4498 * xkm, 0.009, 24764)

'pluto
Call planetary_ellipse(5906 * xkm, 0.249, 1195)

End Sub


Sub planetary_ellipse(a As Currency, e As Double, r As Long)
'a is major axis km
'e is eccentricity
'r is planetary equatorial radius in km

'AddEllipse(Center, MajorAxis, RadiusRatio)
'RadiusRatio must be less than or equal to 1
'MajorAxis is a point, not a length

Dim b As Double
Dim c As Double
Dim obj_ellipse As AcadEllipse
Dim obj_point As AcadPoint


Dim ctr(0 To 2) As Double
Dim f1(0 To 2) As Double
Dim f2(0 To 2) As Double
Dim pt_a(0 To 2) As Double
Dim pt_p(0 To 2) As Double
Dim a_vector(0 To 2) As Double

c = a * e
b = a * (1 - e ^ 2) ^ 0.5

Call initpt(ctr, c, 0, 0)
Call initpt(f1, 0, 0, 0)
Call initpt(f2, 2 * c, 0, 0)
Call initpt(pt_a, a + c, 0, 0)
Call initpt(pt_p, c - a, 0, 0)

Call initpt(a_vector, 1 * a, 0, 0)

Set obj_ellipse = acadDoc.ModelSpace.AddEllipse(ctr, a_vector, b / a)
obj_ellipse.Update

Dim obj_sphere As Acad3DSolid
Set obj_sphere = acadDoc.ModelSpace.AddSphere(pt_a, r)
Set obj_sphere = acadDoc.ModelSpace.AddSphere(pt_p, r)

End Sub

Autocad VBA Logo Turtle Graphics

Logo was a lisp like educational language designed to introduce children to coding. I believe there may be no serious impediments to implementing an experimental version in Autocad VBA. This is a work in process, first post is proof of concept. The full implementation is yet to be planned. I wont worry too much about deviating from standard logo methods or syntax. If i hit a problem that cannot be coded around, that will be information gained. I believe the concepts may turn out to be useful for more general VBA parametric autocad code.

For all of my projects, I code in an Excel XLSM file. I have a standard ACAD_CONNECT sub i use, and reference the Autocad Type Library in the Excel VBAProject. i have never downloaded the Autocad VBA implementation. It is not necessary to code Autocad VBA. I use the VBA editor provided routinely in Excel.

The fundamental element of turtle geometry is the current position of the pen, and the heading or direction it is pointing. This prototype will be 2D, so we need a global variable for the X and Y position, and a variable for the heading. We will keep heading in degrees and convert it in the low level subs to radians.

The first thing we will need is a line subroutine that takes logo style input – current point, distance, and heading – to draw the line and change the pen position to the end of the line. The user wont call this sub directly but will use std routines like Forward, PenUP, Right, Left, etc.

Option Explicit
 Public px As Double 'position x
 Public py As Double 'position y
 Public hxy As Double 'heading degree


Sub line_hd(x1 As Double, y1 As Double, dist As Double, heading As Double)
' call line_t(x1,y1,dist,heading)
' heading in degrees

Dim lineobj As AcadLine
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim heading_radian As Double

pt1(0) = x1: pt1(1) = y1: pt1(2) = 0
heading_radian = heading * Pi / 180

'px and py are global position
px = px + dist * Cos(heading_radian)
py = py + dist * Sin(heading_radian)

pt2(0) = px: pt2(1) = py: pt2(2) = 0
Set lineobj = acadDoc.ModelSpace.AddLine(pt1, pt2)

Update
End Sub

standard logo subroutines FORWARD, RIGHT, LEFT and BACK to get started are pretty simple at this point. i dont have a PENUP, PENDOWN yet that will modify these.

Sub forward(dist As Double)
Call line_hd(px, py, dist, hxy)
End Sub

Sub right(deg As Double)
hxy = hxy - deg
End Sub

Sub left(deg As Double)
hxy = hxy + deg
End Sub

Sub back(dist As Double)
Dim heading_radian As Double
heading_radian = hxy * Pi / 180
px = px - (dist * Cos(heading_radian))
py = py - (dist * Sin(heading_radian))
End Sub

a sample user prototype sub and init sub helper.

 Sub init_turtle()
 Call connect_acad
 px = 0
 py = 0
 hxy = 0
 End Sub
 
 Sub to_honeycomb()
  init_turtle
 Dim i As Integer, j As Integer

For j = 1 To 3
For i = 1 To 6
forward 6
left 60
Next i

left 120
Next j

End Sub

2017-01-15_1

 Sub to_star()
 init_turtle
 Dim i As Integer
 
 For i = 1 To 5
 forward 6
 right 144
 Next i
 
 End Sub
 

2017-01-15_2

the circle routine according to python turtle graphics just takes a radius. from the position and heading of the turtle, it makes a 360 arc back to the starting point. if the radius is positive, it turns counterclockwise, if negative then opposite. the task then is to run a normal perpendicular off the heading vector the same distance as the radius to find the center.

this is a little messy, i dont think it will stay this way.

first a demo calling program, then the circle primitive code.

Sub test_circle()
init_turtle

For i = 1 To 21
forward 6
right 15 + i
forward 6
curcle 3
forward 3
curcle -3
forward 6
curcle -3
forward 3
curcle 3
Next i

End Sub

Sub curcle(radius As Double)
Call circle_turtle(px, py, radius, hxy)
End Sub


Sub circle_turtle(x1 As Double, y1 As Double, radius As Double, hxy As Double)
' circle wrapper
' call circle_hd(x1,y1,radius,heading)
' heading in degrees
Dim newheading As Double
Dim newheading_radian As Double
Dim Cx As Double, Cy As Double
Dim circleobj As AcadCircle
Dim pt2(0 To 2) As Double

If radius > 0 Then
newheading = hxy + 90
Else
newheading = hxy - 90
End If

newheading_radian = newheading * Pi / 180

'px and py are global position
'we are calculating circle center but not changing position
Cx = px + Abs(radius) * Cos(newheading_radian)
Cy = py + Abs(radius) * Sin(newheading_radian)
pt2(0) = Cx: pt2(1) = Cy: pt2(2) = 0

Set circleobj = acadDoc.ModelSpace.AddCircle(pt2, Abs(radius))

Update
End Sub

2017-01-16_1

more to come

Polyline SetBulge Arc factor

The Autocad VBA object AcadLWPolyline is made in straight line segments with AddLightWeightPolyline method using an array of coordinates. The LWPolyline object returned has a SetBulge method to change a straight line segment to an arc. Setbulge takes two parameters, the lower numbered index of the vertex that begins the segment, and a Bulge value. the Bulge value is explained thusly –

“The bulge is the tangent of 1/4 of the included angle for the arc between the selected vertex and the next vertex in the polyline’s vertex list. A negative bulge value indicates that the arc goes clockwise from the selected vertex to the next vertex. A bulge of 0 indicates a straight segment, and a bulge of 1 is a semicircle.”
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2017/ENU/AutoCAD-ActiveX/files/GUID-E1CE125E-AB3A-4645-B548-E43200064F9C-htm.html

The arc no matter what curvature it takes is always a part of a circle. Two lines drawn from the center to the vertexes define the included angle. This center moves along a line as the bulge factor changes. As the center gets closer to the arc, the angle gets larger. If the center moves far away the included angle gets small, the tangent of that angle is small, the arc is nearly a straight line, and the Bulge factor is small.

The gist of the code. Vertexes start numbering with zero.

Dim plineObj As AcadLWPolyline
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points_array)
plineObj.SetBulge 3, -0.5

what does an even number 0.5 Bulge factor give?
2017-01-11_1

what Bulge factor would give an included angle of 90 deg?

2017-01-11_2

since B = TAN(PI/8) this can be entered directly in code

Sub B2_test()
Call connect_acad
Dim pt As Variant

pt = Array(0, 0, Cos(Pi / 4), Sin(-Pi / 4), Cos(Pi / 4), Sin(Pi / 4))
Call draw_array(pt)
global_plineobj.SetBulge 1, Tan(Pi / 8)

End Sub

To create a rounded fillet the vertexes of the arc have to be encoded in the square edge polyline, then rounded.
The B value for 90 degrees is 90/4 or 1/4 * pi/2. Here is a program to create a filleted rectangle of any size with any radius at any location. (the draw_array sub is posted previously)

2017-01-13_1

Sub B2_test_rectangle()
Call connect_acad
Dim pt As Variant
 Dim x1 As Double, x2 As Double, x3 As Double, x4 As Double
 Dim y1 As Double, y2 As Double, y3 As Double, y4 As Double
 Dim A As Double, B As Double, R As Double, Dx As Double, Dy As Double
'A is width X
'B is height Y
'R is fillet radius
'Dx and Dy are coordinates for lower left corner

A = 4
B = 5
R = 1
Dx = 2
Dy = 2
 
 x1 = Dx
 x2 = Dx + R
 x3 = A + Dx - R
 x4 = A + Dx
 
 y1 = Dy
 y2 = Dy + R
 y3 = B + Dy - R
 y4 = B + Dy
 
pt = Array(x2, y1, x3, y1, x4, y2, x4, y3, x3, y4, x2, y4, x1, y3, x1, y2)
Call draw_array(pt)
global_pline.SetBulge 1, Tan(Pi / 8)
global_pline.SetBulge 3, Tan(Pi / 8)
global_pline.SetBulge 5, Tan(Pi / 8)
global_pline.SetBulge 7, Tan(Pi / 8)

End Sub

A slot sub would simply draw a rectangle and use a B factor for the ends to give a 180 degree arc. Here is a routine for both vertical and horizontal slots. This could be combined into one program with a switch or flag. We would also call them with the dimensions as parameters. The B factor is the TAN of one fourth of 180 or pi/4.

2017-01-13_2

Sub B2_horz_slot()
Call connect_acad
Dim pt As Variant
 Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
 Dim A As Double, B As Double, Cx As Double, Cy As Double
'A is length
'B is width
'Cx and Cy are center coordinates

A = 2
B = 0.5
Cx = 3
Cy = 3
 
 x1 = Cx - A / 2
 x2 = Cx + A / 2
 
 y1 = Cy - B / 2
 y2 = Cy + B / 2
 
pt = Array(x1, y1, x2, y1, x2, y2, x1, y2)
Call draw_array(pt)
global_pline.SetBulge 1, Tan(Pi / 4)
global_pline.SetBulge 3, Tan(Pi / 4)
Call draw_point(Cx, Cy, 0) 'this draws a point for reference
End Sub


Sub B2_vert_slot()
Call connect_acad
Dim pt As Variant
 Dim x1 As Double, x2 As Double, y1 As Double, y2 As Double
 Dim A As Double, B As Double, Cx As Double, Cy As Double
'A is length
'B is width
'Cx and Cy are center coordinates

A = 2
B = 0.5
Cx = 3
Cy = 3
 
 x1 = Cx - B / 2
 x2 = Cx + B / 2
 
 y1 = Cy - A / 2
 y2 = Cy + A / 2
 
pt = Array(x1, y1, x2, y1, x2, y2, x1, y2)
Call draw_array(pt)
global_pline.SetBulge 0, Tan(Pi / 4)
global_pline.SetBulge 2, Tan(Pi / 4)
Call draw_point(Cx, Cy, 0)
End Sub

autodesk (or somebody) made the B factor the tan of one fourth the included angle. As the included arc varies from zero to almost 360, one fourth of that angle varies from zero to almost 90, and the tangent of that angle (Bulge Factor B) varies from zero to infinity. Because of the imprecision of doubles, Tan(Pi/2) should give an error, the slope of a vertical line, divide by zero, but the imprecision causes an arc with a very large radius.

Autocad VBA Parameters -3-

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.

2016-12-31_1

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)

acadDoc.ActiveLayer = acadDoc.Layers.Item("Hidden")
Call line(D, E, A2, E)

'each drawing sub re-sets current layer to 0
acadDoc.ActiveLayer = acadDoc.Layers.Item("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)

acadDoc.ActiveLayer = acadDoc.Layers.Item("Hidden")
Call line(0, E, B1, E)

acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
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)

acadDoc.ActiveLayer = acadDoc.Layers.Item("UP")
Call line(D, D1, A2, D1)
Call line(D, C1, A2, C1)

acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
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)

acadDoc.ActiveLayer = acadDoc.Layers.Item("UP")
Call line(0, D1, B1, D1)
Call line(0, C1, B1, C1)

acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
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 objss As AcadSelectionSet
    Dim objBlock As AcadBlock
    Dim i As Integer
        
    Call addss("my_block")
    Set objss = acadDoc.SelectionSets.Item("my_block")
       objss.Select acSelectionSetCrossing, pt_ll, pt_ur
  
 ' make_blk(objss, strblkname, pt_insert)
    On Error Resume Next
    Set objBlock = acadDoc.Blocks.Item(strblkname)
    objBlock.Delete
    On Error GoTo 0
    
    Set objBlock = acadDoc.Blocks.Add(pt_insert, strblkname)
    
    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
    acadDoc.CopyObjects Obj, objBlock
   
    objss.Erase
    objss.Delete
    
    Set objpersistent = acadDoc.ModelSpace.InsertBlock(pt_insert, strblkname, 1, 1, 1, 0)
     
End Sub

Sub addss(strname As String)
    Dim objss As AcadSelectionSet
   On Error Resume Next
    If "" = strname Then
    Exit Sub
    End If
    
    Set objss = acadDoc.SelectionSets.Item(strname)
    objss.Delete
    Set objss = acadDoc.SelectionSets.Add(strname)
    If objss Is Nothing Then
    MsgBox "unable to add " & strname
    Else
    'MsgBox "added"
    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

Public objss As AcadSelectionSet
Public objent As AcadEntity
Public objpersistent As AcadEntity


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)
addss ("FlatPattern")
Set objss = acadDoc.SelectionSets.Item("FlatPattern")
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)
addss ("FlatPattern")
Set objss = acadDoc.SelectionSets.Item("FlatPattern")
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 –
2016-12-31_2

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)
 Call connect_acad
 Call newlayer("UP", 4, acLnWtByLwDefault, "Continuous")
 Call newlayer("Down", 6, acLnWtByLwDefault, "Hidden")
 Call newlayer("Hidden", 6, acLnWtByLwDefault, "Hidden")
 acadDoc.ActiveLayer = acadDoc.Layers.Item("0")
End Sub

Anything you can draw manually with specificity and clearly defined variables you can automate. It is only slightly more effort to automate dimensioning. Practice will refine your technique.