Attribute value to table cell

[BIGAL]

My way of doing it is to make a big list with all the answers sort that list with criteria like blockname att1 att2 att3 then do a count of those objects so end up with blockname att1 att2 att3 count.

 

I have made tables with like 200+ rows and its almost instant, OK a little secret when using insertrows to do say 200 rows its a dog in time spent, but you suppress the display of the table till finished adding then actually draw the table. The time difference is like done instantly.

 

Make a count of common items.lsp:

(vla-put-regeneratetablesuppressed Objtable :vlax-true) ; turn off display table after making the table.

(vla-put-regeneratetablesuppressed Objtable :vlax-false) ; at end display table.

I do have blockname & up to 4 attributes sorting. It is setup to auto detect up to 5 items, could be more.

 

Post a dwg can test. 

 

[VAC]

Super, I use it, it is just fast enought:-)

 

I improve it a little bit with 3 options.

First and third work great (print fields or only values).

 

Second do not know how to detect, if actuall attribute is visible (in dynamic block visibility state) or hidden? Can you help me? It is in the LM:getattributevalues.....line

      (setq is-hidden 1) ; How to find out if the current attribute is hidden or visible

....instead of 1 enter a function that returns 1 - hidden, 0 visible.

 

Some parts of the next code are there only for control:

      (if (= is-hidden 1)

        (setq visibility-info "Hidden")

        (setq visibility-info "Visible")

      )

 

      (setq attribute-name (cdr (assoc 2 enx)))

      (princ (strcat "Attribute Name: " attribute-name " - " visibility-info "\n"))

 

; 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 their attributes, alphabeticaly sort rows by attributes values
; Option 1: copy fields or only values
; Option 2: copy all atributes or only visible - not working yet!
; Option 3: include block names as well
; By VAC
; September 2023

(defun c:atts2table (/ ss ent first-iteration) ; VAC
  ; options
  (setq data_type (getstring "\nSelect the option: (1 - insert values as formulas (fields) or 2 - insert only as text): "))
  (setq attribute_type (getstring "\nSelect the option: (1 - copy all attributes or 2 - copy only visible attributes): ")) 
  (setq block_names (getstring "\nSelect the option: (1 - without block names or 2 - with block names): ")) 
  ; select blocks
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  ) 
  ; select first cell in the table
  (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 '()) 
  ; suppresses automatic table regeneration
  (vla-put-regeneratetablesuppressed Objtable :vlax-true)
  
  ; reads data from blocks
  (foreach ent (LM:ss->list ss)
    ; reads attributes from blocks
    (setq att-values (LM:getattributevalues ent attribute_type))
;    (princ "\n")
    (if att-values
      (progn
        (setq data-item '())
        ; gets the block name
        (setq block-name (LM:getblockname ent))
        ; writes data for sorting
        (setq data-string "")
        (foreach att-value att-values
          (setq value (cdr att-value))
          (setq data-string (strcat data-string value))
        )
        ; writes data
        (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 data-string value tag field block-name) data-item))
        )
        (setq data-matrix (cons (reverse data-item) data-matrix))
      )
    )
  )

  ; sorts data by the first element (data-string)
  (setq sorted-data-matrix (vl-sort data-matrix 'LM:sort-by-first-element))
  ; inserts new rows to the table
  (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)
    (LM:add-rows-to-table objtable num-rows-to-add)
  )
  
  ; prints data
  (foreach data-row sorted-data-matrix
    (setq first-pass t)
    (foreach data-item data-row
      ; inserts new columns to the 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 (= block_names "2")
        (setq num-cols-to-add (+ num-cols-to-add 1))
      )
      (if (> num-cols-to-add 0)
        (LM:add-columns-to-table objtable num-cols-to-add)
      )
      ; inserts values to table by options
      (setq sort-value (car data-item))
      (setq value (nth 1 data-item))
      (setq tag (nth 2 data-item))
      (setq field (nth 3 data-item))
      (setq block-name (nth 4 data-item))
      (if (= block_names "2")
        (if first-pass
          (progn
            (putatt2cell block-name ins)
            (setq current-col (+ current-col 1))
            (setq first-pass nil)
          )
        )
      )
      (if (= data_type "2")
        (putatt2cell value ins)
        (putatt2cell field ins)
      )
      (setq current-col (+ current-col 1))
    )
    (setq current-col (nth 2 ans))
    (setq current-row (+ current-row 1))
  )
  ; enables automatic table regeneration
  (vla-put-regeneratetablesuppressed Objtable :vlax-false)
  (princ)
)

; Performs a hittest on the point 'Pt' against the entities in the 'Lst'.
; Returns the entity, row, and column if 'Pt' hits an entity, or 'nil' otherwise.
(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
    )
  )
)

