Help with Attribute Extractor

July 8, 2019

Using Autocad 2014.

The following LISP program is perfect for my needs to QA several hundred drawings' attributed text, with two exceptions that I cannot seem to remedy:

1. The program asks the user to open the .xls file that it just created in the folder where the open drawing resides.
   This is cumbersome and unnecessary, depending upon how it was opened. If I double-click the .dwg file to start Autocad, the selection window is right there at the drawing folder.
   If Autocad is already running and then I open the drawing, the file selection window makes me go searching for the .xls file the program just created.
   Regardless, is there a way to have the excel file open automatically once I start ATOUT.LSP and the file is created?

(I did play around with Lee Mac's MacAtt v1.3 extractor program and it works well, but there is the time penalty of needing to repeatedly set it up for each drawing, and I'm doing hundreds.)

2. The Excel datasheet has one row of data, then a blank row. If someone can tell me how to NOT to have those blank rows, I would be most grateful.

I don't need to save or retain the resultant Excel files. They're just temporary.

;; Posted by ml3428 20 JUNE 2012
;; www.cadtutor.net/forum/topic/39596-attribute-extraction-lisp-routine_help
;; Post 1
;; Author unknown (fixo?)

;;  Groups elements in sublist by criteria

(defun subtrack (test lst)
(apply 'append (mapcar '(lambda (x)
(if (eq (car x) test)(list x))) lst)))

;;  Counts equivalent subs in list

