transfer blocks to excel

[z_ayri788300]

I tried to organize a lisp which you sent me from link so far . it didn't run. I have turned my lisp again. I send my lisp. Maybe you can add the my request.

Thank you for help
block count excel.LSP

[pbejse]

I see that its fixo's [fatty] code. I'm pretty sure he'll take a crack at the code for you

[fixo]

Upload in attachment your sample drawing with few blocks,
make sure that every block has description,
I will try to help

~'J'~

[z_ayri788300]

Hi I send the sample drawing. Thanks any help.
TEST.dwg

[fixo]

Could not convert your drawing on 2007 version
It has unresolved .bmp file embedded, so you have to
convert this drawing on 2007th but remove the images before,
I will be back later

[z_ayri788300]

I converted it. I will wait your back.
TEST1.dwg

[fixo]

Try this one slightly edited, I can't upload the code as lsp file
by reson of my browser is not support this option, so copy-paste
the whole code and save it with appropriate name

;;From man to man

;; written by Fatty 2005 All rights removed

;; helper function

;; group list into separate sublists

  (defun group-by-first (lst / ret tmp)
  (while (car lst)
  (setq tmp (list (vl-remove-if-not (function (lambda (a)
			(eq a (car lst )))) lst)))
  (setq ret (cons (car tmp) ret))
  (setq lst (vl-remove-if (function (lambda (a)
			(eq a (car lst )))) lst))
  (setq tmp nil))
  (setq ret (mapcar (function (lambda (x)
		(list (car x) (length x)))) (reverse ret)))
    )

;; *** Main program *** ;;

(defun C:BCEX  (/  acsp adoc aexc all_data awb blk_lst bname bnm brds cll clls colm cols com_lst csht data
		data_list datum en filt fnt header_list i intr nwb rang row scol sht srow ss)

  (vl-load-com)
  (setq	adoc (vla-get-activedocument
	       (vlax-get-acad-object)
	       )
	acsp (vla-get-modelspace adoc)
	)
  (setq	blk_lst	nil
	data nil
	com_lst	nil)

  (setq	bname (getstring T
			 "\nEnter a block name (case-sensitive) <*> : \n")) ;press enter to count all blocks
  (if (eq bname "")
    (setq bname "*"))				  ;change to default block name

  (setq	filt (list (cons 0 "INSERT")
		   (cons 2 bname)
		   (cons 410 (getvar 'ctab))))
  (if

    (setq ss (ssget "_X" filt))
     (progn
       (setq i -1)
       (repeat (sslength ss)
	 (setq en (ssname ss (setq i (1+ i))))

	 (setq bnm (vla-get-effectivename (vlax-ename->vla-object en)))
	 (setq blk_lst (cons bnm blk_lst))
	 )
       (setq com_lst (group-by-first blk_lst))

       (vlax-for blkdef	 (vla-get-blocks adoc)
	 (foreach record  com_lst
	   (if (eq (vla-get-name blkdef) (car record))
	     (setq com_lst (subst (append record (list (vla-get-comments blkdef)))
				  record
				  com_lst)))
	   )
	 )

       (setq data     (append
			(append (list (list "Layout" (getvar 'ctab))) com_lst))
	     data     (append data (list (list "Subtotal : " (length blk_lst))))
	     all_data (cons data all_data)
	     blk_lst  nil
	     com_lst  nil
	     data     nil)
       )
     )
;;;  )
  (setq all_data (apply 'append (reverse all_data)))

  ;;=================header text ====================================;;

  (setq header_list '("Name" "Quantity" "Description") cols (length header_list))
  (setq data_list all_data)
  ;; *** Excel part *** ;;

  (setq	aexc (vlax-get-or-create-object "Excel.Application")
	awb  (vlax-get-property aexc "Workbooks")
	nwb  (vlax-invoke-method awb "Add")
	sht  (vlax-get-property nwb "Sheets")
	csht (vlax-get-property sht "Item" 1)
	cll  (vlax-get-property csht "Cells")
	)
  (vlax-put-property csht 'Name "BlockCountInfo")
  (vla-put-visible aexc :vlax-true)
  (setq	row 1
	colm 1
	)
  (vlax-put-property
    cll
    "Item"
    row
    colm
    (vl-princ-to-string "Block Count Info")
    )

  (setq	row  (1+ row)
	colm 1
	)


  (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)
	  )
    )
  ;;	merge header cells :


  (setq	srow "A1"
	scol (strcat (chr (1- (+ (ascii "A") cols)))
		     "1"))
  (vlax-invoke-method csht "Activate")
  (setq	rang (vlax-get-property
	       aexc
	       'Range
	       (vlax-make-variant srow)
	       (vlax-make-variant scol)))
  (vlax-invoke-method rang "Activate")
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property
	rang
	"Cells"
	)
      "Columns"
      )
    "Merge"
    )
;;;	center alignment of header text :
  (vlax-put-property
    rang
    'Horizontalalignment
    (vlax-make-variant 3))
  ;;==============================change font=========================;;

  (setq fnt (vlax-get-property rang "Font"))
  (vlax-put-property fnt "Bold" (vlax-make-variant 1))
  (vlax-put-property fnt "Size" (vlax-make-variant 12))

  ;;	fill cells :
  (setq	row  (1+ row)
	colm 1
	)
  (repeat (length data_list)
    (setq datum (car data_list))
    (repeat (length datum)
      (vlax-put-property
	cll
	"Item"
	row
	colm
	(vl-princ-to-string (car datum))
	)
      (setq datum (cdr datum))
      (setq colm (1+ colm)))

    (setq colm 1
	  row  (1+ row))

    (setq data_list (cdr data_list))
    )
  ;;=============================draw borders=========================;;

  (setq rang (vlax-get-property csht 'UsedRange))
  (vlax-invoke-method rang "Activate")

  (setq	clls
	 (vlax-get-property
	   rang
	   "Cells"
	   ))
  (setq	brds
	 (vlax-get-property
	   clls
	   "Borders"
	   ))
  (vlax-put-property brds "Linestyle" (vlax-make-variant 1))

  ;;==============================change font=========================;;

  (setq fnt (vlax-get-property rang "Font"))
  (vlax-put-property fnt "Italic" (vlax-make-variant 1))
  (vlax-put-property fnt "Size" (vlax-make-variant 10))
  (setq rang (vlax-get-property csht 'UsedRange))
  (vlax-invoke-method
    (vlax-get-property
      (vlax-get-property
	rang
	"Cells"
	)
      "Columns"
      )
    "Autofit"
    )

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

  ;; automatically saving an Excel file :

  (vlax-invoke-method
    nwb
    'SaveAs
    (strcat (getvar "dwgprefix")
	    (strcat "COUNT-"
		    (vl-string-right-trim ".dwg" (getvar "dwgname")))
	    )
    -4143
    nil
    nil
    :vlax-false
    :vlax-false
    1
    2
    )
  (vlax-release-object cll)
  (vlax-release-object rang)
  (vlax-release-object csht)
  (vlax-release-object sht)
  (vlax-release-object nwb)
  (vlax-release-object awb)
  (vlax-release-object aexc)
  (setq aexc nil)
  (gc)
  (gc)
  (princ)
  )
(prompt "\n\t\t***\tBlock count info to Excel program is loaded\t***\n")
(prompt "\n\t\t***\tType BCEX to execute\t***\n")
(princ)

[z_ayri788300]

thank you so much, İt is very useful

[fixo]

Glad to help
Cheers