drawing extraction

[steveo]

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

Mr fixo: If you would care to help, it would be appreciated.
See new attached drawing, and Excel spreadsheet:

Block having two attributes as shown (ITEM & QUANTITY)
Block name can be placed into lisp and not user entered
Block name does not have to be shown in resulting Excel spreadsheet
One column for attribute1 (label it ITEM)
One column for attribute 2 (label it QUANTITY)

However, QUANTITIES for identical ITEM tags should be summed as shown in example Excel spreadsheet
First row of Excel data for each drawing should contain drawing name

The Excel spreadsheet should be able to be appended for similar drawings,
but the resulting data for subsequent drawings as appended are not summed
into any previous drawing data.

[fixo]

Here you go
This program will work just for current drawing
Excel file would be saved automatically in the same folder
Working good for me with limited testing

;; helper functions

(defun create_datafile ( / aexc awb cell cll cls colm headers row sht shts wbks)

;;; based on program written by  ALEJANDRO LEGUIZAMON -  http://arquingen.tripod.com.co  
;;; edited by FATTY T.O.H. aka fixo - (vl-list->string (list 102 97 116 116 121 104 97 108 108 101 120 64 103 109 97 105 108 46 99 111 109))
  (or (vl-load-com))


  (setq	aexc	   (vlax-get-or-create-object "Excel.Application")
	wbks  (vlax-get-property aexc 'Workbooks)
	awb	   (vlax-invoke-method wbks 'Add)
	shts (vlax-get-property awb 'Sheets)
	sht	   (vlax-get-property shts 'Item 1)
	cls	   (vlax-get-property sht 'Cells)
  )


  (vla-put-visible aexc :vlax-false)
  (setq row 1
	colm 1)
(setq cell (variant-value (vlax-get-property cls 'item row colm)))
  (vlax-put-property  cell 'value2 (vlax-make-variant (getvar "dwgname") 8))
  
  (setq headers (list "UNIT" "QUANTITY")
  row  (1+ row)
  colm 1
	 )
	
  (foreach header headers
  (setq cell (variant-value (vlax-get-property cls 'item row colm)))
  
    (vlax-put-property  cell 'value2 (vlax-make-variant header 8))
    (setq colm (1+ colm))
    )
 
  (vlax-invoke-method
    awb
    'SaveAs 
    (strcat (getvar "dwgprefix")
	    (vl-string-right-trim ".dwg" (getvar "dwgname")) ".xls"
    )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
  )

  (vlax-put-property
    awb 'Saved :vlax-true)
  (vlax-invoke-method
    awb 'Close )
  (vlax-invoke-method
    aexc 'Quit)
  (mapcar (function (lambda(item)
		    (vl-catch-all-apply (function (lambda()
			(progn
			(vlax-release-object item)
			(setq item nil)))))))
	    (list  cls sht shts awb wbks aexc)
	  )

  (gc)
  (gc)
  (gc)
  (vl-cmdf "_delay" 500)
  (princ)
);_eof create_datafile


;;====================================================
(defun group-by-filter  (lst )
  (if (caar lst)
    (cons (vl-remove-if-not
	    (function (lambda (x)
			(and(eq (cdar x) (cdaar lst))
			(eq(caadr x)(car (cadr (car lst))))
			)
			))
					   lst)

	  (group-by-filter
	    (vl-remove-if
	      (function (lambda (x)
			  (and(eq (cdar x) (cdaar lst))
			(eq(caadr x)(car (cadr (car lst))))
			)
			  ))
	      lst)
	    )
	  )
    )
  )

;;====================================================

(defun group-by-qty  (lst / item out_data qty record x)
  (while (setq item (car lst))
    (setq record (car item))
    (setq qty (apply '+
		     (mapcar 'atof
			     (mapcar 'cdr (mapcar '(lambda (x) (cadr x)) item)))))
    (setq record (subst	(cons (caadr record) (rtos qty 2 0))
			(cadr record)
			record))
    (setq out_data (cons record out_data))
    (setq lst (cdr lst)))
  (reverse out_data)
  )

;;====================================================

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


(vl-load-com)

(defun C:QTY(/ aexc awb blkname cell cll colm csht exc_data fcol fdata
	     fname ftype itm lastcell lastrow nwb pfset row sht)

  
(setq pfset(vla-get-pickfirstselectionset (vla-get-activedocument (vlax-get-acad-object))))
  
(vla-clear pfset)
  
(setq blkname "KEY-ITEM")
  
(if (not (tblsearch "block" blkname))(progn
  (alert "Block does not exsit.\nProgram exiting.")
  (exit)(princ)))
  
  (setq ftype (list 0 2 410)
	fdata (list "insert" (strcat "`*U*," 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)
	)
;;;select all named blocks in model
(vla-select pfset acselectionsetall nil nil ftype fdata)
(if (zerop(vla-get-count pfset))
 (progn
  (alert "Nothing selected.\nProgram exiting.")
  (exit)(princ))
  )
  
(vlax-for block_obj pfset

(setq exc_data (cons  (extract_blockset block_obj) exc_data))
  )
(setq exc_data (vl-sort exc_data '(lambda(a b)(< (cdar a))(cdar b))))
  
(setq exc_data (group-by-filter exc_data))

(setq exc_data  (group-by-qty exc_data))
  
    ;;		Eof acad part		;;

    ;;	***	Excel part	***	;;
    
;;; based on program written by  ALEJANDRO LEGUIZAMON -  http://arquingen.tripod.com.co  
;;; edited by FATTY T.O.H. aka fixo - (vl-list->string (list 102 97 116 116 121 104 97 108 108 101 120 64 103 109 97 105 108 46 99 111 109))


    ;; reserve an Excel file copy before you ran programm:
    (setq fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))  ".xls"))
    (if (not (findfile fname))
      (create_datafile fname))
   
    ;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<;;
    
    ;; 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)
  
    (vlax-put-property aexc 'DisplayAlerts :vlax-false)
;;;      ;; Find the last cell :
;;;
;;;      ;; Invoke SpecialCells method:
;;;      (setq lastCell (vlax-invoke-method cll
;;;		       'SpecialCells
;;;		       (vlax-make-variant 11 3))
;;;	    )
;;;      (vlax-invoke-method lastCell 'Activate)
;;;      (setq lastRow (vlax-get-property
;;;		       lastCell 'Row))
;;;;;;      (setq lastColumn (vlax-get-property lastCell "Column"));->> if you need it
;;;        (setq row (1+ lastRow));-->get the next row after

(setq row 3)
  (foreach line exc_data
  
  (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) 8))
    (setq colm (1+ colm))
    )
 (setq row  (1+ row))	 
  )
    
   (setq fcol (vlax-get-property csht 'Range "A:A"))
   (vlax-put-property fcol 'NumberFormat "@")
   (setq fcol (vlax-get-property csht 'Range "B:B"))
   (vlax-put-property fcol 'NumberFormat "#0")

   (vlax-invoke (vlax-get-property csht 'Columns) 'AutoFit)
    

  (vlax-invoke-method
    nwb
    'SaveAs 
    (strcat (getvar "dwgprefix")
	    (vl-string-right-trim ".dwg" (getvar "dwgname")) ".xls"
    )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
  )

  (vlax-put-property
    nwb 'Saved :vlax-true)
  (vlax-invoke-method
    nwb 'Close )
  (vlax-invoke-method
    aexc 'Quit)
(mapcar (function (lambda(item)
		    (vl-catch-all-apply (function (lambda()
			(progn
			(vlax-release-object item)
			(setq item nil)))))))
	    (list  cll fcol csht sht nwb awb aexc)
	)

  (gc)
  (gc)
  (gc)

  (princ)
    )
(prompt "\n\t\t***\tStart command with QTY...\t***")
(prin1)

~'J'~

[steveo]

Here you go
This program will work just for current drawing

;; helper functions
(defun create_datafile ( / aexc awb cell cll cls colm headers row sht shts wbks)
;;; based on program written by  ALEJANDRO LEGUIZAMON -  http://arquingen.tripod.com.co  
;;; edited by FATTY T.O.H. aka fixo - (vl-list->string (list 102 97 116 116 121 104 97 108 108 101 120 64 103 109 97 105 108 46 99 111 109))
  (or (vl-load-com))
 
  (setq aexc    (vlax-get-or-create-object "Excel.Application")
 wbks  (vlax-get-property aexc 'Workbooks)
 awb    (vlax-invoke-method wbks 'Add)
 shts (vlax-get-property awb 'Sheets)
 sht    (vlax-get-property shts 'Item 1)
 cls    (vlax-get-property sht 'Cells)
  )
 
  (vla-put-visible aexc :vlax-false)
  (setq row 1
 colm 1)
(setq cell (variant-value (vlax-get-property cls 'item row colm)))
  (vlax-put-property  cell 'value2 (vlax-make-variant (getvar "dwgname") 8))
 
  (setq headers (list "UNIT" "QUANTITY")
  row  (1+ row)
  colm 1
  )
 
  (foreach header headers
  (setq cell (variant-value (vlax-get-property cls 'item row colm)))
 
    (vlax-put-property  cell 'value2 (vlax-make-variant header 8))
    (setq colm (1+ colm))
    )
 
  (vlax-invoke-method
    awb
    'SaveAs 
    (strcat (getvar "dwgprefix")
     (vl-string-right-trim ".dwg" (getvar "dwgname")) ".xls"
    )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
  )
  (vlax-put-property
    awb 'Saved :vlax-true)
  (vlax-invoke-method
    awb 'Close )
  (vlax-invoke-method
    aexc 'Quit)
  (mapcar (function (lambda(item)
      (vl-catch-all-apply (function (lambda()
   (progn
   (vlax-release-object item)
   (setq item nil)))))))
     (list  cls sht shts awb wbks aexc)
   )
  (gc)
  (gc)
  (gc)
  (vl-cmdf "_delay" 500)
  (princ)
);_eof create_datafile
;;; debug (create_datafile)
;;====================================================
(defun group-by-filter  (lst )
  (if (caar lst)
    (cons (vl-remove-if-not
     (function (lambda (x)
   (and(eq (cdar x) (cdaar lst))
   (eq(caadr x)(car (cadr (car lst))))
   )
   ))
        lst)
   (group-by-filter
     (vl-remove-if
       (function (lambda (x)
     (and(eq (cdar x) (cdaar lst))
   (eq(caadr x)(car (cadr (car lst))))
   )
     ))
       lst)
     )
   )
    )
  )
;;====================================================
(defun group-by-qty  (lst / item out_data qty record x)
  (while (setq item (car lst))
    (setq record (car item))
    (setq qty (apply '+
       (mapcar 'atof
        (mapcar 'cdr (mapcar '(lambda (x) (cadr x)) item)))))
    (setq record (subst (cons (caadr record) (rtos qty 2 0))
   (cadr record)
   record))
    (setq out_data (cons record out_data))
    (setq lst (cdr lst)))
  (reverse out_data)
  )
;;====================================================
(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)))
      )
    )
  )
 
;;;(extract_blockset (setq obj (vlax-ename->vla-object (car (entsel)))))
 ;; (setq exc_data nil)***********************
;;temp((caar (
;;       (cdaar exc_data)   (cdar (car exc_data))
;;         (car (cadr (car exc_data)))  (caadr (car exc_data)))
;;;(group-by-filter exc_data)****************
 
(vl-load-com)
(defun C:QTY(/ aexc awb blkname cell cll colm csht exc_data fcol fdata
      fname ftype itm lastcell lastrow nwb pfset row sht)
 
(setq pfset(vla-get-pickfirstselectionset (vla-get-activedocument (vlax-get-acad-object))))
 
(vla-clear pfset)
 
(setq blkname "KEY-ITEM")
 
(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)
(vla-selectonscreen pfset ;|acselectionsetall nil nil|; ftype fdata)
(if (zerop(vla-get-count pfset))
 (progn
  (alert "Nothing selected.\nProgram exiting.")
  (exit)(princ))
  )
 
(vlax-for block_obj pfset
(setq exc_data (cons  (extract_blockset block_obj) exc_data))
  )
(setq exc_data (vl-sort exc_data '(lambda(a b)(< (cdar a))(cdar b))))
 
(setq exc_data (group-by-filter exc_data))
(setq exc_data  (group-by-qty exc_data))
 
    ;;  Eof acad part  ;;
    ;; *** Excel part *** ;;
 
;;; based on program written by  ALEJANDRO LEGUIZAMON -  http://arquingen.tripod.com.co  
;;; edited by FATTY T.O.H. aka fixo - (vl-list->string (list 102 97 116 116 121 104 97 108 108 101 120 64 103 109 97 105 108 46 99 111 109))
 
    ;; reserve an Excel file copy before you ran programm:
    (setq fname (strcat (getvar "dwgprefix")(vl-filename-base (getvar "dwgname"))  ".xls"))
    (if (not (findfile fname))
      (create_datafile fname))
 
    ;; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<;;
 
    ;; 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)
 
    (vlax-put-property aexc 'DisplayAlerts :vlax-false)
;;;      ;; Find the last cell :
;;;
;;;      ;; Invoke SpecialCells method:
;;;      (setq lastCell (vlax-invoke-method cll
;;;         'SpecialCells
;;;         (vlax-make-variant 11 3))
;;;     )
;;;      (vlax-invoke-method lastCell 'Activate)
;;;      (setq lastRow (vlax-get-property
;;;         lastCell 'Row))
;;;;;;      (setq lastColumn (vlax-get-property lastCell "Column"));->> if you need it
;;;        (setq row (1+ lastRow));-->get the next row after
(setq row 3)
  (foreach line exc_data
 
  (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) 8))
    (setq colm (1+ colm))
    )
 (setq row  (1+ row))  
  )
 
   (setq fcol (vlax-get-property csht 'Range "A:A"))
   (vlax-put-property fcol 'NumberFormat "@")
   (setq fcol (vlax-get-property csht 'Range "B:B"))
   (vlax-put-property fcol 'NumberFormat "#0")
   (vlax-invoke (vlax-get-property csht 'Columns) 'AutoFit)
 
  (vlax-invoke-method
    nwb
    'SaveAs 
    (strcat (getvar "dwgprefix")
     (vl-string-right-trim ".dwg" (getvar "dwgname")) ".xls"
    )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
  )
  (vlax-put-property
    nwb 'Saved :vlax-true)
  (vlax-invoke-method
    nwb 'Close )
  (vlax-invoke-method
    aexc 'Quit)
(mapcar (function (lambda(item)
      (vl-catch-all-apply (function (lambda()
   (progn
   (vlax-release-object item)
   (setq item nil)))))))
     (list  cll fcol csht sht nwb awb aexc)
 )
  (gc)
  (gc)
  (gc)
  (princ)
    )
(princ "\n\t\t***\tStart command with QTY...\t***")
(princ)

~'J'~

Dear fixo:
Why does program ask user to select objects when the block name is already set in the program (key-item).
If I try to select all, program responds with pop down dialog saying none found and program exiting ??
Does this make sense to you ? thank you for trying to help, it is appreciated so far. Did the QTY lisp work on my drawing at your testing ?
regards, Steveo

[fixo]

Wait a few minutes

[fixo]

Steveo

Try edited code from post#12

[steveo]

Try edited code from post#12

Program still does not select anything and is indicated by the popdown stating such. Why does it still fail ?
regards, Steveo

[fixo]

Program still does not select anything and is indicated by the popdown stating such. Why does it still fail ?
regards, Steveo

Check for file [drawingname] .xls in the same folder after this program was executed.
I've used your "T-Rake.dwg" from attachments and file "t-rake.xls" was created
succesfully, I don't know why this code isn't working on your machine.

~'J'~

[steveo]

Fixo, thanks for all your help
kind regards,
Steveo

[fixo]

Fixo, thanks for all your help
kind regards,
Steveo

You're welcome
Cheers

~'J'~

[adnhmz593474]

Mr. Fixo good day with my respects,
i am quantity surveyor . i am going to calculate steel types with spaces using filter command selection ..so i need help from you (with thanking) to show the way that i must arrange the boolean functions to do this : selecting all the texts (regardless of its layers or attributes) that containing some value such as 200 and its colour is green this is first condition the second condition (AND) all texts containing 2 parameter (1. its value is T20 , 2. its other value is L=400) ..please how can i do that in the FILTER command..very thanks.