Lisp to Filter a Certain Block

[3arizona]

I found this lisp and got it to work, . The only problem is that i want it to filter for a certain block. Hope someone can help me out.  thanks   

 

(defun C:COUNTATT(/ acapp acol acsp adoc atable attdata attitem atts blkdata blkname blkobj col
       column colwidth  datalist en headers pt row sset swap  tabledata tags total txtheight widths x)
 
 ;private function

 (defun sum-and-groupby-three (lst / groups res sum tmp)
 (while lst
   (setq tmp        (car lst)
     sum
           (apply '+
              (mapcar 'atoi (mapcar 'cdadr 
                  (setq res (vl-remove-if-not

                          '(lambda (a) (and
                                 (eq (cdr (nth 0 a)) (cdr (nth 0 tmp)))
                                 (eq (cdr (nth 1 a)) (cdr (nth 1 tmp)))
                                 (eq (cdr (nth 2 a)) (cdr (nth 2 tmp)))))

                          lst

                        )
                  )
              ))
           )
     groups    (cons (subst (cons "QTY" (itoa sum))(cadr tmp) tmp) groups)
     lst
           (vl-remove-if
             '(lambda (a) (member a res))

             lst

           )
   )
 )

(reverse groups)
)

;            main part            ;

 (if (setq sset (ssget (list (cons 0 "INSERT") (cons 66  1))))         
   (progn
     (setq tabledata nil
       attdata nil
       attitem nil
     )
     
     (while (setq en (ssname sset 0))
   (setq blkobj  (vlax-ename->vla-object en)
         blkname (vla-get-effectivename blkobj)
   )
   (setq atts (vlax-invoke blkobj 'getattributes))
   (foreach attobj    atts

         (setq attitem (cons (vla-get-tagstring attobj) (vla-get-textstring attobj)))
         (setq attdata (cons attitem attdata))

   )

   (setq tabledata (cons (reverse attdata) tabledata))
   (setq attdata nil
         attitem nil
   )
   (ssdel en sset)
     )
(setq headers (mapcar 'car (car tabledata))
       tags    headers 
     )
(setq tabledata (sum-and-groupby-three tabledata))

(setq tabledata (mapcar '(lambda (x)
                (mapcar 'cdr x)
                  )
                 tabledata
             )
     )


     ;; sort by "A1" :
     
    (setq tabledata (vl-sort   tabledata '(lambda(a b)(< (car a)(car b)))))


     (setq total 0)
     (foreach i datalist (setq total (+ total (cdr i))))
   (initget 6)
 (setq txtheight (getreal "\nSpecify Text height for the table <48>:"))
 (cond ((not txtheight)(setq txtheight 48))) ;<-- text height as for as in your drawing

      (or adoc (setq adoc (vla-get-activedocument (setq acapp (vlax-get-acad-object)))))
     (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc))))
(setq acCol (vla-GetInterfaceObject acapp(strcat "AutoCAD.AcCmColor." (itoa(atoi(getvar "acadver"))))))
     (setq pt (getpoint "\nSpecify table location:"))
     (setq atable (vla-addtable
            acsp
            (vlax-3d-point pt)
            (+ 2 (length tabledata))
            (length headers)
            (* txtheight 1.2)
            (* txtheight 20)
          )
     )
     (vla-put-regeneratetablesuppressed atable :vlax-true)
      ;; calculate column widths : 
     (setq swap (append (list headers) tabledata)
       widths nil)
     (while (car swap)
   (setq column (mapcar 'car swap))
   (setq colwidth (* 1.5 (apply 'max (mapcar 'strlen column))txtheight))
   (setq widths (cons colwidth widths))
   (setq swap (mapcar 'cdr swap)))

     (setq widths (reverse widths))
      ;; set column widths
      (setq col 0)
      (foreach wid widths
        (vla-setcolumnwidth atable col wid)
        (setq col (1+ col))
        )
     (vla-put-horzcellmargin atable (* txtheight 0.5))
     (vla-put-vertcellmargin atable (* txtheight 0.3))
     (vla-setTextheight atable 1 txtheight)
     (vla-setTextheight atable 2 txtheight)
     (vla-setTextheight atable 4 txtheight)

     (vla-setText atable 0 0 "Panel Information")
     (vla-SetCellAlignment atable 0 0 acMiddleCenter)
           (vla-put-colorindex accol 2)
(vla-setcellcontentcolor atable 0 0 accol)
     (setq col -1)
     (foreach descr headers
   (vla-setText atable 1 (setq col (1+ col)) descr)
   (vla-SetCellAlignment atable 1 col acMiddleCenter)
   (vla-setcellcontentcolor atable 1 col accol)
     )
     
       (vla-put-colorindex accol 1)
     
      (setq row 2)
     
     (foreach record tabledata

   (setq col 0)
   (foreach item record
     (vla-setText atable row col item)
     (if (= 1 col)
     (vla-SetCellAlignment atable row col acMiddleCenter)


     (vla-SetCellAlignment atable row col acMiddleCenter)
          )
     (vla-setcellcontentcolor atable row col accol)
     (setq col (1+ col))
   )
   (setq row (1+ row))
     )
(vla-put-width atable (apply '+ widths))
     (vla-put-height atable (* 1.2 (vla-get-rows atable)txtheight))
     (vla-put-regeneratetablesuppressed atable :vlax-false)

   )
 )
(if  accol (vlax-release-object accol))
(if  acapp (vlax-release-object acapp))
(princ)
)
(prompt "\n\t---\tStart command with COUNTATT\t---\n")
(prin1)
(or (vl-load-com))
(princ)

 

[mhupp]

Update the ssget with the block name should do the trick

 

 (if (setq sset (ssget (list (cons 0 "INSERT") (cons 2 "BLOCK NAME") (cons 66  1))))    

 

[j2lstaples]

What are you trying to filter for? by effective block name or just block name??

This would require a different operation.

[3arizona]

yes, i wanted to filter per block name.  I appreciate your time.  Thank you!!