Lisp Table
Accepted solution
Hi,
You can use the ActiveX vla-AddTable function to create the table and the use the Table object methods and properties
Oke so:
I want a table with 2 columns 28 rows with in the top row the table name
Below that the names of the columns
All the rows below that Column 1 will always have the same name with exeption for row 5 and 6 They will be like:
(cond
(.....)
(Different product
(.....)
and so on.
Column 2 will be the amount of items based on calculations from my last script.
Example:
Here's an example from which you should get som inspiration.
It creates a table to list the selected block references.
(defun c:listBlock (/ ss name ref refs insPt table row)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(or *blocks*
(setq *blocks* (vla-get-Blocks *acdoc*))
)
(prompt "\nSelect blocks to list or <All>")
(or (setq ss (ssget '((0 . "INSERT"))))
(setq ss (ssget "_X" '((0 . "INSERT")))
)
)
(if ss
(progn
(vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(if (not (vlax-property-available-p x 'Path))
(setq name (vla-get-EffectiveName x)
refs (if (setq ref (assoc name refs))
(subst (cons name (1+ (cdr ref))) ref refs)
(cons (cons name 1) refs)
)
)
)
)
(vla-delete ss)
(initget 1)
(setq insPt (trans (getpoint "\nInsertion point: ") 1 0))
(setq table (vla-addtable
(vla-get-modelspace *acdoc*)
(vlax-3d-point insPt)
(+ 2 (length refs)) ; number of rows (including title and header)
3 ; number of colums
20 ; cell height
80 ; row width
)
)
(vla-put-VertCellMargin table 4.0)
(vla-put-TitleSuppressed table :vlax-false)
(vla-put-HeaderSuppressed table :vlax-false)
(vla-setText table 0 0 "Blocks")
(vla-setText table 1 0 "Name")
(vla-setText table 1 1 "Count")
(vla-setText table 1 2 "Symbol")
(setq row 2)
(foreach item refs
(vla-settext table row 0 (car item))
(vla-settext table row 1 (cdr item))
(vla-SetBlockTableRecordId
table
row
2
(vla-get-ObjectId (vla-Item *blocks* (car item)))
:vlax-true
)
(setq row (1+ row))
)
)
)
(princ)
)
(defun c:listBlock (/ ss name block blocks insPt table row)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(or *blocks*
(setq *blocks* (vla-get-Blocks *acdoc*))
)
;; Select blocks
(prompt "\nSelect blocks to list or <All>")
(or (setq ss (ssget '((0 . "INSERT"))))
(setq ss (ssget "_X" '((0 . "INSERT")))
)
)
(if ss
(progn
;; Build a list of dotted pairs (blockName . numberOfReferences) from the selection set
(vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(if (not (vlax-property-available-p x 'Path))
(setq name (vla-get-EffectiveName x)
blocks (if (setq block (assoc name blocks))
(subst (cons name (1+ (cdr block))) block blocks)
(cons (cons name 1) blocks)
)
)
)
)
(vla-delete ss)
;; Prompt for inserrtion point
(initget 1)
(setq insPt (trans (getpoint "\nInsertion point: ") 1 0))
;; Create the table
(setq table (vla-addtable
(vla-get-modelspace *acdoc*)
(vlax-3d-point insPt)
(+ 2 (length blocks)) ; number of rows (including title and header)
3 ; number of colums
20 ; cell height
80 ; row width
)
)
(vla-put-VertCellMargin table 4.0)
(vla-put-TitleSuppressed table :vlax-false)
(vla-put-HeaderSuppressed table :vlax-false)
;; Fill the titel and the header
(vla-setText table 0 0 "Blocks")
(vla-setText table 1 0 "Name")
(vla-setText table 1 1 "Count")
(vla-setText table 1 2 "Symbol")
;; fill the following rows from the list contents
(setq row 2)
(foreach item blocks
(vla-settext table row 0 (car item)) ; block name
(vla-settext table row 1 (cdr item)) ; references count
(vla-SetBlockTableRecordId ; block symbol
table
row
2
(vla-get-ObjectId (vla-Item *blocks* (car item)))
:vlax-true
)
(setq row (1+ row))
)
)
)
(princ)
)
But, if you're not able to understand such code, maybe you should learn the AutoLISP basics before trying to achieve such task.
We all have to learn how to walk before trying to run...
Hello @_gile
Beautiful Routine !
Please is it possible to have a Micro-Micro-Improvment ?
On the command/text Windows : the total of the Blocks ...
Thanks in advance, Regards, Patrice
Patrice ( Supporting Troops ) - Autodesk Expert Elite
If you are happy with my answer please mark "Accept as Solution" and if very happy please give me a Kudos (Felicitations) - Thanks
If you are happy with my answer please mark "Accept as Solution" and if very happy please give me a Kudos (Felicitations) - Thanks
Patrice BRAUD
@Anonymous a écrit :
Thank for excellence code.
If I don't need 1 st row(Header row), only required the title of row and below data how can do that.
(see attached screenshot)
You should have been able to do it by yourself (look at the commented red lines).
(defun c:listBlock (/ ss name block blocks insPt table row)
(vl-load-com)
(or *acdoc*
(setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
)
(or *blocks*
(setq *blocks* (vla-get-Blocks *acdoc*))
)
;; Select blocks
(prompt "\nSelect blocks to list or <All>")
(or (setq ss (ssget '((0 . "INSERT"))))
(setq ss (ssget "_X" '((0 . "INSERT")))
)
)
(if ss
(progn
;; Build a list of dotted pairs (blockName . numberOfReferences) from the selection set
(vlax-for x (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(if (not (vlax-property-available-p x 'Path))
(setq name (vla-get-EffectiveName x)
blocks (if (setq block (assoc name blocks))
(subst (cons name (1+ (cdr block))) block blocks)
(cons (cons name 1) blocks)
)
)
)
)
(vla-delete ss)
;; Prompt for inserrtion point
(initget 1)
(setq insPt (trans (getpoint "\nInsertion point: ") 1 0))
;; Create the table
(setq table (vla-addtable
(vla-get-modelspace *acdoc*)
(vlax-3d-point insPt)
;(+ 2 (length blocks)) ; number of rows (including title and header)
(+ 1 (length blocks)) ; number of rows (including header)
3 ; number of colums
20 ; cell height
80 ; row width
)
)
(vla-put-VertCellMargin table 4.0)
;(vla-put-TitleSuppressed table :vlax-false)
(vla-put-TitleSuppressed table :vlax-true)
(vla-put-HeaderSuppressed table :vlax-false)
;; Fill the title and the header
;(vla-setText table 0 0 "Blocks")
;(vla-setText table 1 0 "Name")
;(vla-setText table 1 1 "Count")
;(vla-setText table 1 2 "Symbol")
;; Fill the header
(vla-setText table 0 0 "Name")
(vla-setText table 0 1 "Count")
(vla-setText table 0 2 "Symbol")
;; fill the following rows from the list contents
;(setq row 2)
(setq row 1)
(foreach item blocks
(vla-settext table row 0 (car item)) ; block name
(vla-settext table row 1 (cdr item)) ; references count
(vla-SetBlockTableRecordId ; block symbol
table
row
2
(vla-get-ObjectId (vla-Item *blocks* (car item)))
:vlax-true
)
(setq row (1+ row))
)
)
)
(princ)
)
