Attribute value to table cell

[VAC]

Hi, is there a way (lisp) that will connect selected block value with selected table cell? For example, I have block with attribute where I write room names. Than I have table, where I would like to have these room names, paid with filed expression. So when I change room name in any block it will change it in the table.

 

Best way it shoud work is:

1. run lisp

2. click on the attribute value

3. click on the table cell

4. repeate step 2 and 3

...

 

I was searching google, but without success.

 

Many thanks.

[BIGAL]

1st use NENTSEL to pick attribute then make a Field string 

 

2nd use the lisp attached to pick cell

 

3rd put field string into cell

 

 

pick cell in table.lsp

[VAC]

Hi, thank you for your 2nd part. Is anybody who can add 1st and 3rd part to build whole script? I don't know anything about lisps.

[BIGAL]

Post a sample dwg with blocks and table, it better if some one provides something that it has used your dwg.

[VAC]

attribute_to_cell.dwg

Hi, here is my example.

[BIGAL]

Try this

 

; pick attribute paste text to cell in table
; By AlanH with help from lee-mac and Grrr
; July 2021

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
); Defun Hittest
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
); Defun Getacadtableobjects


(defun putatt2cell (txt pt / tables rows cols)
(setq Tables (Getacadtableobjects))
(setq ans  (LM:Hittest Pt Tables))
(setq objtable (nth 0 ans) rows (nth 1 ans) cols (nth 2 ans))
(vla-settext Objtable rows cols txt)
(princ)
)


; ****************************
(defun c:att2cell ( / att cpt str)
(while (setq att (nentsel "\nPick attribute Enter to exit : "))
(setq cpt (getpoint "\nPick cell in table "))
;(setq str (cdr (assoc 1 (entget (car att)))))
(setq id (itoa (vla-get-objectid (vlax-ename->vla-object (car att)))))
(setq str  (strcat "%<\\AcObjProp Object(%<\\_ObjId " id  ">%).TextString>%"))
(putatt2cell str cpt)
)
(princ)
)

 

[VAC]

Works fine, many thanks

[EYNLLIB]

On 7/15/2021 at 3:50 AM, BIGAL said:

Try this

 

; pick attribute paste text to cell in table
; By AlanH with help from lee-mac and Grrr
; July 2021

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
); Defun Hittest
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
); Defun Getacadtableobjects


(defun putatt2cell (txt pt / tables rows cols)
(setq Tables (Getacadtableobjects))
(setq ans  (LM:Hittest Pt Tables))
(setq objtable (nth 0 ans) rows (nth 1 ans) cols (nth 2 ans))
(vla-settext Objtable rows cols txt)
(princ)
)


; ****************************
(defun c:att2cell ( / att cpt str)
(while (setq att (nentsel "\nPick attribute Enter to exit : "))
(setq cpt (getpoint "\nPick cell in table "))
;(setq str (cdr (assoc 1 (entget (car att)))))
(setq id (itoa (vla-get-objectid (vlax-ename->vla-object (car att)))))
(setq str  (strcat "%<\\AcObjProp Object(%<\\_ObjId " id  ">%).TextString>%"))
(putatt2cell str cpt)
)
(princ)
)

 

 

Great routine, I have tried tinkering with it to get it to my use case without success.

 

I'd like to select a group of blocks that have multiple attributes and have each block as a row in a table with each attribute as a column. Any help would be much appreciated!

[VAC]

Hi. Is it possible to make another script like that one or modify it but for multiple attributes at once? I mean - I will select multiple copies of the same block. Each block contains multiple attributes. I would like to export all these attributes to the table (line for each block). Table is just deffined or can be new. Predefined or optional sorting by one of its attributes would be great. And the main task is to make these all values in the table made only by fields, so if I change anything in any original block all table values will change.

Edited September 4, 2023 by VAC

[hosneyalaa]

@VAC

Can you attached example drawing 

[BIGAL]

The biggest issue when doing fields is every single block attribute has a unique ID, no 2 the same, so copy does not work for one block name. You must read every attribute ID as you make a table.

 

Ok part 2 is can do a table based on Blockname and sorted attributes giving count details, eg Door Black goldhandle 5, Door Black Siverhandle 6, is that the ultimate goal ?

[VAC]

Here is my sample file with instructions

sample.dwg

[VAC]

