plecs Posted October 7, 2014 Share Posted October 7, 2014 Who can help me and me to export attributes in excel AutoCAD is Eport to excel. But my block by block have the same name but they are the same individual attrib and when I exported the model 50 block and 30 are identical but I export them separately if you do not have 2 block like the count to be attrib two are not each in different rows and I want to, if the attributes are identical to gather them and pass them to me on a single line and count to be eg 10 Below we have an example of a lisp that makes a table and I count them as block which attrib table but I get what I need but I need excel export all attributes but if I block with attributes identical to the count to be reads are the same block (defun c:partlist (/ *adoc *h* *util attlst blk_id blk_len blk_name blks desc en entlst h header_lsp horizmargin height i j total len0 lst_blk msp pt objtblsty partnum row ss str tblobj txtsty width width1 width2 x y) (vl-load-com) (defun txtwidth (val h msp / txt minp maxp) (setq txt (vla-addtext msp val (vlax-3d-point '(0 0 0)) h)) (vla-getboundingbox txt 'minp 'maxp) (vla-erase txt) (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp))) ) (defun getorcreatetablestyle (tbl_name / name namelst objtblsty objtblstydic tablst txtsty) (setq objtblstydic (vla-item (vla-get-dictionaries *adoc) "ACAD_TABLESTYLE")) (foreach itm (vlax-for itm objtblstydic (setq tablst (append tablst (list itm)))) (if (not (vl-catch-all-error-p (setq name (vl-catch-all-apply 'vla-get-name (list itm))))) (setq namelst (append namelst (list name))) ) ) (if (not (vl-position tbl_name namelst)) (vla-addobject objtblstydic tbl_name "AcDbTableStyle") ) (setq objtblsty (vla-item objtblstydic tbl_name) txtsty (variant-value (vla-getvariable *adoc "TextStyle")) ) (mapcar '(lambda (x) (vla-settextstyle objtblsty x txtsty)) (list actitlerow acheaderrow acdatarow)); (vla-setvariable *adoc "CTableStyle" tbl_name) ) (defun getobjectid (obj) (if (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")) (vlax-invoke-method *util 'getobjectidstring obj :vlax-false) (vla-get-objectid obj) ) ) (defun quantity (lst / item qty rtn) (while lst (setq item (car lst) qty 1 lst (cdr lst) ) (while (= (cadr item) (cadr (car lst))) (setq qty (1+ qty) lst (cdr lst) ) ) (setq rtn (cons (append item (list qty)) rtn)) ) (reverse rtn) ) (if (setq ss (ssget (list (cons 0 "INSERT")))) (progn (setq i -1 lst_blk nil) (while (setq en (ssname ss (setq i (1+ i)))) (setq entlst (entget en) blk_name (cdr (assoc 2 entlst)) attlst nil ) (while (/= (cdr (assoc 0 entlst)) "SEQEND") (if (= (cdr (assoc 0 entlst)) "ATTRIB") (setq attlst (cons (cdr (assoc 1 entlst)) attlst)) ) (setq entlst (entget (setq en (entnext en)))) ) (setq desc (car attlst) attlst (reverse (cdr attlst)) partnum (strcat (car attlst) " x " (cadr attlst) " - " (cadddr attlst)) lst_blk (cons (list blk_name partnum desc) lst_blk) ) ) (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (cadr x) (cadr y))))) ;; Here we need to remove duplicate and add qty to lst_blk (setq lst_blk (quantity lst_blk)) (or *h* (setq *h* (* (getvar "dimtxt") (getvar "dimscale")))) (initget 6) (setq h (getreal (strcat "\nText Height <" (rtos *h*) "> :"))) (if h (setq *h* h)(setq h *h*)) (or *adoc (setq *adoc (vla-get-activedocument (vlax-get-acad-object)))) (setq msp (vla-get-modelspace *adoc) *util (vla-get-utility *adoc) blks (vla-get-blocks *adoc) ) (setq horizmargin h width1 (+ horizmargin (txtwidth "NR. CRT." h msp) horizmargin) width2 (+ horizmargin (txtwidth (cadr (car lst_blk)) h msp) horizmargin) width (+ (* (+ width1 width2) 2) (* width2 1.5)) height (* 2 h) ) (getorcreatetablestyle "CadEng") (setq pt (getpoint "\nPlace Table :") tblobj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 4 height width) ) ;(vla-put-regeneratetablesuppressed tblobj :vlax-true) (vla-setcolumnwidth tblobj 0 width1) (vla-setcolumnwidth tblobj 1 (* width2 1.5)) (vla-setcolumnwidth tblobj 2 (/ width1 1.5)) (vla-setcolumnwidth tblobj 3 width1) ;(vla-setcolumnwidth tblobj 4 width2) (vla-put-vertcellmargin tblobj (* 0.75 h)) (vla-put-horzcellmargin tblobj (* 0.75 h)) (mapcar '(lambda (x) (vla-settextheight tblobj x h)) (list actitlerow acheaderrow acdatarow)) (mapcar '(lambda (x) (vla-setalignment tblobj x ) (list actitlerow acheaderrow acdatarow)) (setq j -1 header_lsp (list "NR. CRT." "LISTA PIESE" "BUC" "GROSIME" ) ) (repeat (length header_lsp) (vla-settext tblobj 1 (setq j (1+ j)) (nth j header_lsp)) ) (setq row 2 i 1) (foreach pt lst_blk (setq blk_name (car pt) j -1 ) (vla-settext tblobj row 0 i) ; ITEM NO. (vla-settext tblobj row 1 (cadr pt)) ; PART NUMBER (vla-settext tblobj row 2 (cadddr pt)) ; QTY (vla-settext tblobj row 3 (caddr pt)) ; DESCRIPTION ;(vla-setblocktablerecordid tblobj row 4 (getobjectid (vla-item blks blk_name)) :vlax-true) (vla-setcellalignment tblobj row 1 acmiddleright) (vla-setcellalignment tblobj row 1 acmiddleleft) (vla-setcellalignment tblobj row 2 acmiddleleft) (vla-setcellalignment tblobj row 3 acmiddleright) (vla-setcellalignment tblobj row 3 acmiddlecenter) (setq row (1+ row) i (1+ i)) ) (vla-deleterows tblobj 0 1) ;(vla-put-regeneratetablesuppressed tblobj :vlax-false) (vlax-release-object tblobj) ) ) (princ) ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.