Change attribute values based on values from AutoCAD table

[hbohm]

Hello everyone, I would like to populate an AutoCAD block with attributes with values pulled from an AutoCAD table. I've tried a few different LISP routines and can't figure out how to pair them up.

This post from @Anonymous is very close to what I'm after, but I don't want to pull the data from an Excel file:
Find & replace 'Attribute TEXT value' based on input provided in XLS

I've found a LISP that extracts the values from each cell of the table and assigns them to a separate variable, but I don't know how to push those values into my block attributes.

Here is the code for the lisp that extracts the table cell values. Could I get some help adding on to it please? Any help is appreciated.

(defun c:TDE (/ c ctr dat etdata ind lst prefix r tab tblent tblobj val varname)
(setq etdata (entget (setq tblent (car (entsel "\nSelect table object: "))))
ind (cdr (assoc 91 etdata))
tab (cdr (assoc 92 etdata))
r 0 ;;;This determines which row to start with
c 0 ;;;This determines which column to start with
ctr 1 ;;;This is the starting variable # (var1, var2, etc.)
prefix "var"
tblobj (vlax-ename->vla-object tblent))
(while (< c tab)
(while (< r ind)
(set (setq varname (read (strcat prefix (itoa ctr))))
(setq val (vlax-invoke tblobj 'getcellvalue r c)))
(setq lst (cons (setq dat (cons varname val)) lst))
(setq ctr (if (listp (cdr dat))
ctr
(1+ ctr))
r (1+ r)))
(setq r 0
c (1+ c)))
(vl-remove-if '(lambda (x) (listp (cdr x))) (reverse lst)))

[devitg · Accepted solution]

@hbohm 

check this , 

(foreach att (vlax-invoke blk 'getattributes  )
		 (vla-put-textstring att (nth (setq attnum (1+ attnum)) lst)))

It do the changes, but with no relations between the table list and the  blocks attributes 

 See dwg 

[hbohm]

@devitg Thanks for the fix. I didn't get around to editing my block attribute "creation order" yet, so that's why the values get inserted incorrectly.

In the new .dwg now I updated my block with the correct order, but the values are entered in reverse order. I'm experimenting with this line in my code to try and change the order it processes the values.

(reverse lst)

Any ideas?

[devitg · Accepted solution]

@hbohm , please give a test 

Find attached LISP a dwg as need 

(defun c:populate-blk (/
ATT
ATT-LIST
ATTNUM
BLK
C
CTR
ETDATA
IND
LST
PREFIX
R
STRING
TAB
TBLENT
TBLOBJ
TBLOBJ-COLS
TBLOBJ-ROWS
VAL
VALUE
                       )

(VL-LOAD-COM)

              
  
(setq etdata (entget (setq tblent (car (entsel "\nSelect table object: ")))))

  
(setq ind (cdr (assoc 91 etdata)));rows at table
(setq tab (cdr (assoc 92 etdata)));col at table
(setq prefix "var")
(setq tblobj (vlax-ename->vla-object tblent))
  (setq tblobj-rows (vla-get-rows tblobj))
  (setq tblobj-cols (vla-get-columns tblobj))


(setq r 0) ;;;This determines which) row to start with
(setq c 0) ;;;This determines which column to start with
(setq ctr 1) ;;;This is the starting variable # (var1, var2, etc.)
 (setq lst ())
  
(repeat  tblobj-rows
  (repeat tblobj-cols
   
(setq val (vlax-invoke tblobj 'getcellvalue   r c))
(setq lst (cons val lst))
(setq ctr (1+ ctr))
(setq c   (1+ c))
    
) ;_ end repeat cols
  ;(setq ctr 1)
  (setq c 0)
  (setq r (1+ r))
);end repeat rows 
  
(setq value  lst)

  ;;Select block, then change attributes to match table values
  (setq blk  (vlax-ename->vla-object (car (entsel "Select Fuse Sticker: "))))
  (setq attnum -1)

(setq att-list (vlax-invoke blk 'getattributes  ))
  ;(setq att (nth 0 att-list))
  
  (foreach att att-list
     ;(IF (<  attnum ( 1- data-count))
          (setq string (nth (setq attnum (1+ attnum)) value))
(if string
    (vla-put-textstring att string)
    )
       
    );end foreach
(princ)
)

[hbohm]

@devitg & @Sea-Haven  Thank you both for your help. I used code segments from each of you to get this to work. Here is my full working code. There is a minor bug that always throws the error "Bad argument value: non-negative: -1" but it still manages to update my block correctly each time I rerun it. Next, I'd like to add a function to clear the rest of the block attributes below the ones that were just updated. For example, when fuses get removed and the table is now shorter than the first time the lisp was ran. Do you know how I can incorporate this into the code?

(defun c:FuseSticker  (/ etdata ind tab r c tblent tblobj tblobj-rows tblobj-cols cellcount val lst blk att attnum)

 (vl-load-com)
 
 ;;Select table, then create list of cell values
 (setq etdata (entget (setq tblent (car (entsel "\nSelect Table Object: "))))
       ind    (cdr (assoc 91 etdata))
       tab    (cdr (assoc 92 etdata))
       r      1   ;;This determines which table row to start with
       c      0   ;;This determines which table column to start with
       tblobj (vlax-ename->vla-object tblent)
       tblobj-rows (vla-get-rows tblobj)
       tblobj-cols (vla-get-columns tblobj)
       cellcount (* (- tblobj-rows 1) tblobj-cols)) ;;Subtract header, multiply rows*columns

  (while (< r ind)
    (while (< c tab)
      (setq val (vlax-invoke tblobj 'getcellvalue r c))
      (setq lst (cons val lst))
      (setq c   (1+ c)))
    (setq c 0
        r (1+ r)))
    
  
  (setq blk (vlax-ename->vla-object (car (entsel "Select Fuse Sticker: "))))
  (setq attnum cellcount)
  (foreach att (vlax-invoke blk 'getattributes  )
		 (vla-put-textstring att (nth (setq attnum (1- attnum)) lst)))

  ) ;;defun

[hbohm]

-EDIT: Unmarked as solution
I got my last function request to work by setting all attributes to "-" first, then populating with the values from the table list.

;;Blank all attributes first
(foreach att (vlax-invoke blk 'getattributes)
  (vla-put-textstring att "-"))

[devitg]

@hbohm 

clearing the att , you lost some  att values 

[hbohm]

@devitg I realize that now. I am working out how to clear only the first 60 attributes, since I put the important block attributes at the bottom. This is where it would have come in handy to define each attribute tag and assign each table cell to them specifically instead of relying on just the order.

[devitg · Accepted solution]

@hbohm 

try with it 

(foreach att (vlax-invoke blk 'getattributes)
    (if (not(WCMATCH  (vla-get-TagString att)"P_ITEM,WDBLKNAM,CAT,FAMILY,MFG,DESCRIPTION,P_TAG1"))
    (vla-put-textstring att "-"))
    )

[hbohm]

@devitg 

Yes I like that much better! It works flawlessly. Thank you

[hbohm · Accepted solution]

I attached the updated .lsp & .dwg files in case someone needs to do something similar in the future.