Attribute Extraction Program?

[DANIEL]

heres my version

(defun gattex() 
  (setq ss (ssget "X" '((0 . "INSERT") (66 . 1)))) 
  (if (not ss) (quit)) 
  (setq file (open "c:\\attributes.CSV" "a") i -1)
     (repeat (sslength ss)
     (setq A (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")))
     (setq l (entget (setq e (ssname ss (setq i (1+ i)))))) 
     (setq A (strcat A ","  (cdr (assoc 2 l))))
         (while (/= (cdr (assoc 0 l)) "SEQEND") 
            (if (= (cdr (assoc 0 l)) "ATTRIB")
            (setq A(strcat A "," (cdr (assoc 1 l))))) 
            (setq l (entget (setq e (entnext e)))) 
         )
     (write-line A file)
   ) 
  (close file) 
  (princ) 
 ) 
(gattex)

thanks again for the insight fuccaro

[iosa1]

Hi everyone. This is my first post on this forum. It is a great forum I must say.
I went through the process of the extraction wizzard and I saw it does have problems. It actually leaves out files from the batch process and in a random fashion. I need to extract info from a block called "I" which has some of the info that the title block has; being it E.C.N. number,
drawing number, revision level, revision class, description of change
and engineer in charge. All this from several drawings (*.dwg files) to
be able to have them in an excel document with the info I mentioned as
column titles. I see the Lisp program that is shown on this forum thread does extract attributes effectivelly. But it takes the info from all the blocks in the drawing. Quoting fuccaro:
"The simplest way is to add a list of block names and to teach the routine to ignore all the blocks not contained in the list. Or to ignore those and work the other ones."
Since I don't know AUTO LISP; how can I make the routine do this?
In other words where in the routine can I tell it which block to look for in each drawing?
How do I tell it which info to look for in each block so I make copies of the routine as needed for different sets of info?
How do I make it to revese the info as in rows to columns and columns to rows?
Sorry if this is too long. I thank you for your time.

[CarlB]

Well to answer one of your questions....

to have the routine work on just the blocks you select, rather than all blocks, change one line from:

(setq ss (ssget "X" '((0 . "INSERT") (66 . 1))))

to

(setq ss (ssget '((0 . "INSERT") (66 . 1))))

[iosa1]

Thanks for your reply. I did the replacement and it still takes all blocks. Where in the routine can I type a list of blocks or an only block from which to extract info?
I'm not litterate on lisp programing.
I appreciate your time.

[Geordie]

Check out this thread at the swamp
http://www.theswamp.org/forum/index.php?topic=8661.0
about extracting attributes

[CarlB]

I replied to iosa1 at another forum but thought it should go here as well since it builds on this thread and on Fuccaro's routine. Edit the second and third lines to specify block names and tag names to extract. Case of text in list needs to match block and tag names.

; 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
(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 Root "attributes.CSV") "a") i -1) 
   (write-line (strcat Root (getvar "DWGNAME") 
                " -found " (itoa (sslength ss)) 
                " block(s) with attributes") file) 
   (repeat (sslength ss)
       (setq TagRow nil ValRow nil) 
       (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
       (write-line "" file) 
       (write-line (strcat "block name:" "," (Dxf 2 Edata)) file) 
       (while (/= (Dxf 0 Edata) "SEQEND") 
          (if
              (and
                  (= (Dxf 0 Edata) "ATTRIB") 
                  (member (dxf 2 Edata) TagList);;if tag is on list
              );and
              (progn
                  (setq TagRow (cons (Dxf 2 Edata) TagRow))
                  (setq valRow (cons (Dxf 1 Edata) ValRow))
              );progn
          )
          (setq Edata (entget (setq e (entnext e))))
       );while
       (write-line (List2String (reverse TagRow)) file)
       (write-line (List2String (reverse ValRow)) file)
   );repeat 
   (close file)
   (princ (strcat "\nDone writing file " Root "attributes.csv"))
   (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)

[Ako]

Here's some VBA to do a similar thing. Just delete the lines with the info that's not required.

Sub Blocks(row, col)
    Dim BlocksSelSet As AcadSelectionSet
    Dim blockref As AcadBlockReference
    Dim AttRef As Variant
    Dim I As Integer
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    Dim groupCode As Variant, dataCode As Variant
    Dim NumOfBlocks As Integer
    Dim mode
    Dim AttMode As Long
    Dim constant As String
    Dim currentmode As Integer
    Dim attrobject As AcadAttribute
    
    On Error Resume Next
    
    Set BlocksSelSet = ThisDrawing.SelectionSets.Add("All_Blocks")
'define type of selection set (crossing, window, etc, in this case, all)
    
    mode = acSelectionSetAll
'this is a selection set filter
    
    gpCode(0) = 0
    dataValue(0) = "Insert"

    
    groupCode = gpCode
    dataCode = dataValue
    'this collects all blocks into the seletion set
    BlocksSelSet.Select mode, , , groupCode, dataCode
   
    NumOfBlocks = BlocksSelSet.Count
    For x = 1 To NumOfBlocks
        Set blockref = BlocksSelSet(x)
        excelsheet.Cells(row, col).Value = blockref.Name
        excelsheet.Cells(row, col + 1).Value = blockref.layer
        excelsheet.Cells(row, col + 2).Value = Format(blockref.insertionPoint(0), "##,##0.00") & "," & Format(blockref.insertionPoint(1), "##,##0.00")
        row = row + 1
        AttRef = blockref.GetAttributes
        
            For I = LBound(AttRef) To UBound(AttRef)
            Set attrobject = AttRef(I)
                ' Do something with the attribute refs here.
                excelsheet.Cells(row, col).Value = AttRef(I).TagString
                excelsheet.Cells(row, col + 1).Value = AttRef(I).layer
                excelsheet.Cells(row, col + 3).Value = AttRef(I).TextString
                
                constant = Choose(attrobject.mode, "acAttributeModeInvisible", "acAttributeModeConstant", "", "acAttributeModeVerify", "", "", "", "acAttributeModePreset")
                
                
                row = row + 1
            Next
        
        
        
    Next
    row = row + 1
  'clean up
    BlocksSelSet.Clear
    BlocksSelSet.Delete
    rownum = row
End Sub

Dave

[au-s]

I am using this and I find it cool...

Is it possible to remake it ?

I want it to

1. overwrite existing cvs-file (cause now it adds lines below previous created ones)
That goes for lisp code


Thanx for help!!

[Lee Mac]

Perhaps;

  ; 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

(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 Root "attributes.CSV") "w")
        i    -1)
  (write-line
    (strcat Root
            (getvar "DWGNAME")
            " -found "
            (itoa (sslength ss))
            " block(s) with attributes")
    file)
  (repeat (sslength ss)
    (setq TagRow nil
          ValRow nil)
    (setq Edata (entget (setq e (ssname ss (setq i (1+ i))))))
    (write-line "" file)
    (write-line (strcat "block name:" "," (Dxf 2 Edata)) file)
    (while (/= (Dxf 0 Edata) "SEQEND")
      (if
        (and
          (= (Dxf 0 Edata) "ATTRIB")
          (member (dxf 2 Edata) TagList)
          ;;if tag is on list
          ) ;and
         (progn
           (setq TagRow (cons (Dxf 2 Edata) TagRow))
           (setq valRow (cons (Dxf 1 Edata) ValRow))
           ) ;progn
         )
      (setq Edata (entget (setq e (entnext e))))
      ) ;while
    (write-line (List2String (reverse TagRow)) file)
    (write-line (List2String (reverse ValRow)) file)
    ) ;repeat 
  (close file)
  (princ (strcat "\nDone writing file " Root "attributes.csv"))
  (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)

[au-s]

COOL!
Thanx man

What did you do?