blocks attributes from one to another block

[Anonymous]

im trying to create a lisp that when i select a block where the attribs are
filled out that it copies this info and has an option to populate all blocks
with the same name or just one block i specify as long as it contains block
attribs with the same definitions ie tag/prompt

here is what i have so far

with some help

(defun C:COPYBLKATTS()
(setq ENT (ssget))
(if (= (sslength ENT) 1)
(progn
(setq BLKINF (BL_GETATTS (cdr (assoc -1 (setq BLK1 (entget (ssname
ENT 0))))))
BLK1NAME (cdr (assoc 2 BLK1))
BLK1LIST (list (cons 0 "INSERT") (cons 2 BLK1NAME))
ENTS (ssget "X" BLK1LIST)
CNT 0
) ;setq
(if (> (sslength ENTS) 1)
(progn
(while (< CNT (sslength ENTS))
(setq ED (entget (ssname ENTS CNT))) ; get 1st entity in ss
(setq EN (cdr (assoc -1 ED))) ; Sets ED to the entity data of entity
EN
(foreach ITEM BLKINF
(setq TAG (cadr ITEM)
VALUE (car ITEM)
) ;setq
(BL_WRITEATTR EN TAG VALUE)
) ;foreach
(setq CNT (1+ CNT))
) ;end while
) ;progn
) ;if
) ;progn
) ;if
(princ)
)
(defun BL_GETATTS (ENAME / ENTL EN ATT TAG ATTLST FLAG TMP)
(setq
ATTLST '()
ENTL (entget ENAME)
TMP (LI_ITEM 66 ENTL)
)
(if (and TMP (not (zerop (logand TMP 1))))
(progn
(setq
ENAME (entnext ENAME)
ENTL (entget ENAME)
EN "ATTRIB"
)
(while (/= EN "SEQEND")
(setq
ATT (LI_ITEM 1 ENTL)
FLAG (LI_ITEM 70 ENTL)
TAG (strcase (LI_ITEM 2 ENTL))
ATTLST (append ATTLST (list (list ATT TAG FLAG)))
ENAME (entnext ENAME)
ENTL (entget ENAME)
EN (LI_ITEM 0 ENTL)
)
)
)
)
ATTLST
)

(defun LI_ITEM (N ALIST)
(cdr (assoc N ALIST))
)

(defun BL_WRITEATTR (ENAME TAG VALUE / ANAME ENTL)
(setq ANAME (BL_FINDATTR ENAME TAG)) ; Search for attribute
(if ANAME
(progn
(setq
ENTL (entget ANAME)
ENTL (subst (cons 1 VALUE) (assoc 1 ENTL) ENTL)
)
(entmod ENTL)
(entupd ENAME)
)
)
ENAME
)

(defun BL_FINDATTR (ENAME TAG / ANAME ENTL EN CNT MORE _TAG)
(setq EN "ATTRIB"
ANAME NIL
TAG (strcase TAG)
MORE t
)
(while MORE
(setq ENAME (entnext ENAME)
ENTL (entget ENAME)
EN (LI_ITEM 0 ENTL)
)
(if (= EN "ATTRIB")
(progn
(setq _TAG (strcase (LI_ITEM 2 ENTL)))
(if (= TAG _TAG)
(setq ANAME ENAME
MORE NIL
)
)
)
(setq MORE NIL)
)
)
ANAME
)
(princ "\nType COPYBLKATTS to begin")

[bdidway]

try this rep att lisp. it works for me.


Blair Didway
ablairproject@cox.net