; Retrieves attribute values for the given block 'blk'.
; 'attribute_type' specifies whether to include all attributes or only visible ones.
; Returns a list of attribute name-value pairs.
(defun LM:getattributevalues (blk attribute_type / enx) ; Lee Mac and VAC
  (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
    (progn
      (setq is-hidden 1) ; How to find out if the current attribute is hidden or visible?
      (if (= is-hidden 1)
        (setq visibility-info "Hidden")
        (setq visibility-info "Visible")
      )
      (setq attribute-name (cdr (assoc 2 enx)))
;      (princ (strcat "Attribute Name: " attribute-name " - " visibility-info ", "))

      (if (or (not (= "2" attribute_type))
              (and (not (= is-hidden 1))
                   (= "2" attribute_type)))
        (progn
          (setq attribute-value (cdr (assoc 1 (reverse enx))))
          (cons
            (cons attribute-name attribute-value)
            (LM:getattributevalues blk attribute_type)
          )
        )
        (LM:getattributevalues blk attribute_type)
      )
    )
  )
)

; Retrieves AutoCAD table objects and returns them as a list of VLA objects.
(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)) )
  )
)

; Inserts the given text 'txt' into the table cell at the specified point 'pt'.
(defun putatt2cell (txt pt) ; VAC
  (if Tables
    (vla-settext (nth 0 Tables) current-row current-col txt)
  )
  (princ)
)

; Converts an AutoCAD selection set 'ss' into a list of entity names.
(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)
)

; Adds the specified number of columns 'num-cols-to-add' to the AutoCAD table 'table'.
(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. "))
    )
  )
)

; Adds the specified number of rows 'num-rows-to-add' to the AutoCAD table 'table'.
(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. "))
    )
  )
)

; Comparison function for sorting rows based on their first element.
(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
  )
)

