Inserting blocks in table cells using LISP

[costas.vassiliou]

Hi everybody,

In our company, we use ACAD 2007. We have a master file with all the aluminium profiles we have in blocks.

Those blocks are not shown in model space.

So I wrote a LISP routine that gets all the blocks, one by one, and inserts them in model space.

Now I want to revise my method and use lisp to make a table and insert the blocks in table cells instead directly to model space..

I created the table using lisp but I do not know how to access and then move from cell to cell and how to 'insert block' in each cell!

Any help will be appreciated ......thanks !

[fixo]

Hi
Give this a shot
Change the table options to your suit

(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 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 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
    (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"
)
; TesT : (C:BTT)

~'J'~

[peter]

Here is a portion of code from my LISP Table Magic course I taught last year at Autodesk University. The course is downloadable and will do what you want listed above. If you do a search on this forum for LISP Table magic I think I posted the code here too.

The function listed below with the errortrap will convert a column in a table with block names in it, into symbols.

Peter

(defun AU06:ConvertBlockNameToSymbol (objTable       ; Object Table
                                      intNumColumn   ; Integer Column Index
                                      / 
                                      intNumRow      ; Integer Row Index
                                      intObjectID    ; Integer Block Definition Object ID
                                      strBlockName)  ; String Block Name
 (repeat (- (setq intNumRow (vla-get-rows objTable)) 2)
  (setq intNumRow   (1- intNumRow ))
  (and 
   (AU06:Errortrap (quote (setq strBlockName (vla-getText objTable intNumRow intNumColumn))))
   (AU06:Errortrap (quote (setq intObjectID (vla-get-objectID 
                                             (vla-item 
                                              (vla-get-blocks
                                               (vla-get-activedocument
                                                (vlax-get-acad-object)))
                                              strBlockName)))))                   
   (AU06:Errortrap
    (quote (vla-setcelltype objTable intNumRow intNumColumn acBlockCell)))
   (AU06:Errortrap
    (quote (vla-setblocktablerecordID objTable intNumRow intNumColumn intObjectID :vlax-true)))
   (AU06:Errortrap
    (quote (vla-SetCellAlignment objTable intNumRow intNumColumn acMiddleCenter))))))
;****************************************************************************************************
(defun AU06:ErrorTrap (symFunction ; Symbol (lisp expr. wrapped in a quote expression)
                       / 
                       objError    ; Object Error test
                       result)     ; Result of wrapped lisp expression.
 (if (vl-catch-all-error-p
      (setq objError (vl-catch-all-apply
                     '(lambda (X)(set X (eval symFunction)))
                      (list 'result)))) 
  nil  
  (if result result 'T)
 )
)

[costas.vassiliou]

Thanks for your response.
I will try it.
Once more thank you a lot !

[costas.vassiliou]

Good morning Peter,

Appreciate your response.
I will try it hopping to achive my goal,

Have a nice day ....Costas

[costas.vassiliou]

Hi there,

I get a '; error: too few arguments' error
at run time. Can you help ?

Costas

Hi
Give this a shot
Change the table options to your suit

(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 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 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
    (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"
)
; TesT : (C:BTT)

~'J'~

[fixo]

What the line generated this error?
Launch this routine from editor with
command (C:BTT)
You'll see this bad line of code

~'J'~

[costas.vassiliou]

When I load from editor (c:btt) I get the following
; 5 forms loaded from #<editor "F:/Lisp/make-tablestyle.LSP">
_$ c:btt
#<USUBR @109c3cf8 C:BTT>

No line numbers !
am I missing something ?

[CAB2k]

You need to include the parenthesise when in VLIDE.
Use (c:btt) and not c:btt

[costas.vassiliou]

Good morning,

Thanks a lot, it works !
This function reads the blocks that shown in model space.

In our case we have the blocks in the drawing
but are NOT shown in model space, If you understand what I mean.
So manually we have to use the insert command and insert one by one
the blocks in table cells.

Is it easy to modify the function to read all the blocks in drawing ? (actually no blocks are shown in model space, in our case )

Appreciate your help.