GatherAtts.lsp

Function:	gatheratts
Purpose	Gathers all the attributes and their values into a list for all insertions of specified blocks.
Arguments	bnames  list of block names to find
Returns	list of lists Organized by block name as follows: ((bname1  the name of the first block   (bref1 atts) the bref object followed by a list of attrib objects   (bref2 atts) the bref object followed by a list of attrib objects ) (bname2  the name of the second block   (bref3 atts) the bref object followed by a list of attrib objects   (bref4 atts) the bref object followed by a list of attrib objects )

(defun gatheratts (bnames / ;end of formal argument list
               rtlist          gatheratts     ;the list to return
               inslist              ;list of block insertions
               attlist atts indx objins ss1 ssl ssp)
                                    ;end of local variable list
(setq
ssp    (ssgetfirst)
bnames (mapcar '(lambda (s) (strcase s)) bnames)
)
(foreach bname bnames
(cond
  ;;Let's see if this block has any insertions
  ((null (setq ss1 (ssget "X" '((0 . "INSERT")))))
   nil                              ;no selection set created, return nil
  )
  ;;How many insertions?
  ((= 0 (setq ssl (sslength ss1)))
   nil                              ;no insertions, return nil
  )
  ;;  We found insertions, lets build a list of their attributes
  (T
   (setq
     indx -1                        ;initialize our index
     inslist nil
   )                                ;end setq
   ;;get all the insertions for this block
   (while (> ssl (setq indx (1+ indx)))


     (cond
       ;;stop this object here if it has not attributes
       ((= :vlax-false
           (vla-get-hasattributes
             (setq objIns
                    (vlax-ename->vla-object (ssname ss1 indx))
             )
           )
        )
        nil
       )
       ((not (or
               ;;it's an un-modified dynamic block or non-dynamic block
               (= bname (strcase (vla-get-name objins)))
               ;;it's a dynamic block
               (= bname (strcase (vla-get-effectivename objins)))
             )                      ;end or
        )                           ;end not
        nil                         ;it isn't one of our blocks, ignore it
       )


       (T                           ;do this to every object that gets by our test
        (setq
          atts    (vla-getattributes objIns)
          attlist (vlax-safearray->list (vlax-variant-value atts))
                                    ;the attributes in a list
          attlist (mapcar
                    '(lambda (a) (cons (vla-get-tagstring a) a))
                    attlist
                  )
          inslist (append inslist (list (cons objins attlist)))
        )                           ;end setq
       )                            ;end T
     )                              ;end cond



   )                                ;end while insertions still found for this block name
   ;;add the lists for the insertions of this block to the return list
   (setq rtlist (append rtlist (list (cons bname inslist))))
  )                                 ;end T
)                                   ;end cond
)                                     ;end foreach
(sssetfirst (car ssp) (cadr ssp))
rtlist                                ;return the list of lists of lists of lists of lists...
)                                       ;end of gatheratts

(Edited 4/18/2009 to improve formatting)