Attribute Extraction To txt - Re-order

I have found a Lisp program on this forum by Miklos Fuccaro (thanks) that is very close to what I need, I have modified it slightly but still have one problem. The Lisp outputs the attributes of named blocks to a text file for importing into label printing software which is what I need but the strings of text seperated by commas need to be in a column instead.

i.e. a,b,c,d should be

a

b

c

d

I need to have any blank attributes retained so they will result in a blank row.

Here is the code:

; Global ATTribute EXtractor 
; by Miklos Fuccaro [email="mfuccaro@hotmail.com"]mfuccaro@hotmail.com[/email] 
;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract
;;Modified March 2009 by B.Leslie to write Attributes only and name txt file with DWG filename.
(defun gattex() 
  (setq Blocklist '("Name1" "Name2" "Name3"));; ** edit to include block names to select
  (setq TagList '("Tag1" "Tag2" "Tag3"));; ** edit to include tag names to extract
  ;;create block names separated by columns, for selection filter
  (setq Blocknames (List2String BlockList))
  (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
  (if (not ss) (quit))
  (setq Root (getvar "DWGPREFIX"))
  (setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_" (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".TXT") "a") i -1) 
  (repeat (sslength ss)
      (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
      (while (/= (Dxf 0 Edata) "SEQEND") 
         (if
             (and
                 (= (Dxf 0 Edata) "ATTRIB") 
                 (member (dxf 2 Edata) TagList);;if tag is on list
             );and
             (progn
                 (setq valRow (cons (Dxf 1 Edata) ValRow))
             );progn
         )
         (setq Edata (entget (setq e (entnext e))))
      );while
      (write-line (List2String (reverse ValRow)) file)
  );repeat 
  (close file)
  (princ (strcat "\nDone writing file " Root "MK_Equipment.txt"))
  (princ) 
);defun
;;-------------------------------
(defun List2String (Alist)
  (setq NumStr (length Alist))
     (foreach Item AList
        (if (= Item (car AList));;first item
           (setq LongString (car AList))
           (setq LongString (strcat LongString "," Item))
         )
     )
  LongString
);defun
;;--------------------------------
(defun Dxf (code pairs)
  (cdr (assoc code pairs))
)
(gattex)

Thanks for any help.

Bryan

Untested, but give this a go:

; Global ATTribute EXtractor 
; by Miklos Fuccaro mfuccaro@hotmail.com 
;-------------------------November 2004 ------- 
;;Edited March 2006 by C. Bassler to allow specification of block and tage names to extract
;;Modified March 2009 by B.Leslie to write Attributes only and name txt file with DWG filename.
(defun gattex() 
  (setq Blocklist '("Name1" "Name2" "Name3"));; ** edit to include block names to select
  (setq TagList '("Tag1" "Tag2" "Tag3"));; ** edit to include tag names to extract
  ;;create block names separated by columns, for selection filter
  (setq Blocknames (List2String BlockList))
  (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BlockNames))))
  (if (not ss) (quit))
  (setq Root (getvar "DWGPREFIX"))
  (setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_" (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".TXT") "a") i -1) 
  (repeat (sslength ss)
      (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
      (while (/= (Dxf 0 Edata) "SEQEND") 
         (if
             (and
                 (= (Dxf 0 Edata) "ATTRIB") 
                 (member (dxf 2 Edata) TagList);;if tag is on list
             );and
             (progn
                 (setq valRow (cons (Dxf 1 Edata) ValRow))
             );progn
         )
         (setq Edata (entget (setq e (entnext e))))
      );while
      (foreach v (reverse ValRow) (write-line v file))
  );repeat 
  (close file)
  (princ (strcat "\nDone writing file " Root "MK_Equipment.txt"))
  (princ) 
);defun
;;-------------------------------
(defun List2String (Alist)
  (setq NumStr (length Alist))
     (foreach Item AList
        (if (= Item (car AList));;first item
           (setq LongString (car AList))
           (setq LongString (strcat LongString "," Item))
         )
     )
  LongString
);defun
;;--------------------------------
(defun Dxf (code pairs)
  (cdr (assoc code pairs))
)
(gattex)

Thanks Lee that works a treat apart from it keep repeating and I get the same data about 30 times.

I think that's because the variables aren't localised - but I may consider just writing another one, because the repeat method can't handle selection sets greater than 32767 entities.

Try this, again - untested:

(defun c:gattex2 (/ Blklst Tglst ss file aEnt)
 (setq Blklst '("Name1,Name2,Name3") Tglst '("Tag1" "Tag2" "Tag3"))
 (if (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 Blklst) (cons 66 1))))
   (progn
     (setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_"
           (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".txt") "a"))
     (foreach Ent (mapcar 'cadr (ssnamex ss))
   (setq aEnt (entnext Ent))
   (while (/= "SEQEND" (cdadr (entget aEnt)))
     (if (member (cdr (assoc 2 (entget aEnt))) Tglst)
       (write-line (cdr (assoc 1 (entget aEnt))) file))
     (setq aEnt (entnext aEnt))))
     (close file))
   (princ "\n<!> No Blocks Found <!>"))
 (princ))

Get this error when run - ; error: bad SSGET list value

My goodness, this really isn't my day today!

(defun c:gattex2 (/ Blklst Tglst ss file aEnt)
 (setq Blklst "Name1,Name2,Name3" Tglst '("Tag1" "Tag2" "Tag3"))
 (if (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 Blklst) (cons 66 1))))
   (progn
     (setq file (open (strcat "F:\\ENGINEER\\GENERIC\\Label Schedule\\Extracted Labels\\MK_Equipment_"
           (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname"))4)) ".txt") "a"))
     (foreach Ent (mapcar 'cadr (ssnamex ss))
   (setq aEnt (entnext Ent))
   (while (/= "SEQEND" (cdadr (entget aEnt)))
     (if (member (cdr (assoc 2 (entget aEnt))) Tglst)
       (write-line (cdr (assoc 1 (entget aEnt))) file))
     (setq aEnt (entnext aEnt))))
     (close file))
   (princ "\n<!> No Blocks Found <!>"))
 (princ))

I think I should go back to bed

That did the trick, you can go back to bed and sleep easy now.

Thank you very much for your help.

Excellent, glad it works for you