Jump to content

Lisp to Filter a Certain Block


Recommended Posts

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


     groups    (cons (subst (cons "QTY" (itoa sum))(cadr tmp) tmp) groups)
             '(lambda (a) (member a res))



(reverse groups)

;            main part            ;

 (if (setq sset (ssget (list (cons 0 "INSERT") (cons 66  1))))         
     (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)

     ;; 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
            (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))
(prompt "\n\t---\tStart command with COUNTATT\t---\n")
(or (vl-load-com))


Link to comment
Share on other sites

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


  • Like 1
  • Thanks 1
Link to comment
Share on other sites

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

This would require a different operation.

Link to comment
Share on other sites

  • 2 weeks later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Create New...