VLIDE at the command line and press Enter.File → New), save as yourscript.lsp.Tools → Load Text in Editor, or drag the .lsp file into the AutoCAD window.PA) at the command line.(load "yourscript.lsp") to your acaddoc.lsp to auto-load on every drawing open.Runs PURGE repeatedly until nothing is left to purge — removes unused blocks, layers, linetypes, styles, and more in one shot.
Usage: Type PA → Enter. Done. Works silently.
(defun c:PA ( / )
;; Purge all unused named objects, repeat until nothing remains
(while
(/= (vla-get-count
(vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(progn
(command "._PURGE" "_ALL" "*" "_No")
(vla-get-count
(vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))))
)
(princ "\nPurge complete.") (princ)
)
Select objects, then pick a destination object — selected objects move to the picked object's layer. No typing layer names.
Usage: Type MOL → select objects → pick the target-layer object.
(defun c:MOL ( / ss ent lay obj)
(setq ss (ssget))
(if ss
(progn
(setq ent (car (entsel "\nPick object on target layer: ")))
(setq lay (cdr (assoc 8 (entget ent))))
(setq obj nil)
(repeat (sslength ss)
(setq obj (ssname ss (if obj (1+ (ssnumber ss obj)) 0)))
(entmod (subst (cons 8 lay) (assoc 8 (entget obj)) (entget obj)))
)
(princ (strcat "\nMoved to layer: " lay))
)
)
(princ)
)
Freezes every layer except the current drawing layer. Great for isolating your active layer quickly without using the Layer Manager.
Usage: Type FAC → Enter. All non-current layers freeze instantly.
(defun c:FAC ( / cur lays lay)
(setq cur (getvar "CLAYER"))
(setq lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for lay lays
(if (and (/= (vla-get-name lay) cur)
(/= (vla-get-name lay) "0"))
(vla-put-freeze lay :vlax-true)
)
)
(princ (strcat "\nFroze all layers except: " cur)) (princ)
)
Thaws every frozen layer in the drawing. Pairs with FAC when you're done isolating your work and need everything visible again.
Usage: Type TAL → Enter.
(defun c:TAL ( / lays lay)
(setq lays (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for lay lays
(vla-put-freeze lay :vlax-false)
)
(command "._REGEN")
(princ "\nAll layers thawed.") (princ)
)
Prompts for a new height, then changes every selected MTEXT or TEXT object to that height. Useful when text imports at the wrong scale.
Usage: Type STH → select text → enter height value.
(defun c:STH ( / ss h i ent ed)
(setq h (getreal "\nNew text height: "))
(if (and h (> h 0))
(progn
(setq ss (ssget '((0 . "TEXT,MTEXT"))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ed (entget ent))
(entmod (subst (cons 40 h) (assoc 40 ed) ed))
(setq i (1+ i))
)
(princ (strcat "\nUpdated " (itoa (sslength ss)) " text objects."))
)
)
)
)
(princ)
)
Searches all TEXT and MTEXT in the drawing for a string and replaces it — no dialog, runs silently at the command line.
Usage: Type FRT → enter search string → enter replacement string.
(defun c:FRT ( / find rep ss i ent ed str old)
(setq find (getstring T "\nFind string: "))
(setq rep (getstring T "\nReplace with: "))
(setq ss (ssget "_X" '((0 . "TEXT,MTEXT"))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq ed (entget ent))
(setq old (cdr (assoc 1 ed)))
(if (wcmatch (strcase old) (strcase (strcat "*" find "*")))
(progn
(setq str (vl-string-subst rep find old))
(entmod (subst (cons 1 str) (assoc 1 ed) ed))
)
)
(setq i (1+ i))
)
(princ "\nFind & replace complete.")
)
)
(princ)
)
Splits an object at a single picked point — equivalent to BREAK with the same point entered twice. Much faster than the standard BREAK command.
Usage: Type BP → pick object → pick break point.
(defun c:BP ( / pt ent)
(setq ent (car (entsel "\nSelect object to break: ")))
(setq pt (getpoint "\nBreak point: "))
(if (and ent pt)
(command "._BREAK" ent "_F" pt pt)
)
(princ)
)
Copies selected objects in place and immediately moves the copies to the layer of a picked reference object. Original objects stay on their layer.
Usage: Type CTL → select objects → pick object on target layer.
(defun c:CTL ( / ss ref lay i ent ed new)
(setq ss (ssget "\nSelect objects to copy: "))
(setq ref (car (entsel "\nPick object on target layer: ")))
(if (and ss ref)
(progn
(setq lay (cdr (assoc 8 (entget ref))))
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(command "._COPY" ent "" "0,0,0" "0,0,0")
(setq new (entlast))
(setq ed (entget new))
(entmod (subst (cons 8 lay) (assoc 8 ed) ed))
(setq i (1+ i))
)
(princ (strcat "\nCopied " (itoa (sslength ss)) " object(s) to layer: " lay))
)
)
(princ)
)
Finds every HATCH object in the drawing and sends them all to the back of the draw order. Fixes hatches covering linework and text.
Usage: Type SHB → Enter. Runs on the entire drawing automatically.
(defun c:SHB ( / ss i ent)
(setq ss (ssget "_X" '((0 . "HATCH"))))
(if ss
(progn
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(vl-cmdf "._DRAWORDER" ent "" "_Back")
(setq i (1+ i))
)
(princ (strcat "\nSent " (itoa (sslength ss)) " hatch(es) to back."))
)
(princ "\nNo hatches found.")
)
(princ)
)
Selects all LINEs and ARCs in the drawing and runs JOIN with a 0 fuzz tolerance — converts chains of connected segments into polylines automatically.
Usage: Type JAP → Enter. Works on entire drawing.
(defun c:JAP ( / ss)
(setq ss (ssget "_X" '((0 . "LINE,ARC"))))
(if ss
(progn
(command "._PEDIT" "_M" ss "" "_Y" "_J" "" "")
(princ "\nJoin complete.")
)
(princ "\nNo lines or arcs found.")
)
(princ)
)
Sums the total length of all selected lines, arcs, and polylines. Reports in drawing units. Handy for conduit runs, cable lengths, and fence lines.
Usage: Type TL → select objects → total reported in command line.
(defun c:TL ( / ss i ent ed total len obj)
(setq ss (ssget '((0 . "LINE,ARC,LWPOLYLINE,POLYLINE,SPLINE"))))
(if ss
(progn
(setq total 0.0 i 0)
(while (< i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss i)))
(if (vlax-property-available-p obj 'Length)
(setq total (+ total (vla-get-length obj)))
)
(setq i (1+ i))
)
(princ (strcat "\nTotal length: "
(rtos total 2 4)
" drawing units ("
(rtos (/ total 12.0) 2 3) " ft)"))
)
)
(princ)
)
Prompts for a layer name and reports how many objects exist on that layer. No dialog — result prints to the command line.
Usage: Type COL → type the layer name → count displayed.
(defun c:COL ( / lay ss cnt) (setq lay (getstring T "\nLayer name: ")) (setq ss (ssget "_X" (list (cons 8 lay)))) (setq cnt (if ss (sslength ss) 0)) (princ (strcat "\nObjects on layer \"" lay "\": " (itoa cnt))) (princ) )
Sums the area of all selected closed polylines, circles, and regions. Reports in sq inches, sq feet, and sq yards — useful for site plans and material takeoffs.
Usage: Type STA → select closed shapes → areas reported.
(defun c:STA ( / ss i obj total sqin sqft sqyd)
(setq ss (ssget '((0 . "LWPOLYLINE,CIRCLE,REGION,ELLIPSE"))))
(if ss
(progn
(setq total 0.0 i 0)
(while (< i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss i)))
(if (vlax-property-available-p obj 'Area)
(setq total (+ total (vla-get-area obj)))
)
(setq i (1+ i))
)
(setq sqin total
sqft (/ total 144.0)
sqyd (/ total 1296.0))
(princ (strcat
"\nTotal Area:"
"\n " (rtos sqin 2 2) " sq in"
"\n " (rtos sqft 2 3) " sq ft"
"\n " (rtos sqyd 2 4) " sq yd"))
)
)
(princ)
)
Prompts for a block name and counts every instance in the drawing including nested xrefs. Great for bill-of-materials checks.
Usage: Type CBC → enter block name → count shown.
(defun c:CBC ( / bname ss cnt)
(setq bname (getstring T "\nBlock name to count: "))
(setq ss (ssget "_X"
(list '(0 . "INSERT") (cons 2 bname))))
(setq cnt (if ss (sslength ss) 0))
(princ (strcat "\nBlock \"" bname "\" count: " (itoa cnt)))
(princ)
)
Explodes only the INSERT (block reference) objects in a mixed selection, leaving non-block objects untouched. Repeats until all nested blocks are flat.
Usage: Type ESB → select objects → only blocks explode.
(defun c:ESB ( / ss blks)
(setq ss (ssget))
(if ss
(progn
(setq blks (ssget "_P" '((0 . "INSERT"))))
(if blks
(progn
(command "._EXPLODE" blks "")
(princ (strcat "\nExploded " (itoa (sslength blks)) " block(s)."))
)
(princ "\nNo blocks in selection.")
)
)
)
(princ)
)
Switches to every layout tab (Model + all Paper Space layouts) and runs ZOOM EXTENTS on each. Fixes layouts that look blank when first opened.
Usage: Type ZEA → Enter. Cycles all tabs automatically.
(defun c:ZEA ( / doc layouts lay i)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq layouts (vla-get-layouts doc))
(vlax-for lay layouts
(vla-activate lay)
(command "._ZOOM" "_E")
)
(princ "\nZoom Extents applied to all layouts.") (princ)
)
Picks two parallel lines and draws a construction centerline exactly between them at the midpoint distance. Results placed on current layer.
Usage: Type CL → pick line 1 → pick line 2 → centerline drawn.
(defun c:CL ( / e1 e2 p1s p1e p2s p2e mids mide) (setq e1 (entget (car (entsel "\nPick first line: ")))) (setq e2 (entget (car (entsel "\nPick second line: ")))) (setq p1s (cdr (assoc 10 e1)) p1e (cdr (assoc 11 e1))) (setq p2s (cdr (assoc 10 e2)) p2e (cdr (assoc 11 e2))) (setq mids (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1s p2s)) (setq mide (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1e p2e)) (command "._LINE" mids mide "") (princ "\nCenterline drawn.") (princ) )
Selects all dimension objects in the drawing and runs DIMREGEN to force them to recalculate and update to the current DIMSTYLE settings.
Usage: Type UAD → Enter. All dims update automatically.
(defun c:UAD ( / ss i ent)
(setq ss (ssget "_X"
'((0 . "DIMENSION,LEADER,MULTILEADER"))))
(if ss
(progn
(command "._DIMREGEN")
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(vla-update (vlax-ename->vla-object ent))
(setq i (1+ i))
)
(princ (strcat "\nUpdated " (itoa (sslength ss)) " dimension(s)."))
)
(princ "\nNo dimensions found.")
)
(princ)
)
Runs AUDIT with auto-fix enabled, then PURGE ALL, then saves the drawing. A one-command drawing health check — run before every major plot.
Usage: Type ADF → Enter. Saves automatically when done.
(defun c:ADF ( / ) (command "._AUDIT" "_Y") ; audit & fix errors (command "._PURGE" "_ALL" "*" "_No") ; purge unused (command "._QSAVE") ; save drawing (princ "\nAudit, Purge, and Save complete.") (princ) )
Prints the current drawing's full file path, creation date, last saved date, and AutoCAD version number to the command line. Useful for version tracking.
Usage: Type DIR → Enter. Info shown in command window.
(defun c:DIR ( / doc)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(princ "\n── Drawing Info ──────────────────")
(princ (strcat "\n File : " (vla-get-fullname doc)))
(princ (strcat "\n Saved: " (menucmd "m=$(edtime,$(getvar,TDUPDATE),DD/MON/YYYY HH:MM:SS)")))
(princ (strcat "\n Units: " (itoa (getvar "INSUNITS"))))
(princ (strcat "\n Limits: " (vl-princ-to-string (getvar "LIMMIN"))
" to " (vl-princ-to-string (getvar "LIMMAX"))))
(princ "\n──────────────────────────────────")
(princ)
)
Creates a standard set of drafting layers with correct colors in one command. Customize the list at the top of the script for your office standards.
Usage: Type CSL → Enter. Layers created if they don't already exist.
(defun c:CSL ( / doc lays data row lname lcolor)
;; Format: ("LAYER-NAME" color-number)
(setq data '(
("A-ANNO-TEXT" 7) ; white
("A-ANNO-DIMS" 3) ; green
("A-ANNO-SYMB" 4) ; cyan
("A-WALL" 1) ; red
("A-DOOR" 2) ; yellow
("A-GLAZ" 5) ; blue
("A-EQPM" 6) ; magenta
("E-LITE" 3) ; green
("E-POWR" 1) ; red
("XREF-UNDERLAY" 150) ; light blue
("DEFPOINTS" 2) ; yellow
))
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq lays (vla-get-layers doc))
(foreach row data
(setq lname (car row)
lcolor (cadr row))
(if (not (tblsearch "LAYER" lname))
(progn
(setq newlay (vla-add lays lname))
(vla-put-color newlay lcolor)
)
)
)
(command "._REGEN")
(princ "\nStandard layers created.") (princ)
)