Code Red > AutoLISP (Vanilla / Visual)
Add attribute to defined block
ribarm:
Hi...
I just wanted to ask if this is possible...
Block is already defined and placed in DWG as references... Now there are no attributes attached to it... I added one single ATTDEF near one reference and the question is - Is it possible to add this ATTDEF as ATTRIB inside that reference through LISP as with REFEDIT that definition vanishes and only when BEDIT, I can see it inside but as ATTDEF... I wonder if DXF 66 is the problem, but I'll attach DWG for you to experiment just for any case...
Thanks, M.R.
MP:
It’s very do-able. In fact, each block instance of a given block definition can sport different attributes - as a block instance (with attribs) is akin to a linked list. I wrote about this many many years ago. I’ll post the link and / or code later (currently in transit, posting from my phone).
ribarm:
--- Quote from: MP on May 16, 2019, 09:54:46 AM ---It’s very do-able. In fact, each block instance of a given block definition can sport different attributes - as a block instance (with attribs) is akin to a linked list. I wrote about this many many years ago. I’ll post the link and / or code later (currently in transit, posting from my phone).
--- End quote ---
I'll be very grateful to see this comes true...
Thanks MP.
ribarm:
Not the happiest solution, but for quick fix, it did the task...
Here are my written materials :
--- Code - Auto/Visual Lisp: ---(defun c:addatt-statblk ( / *adoc* hyperdatalst hyperdata ucsf att blk ss blst blstdata n s attr f lay xdata ldata hyper ) (vl-load-com) (defun hyperdatalst ( hypers-vla / rtn ) (vl-load-com) (vlax-for hyper-vla hypers-vla (setq rtn (cons (hyperdata hyper-vla) rtn)) ) rtn ) (defun hyperdata ( hyper-vla / rtn ) (vl-load-com) (setq rtn (list (vla-get-url hyper-vla) (vla-get-urldescription hyper-vla) (vla-get-urlnamedlocation hyper-vla))) ) (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))) (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark *adoc*) ) (vla-startundomark *adoc*) (if (= 0 (getvar 'worlducs)) (progn (vl-cmdf "_.UCS" "_W") (setq ucsf t) ) ) (alert "Avoid to set ATTDEF you want to add to block that way, that it lies in layer \"0\" - it will then inherit layer of block... This is just warning, but you decide in what layer you want your attribute(s)...") (while (or (not (setq att (car (entsel "\nPick attribute definition on unlocked layer...")))) (if att (or (/= (cdr (assoc 0 (entget att))) "ATTDEF") (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget att)))))))) ) ) ) (prompt "\nMissed or picked wrong entitiy type or picked ATTDEF on locked layer...") ) (while (or (not (setq blk (car (entsel "\nPick static block reference on unlocked layer you want to add attribute that was previously picked...")))) (if blk (or (/= (cdr (assoc 0 (entget blk))) "INSERT") (= :vlax-true (vla-get-isdynamicblock (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk)))))) (= :vlax-true (vla-get-isxref (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk)))))) (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (entget blk))))))))) ) ) ) (prompt "\nMissed or picked wrong entity type, or picked entity not static block, or picked entity on locked layer...") ) (if (not (vl-every '(lambda ( x ) (= x 1.0)) (list (cdr (assoc 41 (entget blk))) (cdr (assoc 42 (entget blk))) (cdr (assoc 43 (entget blk)))))) (progn (prompt "\nMaster block isn't uniformly scaled... Retry routine with uniformly scaled block reference - scaled xscf=1.0 yscf=1.0 zscf=1.0 as reference entity for processing...") (exit) ) ) (setq xdata (assoc -3 (entget blk '("*")))) (setq ldata (vlax-ldata-list blk)) (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object blk)))) (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 (entget blk)))) (cons 410 (getvar 'ctab))))) (foreach b (setq blst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget blk)))))))) (setq blst (vl-remove b blst)) ) ) (setq blst (vl-remove blk blst)) (if (vl-some '(lambda ( x ) (not (equal '(210 0.0 0.0 1.0) (assoc 210 (entget x))))) blst) (setq f t) ) (if f (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst)) (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 10 (entget x))) (cdr (assoc 50 (entget x))) (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst)) ) (setq n (cdr (assoc 2 (entget blk)))) (vl-cmdf "_.UCS" "_e" blk) (vl-cmdf "_.EXPLODE" blk) (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) (setq s (ssget "_P")) (ssadd att s) (vl-cmdf "_.-BLOCK" "{_TEMP_}" "_non" '(0.0 0.0 0.0) s "") (setq attr (getvar 'attreq)) (setvar 'attreq 0) (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) 1.0 1.0 0.0) (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast))))))) (if xdata (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata)))))) ) (setq xdata nil) (if ldata (foreach ld ldata (vlax-ldata-put (entlast) (car ld) (cdr ld)) ) ) (setq ldata nil) (if hyper (foreach h hyper (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h)) ) ) (setq hyper nil) (vl-cmdf "_.UCS" "_P") (foreach b blstdata (if f (progn (setq lay (cdr (assoc 8 (entget (car b))))) (setq xdata (assoc -3 (entget (car b) '("*")))) (setq ldata (vlax-ldata-list (car b))) (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b))))) (vl-cmdf "_.UCS" "_e" (car b)) (entdel (car b)) (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) (cadr b) (caddr b) 0.0) (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast))))))) (if xdata (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata)))))) ) (setq xdata nil) (if ldata (foreach ld ldata (vlax-ldata-put (entlast) (car ld) (cdr ld)) ) ) (setq ldata nil) (if hyper (foreach h hyper (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h)) ) ) (setq hyper nil) (vl-cmdf "_.UCS" "_P") ) (progn (setq lay (cdr (assoc 8 (entget (car b))))) (setq xdata (assoc -3 (entget (car b) '("*")))) (setq ldata (vlax-ldata-list (car b))) (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b))))) (entdel (car b)) (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" (cadr b) (cadddr b) (nth 4 b) (cvunit (caddr b) "radian" "degree")) (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast))))))) (if xdata (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata)))))) ) (setq xdata nil) (if ldata (foreach ld ldata (vlax-ldata-put (entlast) (car ld) (cdr ld)) ) ) (setq ldata nil) (if hyper (foreach h hyper (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h)) ) ) (setq hyper nil) ) ) ) (setvar 'attreq attr) (vl-cmdf "_.PURGE" "_B" n "_N") (vl-cmdf "_.RENAME" "_B" "{_TEMP_}" n) (if ucsf (vl-cmdf "_.UCS" "_P") ) (vla-endundomark *adoc*) (princ))
--- Code - Auto/Visual Lisp: ---(defun c:rematt-statblk ( / *adoc* hyperdatalst hyperdata ucsf att blk ss blst blstdata n s attr f lay xdata ldata hyper ) (vl-load-com) (defun hyperdatalst ( hypers-vla / rtn ) (vl-load-com) (vlax-for hyper-vla hypers-vla (setq rtn (cons (hyperdata hyper-vla) rtn)) ) rtn ) (defun hyperdata ( hyper-vla / rtn ) (vl-load-com) (setq rtn (list (vla-get-url hyper-vla) (vla-get-urldescription hyper-vla) (vla-get-urlnamedlocation hyper-vla))) ) (setq *adoc* (vla-get-activedocument (vlax-get-acad-object))) (if (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark *adoc*) ) (vla-startundomark *adoc*) (if (= 0 (getvar 'worlducs)) (progn (vl-cmdf "_.UCS" "_W") (setq ucsf t) ) ) (while (or (not (setq att (car (nentsel "\nPick attribute on desired static block on unlocked layer...")))) (if att (or (/= (cdr (assoc 0 (entget att))) "ATTRIB") (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget att)))))))) ) ) ) (prompt "\nMissed or picked wrong entitiy type or picked ATTRIB on locked layer...") ) (if (or (not (setq blk (cdr (assoc 330 (entget att))))) (if blk (or (/= (cdr (assoc 0 (entget blk))) "INSERT") (= :vlax-true (vla-get-isdynamicblock (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk)))))) (= :vlax-true (vla-get-isxref (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk)))))) (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (entget blk))))))))) ) ) ) (progn (prompt "\nMissed or picked wrong entity type, or picked entity not static block, or picked entity on locked layer... Quitting...") (exit) ) ) (if (not (vl-every '(lambda ( x ) (= x 1.0)) (list (cdr (assoc 41 (entget blk))) (cdr (assoc 42 (entget blk))) (cdr (assoc 43 (entget blk)))))) (progn (prompt "\nMaster block isn't uniformly scaled... Retry routine with uniformly scaled block reference - scaled xscf=1.0 yscf=1.0 zscf=1.0 as reference entity for processing...") (exit) ) ) (setq xdata (assoc -3 (entget blk '("*")))) (setq ldata (vlax-ldata-list blk)) (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object blk)))) (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 (entget blk)))) (cons 410 (getvar 'ctab))))) (foreach b (setq blst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget blk)))))))) (setq blst (vl-remove b blst)) ) ) (setq blst (vl-remove blk blst)) (if (vl-some '(lambda ( x ) (not (equal '(210 0.0 0.0 1.0) (assoc 210 (entget x))))) blst) (setq f t) ) (if f (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst)) (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 10 (entget x))) (cdr (assoc 50 (entget x))) (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst)) ) (setq n (cdr (assoc 2 (entget blk)))) (vl-cmdf "_.UCS" "_e" blk) (vl-cmdf "_.EXPLODE" blk) (while (< 0 (getvar 'cmdactive)) (vl-cmdf "") ) (setq s (ssget "_P")) (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))) (if (and (= (cdr (assoc 0 (entget e))) "ATTDEF") (= (cdr (assoc 2 (entget e))) (cdr (assoc 2 (entget att))))) (progn (ssdel e s) (entdel e) ) ) ) (vl-cmdf "_.-BLOCK" "{_TEMP_}" "_non" '(0.0 0.0 0.0) s "") (setq attr (getvar 'attreq)) (setvar 'attreq 0) (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) 1.0 1.0 0.0) (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast))))))) (if xdata (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata)))))) ) (setq xdata nil) (if ldata (foreach ld ldata (vlax-ldata-put (entlast) (car ld) (cdr ld)) ) ) (setq ldata nil) (if hyper (foreach h hyper (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h)) ) ) (setq hyper nil) (vl-cmdf "_.UCS" "_P") (foreach b blstdata (if f (progn (setq lay (cdr (assoc 8 (entget (car b))))) (setq xdata (assoc -3 (entget (car b) '("*")))) (setq ldata (vlax-ldata-list (car b))) (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b))))) (vl-cmdf "_.UCS" "_e" (car b)) (entdel (car b)) (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) (cadr b) (caddr b) 0.0) (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast))))))) (if xdata (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata)))))) ) (setq xdata nil) (if ldata (foreach ld ldata (vlax-ldata-put (entlast) (car ld) (cdr ld)) ) ) (setq ldata nil) (if hyper (foreach h hyper (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h)) ) ) (setq hyper nil) (vl-cmdf "_.UCS" "_P") ) (progn (setq lay (cdr (assoc 8 (entget (car b))))) (setq xdata (assoc -3 (entget (car b) '("*")))) (setq ldata (vlax-ldata-list (car b))) (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b))))) (entdel (car b)) (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" (cadr b) (cadddr b) (nth 4 b) (cvunit (caddr b) "radian" "degree")) (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast))))))) (if xdata (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata)))))) ) (setq xdata nil) (if ldata (foreach ld ldata (vlax-ldata-put (entlast) (car ld) (cdr ld)) ) ) (setq ldata nil) (if hyper (foreach h hyper (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h)) ) ) (setq hyper nil) ) ) ) (setvar 'attreq attr) (vl-cmdf "_.PURGE" "_B" n "_N") (vl-cmdf "_.RENAME" "_B" "{_TEMP_}" n) (if ucsf (vl-cmdf "_.UCS" "_P") ) (vla-endundomark *adoc*) (princ))
I wonder again, is there a better solution that would be good and that is not this way cumbersome to use EXPLODE and other command functions like BLOCK, INSERT and that don't involve creating temporary block named "{_TEMP_}" which could already be used in DWG so that routine wouldn't disturb anything existing in DWG...
Regards, M.R.
[EDIT : I've updated codes to preserve HYPERLINKS, XDATA, LDATA and LAYER property of block...]
MP:
Curiously I could not find the post (posted 2014-ish) so I wrote something from scratch.
--- Code: ---(defun _genericize-dxf-data ( dxf-data )
(vl-remove-if
(function
(lambda (p)
(or
(minusp (car p))
(member (car p) '(0 330 360 5 100 66))
)
)
)
dxf-data
)
)
--- End code ---
--- Code: ---(defun _entmake-from-entity-and-map ( entity map )
( (lambda ( entity-data )
(entmake
(mapcar
(function
(lambda ( p / p! )
(if (setq p! (assoc (car p) entity-data))
p!
p
)
)
)
map
)
)
)
(_genericize-dxf-data (entget entity))
)
)
--- End code ---
--- Code: ---(defun _entmake-insert-from-insert ( insert )
(_entmake-from-entity-and-map
insert
'(
(0 . "INSERT")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbBlockReference")
(66 . 1)
(2 . "UNNAMED")
(10 -12.611 33.6579 0.0)
(41 . 1.0)
(42 . 1.0)
(43 . 1.0)
(50 . 0.0)
(70 . 0)
(71 . 0)
(44 . 0.0)
(45 . 0.0)
(210 0.0 0.0 1.0)
)
)
)
--- End code ---
--- Code: ---(defun _entmake-attrib-from-attdef ( attdef )
(_entmake-from-entity-and-map
attdef
'( (0 . "ATTRIB")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbText")
(10 -12.0677 32.7299 0.0)
(40 . 0.381851)
(1 . "VAL-1")
(50 . 0.0)
(41 . 1.0)
(51 . 0.0)
(7 . "Standard")
(71 . 0)
(72 . 0)
(11 0.0 0.0 0.0)
(210 0.0 0.0 1.0)
(100 . "AcDbAttribute")
(280 . 0)
(2 . "ATT-1")
(70 . 0)
(73 . 0)
(74 . 0)
(280 . 0)
)
)
)
--- End code ---
--- Code: ---(defun _entmake-seqend-from-insert ( insert )
(_entmake-from-entity-and-map
insert
'( (0 . "SEQEND")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
)
)
)
--- End code ---
Bring it all together in a wrapper function ...
--- Code: ---(defun _add-attribs-to-insert ( insert ss-attdefs / i e lst object attribs )
(and
(progn (vl-load-com) t)
(eq 'pickset (type ss-attdefs))
(< 0 (setq i (sslength ss-attdefs)))
(setq object (vlax-ename->vla-object insert))
(_entmake-insert-from-insert insert)
(cond
((eq :vlax-false (vla-get-hasattributes object)))
((vl-every
(function (lambda (a) (_entmake-attrib-from-attdef a)))
(mapcar 'vlax-vla-object->ename (vlax-invoke object 'getattributes))
))
)
(progn
(repeat i (setq lst (cons (ssname ss-attdefs (setq i (1- i))) lst)))
(vl-every '_entmake-attrib-from-attdef lst)
)
(_entmake-seqend-from-insert insert)
(progn
(vla-put-lock
(vla-item
(vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(cdr (assoc 8 (entget insert)))
)
:vlax-false
)
(entdel insert)
(repeat (setq i (sslength ss-attdefs))
(vl-catch-all-apply 'entdel (list (ssname ss-attdefs (setq i (1- i)))))
)
T
)
)
)
--- End code ---
Bring it all together in a command ...
--- Code: ---(defun c:add-attribs-to-insert ( / insert ss ss-attdefs )
(princ
(if
(and
(setq insert (car (entsel "\nSelect existing insert: ")))
(eq "INSERT" (cdr (assoc 0 (entget insert))))
(setq ss-attdefs (ssget '((0 . "attdef"))))
(_add-attribs-to-insert insert ss-attdefs)
)
"\nDone."
"\nFailed."
)
)
(princ)
)
--- End code ---
As mentioned previously, this technique allows each instance of a block to sport it's own number of attributes, c/w unique tags if desired. Also, one can make any of the attributes constant after the fact, making them effectively read-only to users. The latter is different than constant attributes which are common to each instance of the block.
Please note that the supplied code creates a new instance of a selected block insert (deleting the original instance - this will impact other programs that rely on the existing insert's handle), populating the new instance with any previous attributes as well as adding the new ones.
See the image below which demonstrates 4 instance of the block "x" (which is defined attribute-less), each having it's own attributes. Attached dwg illuminates same.
Finally, code was written quickly and is not bomb proof, I'll leave that up to you.
Edit: Revised the _add-attribs-to-insert function as it was creating the new attributes in the reverse order desired.
Cheers.
Navigation
[0] Message Index
[#] Next page
Go to full version