drawing extraction

[lee.johnson]

Hello everyone,
I have written before about this, I use the attribute extraction tool before Autocad went to the eattext interface. Now that the company have removed the licenses for any AutoCAD under 2008, i'm stuck using eattext for my calculations. Frankly, I dislike it because it is to many steps for something that I want and to have to do it over and over again. My main issue is that I need to change the units to decimal from Arch and then back again. I cant count how many time i have had to redo a extraction due to the XYZ corrodinates that were in the Architecture units format.
I think a lisp routine as a one button operation would better suite me. I attatached a excel file that I use to paste the results for the old extration tool that we used in 2000.
Can anyone help me with this, I just need it to go to a excel or CSV file so I can paste it into the attached excel sheet. I have excel import the info and format it for the calculations

Thanks for your time

[alanjt]

Are the titles with underscores attribute tag names?

[lee.johnson]

Yes they are. they are the headers the were produced by attribute extraction in 2000 when I first started doing it

[alanjt]

Yes they are. they are the headers the were produced by attribute extraction in 2000 when I first started doing it

So, under count, are you wanting a total of each block name instance, but also, each block instance has it's own row to display the attribute contents?

[lee.johnson]

So, under count, are you wanting a total of each block name instance, but also, each block instance has it's own row to display the attribute contents?

Sorry for the delay couldn't get to my computer yesterday,

When I have extracted attributes the count was always 1 so I left it as it was. Mostly the count column to me is a place holder I don't think it really needed. The excel calculation sheet looks for info in certain cells so I leave it there.

yes, each block instance would have it's own line. The calculations uses the corrdinates of the fist line. as the base and calculates distance to the next corrcinate then to the next and so on.

Thanks

[fixo]

