CXBLKATBlocks and attributesVersion 1.0.0Tested in AutoCAD

Insert a block at many places at once

Puts a block at the centre of every selected circle, arc or ellipse, at every point, text or block, and at the middle of every line, turned along it. Fast for symbols at hundreds of positions.

Download cxblkat.lsp LISP terms

How to use it

Type CXBLKAT and select circles, points, texts, blocks or lines.
Enter the block name from the list shown and the scale.
Choose whether to erase the selected objects.

Good to know

The block goes on the layer of the object it is placed at, and is inserted without asking for attribute values.

Load it in AutoCAD

Save the file anywhere you like.
Type APPLOAD, pick the file and choose Load.
Type the command name: CXBLKAT.

To have it at every start, add it to the Startup Suite in the same dialog, or load a whole folder at once with the optional loader. About the optional loader

Tested in AutoCAD (full version). Other programs that run AutoLISP may work, but they are not tested.

The code

Plain text, nothing hidden. Copy it into a file named cxblkat.lsp, or download it.

;;; ============================================================================
;;; CXBLKAT - Insert a block at every selected object
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxblkat
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; The point a block goes to for an object: the center of a circle, arc or ellipse, the point of a point,
;; block or text, the midpoint of a line.
(defun cx:blkat-point (ed / type)
  (setq type (cx:dxf 0 ed))
  (cond
    ((= type "LINE") (cx:mid (cx:dxf 10 ed) (cx:dxf 11 ed)))
    (T (cx:pt3 (cx:dxf 10 ed)))))

;; Insert the block BLOCK (scaled by SCALE) at every object in NAMES. Blocks go on the layer of the object;
;; at a line the block is turned to the direction of the line. ERASE = T erases the objects. Needs ATTREQ 0 and OSMODE 0.
;; Returns how many blocks were inserted.
(defun cx:blkat-run (names block scale erase / n ed rot)
  (setq n 0)
  (if (tblsearch "BLOCK" block)
    (foreach e names
      (setq ed  (entget e)
            rot (if (= (cx:dxf 0 ed) "LINE")
                  (* (/ (angle (cx:dxf 10 ed) (cx:dxf 11 ed)) pi) 180.0)
                  0.0))
      (command "_.-INSERT" block "_Scale" scale "_Rotate" rot (cx:blkat-point ed))
      (cx:upd (entlast) 8 (cx:dxf 8 ed))
      (if erase (entdel e))
      (setq n (1+ n))))
  n)