So I create this incomplete script. There are maybe two things that do not function:

1. it do not change cell's position as expected - it maybe overwrites values still in the same cell....maybe variable ins is not global? or maybe called putatt2cell function overpowers (reads first point of selection) the next move-to-next-cell

2. missing sort output by data in the fisrt attribute value (in my case) would be necessary to implement....the code must be changed to load everything (it just does) and after that it must sort it and than print....I do not know how to do it

...

Could anybody help?

(No need to handle the exception if the table do not have enought rows or columns. I will prepere table first.)

 

PS: in the previous sample file, blocks have some hidden attributes - visibility state has to be changed to see them.

 

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
); Defun Hittest
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
); Defun Getacadtableobjects


(defun putatt2cell (txt pt / tables rows cols)
  (setq Tables (Getacadtableobjects))
  (setq ans  (LM:Hittest Pt Tables))
  (setq objtable (nth 0 ans) rows (nth 1 ans) cols (nth 2 ans))
  (vla-settext Objtable rows cols txt)
  (princ)
)

(defun c:atts2table (/ ss)
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  )
  
  (setq ins (getpoint "\nSelect cell in table: "))
  
  (foreach ent (LM:ss->list ss)
    (setq att-values (LM:getattributevalues ent))
    (if att-values
      (progn
        (foreach att-value att-values
          (setq tag (car att-value))
          (setq value (cdr att-value))
          (setq field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object ent))) ">%)." tag ">%"))
;          (setq message (strcat "Tag: " tag ", Value: " value))
;          (princ message)
          (putatt2cell field ins)
          (setq ins (LM:move-to-next-cell ins))
        )
      )
    )
  )
  (princ)
)

(defun LM:move-to-next-cell (ins)
  (setq row (+ (cadr ins) 1))
  (setq col (car ins))
  (setq ins (list col row))
  ins
)

(defun LM:getattributevalues ( blk / enx ) ; Lee Mac
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (cons
            (cons
                (cdr (assoc 2 enx))
                (cdr (assoc 1 (reverse enx)))
            )
            (LM:getattributevalues blk)
        )
    )
)

(defun LM:ss->list (ss)
  (setq lst nil)
  (if ss
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  )
  (reverse lst)
)

 

Edited September 6, 2023 by VAC

[VAC]

So I've just correct first issue - now it just works:-)

I need to solve issue 2 - sort data by the first attribute (or another if possible) in the blocks and then print them sorted.

; pick attribute paste text to cell in table
; By AlanH with help from lee-mac and Grrr
; July 2021
; By VAC
; September 2023

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
); Defun Hittest
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
); Defun Getacadtableobjects

(defun putatt2cell (txt pt) ; VAC
  (if Tables
    (progn
      (vla-settext (nth 0 Tables) current-row current-col txt)
    )
  )
  (princ)
)

(defun c:atts2table (/ ss) ; VAC
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  )
  
  (setq ins (getpoint "\nSelect first cell in the table: "))
  (setq ans (LM:Hittest ins (setq Tables (Getacadtableobjects))))
  (setq objtable (nth 0 ans))
  (setq current-row (nth 1 ans))
  (setq current-col (nth 2 ans))

  (foreach ent (LM:ss->list ss)
    (setq att-values (LM:getattributevalues ent))
    (if att-values
      (progn
        (foreach att-value att-values
          (setq tag (car att-value))
          (setq value (cdr att-value))
          (setq field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object ent))) ">%)." tag ">%"))
;          (setq message (strcat "Tag: " tag ", Value: " value))
;          (princ message)
          (putatt2cell field ins)
          (setq current-col (+ current-col 1))
        )
      )
    )
    (setq current-col (nth 2 ans))
    (setq current-row (+ current-row 1))
  )
  (princ)
)

(defun LM:getattributevalues ( blk / enx ) ; Lee Mac
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (cons
            (cons
                (cdr (assoc 2 enx))
                (cdr (assoc 1 (reverse enx)))
            )
            (LM:getattributevalues blk)
        )
    )
)

(defun LM:ss->list (ss) ; VAC
  (setq lst nil)
  (if ss
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  )
  (reverse lst)
)

 

Edited September 7, 2023 by VAC

[VAC]

I have changed my script and at the end and I prepared function  LM:sort-data-by-first-attribute. How to define it to sort data alphabetically? (Now it returns original data)

 

