| AutoLisp Example Programs
Most From Users
Request
CopyC.lsp - Wendy Diffendall,
the Senior CAD Drafter at Facilities Planners + Architects in Harrisburg, PA. wanted a
program to do multiple Copies with preset defaults.
GetArea.lsp - Jamey
Westmoreland, a Civil Engineer E.I.T. for Toothman-Orton Engineering Co. in Boise ID
wanted a program to label the accumulated area of selected polyline entities.
GetAcre.lsp - Bruce Stanton
wanted a program to label each polyline entity with the area in square feet and acreage.
DLD.lsp - An anonymous
visitor wanted a program to draw a vertical line next to multiple lines of text during a
Dim Leader command. Sounds easy right? Yeesh!
LTR.lsp - Jamey
Westmoreland, a Civil Engineer E.I.T. for Toothman-Orton Engineering Co. in Boise ID
wanted a program to select a Line entity, a Text entity, then rotate the text entity based
on the angle of the line.
TXTCNT.lsp - An anonymous
visitor wanted a program to count how many times each text entity appeared in a drawing
and display the results sorted in a dialog box.
TEXTIN.lsp - A program to
read from a text file and write to an AutoCAD drawing.
TEXTOUT.lsp - A program to
read from an AutoCAD drawing and write to a text file.
Support this Site!
CopyC.lsp
Wendy Diffendall, the Senior CAD Drafter at
Facilities Planners + Architects in Harrisburg, PA. wanted a program to make the Copy
command continuous. Ask for a distance, ask for an angle, set them as
defaults, then Copy Continuously.
[ The Copy, Array and Offset commands were not cutting
it!]
;CopyC.lsp - Copy Continuous
(defun C:CC()
;turn off the system echo
(setvar "cmdecho" 0)
;set the exit note to be successful
(setq ernote "\n ...CC.lsp Complete!")
;get a selection set
(if(setq eset(ssget))
(progn
;set the base point [bpt] to be the center
of the screen
;and set some variables to nothing
(setq bpt (getvar "viewctr") dis nil ang nil ans
"" acuDis nil)
;if the get distance function returns
something invalid... keep trying
(while(not(setq dis(getdist (getvar "viewctr") "\n
Distance: "))))
;if the get angle function returns
something invalid... keep trying
(while(not(setq ang(getangle (getvar "viewctr")
"\n Angle: "))))
;set the accumulated distance variable to
equal the distance variable
(setq acuDis dis)
;while the user does not want to exit
(while(/= ans "X")
;print the current angle and
distance to the command line
(princ (strcat "\n Angle = " (angtos ang) "
Distance = " (rtos dis)))
;find out what the user wants to
do....return all answers in uppercase
(setq ans
(strcase
(getstring
"\n eXit/Angle/Distance/Enter to Copy: X/A/D <enter>: ")
)
)
;if the user presses enter then
(if(= ans "")
(progn
;copy the entities from the [bpt] to the accumlated distance away
(command "copy"
eset "" bpt (polar bpt ang acuDis))
;set
the accumulated distance to be farther from base point
;in other words...if dis =
24" then the 1st copy should be 24" from
;the original....the second
copy should be 48" from the original
;the [acuDis] variable holds
this distance. It gets [dis] added to
;it each loop.
(setq acuDis(+ acuDis dis))
)
)
;if the user presses X to exit
or types the word EXIT then set the
;[ans] variable to equal
"X". The program will exit.
(if(= ans "EXIT")(setq ans "X"))
;if the user wants to change
the angle. [ang]
(if(or(= ans "ANGLE")(= ans "A"))
(while(not(setq ang(getangle (getvar
"viewctr") "\n Angle: "))))
)
;if the user wants to change
the distance [dis]
;don't forget to reset the accumulated distance
[acuDis]
(if(or(= ans "DISTANCE")(= ans
"D"))
(progn
(while(not(setq dis(getdist
(getvar "viewctr") "\n Distance: "))))
(setq acuDis dis)
)
)
)
)
;set the exit message to be unsuccessful if nothing was
selected
(setq ernote "\n Error - Nothing Selected. ")
)
;reset the system echo
(setvar "cmdecho" 1)
;print the exit message to the command line
(princ ernote)
;suppress the final echo
(princ)
)
;end of program
Download this file: Click Here!
GetArea.lsp
Jamey Westmoreland, a Civil Engineer E.I.T. for Toothman-Orton
Engineering Co. in Boise ID wanted a program to label the accumulated area of selected
polyline entities.
;GetArea.lsp - Total the areas of selected
polyline entities.
;Warning....This will also return an area for an entity that is not enclosed.
(defun C:GetArea()
;turn off the system echo
(setvar "cmdecho" 0)
;set up a variable to hold the accumulated areas
(setq myArea 0)
;while the user keeps making a selection
(while(setq ent(entsel))
;if an entity was selected and not a point in
space
(if(car ent)
(progn
;let AutoCAD get the area
of the object...cheap yet effective way out.
;Note: AutoCAD stores the area in the system
variable "Area"
(command "area" "Object"
(car ent))
;print the area to the
command line
(princ
(strcat
"\n Total Area for this Object = " (rtos (getvar "Area")))
)
;accumulate the area if
it exist
(if (getvar "Area")(setq myArea(+
myArea (getvar "Area"))))
)
)
)
;ask for a text insertion point
(setq pt1(getpoint "\n Insertion Point: "))
;print the area in the drawing
(command "text" pt1 "" "" (strcat "Total Area:
" (rtos myArea)))
;print the exit message to the command line
(princ "\n ...GetArea.lsp Complete. \n ")
;suppress the last echo
(princ)
)
;end of program
Download this file: Click
Here!
GetAcre.lsp
Bruce Stanton wanted a program similar to the one
above. Except, he wanted to label each polyline entity with the area in square feet
and acreage.
;GetAcre.lsp - Get the area of a selected
polyline entity.
;Warning....This will also return an area for an entity that is not enclosed.
(defun C:GA()
;turn the system echo off
(setvar "cmdecho" 0)
;set up the exit message
(setq ernote "\n ...GA.lsp Complete. ")
;set up a variable to hold the area
(setq myArea 0)
;select one object
(setq ent(entsel))
;if an object was selected and not some point in space
(if (car ent)
(progn
;get AutoCAD to find the area of the polyline,
cheap yet effective way out
;Note: AutoCAD stores the information in the system variable
"Area"
(command "area" "Object" (car ent))
;get the area from the system variable
"Area" and convert from
;square inches to square feet
(setq myarea (/(getvar "Area")144.0))
;print the sq feet to the command line
(princ "\n Total Square Feet : ")(princ (rtos myArea))
;print the acreage to the command line after
converting
(princ "\n Total Acreage : ")(princ (rtos (/ myArea
43560.0)))
;ask the user for an insertion point for the
text
;if the user presses enter then by pass the insertion procedure
(if(setq pt1(getpoint "\n Insertion Point: "))
(progn
;print the sq feet on the
drawing
(command "text" pt1 ""
""
(strcat "Total Square Feet : " (rtos myArea))
)
;move the text starting
point and print the acreage on the drawing
(command "text"
(polar pt1 (* pi 1.5) (* 1.5
(getvar "textsize")))
"" ""
(strcat "Total Acreage : " (rtos (/ myArea 43560.0)))
)
) ;close
the if progn for point selection
) ;close
the if
)
;close the if progn for object selection
;if nothing was selected then change the exit
note to be unsuccessful
(setq ernote "\n Error - Nothing Selected.")
) ;close the if
statement
;print the exit note to the command line
(princ ernote)
;reset the system echo variable
(setvar "cmdecho" 1)
;suppress the last echo
(princ)
)
; End of program
Download this file: Click
Here!
DLD.lsp
Visitor wanted a program that would draw a vertical line
next to multiple lines of text during a Dim Leader command. Sounds simple right?
Yeesh!
;DLD.lsp -
Draw a vertical line next to multiple lines of
; text during a dim leader command.
(defun C:DLD()
;turn system echo off
(setvar "cmdecho" 0)
;get the start point of the leader line
(setq pt1(getpoint "\n Start Point: "))
;setup some variables to be used later
;[tp1] is a temporary point
;[cntr] is a counter
;[tht] holds the current text size
(setq tpt pt1 cntr 0 tht (getvar "textsize"))
;unremark the next line and replace YOUR_LAYER_NAME with your layer
name,
;this would be the layer name for your leader lines and arrow head.
;If you are using a version of autocad above 14 you might have to replace
;"layer" with "-layer" or perhaps "_layer". You could write
a function
;to check the version of autocad and decide which to use at that point.
;(command "layer" "set" "YOUR_LAYER_NAME" "")
;loop until the user quits selecting points
(while (/= nil(setq tpt(getpoint tpt "\n Next Point: ")))
;if it is the first point the user has selected
(if(= cntr 0)
;start the leader command to get an arrow
head and the first line
;then use the (command) function to exit the leader command
(command "dim1" "lea" pt1 tpt (command))
;else just draw lines
(command "line" oldpt tpt "")
)
;increment the counter
(setq cntr(+ cntr 1))
;get the angle of the last line drawn
(setq angl(angle oldpt tpt))
;save the last point drawn
(setq oldpt tpt)
)
;find the location for the text using the
;text size times 0.25
(setq txpt(polar oldpt angl (* tht 0.25)))
;loop while the user types in something besides <enter>
;the T allows spaces in the text string
(while(/= "" (setq str(getstring T "\n Text: ")))
;unremark the next line and replace YOUR_LAYER_NAME
with your layer name.
;this would be the layer name for your text. If you are using a version
;of autocad above 14 you might have to replace "layer" with
"-layer" or
;perhaps "_layer". You could write a function to check the version
of
;autocad and decide which to use at that point.
;(command "layer" "set" "YOUR_LAYER_NAME"
"")
;check the last line angle to decide whether the text
;should be Left or Right Justified.
(if(or(< angl (/ pi 0.5))(> angl (* pi 1.5)))
;left justified
(command "text" "j" "ML" txpt
"" 0 str)
;right justified
(command "text" "j" "MR" txpt
"" 0 str)
)
;unremark the next line and replace YOUR_LAYER_NAME
with your layer name.
;this would be the layer name for the vertical line next to the text.
;If you are using a version of autocad above 14 you might have to replace
;"layer" with "-layer" or perhaps "_layer". You
could write a function
;to check the version of autocad and decide which to use at that point.
;(command "layer" "set" "YOUR_LAYER_NAME"
"")
;draw the vertical line
(command "line"
(polar oldpt (* pi 0.5) (/ tht 2.0))
(polar oldpt (* pi 1.5) (+ (/ tht 2.0)(* tht 0.25)))
""
)
;reset the text starting location down a line
(setq txpt (polar txpt (* pi 1.5) (+ tht(* tht 0.25))))
;reset the location of the next vertical line
(setq oldpt(polar oldpt (* pi 1.5) (+ tht(* tht 0.25))))
)
;reset the system echo
(setvar "cmdecho" 1)
;suppress the last echo
(princ)
)
;End of Program
Download this file: Click
Here!
LTR.lsp
Jamey Westmoreland, a Civil Engineer E.I.T. for
Toothman-Orton Engineering Co. in Boise ID wanted a program to select a Line entity, a
Text entity, then rotate the text entity based on the angle of the line.
;LTR.lsp - select a Line entity and a Text entity then rotate the
text entity based on line angle.
(defun C:LTR()
;turn off the system echo
(setvar "cmdecho" 0)
;display a message on the command line
(princ "\n Select LINE with Correct Angle.")
;let the user select one entity
(if (setq eset(entsel))
(progn
;get the entity name from the entsel
command
(setq en(car eset))
;get the DXF group codes of the selected
entity
(setq enlist(entget en))
;check to see if a LINE was selected
(if(= "LINE" (cdr(assoc 0 enlist)))
(progn
;display a message on the
command line
(princ "\n Select TEXT to Match Line
Angle.")
;let the user select one
entity
(if(setq eset2(entsel))
(progn
;get the starting point of the line
(setq ept1(cdr(assoc 10
enlist)))
;get the end point of the line
(setq ept2(cdr(assoc 11
enlist)))
;get the angle from the end points of the line
(setq ang1(angle ept1
ept2))
;get the entity name from the entsel function
(setq en2(car eset2))
;get the DXF Group Codes of the entity
(setq enlist2(entget
en2))
;change the angle in the text entities DXF group codes
(setq enlist2(subst
(cons 50 ang1)(assoc 50 enlist2)enlist2))
;update the text entity
(entmod enlist2)
)
;if the second
entity wasn't selected...
(princ "\n Select Text Entity
Please. Program Aborted.")
)
)
;if the first entity wasn't a line
(princ "\n Enitity selected was not a LINE. Program
Aborted.")
)
)
;if the first entity wasn't selected
(princ "\n Nothing selected. Program Aborted.")
)
;reset the system echo
(setvar "cmdecho" 1)
;suppress the last echo
(princ)
)
;End of Program
Download this file: Click
Here!
TXTCNT.lsp
Visitor wanted a program to count how many times each text
entity appeared in a drawing and display the results sorted in a dialog box.
;TXTCNT.lsp - Count how many times each text entity appears.
; Display the results sorted in a dialog box.
(defun C:TXTCNT()
;define a sort routine - Usage: (srt list) - Let's not go into this
yet! It works.
(defun srt(alist / n)(setq lcup nil rcup nil)
(defun cts(a b)(cond((> a b)t)((= a b )t)(t nil)))
(foreach n alist
(while (and rcup(cts n(car rcup)))(setq lcup(cons(car
rcup)lcup)rcup(cdr rcup)))
(while (and lcup(cts(car lcup)n))(setq rcup(cons(car
lcup)rcup)lcup(cdr lcup)))
(setq rcup(cons n rcup))
)
(append(reverse lcup)rcup)
)
;turn the command echo off
(setvar "cmdecho" 0)
;setup a variable to hold the data
(setq datalist(list))
;select objects
(if (setq eset(ssget))
(progn
;set
a counter to the first item in the selection set
(setq cntr 0)
;loop through each selected entity
(while (< cntr (sslength eset))
;grab the entity's name
(setq en(ssname eset cntr))
;grab the DXF group codes of the entity
(setq enlist(entget en))
;ignore the entity if it is not a TEXT entity
(if(= "TEXT" (cdr(assoc 0 enlist)))
(progn
;get the text value from the DXF Group Code
(setq str(cdr(assoc 1 enlist)))
;setup a variable to check if the entity exist in the datalist list
(setq existing 0)
;loop through the datalist to find out if it is a new entity that needs
;to be added to the list or if it already exist
and it's counter needs
;to be incremented
(foreach a datalist
(if (= (car a) str)(setq existing
1))
)
;if the entity is new then
(if (= existing 0)
;do this - Add the item to the datalist along with a counter that starts at 1
(setq datalist(append datalist
(list (cons str 1))))
;else it's cntr needs to be incremented
(setq datalist
(subst
(cons str (+ 1
(cdr(assoc str datalist))))
(assoc str
datalist)
datalist
)
)
)
)
)
;increment the entity counter
(setq cntr(+ cntr 1))
)
)
)
;setup a variable to
hold the data again, this time in a different fashion
(setq newList(list))
;rearrange the list
(foreach a datalist
(setq newList
(append newList
(list
(strcat
(substr
(strcat (car a) "
. . . . . . . . . . . . . . . . . . . . . . . . . . ")
1 50
)
" - " (itoa(cdr a))
)
)
)
)
)
;sort the list
(setq newList(srt newList))
;put up the dialog box
(setq dcl_id (load_dialog "TXTCNT.dcl"))
;see if it is already loaded
(if (not (new_dialog "TXTCNT" dcl_id) ) (exit))
;add the data to the list in the dialog box
(start_list "datalist")
(mapcar ' add_list newList)
(end_list)
;if an action event occurs, do this function
(action_tile "cancel" "(setq ddiag 1)(done_dialog)")
;display the dialog box
(start_dialog)
;if the cancel button was pressed - display message
(if (= ddiag 1)
(princ "\n \n ...TXTCNT Cancelled. \n ")
)
;unload the dialog box
(unload_dialog dcl_id)
;turn the command echo back on
(setvar "cmdecho" 1)
;supress the last echo
(princ)
)
;End of AutoLisp Program
DCL File:
TXTCNT : dialog {
label = "TXTCNT - Text Counter By: /";
: row {
: list_box {
key = "datalist";
multiple_select = "FALSE";
width = 60;
}
}
: boxed_row {
: button {
key = "cancel";
label = " Cancel ";
is_default = false;
is_cancel = true;
}
}
}
End of DCL File
Download this AutoLisp file: Click Here!
Download this DCL file: Click Here!
TextIn.lsp
Read
Text From a File, Write Text in the AutoCAD Drawing
;TEXTIN.LSP By: Jeffery P. Sanders
;This program takes any text file and prints it in AutoCAD.
;define program - listing your variable names
here
; resets them to nil after the program finishes
(defun C:TEXTIN(/ lts ernote inspt filen fil
lineone)
;turn echo off
(setvar
"cmdecho" 0)
;get ltscale (Note: ltscale
should always equal dimscale)
(setq lts(getvar "ltscale"))
;set the exit note to display
successful
(setq ernote "\n....TextIn Complete.")
;get the text insertion point
(setq inspt(getpoint "\nInsertion Point: "))
;use dialog box to get file name / the
4 allows
;the user to type in a new file extension
;the "txt" sets the default to be "*.txt"
(setq filen
(getfiled "Select Text File" "" "txt" 4)
)
;if file exist, open file to read
(if (setq fil(open filen "r"))
;progn necessary for
multiple statements inside if statement
(progn
;while the line from
text file does not equal nil
(while (setq lineone(read-line fil))
;print
the text in AutoCAD drawing
(command "text" inspt(* lts(getvar
"textsize"))0.0 lineone)
;move
down one line each loop by resetting the insertion point
(setq inspt
;start the polar function i.e. [polar pt angle distance]
(polar
;from the insertion point
inspt
;set the angle to go down i.e. (270 deg OR pi + pi/2
radians)
(* pi 1.5)
;distance down to the next line is (textsize x 1.5) x
ltscale
(* lts (* 1.5(getvar
"textsize")))
)
; close the polar function
) ; close the setq
) ; close the while loop
;close the text file
(close fil)
) ; close the if progn statement
;else set the exiting remark as
an error
(setq ernote (strcat "\nCannot Find File: " filen))
) ; close the if statement
;turn echo on
(setvar "cmdecho" 1)
;print the exiting remark
(princ ernote)
(princ "\n ") ;
clear command line
(princ) ; no echo
)
; close the program
TextOut.lsp
Read Text From an AutoCAD Drawing, Write the Text To a File
;TEXTOUT.LSP By: Jeffery P. Sanders
;This program gets text from an AutoCAD drawing and writes it to a text file.
;define program - listing your variable
names here
; resets them to nil after the program finishes
(defun C:TEXTOUT(/ lts ernote filen fil eset en enlist cntr)
;turn echo off
(setvar "cmdecho" 0)
;get ltscale (Note: ltscale should always equal
dimscale)
(setq lts(getvar "ltscale"))
;set the exit note to successful
(setq ernote "\n....TextOut Complete.")
;use dialog box to set file name / the 1 allows
;the user to type in a new file name
;the "txt" sets the default to be "*.txt"
(setq filen
(getfiled "Type or Select Text File Name" ""
"txt" 1)
)
;open file to write
(if (setq fil(open filen "w"))
;progn necessary for multiple statements
inside an if statement
(progn
;if ssget returns a valid
selection set
(if (setq eset(ssget))
;progn necessary
for multiple statements inside an if statement
(progn
;set
the entity counter to zero [the first entity in a set is zero]
(setq cntr 0)
;step
through each entity in the selection set
(while (< cntr (sslength eset))
;get the entity name indexed by cntr
(setq en(ssname eset
cntr))
;get the DXF group codes for the entity
(setq enlist(entget
en))
;check the group code 0 to see if entity type = TEXT
(if(= "TEXT"
(cdr(assoc 0 enlist)))
;progn necessary for multiple statements inside an if statement
(progn
;get the text string from the entity's DXF Group Code 1
(setq str(cdr(assoc 1 enlist)))
;print the string to the command line
(princ (strcat "\nOutput To File: " str))
;print the string to the file
(princ (strcat "\n" str) fil)
) ;close the if progn
) ;close the if statement
;increment the counter to get the next entity
(setq cntr(+ cntr 1))
) ;close the while loop
;close the text file
(close fil)
) ;close
the if progn
;set the exit note as an error
(setq ernote "\nError - No Entities
Selected.")
) ; close the
if statement
) ;close the if progn
;set the exit note to be an
error
(setq ernote (strcat "\nError - Could not create File: "
filen))
) ;close the if statement
;turn the command echo back on
(setvar "cmdecho" 1)
;print the exit note to the command
line
(princ ernote)
;clear the command line
(princ "\n ")
;supress last echo
(princ)
) ;close the program
New!
Having trouble with one of the programs not working for your version of AutoCAD?
Click this-----> Please fix this!
Support this Site!
AutoLisp Home
Home
All questions/complaints/suggestions should be sent to /
Last Updated April 1st, 2013
Copyright 2002-2013 /. All rights reserved. |
