I have found that updating help sheets that nobody uses is a pain and a waste of time. Many of these are old and do not work with newer versions of AutoCAD. I am still writing and updating my lisps, and I'm better now than I was when most of these were done. My newer stuff is much better.
My personal AutoCAD setup looks nothing like this web page. Each problem and each profession requires its
own touch. Therefore, each lisp that is uploaded to the site is generic. I can modify them to your needs! These are
mostly in order of complexity, not usefulness. Be sure to request a lisp
before you leave the site. I may already have it what you need. I've literally written thousands.
Check here and here for more lisps.
These are listed in order of complexity. The most difficult lisps
I've written are field specific and would not likely be useful to the general
public.
Download all lisps:
better formatting, less bugs, more functions not included on this page, including:
xi - isolate an xref layer and make it into a new xref
trunclayers - shorten layer names and remove spaces
ptbindall - bind all xrefs, removing unused layers
byall - change all the colors in all blocks to bylayer
ln - select all lines of a selected length
nl - list all the nested layer names for an xref object
oo - open an xref you select
Or browse the html:
[Generic Script]
[Load Explorer window in Current Directory]
[Previous Objects to New Layer]
[Change X-ref color]
[Copy and paste text]
[Add text to the end of a string]
[Addpoints & Midpoint]
[Open next drawing]
[Resize a line]
[Close wall]
[Ddedit & Ddatte]
[Setlast & Setprevious]
[Move all of a selected attribute]
[Make into a 2d dwg]
[List all lisps within files in a directory]
[Undefined Shape xx fix]
[Batch Bind]
[Match blocks]
[Toggle between text]
Generic Script:
(DEFUN C:gs () ; A generic script in AutoLISP. -- for training purposes -- It does nothing! - By
Brian Forbes - http://www.autolisp.org/
(PRINC "You can make this say whatever you want!")(COMMAND
"move") (COMMAND) (COMMAND "select" "p" pause)
)
Load Explorer Window in Current Directory:
(DEFUN C:DIRR() ; By Brian Forbes - http://www.autolisp.org/
(STARTAPP "EXPLORER.EXE" (GETVAR
"DWGPREFIX")) (princ))
Previous Objects to New Layer:
(DEFUN C:p2n () ; Previous to New Layer - By Brian Forbes - http://www.autolisp.org/
(PROMPT "\nName of layer for entities to reside:
")(SETQ newlay (GETSTRING))
(COMMAND "LAYER" "N" newlay ""
"CHANGE" "p" "" "P" "LA" newlay
"" "CHANGE" "p" "" "P" "C"
"BYLAYER" ""))
Change Color:
(DEFUN C:cxc (/ osm ln) ; Change the color of a layer by selecting an object -
By Brian Forbes - http://www.autolisp.org/
(SETQ osm (getvar "osmode")) (SETVAR "osmode"
0)
(SETQ ln (cdr (assoc 8 (entget (car (nentselp (getpoint
"Select object: ")))))))
(PROMPT "Select Color: ")
(COMMAND "LAYER" "C" pause ln "")
(SETVAR "osmode" osm) (PRINC))
Text:
(DEFUN C:cf () ; Copy text [normally with snap modes enabled, this one is simplified]
- By Brian Forbes - http://www.autolisp.org/
(PRINC (SETQ CT (CDR (ASSOC 1 (setq ed (entget (car
(nentselp (getpoint "Select text to copy: ")))))))))
(while T (c:yt))
(PRINC))
(DEFUN C:YT () ; Paste text - By Brian Forbes - http://www.autolisp.org/
(setq ed (entget (car (nentselp (getpoint "\nSelect
text to replace: ")))))
(entmod (subst (cons 1 CT) (assoc 1 ed) ed ) )
(ENTUPD (CDR (CAR ED)))
)
Add Text to the End of a String
(defun c:ate() ;; Add text to the end of a string - By Brian Forbes - http://www.autolisp.org/
(command "undo" "_be")
; (setq ui (getstring)) ; Use this to prompt for string and comment out the following line
(setq ui " Your string here!")
(setq ed (entget (car (nentselp (cadr (entsel))))))
(entmod
(subst
(cons 1 (strcat (cdr (assoc 1 ed))
(if (= (setq str ui) "") " " str)
))
(assoc 1 ed)
ed
)
)
(ENTUPD (CDR (CAR ed)))
(command "undo" "_end")
(PRINC))
Add Points & Midpoint:
(defun addpoints (p1 p2 / p3) ; adds 2 points together - By Brian Forbes - http://www.autolisp.org/
(setq p3 (list (+ (car p1) (car p2)) (+ (cadr p1) (cadr
p2)) (+ (caddr p1) (caddr p2)) )))
(defun mp ( p1 p2 / p1x p1y p2x p2y ) ; Returns the point between two points
- By Brian Forbes - http://www.autolisp.org/
(SETQ P1X (CAR p1))(SETQ P1Y (CADR p1))
(SETQ P2X (CAR p2))(SETQ P2Y (CADR p2))
(LIST (/ (+ P1X P2X) 2) (/ (+ P1Y P2Y) 2)))
Open Next Drawing:
(DEFUN C:nd () ; next drawing - no save - by Brian Forbes - http://www.autolisp.org/
(SETVAR "clayer" (GETVAR "clayer"))
; This line makes the open command give a save prompt
(COMMAND "dir" (STRCAT (GETVAR"dwgprefix")
"*.dwg /b /on > c:\\temp.txt"))
(SETQ fn (open "c:\\temp.txt" "r"))
(SETQ eof "I'm not nil!!")
(SETQ dn (getvar "dwgname"))
(WHILE eof
(SETQ eof (READ-LINE fn))
(IF (= eof dn) (PROGN (SETQ
eof nil) (SETQ dwn (READ-LINE fn))))
)
(CLOSE fn) (COMMAND "del" "c:\\temp.txt")
(SETQ FN (STRCAT (GETVAR "DWGPREFIX") DWN))
;(COMMAND "qsave") ; delete the ; at the front
of the line to save the dwg by default
(COMMAND "open" "YES" fn)
(PRINC dwn)(PRINC)
)
Resize a line:
(defun c:res () ; Resize a line - by Brian Forbes - http://www.autolisp.org/
(command "undo" "be")(setq osm (getvar
"osmode"))(setvar "osmode" 0)
(setq op (getpoint "Select object to resize: "))
(while (not (setq obj (ssname (ssget op) 0)))
(setq op (getpoint "Select
object to resize: "))
)
(setq P1 (cdr (assoc 10 (entget obj))))
(setq P2 (cdr (assoc 11 (entget obj))))
(setq newdist (getstring "New size in inches: "))
(if (< (distance p1 op) (distance p2 op))
(progn
(command
"line" p1 "" "line" (strcat "@" newdist
"<" (angtos (angle p1 p2) 0 4)) "")
(entmod
(subst (cons 11 (getvar "lastpoint")) (assoc 11 (entget obj)) (entget
obj))))
(progn
(command
"line" p2 "" "line" (strcat "@" newdist
"<" (angtos (angle p2 p1))) "")
(entmod
(subst (cons 10 (getvar "lastpoint")) (assoc 10 (entget obj)) (entget
obj))))
)
(command "undo" "e") (setvar "osmode"
osm)
(princ))
Connect Two Lines With a Line:
(DEFUN C:CW (/ POINT1 POINT2 POINT3 POINT4 P1 P2 SS LAY) ; - By Brian Forbes -
http://www.autolisp.org/
(SETQ LAY (GETVAR "CLAYER"))
(C:SETP) (SETQ SS (SSGET "P"))
(SETQ POINT1 (CDR (ASSOC 10 (ENTGET (SSNAME SS 0))))
POINT2 (CDR (ASSOC 11 (ENTGET (SSNAME SS 0)))))
(SETQ POINT3 (CDR (ASSOC 10 (ENTGET (SSNAME SS 1))))
POINT4 (CDR (ASSOC 11 (ENTGET (SSNAME SS 1)))))
(IF (< (DISTANCE POINT1 (GETVAR "LASTPOINT"))
(DISTANCE POINT2 (GETVAR "LASTPOINT")))
(SETQ P1 POINT1) (SETQ P1 POINT2))
(IF (< (DISTANCE POINT3 (GETVAR "LASTPOINT"))
(DISTANCE POINT4 (GETVAR "LASTPOINT")))
(SETQ P2 POINT3) (SETQ P2 POINT4)
)
(SETVAR "CLAYER" (cdr (assoc 8 (entget (SSNAME
SS 0)))))
(COMMAND "LINE" P1 P2 "")
(SETVAR "CLAYER" LAY)
)
Ddedit and Ddatte in One Shot:
(DEFUN C:ED() ;; Ddedit and Ddatte in one - By Brian Forbes - http://www.autolisp.org/
(C:SETL)
(IF (OR
(= "TEXT" (CDR (ASSOC
0 (ENTGET (SSNAME (SSGET "L") 0)))))
(= "DIMENSION" (CDR
(ASSOC 0 (ENTGET (SSNAME (SSGET "L") 0)))))
(= "MTEXT" (CDR (ASSOC
0 (ENTGET (SSNAME (SSGET "L") 0)))))
(= "ATTDEF" (CDR (ASSOC
0 (ENTGET (SSNAME (SSGET "L") 0)))))
)
(COMMAND "DDEDIT" "L" "")
(COMMAND "DDATTE" "L"))
(princ))
Set Last and Previous: (for the 2 previous functions)
(DEFUN C:SETL() ; By Brian Forbes - http://www.autolisp.org/
(COMMAND "._SELECT" "_SI" "_AU"
PAUSE "COPY" "P" "" "_non" "@0,0"
"_non" "@0,0" "ERASE" "P" "")
(princ))
(DEFUN C:SETP() ; By Brian Forbes - http://www.autolisp.org/
(COMMAND "._SELECT" "_SI" "_AU"
PAUSE) (princ))
Move objects with selected attribute:
(DEFUN C:mj ( / num obj obj2) ; Move Attribute - By Brian Forbes - http://www.autolisp.org/
(SETQ num (GETINT "Number of attribute: "))
(SETQ obj (CDR (ASSOC num (ENTGET (CAR (ENTSEL "\nSelect
sample object to move: "))))))
(SETQ obj2 (SSGET "X" (LIST (CONS num obj))))
(COMMAND "MOVE" obj2 "")
(princ))
The Following is for use with mj [ssget] - print out and attach to monitor!
-4 - Conditional operator
-3 - Extended data sentinel
-2 - Name
0 - Type
1 - Text
2 - Name, block name, attrib tag
3-4 - Misc.
6 - Ltype
7 - Text Style or attrib def.
8 - Layer
10 - Primary pt.
11-18 - Other pts.
39 - Thickness
40-48 - Block scale, text height, etc.
50-58 - Angles
62 - Color
66 - "Entities follow"
67 - Drawing space (0 ps, 1 ms)
70-78 - Integers for counters
210 - 3d
999 - Comments
Puts all selected objects z point on 0:
; Z0
; By Brian Forbes - http://www.autolisp.org/
; Home of the custom built lisp!
;
; Permissions:
; Permission is hereby granted to copy and modify this lisp. It
is provided "as is" by the author.
; The authorship and url must remain with the copied function.
; Version:
; 1.0 - Sept 20, 2002
; 1.1 - Sept 20, 2002 - Fixed the need to repeat the command
; 1.2 - Oct. 8, 2002 - Added pline functionality, added header text
; Explanation:
; This function takes all selected objects and makes them two dimensional
by putting all the objects'
; z coordinate on 0.
; Known bugs:
; none
; Function call:
; z0 on the command line
;
(defun c:z0 () ; puts all selected objects z point on 0 - By Brian Forbes -
http://www.autolisp.org/
(princ "Select objects: ") (setq ss (ssget) count (1-
(sslength ss)) asno 9)
(command "undo" "mark")
(while (>= count 0)
(setq curent (entget (ssname ss count)))
(while (and
(setq
asno (1+ asno))
(<
asno 19)
(if
(not (assoc asno curent)) (progn ; begin if polyline
(setq
asno 38)
(if
(assoc asno curent) (progn
(entupd
(cdr (assoc -1 (entmod
(subst
(cons
asno 0.0)
(assoc
asno curent)
curent
)
))))
nil
)
nil
)
)
T
) ;
if polyline
)
(if (/= 0 (cadddr (assoc asno curent)))
(entupd (cdr (assoc -1 (setq
curent (entmod
(subst
(cons
asno (list (cadr (assoc asno curent)) (caddr (assoc asno curent)) 0))
(assoc
asno curent)
curent
)
))))) ; entupd
) ; if
) ; while and
(setq count (1- count) asno 9)
) ; while count
(princ)
)
List All Lisps in a Directory:
(defun c:listlisp ( / sample count found dir files curfile input output curline continue eol n n2 eofcountdown)
; --------------------------------------------------------
; listlisp v2 - by Brian Forbes - http://www.autolisp.org/
; --------------------------------------------------------
(setq sample (getfiled "Select sample file: " "I:\\Standard\\lisp\\brian\\2002\\" "lsp" 8))
(setq count (strlen sample))
(while (and (> (setq count (1- count)) 0) (not found))
(if (= (substr sample count 1) "\\") (setq found count))
) ; while
(setq dir (substr sample 1 found))
(setq files (vl-directory-files dir))
(setq count (length files))
(while (>= (setq count (1- count)) 0)
(setq curfile (nth count files))
(if (< (strlen curfile) 4)
(setq files (vl-remove curfile files))
(if (not (= "LSP" (strcase (substr curfile (- (strlen curfile) 2) 3))))
(setq files (vl-remove curfile files))
) ; if
) ; if
) ; while count
(setq count (length files))
(setq output (open "c:\\lispout.txt" "w"))
(while (>= (setq count (1- count)) 0)
(setq input (open (findfile (strcat dir (nth count files))) "r"))
(write-line (princ (nth count files)) output) (princ " - ")
(setq curline (read-line input) continue T eol "1234567" n 1 n2 1)
(while continue
(if (not curline)
(setq continue nil)
(progn
(while (and (= (strlen eol) 7) (/= (setq eol (strcase (substr curline n 7))) "(DEFUN "))
(setq n (+ 1 n) )
) ; while not defun
(if (= eol "(DEFUN ") (progn
(setq n (+ n 7) n2 n)
(while (and (/= (substr curline n2 1) " ") (/= (substr curline n2 1) "(") (/= (substr curline n2 1) ""))
(setq n2 (+ n2 1))
)
(write-line (substr curline n (- n2 n)) output)
)) ; if & progn defun
(setq curline (read-line input) continue T eol "1234567" n 1 n2 1)
) ; progn curline
) ; if curline
) ; while continue
(setq eofcountdown 30)
(while (> eofcountdown 0)
(setq curline (read-line input))
(if curline (setq continue T eofcountdown -1 eol "1234567" n 1 n2 1) (setq eofcountdown (- eofcountdown 1)))
) ; while
(close input)
) ; while count
(close output)
(princ "Done!")
(startapp "write" "c:\\lispout.txt")
(princ)
) ; listlisp v2