; pick attribute paste text to cell in table
; By AlanH with help from lee-mac and Grrr
; July 2021
; By VAC
; September 2023

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
); Defun Hittest
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
); Defun Getacadtableobjects

(defun putatt2cell (txt pt) ; VAC
  (if Tables
    (progn
      (vla-settext (nth 0 Tables) current-row current-col txt)
    )
  )
  (princ)
)

(defun c:atts2table (/ ss ent) ; VAC
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  )

  (setq ins (getpoint "\nSelect first cell in the table: "))
  (setq ans (LM:Hittest ins (setq Tables (Getacadtableobjects))))
  (setq objtable (nth 0 ans))
  (setq current-row (nth 1 ans))
  (setq current-col (nth 2 ans))

  (setq data-matrix '())

  (foreach ent (LM:ss->list ss)
    (setq att-values (LM:getattributevalues ent))
    (if att-values
      (progn
        (setq data-item '())
        (foreach att-value att-values
          (setq tag (car att-value))
          (setq value (cdr att-value))
          (setq field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object ent))) ">%)." tag ">%"))
          (setq data-item (cons (list tag field) data-item))
        )
        (setq data-matrix (cons (reverse data-item) data-matrix))
      )
    )
  )

  (setq sorted-data-matrix (LM:sort-data-by-first-attribute data-matrix))

  (foreach data-row sorted-data-matrix
    (foreach data-item data-row
      (setq tag (car data-item))
      (setq field (cadr data-item))
      (putatt2cell field ins)
      (setq current-col (+ current-col 1))
    )
    (setq current-col (nth 2 ans))
    (setq current-row (+ current-row 1))
  )
  (princ)
)

(defun LM:getattributevalues ( blk / enx ) ; Lee Mac
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (cons
            (cons
                (cdr (assoc 2 enx))
                (cdr (assoc 1 (reverse enx)))
            )
            (LM:getattributevalues blk)
        )
    )
)

(defun LM:ss->list (ss) ; VAC
  (setq lst nil)
  (if ss
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  )
  (reverse lst)
)

(defun LM:sort-data-by-first-attribute (data-list)
  data-list ; here sorting code?
)

 

Edited September 7, 2023 by VAC

[VAC]

Or is there a way, how to sort table data by selected column?

Edited September 7, 2023 by VAC

[VAC]

I added conditions when existing table has not enought rows or columns. How to add them to table?

So I need help with these functions:

1.

(defun LM:sort-data-by-first-attribute (data-list)

?

)

(I found this https://apps.autodesk.com/ACD/en/Detail/Index?id=4790977574413485803&appLang=en&os=Win64 but I'd like to implement it directly)

 

2.

(defun LM:add-columns-to-table (table num-cols-to-add)

?

)

 

3.

(defun LM:add-rows-to-table (table num-rows-to-add)

?

)

 

; pick attribute paste text to cell in table
; By AlanH with help from lee-mac and Grrr
; July 2021
; By VAC
; September 2023

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
); Defun Hittest
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
); Defun Getacadtableobjects

(defun putatt2cell (txt pt) ; VAC
  (if Tables
    (progn
      (if (or (> num-cols-to-add 0) (> num-rows-to-add 0))
        (progn
          (if (> num-cols-to-add 0)
            (progn
              (LM:add-columns-to-table objtable num-cols-to-add)
            )
          )
          (if (> num-rows-to-add 0)
            (progn
              (LM:add-rows-to-table objtable num-rows-to-add)
            )
          )
          
        )
        (progn
          (vla-settext (nth 0 Tables) current-row current-col txt)
        )
      )
    )
  )
  (princ)
)

