troggarf Posted January 12, 2011 Posted January 12, 2011 So I have tried Lee-Mac's 2 block counters. I don't want another Block counter. I do however want to understand how to modify this Block Counter that I found. I don't remember where I found it (it could have been from here @ cADTutor). I made a change in some of the table heading from Vietnamese to English. However, I want to know how to delete a column (maybe 2). And add a total option that gives a total of all of the blocks. I don't want another block counter because I like how this one asks for the text height and allows for a selection set by either picking individual blocks or by a window (I have no need for a global block counter). I would like to get rid of the column "Don vi" and possibly the first column. I have tried commenting out ( some lines but that doesn't seem to work. Thanks for any help ;; free lisp from cadviet.com ;; Altered by Greg Battin 1/10/2011 for english use (defun c:BlkQty (/ blk_id blk_len blk_name blks ent h header_lsp height i j len0 lst_blk msp pt row ss str tblobj width width1 width2 x y) ;; By : Gia Bach, gia_bach @ www.CadViet.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))) ;main (if (setq ss (ssget (list (cons 0 "INSERT")))) (progn (vl-load-com) (setq i -1 len0 (while (setq ent (ssname ss (setq i (1+ i)))) (setq blk_name (cdr (assoc 2 (entget ent)))) (if (> (setq blk_len (strlen blk_name)) len0) (setq str blk_name len0 blk_len) ) (if (not (assoc blk_name lst_blk)) (setq lst_blk (cons (cons blk_name 1) lst_blk)) (setq lst_blk (subst (cons blk_name (1+ (cdr (assoc blk_name lst_blk)))) (assoc blk_name lst_blk) lst_blk))) ) (setq lst_blk (vl-sort lst_blk '(lambda (x y) (< (car x) (car y)) ) )) (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 width1 (* 4 (TxtWidth " " h msp)) width (* 2 (TxtWidth "Text Height" h msp)) height (* 2 h)) (if str (setq width2 (* 1.5 (TxtWidth (strcase str) h msp))) (setq width2 width)) (if (> h 3) (setq width (* (fix (/ width 10))10) width1 (* (fix (/ width1 10))10) width2 (* (fix (/ width2 10))10) height (* (fix (/ height 5))5))) (GetOrCreateTableStyle "CadEng") (setq pt (getpoint "\nPlace Table :") TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 2) 5 height width)) (vla-put-regeneratetablesuppressed TblObj :vlax-true) (vla-SetColumnWidth TblObj 0 width1) (vla-SetColumnWidth TblObj 1 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)) (vla-MergeCells TblObj 0 0 0 4) (vla-setText TblObj 0 0 "Block Count Table") (setq j -1 header_lsp (list " " "Block Name" "Don vi" "Quantity" "Preview")) (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) (mapcar '(lambda (x)(vla-setText TblObj row (setq j (1+ j)) x)) (list i blk_name "cai" (cdr pt))) (vla-SetBlockTableRecordId TblObj row 4 (GetObjectID (vla-item blks blk_name)) :vlax-true) (vla-SetCellAlignment TblObj row 1 7) (vla-SetCellAlignment TblObj row 3 9) (setq row (1+ row) i (1+ i)) ) (vla-put-regeneratetablesuppressed TblObj :vlax-false) (vlax-release-object TblObj) ) ) (princ)) Quote
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.