;---------------------------------------------------------- ; Attribute manipulation example ; From 1999 Autodesk University course PR31 ; taught by Bill Kramer ; ; Utilities: ; C:ATTOUT - extract attributes and block info ; C:ATTINP - import attributes and block info ; ATT:REPLACE - replace attributes in a block insert ; ATT:GETS - get attributes attached to a block insert ;;;----------------------------------------------------------- ;; ;; Extract all blocks containing attributes to ;; a text file. Include the block name as well ;; as the block handle with the data. ;; (defun C:ATTOUT () ;; ;; Enable handles in older AutoCADs, already on in 14, 2000 (if (/= (getvar "HANDLES") 1) (command "_HANDLES" "_ON")) ;; ;; build a selection set of all inserts with ;; attributes. (setq SS1 (ssget "X" '((0 . "INSERT")(66 . 1)))) ;; ;; if inserts found with attributes, build ;; report file. (if SS1 (progn (setq FN (strcat (getvar "DWGNAME") ".OUT") FH (open FN "w") CNT (sslength SS1) ) ;; ;; Loop through the selection set. ;; (repeat CNT (setq CNT (1- CNT) ;;started at the end of the set EN (ssname SS1 CNT) ;;get entity name EL (entget EN) ;;get entity list EH (cdr (assoc 5 EL)) ;;get entity handle ATTS (ATT:GETS EN) ;;get all the attributes LN (strcat "\"" (cdr (assoc 2 EL)) "\" \"" (cdr (assoc 5 EL)) "\"" (apply 'strcat (mapcar '(lambda (A) (strcat " \"" (cdr A) "\"")) ATTS))) ) (write-line LN FH) ) (close FH) )) (princ) ) ;;--------------------------------------------------------- ; (defun C:ATTINP () (setq FN (strcat (getvar "DWGNAME") ".INP") FN (findfile FN) ) (if FN (progn (setq FH (open FN "r")) ;; ;; Loop as long as data is in the file ;; (while (setq LN (read-line FH)) ;; ;; Convert string data into a list. (setq LN (read (strcat "(" LN ")")) HNDL (cadr LN) ;;get the handle EN (handent HNDL) ;;turn it into entity name ) (ATT:REPLACE EN (cddr LN)) ;;replace attributes utility ) (close FH) )) (princ) ) ;;--------------------------------------------------------- ;ATT:REPLACE - Replace attributes in entity (EN) ;from the list (ATTS). The list can be a sequential ;list of strings to be replaced or a list containing ;tag names and attribute values to be replaced specifically. ; (defun ATT:REPLACE (EN ATTS) (setq EN1 EN) (if (atom (car ATTS)) ;;is first list element an atom? ;;update sequential (foreach ATT ATTS (setq EN (entnext EN) ;;get the next entity EL (entget EN) ;;it is an attribute EL (subst (cons 1 ATT) ;;substitute the value (assoc 1 EL) EL) ) (entmod EL) ;;update it in the drawing database ) ;;else update by tag names (while (= "ATTRIB" (cdr (assoc 0 (setq EL (entget (setq EN (entnext EN))))))) (if (assoc (cdr (assoc 2 EL)) ATTS) (entmod (subst (cons 1 (cadr ;;use CDR if dotted pairs (assoc (cdr (assoc 2 EL)) ATTS))) (assoc 1 EL) EL) ) ) ) ) ;; ;; Regenerate the block insert and attributes. ;; (entupd EN1) ) ;;--------------------------------------------------------- ;ATT:GETS - Utility routine to get all attributes for ;an insert object (EN). ;; (defun ATT:GETS (EN / EL RES) (setq EN (entnext EN) EL (entget EN)) (while (= "ATTRIB" (cdr (assoc 0 EL))) (setq RES (cons (cons (cdr (assoc 2 EL)) (cdr (assoc 1 EL))) RES) EN (entnext EN) EL (entget EN))) (reverse RES) )