Attribute Extraction To txt - Re-order

[RocketBott]

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

[Lee Mac]

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)

[RocketBott]

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

[Lee Mac]

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.

[Lee Mac]

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

[RocketBott]

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

[Lee Mac]

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

[RocketBott]

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

Thank you very much for your help.

[Lee Mac]

Excellent, glad it works for you