(defun c:atts2table (/ ss ent) ; VAC
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  )

  (setq ins (getpoint "\nSelect first cell in the table: "))
  (setq ans (LM:Hittest ins (setq Tables (Getacadtableobjects))))
  (setq objtable (nth 0 ans))
  (setq current-row (nth 1 ans))
  (setq current-col (nth 2 ans))

  (setq data-matrix '())

  (foreach ent (LM:ss->list ss)
    (setq att-values (LM:getattributevalues ent))
    (if att-values
      (progn
        (setq data-item '())
        (foreach att-value att-values
          (setq tag (car att-value))
          (setq value (cdr att-value))
          (setq field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object ent))) ">%)." tag ">%"))
          (setq data-item (cons (list tag field) data-item))
        )
        (setq data-matrix (cons (reverse data-item) data-matrix))
      )
    )
  )

  (setq sorted-data-matrix (LM:sort-data-by-first-attribute data-matrix))
   
  (setq num-cols-in-data (length (car sorted-data-matrix)))
  (setq num-current-cols (vla-get-Columns objtable))
  (setq num-cols-to-add (- num-cols-in-data num-current-cols))
  (setq num-cols-to-add (+ num-cols-to-add (nth 2 ans)))
  (setq num-rows-in-data (length sorted-data-matrix))
  (setq num-current-rows (vla-get-Rows objtable))
  (setq num-rows-to-add (- num-rows-in-data num-current-rows))
  (setq num-rows-to-add (+ num-rows-to-add (nth 1 ans)))

  (foreach data-row sorted-data-matrix
    (foreach data-item data-row
      (setq tag (car data-item))
      (setq field (cadr data-item))
      (putatt2cell field ins)
      (setq current-col (+ current-col 1))
    )
    (setq current-col (nth 2 ans))
    (setq current-row (+ current-row 1))
  )
  (princ)
)

(defun LM:getattributevalues ( blk / enx ) ; Lee Mac
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (cons
            (cons
                (cdr (assoc 2 enx))
                (cdr (assoc 1 (reverse enx)))
            )
            (LM:getattributevalues blk)
        )
    )
)

(defun LM:ss->list (ss) ; VAC
  (setq lst nil)
  (if ss
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  )
  (reverse lst)
)

(defun LM:sort-data-by-first-attribute (data-list)
  (princ "sorting data alphabetically. ") 
  data-list
)

(defun LM:add-columns-to-table (table num-cols-to-add)
  (princ (strcat "add " (itoa num-cols-to-add) " cols. "))
)

(defun LM:add-rows-to-table (table num-rows-to-add)
  (princ (strcat "add " (itoa num-rows-to-add) " rows. "))
)

 

4. And there must be something wrong when any attribute's label has dot "." in it. For example if any attribute is labeled like "X.Y" then the field inserted to the table shows ####. I do not know why? Maybe gets bad object ID? How to fix it?

Edited September 7, 2023 by VAC

[BIGAL]

Sounds like take a step back the way around how many columns is to make a list with (blockname att1 att2 and so on ) yes a block may have 1 attribute or 10 or even 0, once you make the list you look at how many items in each sub list so keep largest as your column number. (length newlst) What I am saying is select all blocks in one go, Sometimes its easier to re-make the table rather than adding 1 or 2 blocks.

 

I use insertrows to make the rows 

(foreach cell lst3
(vla-InsertRows Objtable  numrows (vla-GetRowHeight Objtable (1- numrows)) 1)

then fill in cells

I remade the original list of block & atts and padded the new master list so all sub lists are same length (block1 att1 att2 "" "" "" "")(block2 att1 att3 att4 att5 att6) when putting the value into the cell if "" then skip.

 

Re the sort just do the vl-sort on last list then will be by block name. You can sort on multi levels I have in a program 5 levels deep for blocks with attributes. 

 

[VAC]

Adding rows and columns added - thank you. Now I need help how to define sorting throught vl-sort?

 

; pick attribute paste text to cell in table
; By AlanH with help from lee-mac and Grrr
; July 2021
; By VAC
; September 2023

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
); Defun Hittest
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
); Defun Getacadtableobjects

(defun putatt2cell (txt pt) ; VAC
  (if Tables
    (progn
      (vla-settext (nth 0 Tables) current-row current-col txt)
    )
  )
  (princ)
)

(defun c:atts2table (/ ss ent first-iteration) ; VAC
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  )

  (setq ins (getpoint "\nSelect first cell in the table: "))
  (setq ans (LM:Hittest ins (setq Tables (Getacadtableobjects))))
  (setq objtable (nth 0 ans))
  (setq current-row (nth 1 ans))
  (setq current-col (nth 2 ans))

  (setq data-matrix '())
  (setq first-iteration t)

  (foreach ent (LM:ss->list ss)
    (setq att-values (LM:getattributevalues ent))
    (if att-values
      (progn
        (setq data-item '())
        (foreach att-value att-values
          (setq tag (car att-value))
          (setq value (cdr att-value))
          (setq field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object ent))) ">%)." tag ">%"))
          (setq data-item (cons (list tag field) data-item))
        )
        (setq data-matrix (cons (reverse data-item) data-matrix))
      )
    )
  )

  (setq sorted-data-matrix (LM:sort-data-by-first-attribute data-matrix))