(defun c:CXBLKAT ( / *error* cx:sv ss block scale erase n)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect circles, arcs, points, texts, blocks or lines to put blocks at: "
                        '((0 . "CIRCLE,ARC,POINT,TEXT,MTEXT,INSERT,ELLIPSE,LINE"))))
    (progn
      (princ (strcat "\nBlocks in this drawing: " (cx:join (cx:block-names) ", ")))
      (setq block (cx:ask-str "Block to insert" "-"))
      (if (not (tblsearch "BLOCK" block))
        (princ (strcat "\nThere is no block named " block "."))
        (progn
          (setq scale (cx:ask-real "Scale" 1.0)
                erase (= (cx:ask-kw "Erase the selected objects" "Yes No" "No") "Yes"))
          (cx:start '(("CMDECHO" . 0) ("ATTREQ" . 0) ("ATTDIA" . 0) ("OSMODE" . 0)))
          (setq n (cx:blkat-run (cx:ss->list ss) block scale erase))
          (princ (strcat "\n" (itoa n) " block(s) inserted."))
          (cx:end)))))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

(defun cx:dxf (code ed)
  (cdr (assoc code ed)))

(defun cx:mid (a b)
  (list (/ (+ (car a) (car b)) 2.0) (/ (+ (cadr a) (cadr b)) 2.0) (/ (+ (caddr a) (caddr b)) 2.0)))

;; A point with a Z value (2D points get 0).
(defun cx:pt3 (p)
  (list (car p) (cadr p) (if (caddr p) (caddr p) 0.0)))

;; Change one group of an entity: (cx:upd ename 8 "LAYER1"); the group is added when missing.
(defun cx:upd (ename code value / ed old)
  (setq ed (entget ename) old (assoc code ed))
  (entmod (if old (subst (cons code value) old ed) (append ed (list (cons code value)))))
  (entupd ename))

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Use the objects already selected, or ask the user to select; FILTER is an ssget filter list or nil.
(defun cx:pick (msg filter / ss)
  (setq ss (if filter (ssget "_I" filter) (ssget "_I")))
  (if (null ss)
    (progn
      (princ msg)
      (setq ss (if filter (ssget filter) (ssget)))))
  ss)

(defun cx:join (lst delim / out)
  (setq out "")
  (foreach s lst
    (setq out (if (= out "") s (strcat out delim s))))
  (if lst out ""))

;; 1-based position of SUB in STR at or after START, or nil.
(defun cx:find (str sub start / n i r)
  (setq n (strlen sub) i start r nil)
  (if (> n 0)
    (while (and (not r) (<= i (1+ (- (strlen str) n))))
      (if (= (substr str i n) sub) (setq r i))
      (setq i (1+ i))))
  r)

;; The names of the block definitions that can be inserted (no anonymous or xref blocks).
(defun cx:block-names (/ r out)
  (setq r (tblnext "BLOCK" T))
  (while r
    (if (and (/= (substr (cx:dxf 2 r) 1 1) "*") (not (cx:find (cx:dxf 2 r) "|" 1)))
      (setq out (cons (cx:dxf 2 r) out)))
    (setq r (tblnext "BLOCK")))
  (reverse out))

;;; Helpers that draw small things: labels and markers. See helpers.lsp for the format.

;; Ask for a string (spaces allowed) with a default; "-" means an empty string.
(defun cx:ask-str (msg def / v)
  (setq v (getstring T (strcat "\n" msg " <" def ">: ")))
  (cond ((= v "") def) ((= v "-") "") (T v)))

;; Real X as text with at most PREC decimals and no trailing zeros ("2.50" -> "2.5", "3.00" -> "3").
(defun cx:num (x prec / s)
  (setq s (rtos x 2 prec))
  (if (wcmatch s "*.*")
    (progn
      (while (= (substr s (strlen s)) "0") (setq s (substr s 1 (1- (strlen s)))))
      (if (= (substr s (strlen s)) ".") (setq s (substr s 1 (1- (strlen s)))))))
  (if (or (= s "-0") (= s "")) "0" s))

(defun cx:ask-real (msg def / v)
  (setq v (getreal (strcat "\n" msg " <" (cx:num def 6) ">: ")))
  (if v v def))

;; Replace every OLD in STR by NEW (case sensitive).
(defun cx:replace (str old new / n out pos)
  (setq n (strlen old) out "" pos 1)
  (if (= n 0)
    str
    (progn
      (while (<= pos (1+ (- (strlen str) n)))
        (if (= (substr str pos n) old)
          (setq out (strcat out new) pos (+ pos n))
          (setq out (strcat out (substr str pos 1)) pos (1+ pos))))
      (strcat out (substr str pos)))))

;; Ask for one of the keywords in BITS ("Yes No"), default DEF; returns the keyword.
(defun cx:ask-kw (msg bits def / v)
  (initget 0 bits)
  (setq v (getkword (strcat "\n" msg " [" (cx:replace bits " " "/") "] <" def ">: ")))
  (if v v def))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

;; Selection set to a list of entity names.
(defun cx:ss->list (ss / i out)
  (setq i 0)
  (if ss
    (repeat (sslength ss)
      (setq out (cons (ssname ss i) out)
            i   (1+ i))))
  (reverse out))

(princ "\nCXBLKAT loaded. Type CXBLKAT to start.")
(princ)

Version history

Version 1.0.0 · October 27, 2026

First release.