Jump to content

Lisp Problem Block Preview in Table - Bloc COUNT


mihaibantas

Recommended Posts

Hi to all,

 

I have a problem with a code found on the internet (the code make a similar job lisp BLOCK COUNTER ).

 

Lisp works fine with simple blocks...but when you select blocks with attributes in the column preview section, the selected block with attribute does not show the values entered when the block was inserted.

Above does not even show the real name of the initial block.

 

Below you have a dwg file with my blocks but also the Lisp code.

 

(defun c:BlkQty (/ blk_id blk_len blk_name blks ent h header_lsp height i j TOTAL
       len0 lst_blk msp pt row ss str tblobj width width1 width2 x y
)
;;  By : Gia Bach, gia_bach @  www.CadViet.com
;;
(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)))  
;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)) ) ))
     (SETQ TOTAL 0)
     (FOREACH I LST_BLK (SETQ TOTAL (+ TOTAL (CDR I))))
     (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 )8)
         width1 (* (fix (/ width1 )8)
         width2 (* (fix (/ width2 )8)
         height (* (fix (/ height 5))5)))
     (GetOrCreateTableStyle "CadEng")
     (setq pt (getpoint "\nPlace Table :")
       TblObj (vla-addtable msp (vlax-3d-point pt) (+ (length lst_blk) 3) 4 height width));CHANGE 5 TO 4
     (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 3);change 4 to 3
     (vla-setText TblObj 0 0 "CARTEA INDICATOARELOR RUTIERE")
     (setq j -1 header_lsp (list "NR. CRT." "DENUMIRE S.T.A.S. 1848-1/2011" "TOTAL INDICATOARE" "FIG. S.T.A.S. 1848-1/2011"));;;;;;;;;;;;;;;;;;;;;;REMOVE "DON VI"
     (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  (cdr pt)));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;REMOVE "CAI"
   (vla-SetBlockTableRecordId TblObj row 3 (GetObjectID (vla-item blks blk_name)) :vlax-true);CHANGE 4 TO 3
   (vla-SetCellAlignment TblObj row 1 7)
   (vla-SetCellAlignment TblObj row 2 9);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;CHANGE 3 TO 2
   (setq row (1+ row) i (1+ i))    )
       (VLA-SETTEXT TBLOBJ ROW 1 "TOTAL")
       (VLA-SETTEXT TBLOBJ ROW 2 TOTAL)
   (vla-SetCellAlignment TblObj row 1 7)
   (vla-SetCellAlignment TblObj row 2 9)
     (vla-put-regeneratetablesuppressed TblObj :vlax-false)
     (vlax-release-object TblObj) )  )
 (princ))

[ATTACH]62448[/ATTACH]

 

Have a nice day to all ...

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...