CXBLKCOUNTBlocks and attributesVersion 1.0.0Tested in AutoCAD

Count blocks by name

Lists how many times each block appears in the drawing or in a selection, most frequent first, and can place the list as a text block.

Download cxblkcount.lsp LISP terms

How to use it

Type CXBLKCOUNT and choose All or Selection.
Read the list at the command line.
Choose Yes to place it in the drawing.

Good to know

Counts blocks in the current model or layout tab.

Load it in AutoCAD

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

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 cxblkcount.lsp, or download it.

;;; ============================================================================
;;; CXBLKCOUNT - Count blocks by name
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxblkcount
;;; 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
;;; ============================================================================

;; Count the block references in NAMES by block name.
;; Returns ((name . count) ...), the most frequent first, equal counts in alphabetical order.
(defun cx:blkcount-run (names / table name pair)
  (foreach e names
    (setq name (cx:dxf 2 (entget e)))
    (if (setq pair (assoc name table))
      (setq table (subst (cons name (1+ (cdr pair))) pair table))
      (setq table (cons (cons name 1) table))))
  (cx:sort table
           (function (lambda (a b)
             (or (> (cdr a) (cdr b))
                 (and (= (cdr a) (cdr b)) (< (strcase (car a)) (strcase (car b)))))))))

(defun c:CXBLKCOUNT ( / *error* cx:sv ss rows pt total)
  (setq *error* cx:err)
  (setq ss (if (= (cx:ask-kw "Count blocks in" "All Selection" "All") "All")
             (ssget "X" (list '(0 . "INSERT") (cons 410 (getvar "CTAB"))))
             (cx:pick "\nSelect blocks: " '((0 . "INSERT")))))
  (if ss
    (progn
      (setq rows (cx:blkcount-run (cx:ss->list ss)) total 0)
      (foreach r rows
        (setq total (+ total (cdr r)))
        (princ (strcat "\n" (itoa (cdr r)) " x  " (car r))))
      (princ (strcat "\n" (itoa total) " block(s) of " (itoa (length rows)) " different name(s)."))
      (if (and (= (cx:ask-kw "Place the list in the drawing" "Yes No" "No") "Yes")
               (setq pt (getpoint "\nTop-left corner of the list: ")))
        (progn
          (cx:start '(("CMDECHO" . 0)))
          (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 pt)
                          (cons 40 (getvar "TEXTSIZE")) '(41 . 0.0) '(71 . 1) '(72 . 5)
                          (cons 1 (cx:join (mapcar (function (lambda (r) (strcat (car r) " : " (itoa (cdr r))))) rows) "\\P"))
                          (cons 7 (getvar "TEXTSTYLE"))))
          (cx:end))))
    (princ "\nNo blocks found."))
  (princ))


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

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

;; Merge sort of LST with PRED (a function of two items that is true when the first goes first).
(defun cx:sort (lst pred / half a b out)
  (cond
    ((or (null lst) (null (cdr lst))) lst)
    (T
     (setq half (/ (length lst) 2) a nil b lst)
     (repeat half (setq a (cons (car b) a) b (cdr b)))
     (setq a (cx:sort (reverse a) pred) b (cx:sort b pred) out nil)
     (while (and a b)
       (if (apply pred (list (car b) (car a)))
         (setq out (cons (car b) out) b (cdr b))
         (setq out (cons (car a) out) a (cdr a))))
     (append (reverse out) a b))))

;; 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))

;; 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))

;; 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)

;; 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))

;; 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))

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

(princ "\nCXBLKCOUNT loaded. Type CXBLKCOUNT to start.")
(princ)

Version history

Version 1.0.0 · 27 Ekim 2026

First release.