(defun countsub	(lst sub)
  (cond	((null lst) 0)
	((and (equal (caar lst) (car sub) 0.00001)
	      (equal (cadar lst) (cadr sub) 0.00001)
	 )
	 (1+ (countsub (cdr lst) sub))
	)
	(T (countsub (cdr lst) sub))
  )
)
;;  Get info from block include from constant attributes in following form:
;; (("TAG1" . "VALUE1") ("TAG2" . "VALUE2") ...("*CONSTANT*: TAGN" . "VALUEN"))

  (defun get-all-atts (obj / atts att_list const_atts const_list ent)
    (and
	 (if (and obj 
		  (vlax-property-available-p obj 'Hasattributes)
		  (eq :vlax-true (vla-get-hasattributes obj))
	     )
	   (progn
	     (setq atts (vlax-invoke obj 'Getattributes))
	     (foreach att atts
	       (setq att_list
		      (cons (cons (vla-get-tagstring att)
				  (vla-get-textstring att)
			    )
			    att_list
		      )
	       )
	     )
	   )
	 )
    )
    (cond ((vlax-method-applicable-p obj 'Getconstantattributes)
	   (setq const_atts (vlax-invoke obj 'Getconstantattributes))
	   (foreach att	const_atts
	     (setq const_list
		    (cons (cons	(vla-get-tagstring att)
				(vla-get-textstring att)
			  )
			  const_list
		    )
	     )
	   )
	   (setq att_list (reverse (append const_list att_list)))
	  )
	  (T (reverse att_list))
    )
  )

;;			Main part			;;
  (defun C:ATOUT (/	 acsp	  adoc	   aexc	    awb	     axss
		bname	 cll	  colm	   com_data csht     data
		exc_data fname	  header_list	    info     nwb
		osm	 row	  sht	   ss	    str1     str2
		subtot	 tmp_data tmp_get  tmp_snip tot
	       )

    (vl-load-com)
    (setq adoc (vla-get-activedocument
		 (vlax-get-acad-object)
	       )
	  acsp (vla-get-modelspace adoc)
    )
    (setq osm (getvar "osmode"))
    (setvar "osmode" 0)
    (setvar "cmdecho" 0)
    (vla-endundomark adoc)
    (vla-startundomark adoc)

    (vl-cmdf "zoom" "a")
    (vl-cmdf "zoom" ".85x")
    ;;    variations of the selection
    ;;  All blocks :
        (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1))))
    ;;	Selected on screen:
;;;(setq ss (ssget '((0 . "INSERT"))))
    ;; All blocks by name:
;;;    (setq bname (getstring "\n	***	Block name:\n"))
;;;    (setq ss (ssget "_X" (list (cons 0 "INSERT")(cons 66 1) (cons 2 bname))))
    (setq axss (vla-get-activeselectionset adoc))
    (setq com_data nil)				  ;for debug only

    (vlax-for a	axss
      (setq tmp_get (get-all-atts a))
      (setq tmp_data (append (list (vla-get-name a)(vla-get-handle a)) tmp_get))
      (setq com_data (cons tmp_data com_data))
      (setq tmp_data nil)
    )						  ;ok
    (setq tot (length com_data))
    (setq exc_data nil)				  ;for debug only
    (while com_data
      (setq tmp_snip
	     (subtrack (caar com_data) com_data)
      )
      (setq str1 (strcat "Subtotal blocks "
			 "\"" (caar com_data) "\""
                         ": "
		 )
	    str2
		 (itoa (length tmp_snip))
      )
      (setq exc_data (append exc_data
			     (list (append tmp_snip (list (list str2 str1))))
		     )
	    com_data (vl-remove-if
		       (function not)
		       (mapcar (function (lambda (x)
					   (if (not (member x tmp_snip))
					     x
					   )
					 )
			       )
			       com_data
		       )
		     )
	    tmp_snip nil
      )
    )
    (setq exc_data
           (mapcar (function (lambda (x)
               (mapcar (function (lambda (y)                
                   (append (list (cadr y)(car y))(cddr y))))
                       x
                       )
                               )
                             )
                   exc_data)
                   )
    ;;		Eof calc part		;;

    ;;	***	Excel part	***	;;
	
;++++++++++++++++++++++++++++++++++++++++
;++++++++++++++++++++++++++++++++++++++++
    (setq fn (vl-filename-base (getvar "dwgname")))
    (setq fname (strcat (getvar "dwgprefix") fn ".xls"))
;++++++++++++++++++++++++++++++++++++++++
;++++++++++++++++++++++++++++++++++++++++
;; replace above two lines with this one AFTER we figure
;;   out how to get the file to open automatically

;	(setq fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))".xls"))
;++++++++++++++++++++++++++++++++++++++++
;++++++++++++++++++++++++++++++++++++++++
 
    (setq fname (open fname "W"))
    (close fname)

;++++++++++++++++++++++++++++++++++++++++
;++++++++++++++++++++++++++++++++++++++++
; If the file opened automatically, this next line should go away.
;   No further need for 'fn'

    (alert (strcat "Select file " "\"" (strcat fn ".xls") "\""))
;++++++++++++++++++++++++++++++++++++++++
;++++++++++++++++++++++++++++++++++++++++
    (setq fname (getfiled "Excel Spreadsheet File" "" "XLS" 8))
    (setq fname (findfile fname))
    ;;; Excel part written by  ALEJANDRO LEGUIZAMON -  http://arquingen.tripod.com.co  
    (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")
    )
    (vlax-put-property csht 'Name "AttOut-AttIn")
    (vla-put-visible aexc :vlax-true)
    (setq row 1
	  colm 1
    )

    (setq header_list
           '("HANDLE"
             "BLOCK NAME"
             "DATA3"
             "DATA4"
             "DATA5"
             "DATA6"
			 "DATA7"
			 "DATA8"
			 "DATA9"
            )
    ) ;_ end of setq

    (repeat (length header_list)
      (vlax-put-property
	cll
	"Item"
	row
	colm
	(vl-princ-to-string (car header_list))
      )
      (setq colm (1+ colm)
	    header_list
	     (cdr header_list)
      )
    )
    (setq row 2
	  colm 1
    )
    (repeat (length exc_data)
      (setq data   (reverse (cdr (reverse (car exc_data))))
	    subtot (last (car exc_data))
      )
      (repeat (length data)
	(setq info (car data))
	(repeat	(length info)
	  (vlax-put-property
	    cll
	    "Item"
	    row
	    colm
            (if (< colm 3)
	    (vl-princ-to-string (car info))
            (vl-princ-to-string (cdar info)))
	  )
	  (setq colm (1+ colm))
	  (setq info (cdr info))
	)
        (setq data (cdr data))
	(setq row  (1+ row)
	      colm 1
	)
      )

     
      
      (setq colm (1+ colm))
      (vlax-put-property
	cll
	"Item"
	row
	colm
	
      )

      (setq exc_data (cdr exc_data))
      (setq row	 (1+ row)
	    colm 1
      )
    )

    (setq row  (1+ row)
	  colm 1
    )
    
    (setq colm (1+ colm))
    (vlax-put-property
      cll
      "Item"
      row
      colm
      
    )
   (setq fcol (vlax-get-property csht "Range" "A:Z"))
   (vlax-put-property fcol "NumberFormat" "@")
;;;        Columns("A:A").Select
;;;    Range("A394").Activate
;;;    Selection.NumberFormat = "@"
    (vlax-invoke (vlax-get-property csht "Columns") "AutoFit")
    (vlax-release-object cll)
    (vlax-release-object fcol)
    (vlax-release-object csht)
    (vlax-release-object sht)
    (vlax-release-object nwb)
    (vlax-release-object awb)
    (vlax-release-object aexc)
    (setq aexc nil)
    (setvar "osmode" osm)
    (setvar "cmdecho" 1)
    (vla-clear axss)
    (vlax-release-object axss)
    (vla-regen adoc acactiveviewport)
    (vla-endundomark adoc)
    (gc)
    (gc)
;++++++++++++++++++++++++++++++++++++++++
;++++++++++++++++++++++++++++++++++++++++
;; This can just go away.
;;    (alert "Save Excel manually")
;++++++++++++++++++++++++++++++++++++++++
;++++++++++++++++++++++++++++++++++++++++
    (princ)
    )
(princ "\n\t\t***\tStart command with ATOUT...\t***")
(princ)

;; Just for testing
(C:ATOUT)

Thanks for any assistance,
Steve

Edited July 8, 2019 by StevJ
changed some stuff

July 9, 2019

Have a look at this, for start open xls use (getvar "dwgprefix")


(getfiled "Select a Lisp File" "c:/program files/<AutoCAD installation directory>/support/" "lsp" 8)
	 

(setq fname (getfiled "Excel Spreadsheet File" "" "XLS" 8))

Edited July 9, 2019 by BIGAL

July 10, 2019

BIGAL,

No amount of program manipulation could coax it to open the Excel file automatically.

I'll use the program in its current form, and keep researching and trying as time permits.

Not gonna give up, because this program has thrown down the gauntlet, so I gotta keep at it.

Thanks for the hints, BIGAL, but at present I'm just not up to this task, it seems. Maybe I'm over-thinking it?

Steve

Edited July 10, 2019 by StevJ

July 12, 2019

You can open a excel if its not open either to just behind the scenes to edit or actually open it so you can see.

This is something I have been playing with as a generic sort of excel it can be ran with a known xls. maybe it will provide some help. It is a work in progress.

AHGETCELLS.lsp

July 13, 2019

Thanks, BIGAL.

I'll see what I can learn from it.

I did eliminate the double-spaced rows in the Excel output file, but getting rid of that file search window and just opening the excel file still eludes me.

Steve

July 13, 2019

YeeHa! Patience and perseverance have been rewarded.

THIS WORKS NOW. Automatically opens the file and the program fills it up with attributes.

This is what I added to the program to get the Excel file to open without user action.
Shamelessly 'borrowed' from a post by BeekeeCZ on the Autodesk forum on 30 JAN 2017.
After a bit of modification and addition of "w\\" to the startapp line, it is now a more efficient QA tool and works all its magic automatically.

I'm as happy as a puppy with two tails!

 (if (findfile (setq path (vl-string-right-trim "\\" (getvar 'dwgprefix))
                     path (substr path 1 (vl-string-position (ascii "\\") path 0 T))
                     fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))".xls")))
    (startapp "C:\\Program Files (x86)\\Microsoft Office\\Office11\\EXCEL.EXE" "w:\\" fname)
  )

Steve

Edited July 13, 2019 by StevJ
indecision

July 13, 2019

The only problem is your opening the excel but you have to run other code to look at wether its open already and set up a link to it. If you look at Getexcel.lsp it has lots of functions in it including opening and pass its name to Autocad for a get or set. I used a slightly different method in the code I posted which is by another author.


; OpenExcel - Opens an Excel spreadsheet
;   Syntax:  (OpenExcel ExcelFile$ SheetName$ Visible)
;   Example: (OpenExcel "C:\\Folder\\Filename.xls" "Sheet1" nil)

and

(setq ExcelFile$ (findfile ExcelFile$))
  (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
  (vlax-invoke-method (vlax-get-property *ExcelApp% 'WorkBooks) 'Open ExcelFile$)

Edited July 13, 2019 by BIGAL

July 14, 2019

I see your point. If the Excel file is still open and I run the program on the same drawing again, the program quits with an error.

I've been looking at the Getcells.lsp you posted since Friday. I've not been able to get good with regular lisp, much less the all those vla/vlax things, but i'm working on trying to decipher it. Ever so slowly.

I think the best answer might be just to close the Excel file before running the program again, but getting the program to update the open file would be great. Or even prompting that the Excel file must be closed before the program can update it. I'll keep plugging away at it.

By the way. After studying the code I posted yesterday:

(if (findfile (setq path (vl-string-right-trim "\\" (getvar 'dwgprefix))
                     path (substr path 1 (vl-string-position (ascii "\\") path 0 T))
                     fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))".xls")))
    (startapp "C:\\Program Files (x86)\\Microsoft Office\\Office11\\EXCEL.EXE" "w:\\" fname)
  )

It seems those first two lines weren't adding to the overall effort, so I removed them and changed it to:

  (setq fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))".xls")) 
  (startapp "C:\\Program Files (x86)\\Microsoft Office\\Office11\\EXCEL.EXE" "w:\\" fname)

Now that's just better.

I'm not done tweaking with it just yet, BIGAL, and thanks again for the ideas and assistance.

Steve

Edited July 14, 2019 by StevJ
stoopid spellin errers

Sign In

Help with Attribute Extractor

Recommended Posts

StevJ

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

StevJ

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

StevJ

Link to comment

Share on other sites

StevJ

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

StevJ

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity