Lisp routine to place Circle to different blocks and count the no of circles placed for each type of block

[nanja_c86]

Please help me complete this lisp. Attached the dwg and lisp files.

I need lisp to place circle to all the blocks which are listed in the program and need to count the number of circles placed for each block type and display as a alert message. if any block not found need shows alert msg that this block not found in dwg.

[ВeekeeCZ · Accepted solution]

And what's the issue? 

(defun c:amp_list (/ s i d n a l)
  
  (if (and (setq s (ssget "_X" '((0 . "INSERT") (2 . "DA_LE1,DA_DUAL-MINI,DA_TRPLE,DA_QUAD,DA_SNGLE-MINI"))))
	   (if (tblsearch "LAYER" "CIRCLES")
	     (vl-cmdf "_.layer" "_t" "CIRCLES" "_on" "CIRCLES" "")
	     (vl-cmdf "_.layer" "_n" "CIRCLES" "_lw" 0.5 "CIRCLES" "_co" 2 "CIRCLES" "")))
    (repeat (setq i (sslength s))
      (setq d (entget (ssname s (setq i (1- i))))
	    n (cdr (assoc 2 d))
	    l (if (setq a (assoc n l))
		(subst (cons n (1+ (cdr a))) a l)
		(cons (cons n 1) l)))
      (entmake (list '(0 . "CIRCLE") (assoc 10 d) '(40 . 25) '(8 . "CIRCLES")))))
  (and (setq l (vl-sort l '(lambda (e1 e2) (< (car e1) (car e2)))))
       (setq l (cons (cons "AMPS" (apply '+ (mapcar 'cdr l))) l))
       (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (itoa (cdr x)) " " (car x) " circles placed")) l))))
  (princ)
  )

[nanja_c86]

Dear BeekeeCZ,

Great!

It's working as required. Thank you very much.
One more thing instead of Showing block name in Alert Msg , i need something like this

DA_QUAD & DA_TRPLE blocks to be added and display as Tripple

DA_DUAL-MINI : MB
DA_LE1: LE
DA_QUAD & DA_TRPLE: TRIPPLE 

[ВeekeeCZ · Accepted solution]

Ok, fill up the translation list

(defun c:amp_list (/ r s i d n a l)

  (setq r '(("DA_LE1" . "LE")
	    ("DA_DUAL-MINI" . "B")
	    ("DA_TRPLE" . "D")
	    ("DA_QUAD" . "D")
	    ("DA_SNGLE-MINI" . "E")))
  
  (if (and (setq s (ssget "_X" (list '(0 . "INSERT") (cons 2 (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ",")) r))))))
	   (if (tblsearch "LAYER" "CIRCLES")
	     (vl-cmdf "_.layer" "_t" "CIRCLES" "_on" "CIRCLES" "")
	     (vl-cmdf "_.layer" "_n" "CIRCLES" "_lw" 0.5 "CIRCLES" "_co" 2 "CIRCLES" "")))
    (repeat (setq i (sslength s))
      (setq d (entget (ssname s (setq i (1- i))))
	    n (cdr (assoc 2 d))
	    n (cdr (assoc n r))
	    l (if (setq a (assoc n l))
		(subst (cons n (1+ (cdr a))) a l)
		(cons (cons n 1) l)))
      (entmake (list '(0 . "CIRCLE") (assoc 10 d) '(40 . 25) '(8 . "CIRCLES")))))
  (and (setq l (vl-sort l '(lambda (e1 e2) (< (car e1) (car e2)))))
       (setq l (cons (cons "AMPS" (apply '+ (mapcar 'cdr l))) l))
       (alert (apply 'strcat (mapcar '(lambda (x) (strcat "\n" (itoa (cdr x)) " " (car x) " circles placed")) l))))
  (princ)
  )

[nanja_c86]

Perfect. Thanks a lot for the help.