Create a table by lisp

[juanragal]

Hi lispmasters!

 

I found and modificated this code for make a table from a list. Is very usefull, but when the list is very large the routine spends a lot of time creating it. with a list of 254 items, almost 4 minuts pass...

 

Maybe is for the last "while" ?

 

Thanks in advance

 

(defun tabla (TITULO LISTA POINT ALTTEXT / ActiveDocument mSpace pt
              myTable nRows nCols row cell altfilas filas columnas )
  (vl-load-com)
  (setq ActiveDocument (vla-get-activedocument
             (vlax-get-acad-object)))
  (setq mSpace(vla-get-modelspace ActiveDocument))
  
  
  (setq pt (vlax-make-safearray vlax-vbDouble
                                   '(0 . 2)))
  (SETQ FILAS (+ 1(LENGTH LISTA))
	cOLUMNAS (LENGTH (CAR LISTA))
	ALTFILAS (* ALTTEXT 1.2))
  
  ;insertion point for the table
  (vlax-safearray-fill pt POINT)
  (setq myTable
     (vla-addtable mSpace (vlax-3d-point point) filas columnas ALTFILAS (* 1.1 (anchotext 2 lista))))
  (vla-setcelltextheight myTable 0 0 ALTTEXT)
  (vla-settext myTable 0 0 TITULO)
 
  ;rows and columns zero based
  (setq nRows(- (vla-get-rows myTable) 1))
  (setq nCols(- (vla-get-columns myTable) 1))
   
  ; rows and columns after row 0, column 0
  (setq row 1)
  (setQ cell 0)
 
  ; loop through cells
  (while (<= row nRows)
    (while (<= cell nCols)
      (setq cont (car lista))
   (vla-setCelltextHeight myTable row cell ALTTEXT)
        (vla-settext myTable row cell (nth cell cont))
        ; make cell alignment middle center
        (vla-setCellAlignment myTable row cell 5 )    
   (setq cell (1+ cell))
   );while
  (setq row (1+ row))
    (setq lista (cdr lista))
  (setq cell 0) 
);while
(princ)
)

 

[Jonathan Handojo]

This is my version of List-To-Table. Some curtesy of mine to share my function that I use in my workplace

 

;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object
;; lst - list of lists where each list is a list of strings
;;	=> if you wish to insert a block in the cell, prefix using "<block>" followed by the block name
;;	=> e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (2 or 3 reals)
;; tblstyle - Table style to use


(defun JH:list-to-table (space lst pt tblstyle / i j lens ncols rows totlen txt vtable)
    (setq ncols (apply 'max (mapcar 'length lst))
	  vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
	  )
    (vla-put-RegenerateTableSuppressed vtable :vlax-true)
    (vla-put-StyleName vtable tblstyle)
    (repeat (setq i (length lst))
	(setq rows (nth (setq i (1- i)) lst))
	(vla-SetRowHeight vtable i (* 2 (vlax-invoke vtable 'GetCellTextHeight i 0)))
	(repeat (setq j (length rows))
	    (setq lens
		     (cons
			 (+
			     (abs
				 (apply '-
					(mapcar 'car
						(textbox
						    (list
							(cons 1 (setq txt (nth (setq j (1- j)) rows)))
							(cons 40 (vlax-invoke vtable 'GetCellTextHeight i j))
							(cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
							)
						    )
						)
					)
				 )
			     (vlax-invoke vtable 'GetCellTextHeight i j)
			     )
			 lens
			 )
		  )
	    (if (eq (strcase (substr txt 1 7)) "<BLOCK>")
		(progn
		    (setq blk (substr txt 8))
		    (if (and
			     (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
			     (vlax-method-applicable-p vtable 'setblocktablerecordid32)
			     )
			 (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)))
			 (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blk)) :vlax-true)
			 )
		    )
		(vla-SetText vtable i j txt)
		)
	    )
	(setq totlen (cons lens totlen) lens nil)
	)
    (repeat ncols
	(vla-SetColumnWidth vtable (setq ncols (1- ncols))
	    (apply 'max
		   (vl-remove nil
		       (mapcar
			   '(lambda (x)
				(nth ncols x)
				)
			   totlen
			   )
		       )
		   )
	    )
	)
    (vla-put-RegenerateTableSuppressed vtable :vlax-false)
    vtable
    )

 

[marko_ribar]

Also, try this version (look at ; commented line at the end of sub function - basically there are 2 versions of lists : one with title, headers and data and the other with just headers and data - you simply remove first title nesting ("TITLE" (...)) to just (...)...

 

Here is link :

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/table-editing/m-p/9336344/highlight/true#M396370

[juanragal]

Your help is amazing, for the quick of response and the quality of the solutions. 

 

Jonathan, I will try the code and keep authorship on my code if finally use it. If you think more of that is necessary, please tell me.

 

Marko_ribar. I undestand that you tell me. Ok. I will try it!

 

Thank you so much!

[Jonathan Handojo]

8 minutes ago, juanragal said:

Your help is amazing, for the quick of response and the quality of the solutions. 

 

Jonathan, I will try the code and keep authorship on my code if finally use it. If you think more of that is necessary, please tell me.

 

Marko_ribar. I undestand that you tell me. Ok. I will try it!

 

Thank you so much!

It's all good. You can use my function as you please. That what this forum is for.

 

P.S. The reason you're waiting 4 minutes is because:

 

- Any function that involves modifying cell content of the table will do so by opening the cell, modifying it, closing the cell, and finally regenerating the table. So in your case, the table is being regenerated 254 times, hence why you're waiting so long. That's what the vla-put-RegenerateTableSuppressed function is for.

 

- So you first disable the regeneration by setting this on the table to :vlax-true, do your iterations and put the texts into the table, and finally once done, you set it back to :vlax-false to fully display every cell. Key point being, you only need to regenerate the table once as opposed to 254 times... after you put all the texts in.

 

So it goes like:

 

(vla-put-RegenerateTableSuppressed tab :vlax-true)

(foreach x lst
    ;;; your codes to put all the texts
    )

(vla-put-RegenerateTableSuppressed tab :vlax-false)

 

[juanragal]

wow... definitly, you become right now my best friend of lisp users jonathan... Thank you very much...

[BIGAL]

Agree suppress is the way to go was doing tables like this size minutes became seconds, I used addrows not sure if faster than method posted. Add a row with height etc set.

Edited November 27, 2020 by BIGAL

[juanragal]

On 11/27/2020 at 4:40 AM, BIGAL said:

Agree suppress is the way to go was doing tables like this size minutes became seconds, I used addrows not sure if faster than method posted. Add a row with height etc set.

Thank you Bigal for your suggestions.

 

 

[barristann]

Jonathan, I'm still learning lisp. Could you please tell me what I'm doing wrong?

 

error: bad argument type: VLA-OBJECT nil

 

(defun c:tatest ()
(vl-load-com)

 

(setq Coords '((123 -50 10)
               (124 50 -13)
               (223 -150 120)
               (123 -1.50 -10)))

;
(setq pt1 (getpoint "\nSelect Insertion Point: "))

 

(JH:list-to-table ModelSpace Coords pt1 Standard)

)

[BIGAL]

It may be this (JH:list-to-table ModelSpace Coords pt1 "Standard") if you use Standard that is expected to be a variable that contains the table style name.

Edited November 29, 2023 by BIGAL

[barristann]

Thanks for replying, BIGAL. I'm still getting the same error message.

[barristann]

I have this message 

error: bad argument type: VLA-OBJECT "ModelSpace"

 

;;;;;;
(defun c:tatest ()
(vl-load-com)
;;;;;;

(setq Coords '((123 -50 10)
               (124 50 -13)
               (223 -150 120)
               (123 -1.50 -10)))

;;;;;;;;;;;

(setq space (strcat "ModelSpace"))
(setq pt1 (getpoint "\nSelect Insertion Point: "))

(JH:list-to-table space list1 pt1 "Standard")

)
 

[pkenewell]

@barristann

Take a little more time to understand what the arguments of the function mean and how to program in Visual LISP.  Note: "space" is a variable that holds the ActiveX object for AutoCAD's Model Space. You retrieve the working space with the following:

;; Retrieves the current active space you are working in, whether MSPACE or PSPACE
(setq doc (vla-get-activedocument (vlax-get-acad-object))
      space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
)

 

Try this after the JH:List-to-table function is loaded:

(defun c:tatest (/ coords space pt1) ; localize your variables
   (vl-load-com)

   ; must be a list of strings. first list is title, next list is header rows.
   (setq Coords '(("Table Title")
                  ("head1" "head2" "head3")
                  ("123"  "-50"  "10")
                  ("124"   "50"  "-13")
                  ("223" "-150"  "120")
                  ("123" "-1.50" "-10")
                 )
   )
   ;; Retrieves the current active space you are working in, whether MSPACE or PSPACE
   (setq doc (vla-get-activedocument (vlax-get-acad-object))
         space (if (> (getvar "CVPORT") 1)(vla-get-modelspace doc)(vla-get-paperspace doc))
   )
   ; don't run the function unless a point is acutally selected
   (if (setq pt1 (getpoint "\nSelect Insertion Point: "))
      (JH:list-to-table space coords pt1 "Standard")
   )
   ; exit quietly (no return value)
   (princ)
)

 

Edited November 29, 2023 by pkenewell

[barristann]

Brilliant pkenewell! It works! Thank you so much for the explanation, pkenewell!

[Jonathan Handojo]

Hi @barristann,

 

So sorry about the huge delay... I haven't been in this site for so long, so I'm grateful to those who resolved your issues first before I get a chance to come back.

 

I've made some improvements to the function while I was away, so here's the new one, with the following enhancements:

 

• List of lists can now take any data type (integers, reals, etc)
• Column width adjustment enhancement when blocks are inserted.

;; JH:list-to-table --> Jonathan Handojo
;; Creates a table from a list of lists of strings
;; space - ModelSpace or Paperspace vla object.
;; lst - list of lists where each list is a list of items to put into the table
;;      => Can be any data type: string, integer, real, etc.
;;      => if you wish to insert a block in the cell, specify the block name and prefix using "<block>"
;;      => e.x. if you want to insert the block "TestBlock1", input the string as "<block>TestBlock1"
;; pt - Insertion point of table (a list of 2 or 3 real numbers)
;; tblstyle - Table style to use, or nil to use the current table style
;;      => If table style does not exist, uses current table style


(defun JH:list-to-table (space lst pt tblstyle / blk blks hgt i j lens ncols rows totlen txt vtable)
    (setq ncols  (apply 'max (mapcar 'length lst))
          vtable (vla-AddTable space (vlax-3d-point pt) (length lst) ncols 10 10)
          blks (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
    )
    (vla-put-RegenerateTableSuppressed vtable :vlax-true)
    (or tblstyle (setq tblstyle (getvar "ctablestyle")))
    (if (JH:TableStyle-p tblstyle) (vla-put-StyleName vtable tblstyle))
    (repeat (setq i (length lst))
        (setq rows (nth (setq i (1- i)) lst))
        (vla-SetRowHeight vtable i (* 2.5 (vlax-invoke vtable 'GetCellTextHeight i 0)))
        (repeat (setq j (length rows))
            (setq 
                j (1- j)
                txt (vl-princ-to-string (nth j rows))
                hgt (vlax-invoke vtable 'GetCellTextHeight i j)
                lens
                (cons
                    (+
                        (abs
                            (apply '-
                                (mapcar 'car
                                    (textbox
                                        (list
                                            (cons 1 txt)
                                            (cons 40 hgt)
                                            (cons 7 (vlax-invoke vtable 'GetCellTextStyle i j))
                                        )
                                    )
                                )
                            )
                        )
                        hgt
                    )
                    lens
                )
            )
            (if
                (and
                    (eq (strcase (substr txt 1 7)) "<BLOCK>")
                    (tblsearch "block" (setq blk (substr txt 8)))
                )
                (progn
                    (if (and
                            (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
                            (vlax-method-applicable-p vtable 'setblocktablerecordid32)
                        )
                        (vla-SetBlockTableRecordId32 vtable i j (vla-get-ObjectID (vla-item blks blk)))
                        (vla-SetBlockTableRecordId vtable i j (vla-get-ObjectID (vla-item blks blk)) :vlax-true)
                    )
                    (setq lens (cons hgt (cdr lens)))
                )
                (vla-SetText vtable i j txt)
            )
        )
        (setq totlen (cons lens totlen) lens nil)
    )
    (repeat ncols
        (vla-SetColumnWidth vtable (setq ncols (1- ncols))
            (apply 'max
                (vl-remove nil (mapcar '(lambda (x) (nth ncols x)) totlen))
            )
        )
    )
    (vla-put-RegenerateTableSuppressed vtable :vlax-false)
    vtable
)

;; JH:TableStyle-p --> Jonathan Handojo
;; Checks if a table style exists in the current drawing

(defun JH:TableStyle-p (sty)
    (not
        (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-item
                (list 
                    (vla-item
                        (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object)))
                        "ACAD_TABLESTYLE"
                    )
                    sty
                )
            )
        )
    )
)

 

[BIGAL]

Johnathon just some ideas, in one table coding I did, I looked at the (strlen str) of each column added a fuzz factor like 4 so could work out the column widths to suit. So if you have like ID column with numbers say 1-250 it does not need to be very wide, a "Part Number 1234-5678" needs to be much wider, a qty again can be narrow. So make a guess of column width make the table, then reset the column widths. I found it easier to make a custom table style that matches client needs than to try and do massive edits, but most times the client is paying for it to be correct.

[Jonathan Handojo]

9 minutes ago, BIGAL said:

Johnathon just some ideas, in one table coding I did, I looked at the (strlen str) of each column added a fuzz factor like 4 so could work out the column widths to suit. So if you have like ID column with numbers say 1-250 it does not need to be very wide, a "Part Number 1234-5678" needs to be much wider, a qty again can be narrow. So make a guess of column width make the table, then reset the column widths. I found it easier to make a custom table style that matches client needs than to try and do massive edits, but most times the client is paying for it to be correct.

Well, you're not technically wrong. The function already does take into account column widths and perform the calculations to ensure all the columns are sized to autofit. However, there's just one small issue that I still have to face.

 

The issue is that, depending on the table style, the cells could be merged across columns, which makes width calculations a bit trickier. The main reason I had the table style argument is so that all the text heights, fonts, etc. are all preset and makes the whole thing easier. But nonetheless, it still won't solve the issue with the column widths whose cells are merged (especially if the table heading is super long).

 

For the time being, the calculation to get the width is:

 

1. Get the cell font style and cell font height using GetCellTextStyle and GetCellTextHeight
   1. This is dependent on the table style being used.
2. Use the textbox function to get the bounding box of the text. The horizontal displacement returned by the function is the width of the column.
3. I added a "fuzz" on this width by adding the text height in that cell. This will make the cell look equally neat.

 

[BIGAL]

Thanks Johnathon like always forever learning new stuff, that textbox is a good function uses current Textsize variable when working out box size. Can still use a defun taking a text list to find the max X value. Looks at each character which is great.

 

(textbox '((1 . "1111")))
((0.0 0.0 0.0) (11.6666666666667 5.0 0.0))
(textbox '((1 . "2222")))
((0.0 0.0 0.0) (18.3333333333333 5.0 0.0))

 

Edited February 21 by BIGAL

[Jonathan Handojo]

4 hours ago, BIGAL said:

Thanks Johnathon like always forever learning new stuff, that textbox is a good function uses current Textsize variable when working out box size. Can still use a defun taking a text list to find the max X value. Looks at each character which is great.

 

(textbox '((1 . "1111")))
((0.0 0.0 0.0) (11.6666666666667 5.0 0.0))
(textbox '((1 . "2222")))
((0.0 0.0 0.0) (18.3333333333333 5.0 0.0))

 

No worries BIGAL. Good to see you enjoy learning new stuff everyday.

 

Yeah, I think it might be a good idea to make a function to get the height and width of the text. As can be seen from my function, it did take a few lines and functions to just get the horizontal width itself.

 

Also, you can also set its text height and style too (codes 40 and 7 respectively), which will make it more accurate. So you can use:

 

(textbox '((1 . "I am a Standard Text Style with Text Height 10") (7 . "Standard") (40 . 10.0)))

 

[barristann]

Great improvements Jonathan. This saves a lot of time and headaches when creating table. It's painful without your codes. Thank you for your work, Jonathan