(if first-iteration
      (progn
        (setq first-iteration nil)
        (setq num-cols-in-data (length (car sorted-data-matrix)))
        (setq num-current-cols (vla-get-Columns objtable))
        (setq num-cols-to-add (- num-cols-in-data num-current-cols))
        (setq num-cols-to-add (+ num-cols-to-add (nth 2 ans)))
        (setq num-rows-in-data (length sorted-data-matrix))
        (setq num-current-rows (vla-get-Rows objtable))
        (setq num-rows-to-add (- num-rows-in-data num-current-rows))
        (setq num-rows-to-add (+ num-rows-to-add (nth 1 ans)))  

        (if (or (> num-cols-to-add 0) (> num-rows-to-add 0))
          (progn
            (if (> num-cols-to-add 0)
              (progn
                (LM:add-columns-to-table objtable num-cols-to-add)
              )
            )
            (if (> num-rows-to-add 0)
              (progn
                (LM:add-rows-to-table objtable num-rows-to-add)
              )
            )
          )
        )
      )
  )

  (foreach data-row sorted-data-matrix
    (foreach data-item data-row
      (setq tag (car data-item))
      (setq field (cadr data-item))
      (putatt2cell field ins)
      (setq current-col (+ current-col 1))
    )
    (setq current-col (nth 2 ans))
    (setq current-row (+ current-row 1))
  )
  (princ)
)

(defun LM:getattributevalues ( blk / enx ) ; Lee Mac
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (cons
            (cons
                (cdr (assoc 2 enx))
                (cdr (assoc 1 (reverse enx)))
            )
            (LM:getattributevalues blk)
        )
    )
)

(defun LM:ss->list (ss) ; VAC
  (setq lst nil)
  (if ss
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  )
  (reverse lst)
)

(defun LM:sort-data-by-first-attribute (data-list)
  (princ "sorting data alphabetically. ") 
  data-list
)

(defun LM:add-columns-to-table (table num-cols-to-add) ; VAC
  (if (> num-cols-to-add 0)
    (progn
      (setq num-current-cols (vla-get-Columns table))
      (vla-InsertColumns table num-current-cols (vla-GetColumnWidth objtable (1- num-current-cols)) num-cols-to-add)
      (princ (strcat "Added " (itoa num-cols-to-add) " columns. "))
    )
  )
)

(defun LM:add-rows-to-table (table num-rows-to-add) ; VAC
  (if (> num-rows-to-add 0)
    (progn
      (setq num-current-rows (vla-get-Rows table))
      (vla-InsertRows table num-current-rows (vla-GetRowHeight objtable (1- num-current-rows)) num-rows-to-add)
      (princ (strcat "Added " (itoa num-rows-to-add) " rows. "))
    )
  )
)

 

Edited September 8, 2023 by VAC

[VAC]

Everything seems to work correctly now. 

Could anybody taste it on different types of blocks and even different number of attributes in that blocks? What do you think about my first LISP script?

It's just slower when working with a lot of elements due to simple sorting function, I thing.

 

I would like to implement next sorting by the second, third,.. attribute in the block. Maybe next time.

 

 

; select blocks, insert attribute values from these blocks as a field into the table, adjust the size (add rows or columns) of the table according to the number of selected blocks and the number of attributes, sort rows by the first attribute value in each block
; By VAC
; September 2023
; pick attribute paste text to cell in table
; By AlanH with help from lee-mac and Grrr
; July 2021