Try this out, change to suit

 
(vl-load-com)
(defun C:ATOUT(/  aexc awb  blkname exc_data cell cll colm csht data exc_data
        fcol fdata fname ftype info ins_point ins_record
        itm  nwb pfset row sht subtot  )
 
  ;;helper fubnction
(defun extract_blockset  (block_obj / att_list att_pairs )
     (reverse
    (if (and
   (vlax-property-available-p block_obj 'hasattributes)
   (setq att_list (vlax-invoke block_obj 'getattributes)))
 
   (foreach att_obj  att_list
     (setq att_pairs (cons (cons (strcase (vla-get-tagstring att_obj))
            (vla-get-textstring att_obj))
      att_pairs)))
      )
    )
  )
 
;;main part
(setq pfset(vla-get-pickfirstselectionset (vla-get-activedocument (vlax-get-acad-object))))
 
(vla-clear pfset)
  (setq blkname (getstring t "\nEnter block name: "))
 
(if (not (tblsearch "block" blkname))(progn
  (alert "Block does not exsit.\nProgram exiting.")
  (exit)(princ)))
 
  (setq ftype (list 0 2 410)
 fdata (list "insert" blkname (getvar 'ctab)))
 
  (setq ftype (vlax-safearray-fill
  (vlax-make-safearray vlax-vbinteger
    (cons 0 (1-(length ftype)))) ftype)
 fdata (vlax-safearray-fill
  (vlax-make-safearray vlax-vbvariant
 
    (cons 0 (1-(length fdata)))) fdata)
 )
;;;  (vla-select pfset acselectionsetall nil nil ftype fdata);<--select all blocks in the current tab
(vla-selectonscreen pfset ;|acselectionsetall nil nil|; ftype fdata);<-- selct manually
 
(if (zerop(vla-get-count pfset))
 (progn
  (alert "Nothing selected.\nProgram exiting.")
  (exit)(princ))
  )
 
(vlax-for block_obj pfset
  (setq ins_point (vlax-get block_obj 'insertionpoint)
 ins_record (list (cons "BlockName" (vla-get-effectivename block_obj))
    (cons "Position X" (car ins_point))
    (cons "Position Y"(cadr ins_point))
    (cons "Position Z"(caddr ins_point))))
(setq exc_data (append (list
       (append 
          ins_record (extract_blockset block_obj)))
      exc_data)
      )
 
  )
    ;;  Eof acad part  ;;
    ;; *** Excel part *** ;;
 
    ;;;    Excel part based on code that was written by  ALEJANDRO LEGUIZAMON
    ;;;    http://arquingen.tripod.com.co  
    (setq fname (getfiled "Select Your Working Excel Spreadsheet File:" "" "XLS" 8))
    (setq fname (findfile fname))
 
    ;; remove the following code block if you don't need it
    ;; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>;;
    ;; reserve an Excel file copy before you ran programm:
;;;    (setq fcopy (strcat (getvar "dwgprefix")(vl-filename-base fname) "-COPY-"
;;;    (menucmd "M=$(edtime,$(getvar,date),HH-MM)") ".xls"))
;;;    (vl-catch-all-apply
;;;      (function (lambda()
;;;    (vl-file-copy fname fcopy))))
;;;    (alert (strcat "Excel file copy saved as:\n"
;;;    "\"" fcopy "\"")
;;;    )
    ;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<;;
 
    ;; define Excel objects
    (setq aexc (vlax-get-or-create-object "Excel.Application")
   awb  (vlax-get-property aexc 'Workbooks)
   nwb  (vlax-invoke-method awb 'Open fname)
   sht  (vlax-get-property nwb 'Sheets)
   csht (vlax-get-property sht 'Item 1)
   cll  (vlax-get-property csht 'Cells)
    )
    (vla-put-visible aexc :vlax-true)
  (setq row 1)
  (foreach line exc_data
  (setq row  (1+ row))
  (setq colm 1)
  (foreach single line
  (setq cell (variant-value (vlax-get-property cll 'item row colm)))
 
    (vlax-put-property  cell 'value2 (vlax-make-variant(cdr single)))
    (setq colm (1+ colm))
    )
 
  )
 
   (setq fcol (vlax-get-property csht 'Range "A:A"))
   (vlax-put-property fcol 'NumberFormat "@")
   (setq fcol (vlax-get-property csht 'Range "B:D"))
   (vlax-put-property fcol 'NumberFormat "#0.000")
   (setq fcol (vlax-get-property csht 'Range "E:O"))
   (vlax-put-property fcol 'NumberFormat "@")
   (vlax-invoke (vlax-get-property csht 'Columns) 'AutoFit)
    (mapcar (function (lambda(item)
   (vlax-release-object item)
   (setq itm nil)))
     (list  cll fcol csht sht nwb awb aexc))
    (gc)
    (gc)
    (alert "Click Icon and Save Excel manually")
    (princ)
    )
(princ "\n\t\t***\tStart command with ATOUT...\t***")
(princ)

~'J'~

[steveo]

the ATOUT.lsp doesn't seem to totally work for me. Program does not recognize the selected block after entering the correct block name, and when a selection is made, program reports none found, and exits with alert dialog. ?? what could be wrong... reboot did not help, different dwg with different block and attributes did not help.
Steve

[fixo]

the ATOUT.lsp doesn't seem to totally work for me. Program does not recognize the selected block after entering the correct block name, and when a selection is made, program reports none found, and exits with alert dialog. ?? what could be wrong... reboot did not help, different dwg with different block and attributes did not help.
Steve

Guess you used dynamic blocks
post the simple drawing in attachments here for testing
(I have A2009)
or change this line of code:

 
fdata (list "insert" blkname (getvar 'ctab)))

on this one:

fdata (list "insert" (strcat "`*U*" ",",blkname) (getvar 'ctab)))

~'J'~

[steveo]

Guess you used dynamic blocks
post the simple drawing in attachments here for testing
(I have A2009)
or change this line of code:

 
fdata (list "insert" blkname (getvar 'ctab)))

on this one:

fdata (list "insert" (strcat "`*U*" ",",blkname) (getvar 'ctab)))

~'J'~

viso:
Attached is sample dwg I was using for atout.lsp see if program works for you on this dwg
regards, Steve

[fixo]

I wrote this lisp accordingly to explanation in the post#5,
by this reason I left out 'Count' colum
this lisp will write just one block and all its attribute values per every line

From there I have 3 questions
1. Do you need to write all the same way?
2. Do you want to write to newly created Excel file
or into exisiting one
3. What the column names would be in this Excel file

Theres is no explanation in your drawing at all
Please explain me that well coz I won't to rewrite this lisp many times