; Gets the block name for the specified 'ent' entity.
(defun LM:getblockname (ent) ; VAC
  (if (and ent (vlax-ename->vla-object ent))
    (vlax-get-property (vlax-ename->vla-object ent) 'EffectiveName)
    ; (vla-get-Name (vlax-ename->vla-object ent))
  )
)

 

Edited September 12, 2023 by VAC

[VAC]

Hi, I've upgraded my script. It works, but only in global system, not in local. Error when selecting first table cell. How to fix it?

 

Here is my last code:

 

; 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 their attributes, alphabeticaly sort rows by attributes values
; Option 1: copy fields or only values
; Option 2: include block names as well
; Option 3: copy all atributes or only visible
; By VAC
; September 2023

(defun c:atts2table (/ ss ent first-iteration) ; VAC

  ; Performs a hittest on the point 'Pt' against the entities in the 'Lst'.
  ; Returns the entity, row, and column if 'Pt' hits an entity, or 'nil' otherwise.
  (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
      )
    )
  )

  ; Retrieves attribute values for the given block 'blk'.
  ; 'attribute_type' specifies whether to include all attributes or only visible ones.
  ; Returns a list of attribute name-value pairs.
  (defun LM:getattributevalues_m (blk attribute_type / enx) ; Lee Mac and VAC
    (setq blk1 blk)
    (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
      (progn
        (setq attribute-name (cdr (assoc 2 enx)))
        (setq is-visible (LM:get-entities-in-block blk1 attribute-name))
        (if (not (= "2" attribute_type))
          (setq is-visible "YES")
        )
        (if (= "YES" is-visible)
          (progn
            (setq attribute-value (cdr (assoc 1 (reverse enx))))
            (cons
              (cons attribute-name attribute-value)
              (LM:getattributevalues_m blk attribute_type)
            )
          )
          (LM:getattributevalues_m blk attribute_type)
        )
      )
    )
  )

  ; Gets the block entities visibility.
  (defun LM:get-entities-in-block (ent attribute-name / is_visible)
    (setq is_visible_return "NO")
    (while (not (eq "SEQEND" (dxf 0 (setq ent (entnext ent)))))
      (setq tag (dxf 2 ent))
      (setq is_visible
        (if (= :vlax-true (vla-get-visible (vlax-ename->vla-object ent)))
          "YES"
          "NO"
        )
      )
      (if (and (= attribute-name tag) (= "YES" is_visible))
        (setq is_visible_return is_visible)
      )
    )
    is_visible_return
  )

  ; The dxf function is used to extract values from entity lists (DXF records) in AutoCAD.
  (defun dxf (code something)
    (if something
      (cdr (assoc	code
              (cond ((= 'ename (type something)) (entget something))
                    ((and (= 'list (type something)) (vl-every 'vl-consp something)) something)
                    ((= 'vla-object (type something)) (entget (vlax-vla-object->ename something)))
              )
            )
      )
    )
  )
  
  ; Retrieves AutoCAD table objects and returns them as a list of VLA objects.
  (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)) )
    )
  )

  ; Inserts the given text 'txt' into the table cell at the specified point 'pt'.
  (defun LM:putatt2cells (objtable txt pt) ; VAC
    (if objtable
      (vla-settext objtable current-row current-col txt)
    )
    (princ)
  )

  ; Converts an AutoCAD selection set 'ss' into a list of entity names.
  (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)
  )

  ; Adds the specified number of columns 'num-cols-to-add' to the AutoCAD table 'table'.
  (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 "\nAdded " (itoa num-cols-to-add) " columns. "))
      )
    )
  )

  ; Adds the specified number of rows 'num-rows-to-add' to the AutoCAD table 'table'.
  (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 "\nAdded " (itoa num-rows-to-add) " rows. "))
      )
    )
  )

  ; Comparison function for sorting rows based on their first element.
  (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
    )
  )

  ; Gets the block name for the specified 'ent' entity.
  (defun LM:getblockname (ent) ; VAC
    (if (and ent (vlax-ename->vla-object ent))
      (vlax-get-property (vlax-ename->vla-object ent) 'EffectiveName)
      ; (vla-get-Name (vlax-ename->vla-object ent))
    )
  )

  ; options
  (setq data_type (getstring "\nSelect the option: (1 - insert values as formulas (fields) or 2 - insert only as text): <1> "))
  (setq block_names (getstring "\nSelect the option: (1 - without block names or 2 - with block names): <1> ")) 
  (setq attribute_type (getstring "\nSelect the option: (1 - copy all attributes or 2 - copy only visible attributes): <1> ")) 
  ; select blocks
  (setq ss (ssget '((0 . "INSERT"))))
  (if (not ss)
    (progn
      (prompt "\nNo blocks found.")
      (exit)
    )
  ) 
  ; select first cell in the table
  (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 '()) 
  
  ; reads data from blocks
  (foreach ent (LM:ss->list ss)
    ; reads attributes from blocks
    (setq att-values (LM:getattributevalues_m ent attribute_type))
    (if att-values
      (progn
        (setq data-item '())
        ; gets the block name
        (setq block-name (LM:getblockname ent))
        ; writes data for sorting
        (setq data-string "")
        (foreach att-value att-values
          (setq value (cdr att-value))
          (setq data-string (strcat data-string value))
        )
        ; writes data
        (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 data-string value tag field block-name) data-item))
        )
        (setq data-matrix (cons (reverse data-item) data-matrix))
      )
    )
  )

  ; sorts data by the first element (data-string)
  (setq sorted-data-matrix (vl-sort data-matrix 'LM:sort-by-first-element))
  ; inserts new rows to the table
  (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) (nth 1 ans))) 
  (if (> num-rows-to-add 0)
    (progn
      (vla-put-regeneratetablesuppressed Objtable :vlax-true)
      (LM:add-rows-to-table objtable num-rows-to-add)
      (vla-put-regeneratetablesuppressed Objtable :vlax-false)
    )
  )
  
  ; prints data
  (foreach data-row sorted-data-matrix
    (setq first-pass t)
    (foreach data-item data-row
      ; inserts new columns to the 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) (nth 2 ans)))
      (if (= block_names "2")
        (setq num-cols-to-add (+ num-cols-to-add 1))
      )
      (if (> num-cols-to-add 0)
        (progn
          (vla-put-regeneratetablesuppressed Objtable :vlax-true) 
          (LM:add-columns-to-table objtable num-cols-to-add)
          (vla-put-regeneratetablesuppressed Objtable :vlax-false)
        )
      )
      ; inserts values to table by options
      (setq sort-value (car data-item))
      (setq value (nth 1 data-item))
      (setq tag (nth 2 data-item))
      (setq field (nth 3 data-item))
      (setq block-name (nth 4 data-item))
      (if (= block_names "2")
        (if first-pass
          (progn
            (LM:putatt2cells objtable block-name ins)
            (setq current-col (+ current-col 1))
            (setq first-pass nil)
          )
        )
      )
      (if (= data_type "2")
        (LM:putatt2cells objtable value ins)
        (LM:putatt2cells objtable field ins)
      )
      (setq current-col (+ current-col 1))
    )
    (setq current-col (nth 2 ans))
    (setq current-row (+ current-row 1))
  )
  (princ)
)

 

 

The same is it in this easier script.

; Copy fields/texts between cells
(defun c:cfbc () ; VAC
(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
        )
      )
)

(setq obj (vlax-ename->vla-object (car (entsel "Pick table object"))))
  (while t
    (setq ans (vla-fieldcode (vlax-ename->vla-object (car (nentsel "\nSelect Cell to Copy Field/Text: ")))))
    (setq ins (getpoint "\nSelect Cell to Insert Field/Text: "))
    (setq ans1 (LM:Hittest ins (setq Tables (Getacadtableobjects))))
    (vla-settext obj (nth 1 ans1) (nth 2 ans1) ans)  
  )
)

 

Maybe it is in the Lee Mac Hiitest function definition?

 

 

Edited February 20 by VAC