[编程交流] 命名块的Bcount lisp

(if (setq ss (ssget "_x" '((2 . "E"))))
 (sssetfirst nil ss)
)

'((0 . "INSERT")(2 . "E"))

(defun c:bcc (/ table dcl lsblk nm ss tol)
;Ketxu 2012
(vl-load-com) 
   (defun table (s / d r)
   (while (setq d (tblnext s (null d)))
   (setq r (cons (cdr (assoc 2 d)) r))
   )
   )
   (defun DCL(Title @ ThongTin lstVal / fl ret)   
        (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
        (setq  ret (open fl "w"))
        (mapcar
       '(lambda (x) (write-line x ret))
       (list 
       "mip_msg : dialog { "
       (strcat "label="" title ""; width = 40;fixed_width = true;")  ; 
       ":popup_list {label = "Block : ";key="kLst";}" 
       ": column {"
       ": row {"
       "    fixed_width = true;"
       "    alignment = centered;"
       ":button {label = "\OK"; is_cancel = true;fixed_width = true;width = 1;}"
       "    : spacer { width = 2; }"
       ":button {label = "About";fixed_width = true;width = 1;key = "kThongTin";}" 
       "}"
       "}"
       " :text_part {alignment=centered;"
        (strcat "label="" @ "";")
        "}}"
       )    
        ) ;_ end of mapcar
        (setq ret (close ret))
        (if (and (not (minusp (setq dcl_id (load_dialog fl))))
         (new_dialog "mip_msg" dcl_id)
        ) ;_ end of and
       (progn 
       (start_list "kLst" 3)
       (mapcar '(lambda(x)(add_list x)) lstVal)
       (end_list)
       (action_tile "kLst" "(setq ret (nth (atoi $value) lstVal))")
       (start_dialog) 
       ) ;_ end of progn
        ) ;_ end of if
        (unload_dialog dcl_id)  
        (vl-file-delete fl)
        ret 
   )
(setq lstBlk (vl-remove-if '(lambda(x)(wcmatch x "`**"))(acad_strlsort (table "Block")))) 
(cond ((setq nm (DCL "Select block :" "@Ketxu" "Count choiced block @Ketxu" lstBlk))
(setq  ss  (ssget (list (cons 0 "INSERT")(cons 2 (strcat nm ",`**"))))
tol (length (setq tmp (vl-remove-if-not '(lambda(x)(= (vla-get-EffectiveName (vlax-ename->vla-object x)) nm)) (acet-ss-to-list ss))))
)
))
(cond ((> tol 0)
(sssetfirst nil (acet-list-to-ss tmp))
(princ (strcat "Number of block " nm " in selection area : " (itoa tol) ))
)(T (princ "Nothing"))
)
(princ)
)