Code Lisp about Insert a Block in a Table Cell

[Tue_NV]

Hi all!

I' ve a table. I want insert a Block in a Table Cell but I don't know to build this code?

Could you help me to solve this problem?

Thank you so much.

[fixo]

Hi all!

I' ve a table. I want insert a Block in a Table Cell but I don't know to build this code?

Could you help me to solve this problem?

Thank you so much.

 

See if this helps

(defun make-tablestyle ( name desc txtstyle h1 h2 h3 / tblstyle adoc)
 (or (vl-load-com))
 (setq 
   tblstyle (vla-addobject 
     (vla-item (vla-get-dictionaries 
            (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
            ) 
          "Acad_Tablestyle" 
          ) 
     name 
     "AcDbTableStyle" 
     ) 
   )
 (setq acmCol (vla-getinterfaceobject
       (vlax-get-acad-object)
       (strcat "AutoCAD.AcCmColor."
        (substr (getvar "ACADVER") 1 2))))  
 (vla-put-name tblstyle name)

 (vla-put-headersuppressed tblstyle :vlax-false) 
 (vla-put-titlesuppressed tblstyle :vlax-false)
 (vla-put-description tblstyle desc) 
 (vla-put-flowdirection tblstyle 0)
 (vla-put-bitflags tblstyle 1)
 (vla-put-horzcellmargin tblstyle (/ h3 5))  
 (vla-put-vertcellmargin tblstyle (/ h3 5))
 (vla-settextstyle tblstyle 7 txtstyle)
;;;  (vla-settextstyle tblstyle 4 txtstyle)
;;;  (vla-settextstyle tblstyle 1 txtstyle)
 (vla-settextheight tblstyle 1 h3)  
 (vla-settextheight tblstyle 4 h2) 
 (vla-settextheight tblstyle 2 h1) 
 (vla-setrgb acmCol 204 102 0)
;;;  (vla-put-colorindex acmCol 32) 
 (vla-setgridcolor tblstyle 63 7 acmCol)

 (vla-setgridvisibility tblstyle 63 7 :vlax-true) 
 (vla-setgridlineweight  tblstyle 18 7 aclnwt009) 
 (vla-setgridlineweight tblstyle 45 7 aclnwt050) 
 (vlax-release-object acmCol)
 )

;=========== * prepared part for block table creation * ===========;
(defun C:BTT (/ acmcol acsp adoc objtable axss blkid cnt col
      columns desc desc_wid headers i lst_count
      lst_name nm row rows ss table_data total tmp)
 (if (< (atof (getvar "ACADVER")) 16.0)
 (alert "This routine will work\nfor versions A2005 and higher")
 (progn
 (alert "\tBe patience\n\tWorks slowly")
 (vl-load-com) 
 (or adoc
   (setq adoc (vla-get-activedocument
 (vlax-get-acad-object))))
 (or acsp (setq acsp (if (= (getvar "TILEMODE") 0)
 (vla-get-paperspace
 adoc)
 (vla-get-modelspace
 adoc))
 )
 )
 (make-tablestyle "Block-Count" "Symbol table" "Standard" 10.0 10.0 12.0)
 (setq acmCol (vla-getinterfaceobject
       (vlax-get-acad-object)
       (strcat "AutoCAD.AcCmColor."
        (substr (getvar "ACADVER") 1 2))))
 (setq dht (getvar "dimtxt"))
 (setq ss (ssget "_X" '((0 . "INSERT"))))
 (setq total (itoa (sslength ss)))
 (setq axss (vla-get-activeselectionset adoc))
 (vlax-for a axss
   (setq nm (vlax-get a 'Name)) 
   (setq lst_name
(cons nm lst_name))    
   (if (not (member nm lst_count))
     (setq lst_count (cons nm lst_count))))
 (foreach i lst_count
   (setq tmp (length (vl-remove-if-not (function (lambda (x)(eq x i))) lst_name))
  desc (cdr (assoc 4 (entget (tblobjname "BLOCK" i))))
  tmp (list i tmp (if (not desc) "No description for this symbol" desc) "")
  table_data (cons tmp table_data)))
(setq desc_wid (* (getvar "dimtxt")(apply 'max (mapcar 'strlen (mapcar 'caddr table_data)))))
(setq columns  (length (car table_data)) 
rows  (length table_data) 
 )
(setq objtable (vlax-invoke
  acsp
  'Addtable
  (getpoint "\nUpper left table insertion point: \n")
  (+ 3 rows)
  columns
  ;; rows height (change by suit):
  (* dht 1.667);28
  ;; columns width (change by suit):
  (* dht 8.333);50
       )
 )
 (vla-put-regeneratetablesuppressed objtable :vlax-true)
 (vla-put-layer objtable "0")
 (vla-put-titlesuppressed objtable :vlax-false)
 (vla-put-headersuppressed objtable :vlax-false)
 (vla-put-horzcellmargin objtable (* dht 0.5))
 (vla-put-vertcellmargin objtable (* dht 0.5))

 (vla-settextstyle objtable 2 "Standard")
 (vla-settextstyle objtable 4 "Standard")
 (vla-settextstyle objtable 1 "Standard")

 (vla-setrowheight objtable 2 (* dht 1.5))
 (vla-setrowheight objtable 4 (* dht 1.25))
 (vla-setrowheight objtable 1 (* dht 1.25))

 (vla-settextheight objtable 2 (* dht 1.25))
 (vla-settextheight objtable 4 dht)
 (vla-settextheight objtable 1 dht)

 (vla-put-colorindex acmcol 256)
 (vla-put-truecolor objtable acmcol)

 (vla-setcolumnwidth objtable 0 (* dht 10))
 (vla-setcolumnwidth objtable 1 (* dht 5))
 (vla-setcolumnwidth objtable 2 desc_wid)
 (vla-setcolumnwidth objtable 3 (* dht 12))

 (vla-put-colorindex acmcol 2)
 (vla-settext objtable 0 0 "SYMBOL LIST") ;(change by suit)
 (vla-setcelltextheight objtable 0 0 (* dht 1.5))
 (vla-setcellcontentcolor objtable 0 0 acmcol)
 (vla-put-colorindex acmcol 102)
 (setq headers '("SYMBOL" "QTY" "EQUIPMENT DESCRIPTION" "REMARKS");(change by suit)
 )

 (setq col 0
row 1
 )
 (foreach a headers
   (vla-settext objtable row col a)
   (vla-setcelltextheight objtable row col (* dht 1.25))
   (vla-setcellcontentcolor objtable row col acmcol)
   (setq col (1+ col))
 )
(vla-put-colorindex acmcol 40)  
(setq lst_count (acad_strlsort (mapcar 'car table_data)) row 2 col 0)

(foreach i lst_count
(setq blkID (vla-get-objectid (vla-item (vla-get-blocks adoc) i)))
(vla-setblocktablerecordid objtable row col blkID :vlax-true)
(vla-setblockscale objtable row col 0.75)
 (vla-setcellalignment objtable row col acMiddlecenter)
 (vla-setcellcontentcolor objtable row col acmcol)
 (setq row (1+ row)))
 (setq cnt 1 row 2)
 (foreach i (mapcar 'cdr table_data)
 (setq col 1)
 (foreach a i
   (vla-settext objtable row col a)
   (if (/= col 1)
   (vla-setcellalignment objtable row col acMiddleLeft)
   (vla-setcellalignment objtable row col acMiddleCenter))
   (vla-setcellcontentcolor objtable row col acmcol)
   (setq col (1+ col)))
   (setq row (1+ row))
   )
 (vla-put-colorindex acmcol 12)
 (vla-settext objtable row 2 "Total:")
 (vla-setcellalignment objtable row 0 acMiddleLeft)
 (vla-setcellcontentcolor objtable row 0 acmcol)

 (vla-settext objtable row 3 total)
;;;    (itoa (apply 'max (mapcar 'cadr table_data))))
 (vla-setcellalignment objtable row 1 acMiddleCenter
)
 (vla-setcellcontentcolor objtable row 1 acmcol)
 (vla-put-regeneratetablesuppressed objtable :vlax-false)
 (vl-catch-all-apply
   (function
     (lambda ()
(progn
  (vla-clear axss)
  (vla-delete axss)
  (mapcar 'vlax-release-object (list axss objtable))
  )
)
     )
   )
 (vla-regen adoc acactiveviewport)
 (alert "Done")
 )
   )
 (princ)
)
(prompt
 "\n\t\t\t   |-----------------------------|\n"
)
(prompt
 "\n\t\t\t  <|  Start with BTT to execute  |>\n"
)
(prompt
 "\n\t\t\t   |-----------------------------|\n"
)
(vl-load-com)

 

~'J'~

[Lee Mac]

Perhaps check this code.

[Costas]

Hi there,

 

I am using this lisp routine but I can't change the block scale.

Whatever value I put in the place of 0.75, (vla-setblockscale objtable row col 0.75), the block has the same size.

 

Can you help ?

Costas