[编程交流] Qselect公司

(defun  c:test (/ efname ob blks cnt i)(vl-load-com)
(setq  efname
  (lambda (k)
    (vla-get-effectivename
      (if (eq (type k) 'ENAME )
      (vlax-ename->vla-object k) k)
      )
    )
 )
 (while (setq ob (ssget "_:S:E" '((0 . "INSERT"))))
   (setq cnt 0)
   (if (setq blks (ssget "_X"
         (list '(0 . "INSERT")
           (cons 2
             (strcat (setq bn (strcase (efname (ssname ob 0)))) ",`*U*"
               )
             )
           )
         ))
     (progn
     (repeat (setq i (sslength blks))
               (if (eq (strcase (efname (ssname blks (setq i (1- i))  ))) bn)
                         (setq cnt (1+ cnt))))        
       (alert
         (strcat "There are "
           (itoa cnt) " "" bn
           "" Block(s) on this drawing file:"
           )
         )
       )
     )
   )
 (princ)
 )