(defun c:atts2table (/ ss ent first-iteration) ; VAC
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  )

  (setq ins (getpoint "\nSelect first cell in the table: "))
  (setq ans (LM:Hittest ins (setq Tables (Getacadtableobjects))))
  (setq objtable (nth 0 ans))
  (setq current-row (nth 1 ans))
  (setq current-col (nth 2 ans))
  (setq data-matrix '())

  (foreach ent (LM:ss->list ss)
    (setq att-values (LM:getattributevalues ent))
    (if att-values
      (progn
        (setq data-item '())
        (foreach att-value att-values
          (setq tag (car att-value))
          (setq value (cdr att-value))
          (setq field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid (vlax-ename->vla-object ent))) ">%)." tag ">%"))
          (setq data-item (cons (list value tag field) data-item))
        )
        (setq data-matrix (cons (reverse data-item) data-matrix))
      )
    )
  )
  
  ; inserts new rows to table
  (setq first-iteration t)
  (if first-iteration 
    (progn    
      (setq first-iteration nil)
      (setq sorted-data-matrix (vl-sort data-matrix 'LM:sort-by-first-element))
      (setq num-rows-in-data (length sorted-data-matrix))
      (setq num-current-rows (vla-get-Rows objtable))
      (setq num-rows-to-add (- num-rows-in-data num-current-rows))
      (setq num-rows-to-add (+ num-rows-to-add (nth 1 ans)))  
      (if (> num-rows-to-add 0)
        (progn
          (LM:add-rows-to-table objtable num-rows-to-add)
        )
      )
    )
  )

  (foreach data-row sorted-data-matrix
    (foreach data-item data-row
      ; inserts new columns to table
      (setq num-cols-in-data (length data-row))
      (setq num-current-cols (vla-get-Columns objtable))
      (setq num-cols-to-add (- num-cols-in-data num-current-cols))
      (setq num-cols-to-add (+ num-cols-to-add (nth 2 ans)))
      (if (> num-cols-to-add 0)
        (progn
          (LM:add-columns-to-table objtable num-cols-to-add)
        )
      )
      ; inserts values to table
      (setq value (car data-item))
      (setq tag (cadr data-item))
      (setq field (caddr data-item))
      (putatt2cell field ins)
      (setq current-col (+ current-col 1))
    )
    (setq current-col (nth 2 ans))
    (setq current-row (+ current-row 1))
  )
  (princ)
)

(Defun LM:Hittest ( Pt Lst ) ; Lee Mac
      (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
        (Vl-some
          (Function
            (Lambda ( O / R C )
              (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
            )
          )
          Lst
        ); Vl-some
      ); If
)

(defun LM:getattributevalues ( blk / enx ) ; Lee Mac
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
        (cons
            (cons
                (cdr (assoc 2 enx))
                (cdr (assoc 1 (reverse enx)))
            )
            (LM:getattributevalues blk)
        )
    )
)
	
(Defun Getacadtableobjects ( / Ss I L ); Grrr1337
      (If (Setq Ss (Ssget "X" (List '(0 . "Acad_table") (If (= 1 (Getvar 'Cvport)) (Cons 410 (Getvar 'Ctab)) '(410 . "Model")))))
        (Repeat (Setq I (Sslength Ss)) (Setq L (Cons (Vlax-ename->vla-object (Ssname Ss (Setq I (1- I)))) L)) )
      ); If
)

(defun putatt2cell (txt pt) ; VAC
  (if Tables
    (vla-settext (nth 0 Tables) current-row current-col txt)
  )
  (princ)
)

(defun LM:ss->list (ss) ; VAC
  (setq lst nil)
  (if ss
    (repeat (setq i (sslength ss))
      (setq lst (cons (ssname ss (setq i (1- i))) lst))
    )
  )
  (reverse lst)
)

(defun LM:add-columns-to-table (table num-cols-to-add) ; VAC
  (if (> num-cols-to-add 0)
    (progn
      (setq num-current-cols (vla-get-Columns table))
      (vla-InsertColumns table num-current-cols (vla-GetColumnWidth objtable (1- num-current-cols)) num-cols-to-add)
      (princ (strcat "Added " (itoa num-cols-to-add) " columns. "))
    )
  )
)

(defun LM:add-rows-to-table (table num-rows-to-add) ; VAC
  (if (> num-rows-to-add 0)
    (progn
      (setq num-current-rows (vla-get-Rows table))
      (vla-InsertRows table num-current-rows (vla-GetRowHeight objtable (1- num-current-rows)) num-rows-to-add)
      (princ (strcat "Added " (itoa num-rows-to-add) " rows. "))
    )
  )
)

(defun LM:sort-by-first-element (row1 row2) ; VAC
  (setq first-elem1 (caar row1))
  (setq first-elem2 (caar row2))
  (if (< first-elem1 first-elem2)
    T
    nil
  )
)

 

Edited September 8, 2023 by VAC