;;;Update block insertions and preserve attributes. (uses MKLAYR.LSP, UKWORD.LSP)
;;;both are available FREE at http://www.pinehurst.net/~pfrancis/lisp.htm
;;;
;;;	AUTHOR: Henry C. Francis
;;;           425 N. Ashe Street
;;;	        Southern Pines, NC 28387
;;;	All rights reserved without prejudice.
;;;
;;;	Copyright:	12-20-94
;;;	Edited:	5-16-98
;;;
(DEFUN C:UBLK (/       lupr    attrq   blknm   ent     tsln    cntr
	       inxyz   clayr   getit   natlst  taglst  inscl   inang
	       bins    attr    dblnk   att1    att2    att3    tset
	       tent    bent    xatlst
	      )
  (if clnmstd
    nil
    (load "mklayr")
  ) ;_ end of if
  (setq lupr (getvar "luprec"))
  (setq attrq (getvar "attreq"))
  (setvar "ATTREQ" 0)
  (setq clayr (getvar "clayer"))
  (setq	ent   (entget (car (entsel "Select block to update. ")))
	blknm (cdr (assoc 2 ent))
	tset  (ssadd (cdr (assoc -1 ent)))
  ) ;_ end of setq
  (setq cntr 0)
  (command ".insert" (strcat blknm "="))
  (command)
  (if c:mklayr
    nil
    (load "mklayr")
  ) ;_ end of if
  (if (clnmstd)
    (if	(not (= (substr clayr 2 1) "-"))
      (setq llt "-")
    ) ;_ end of if
  ) ;_ end of if
  (setq	modf "SYMB"
	xatlst nil
  ) ;_ end of setq
  (c:mklayr)
  (setq bent (entget (ssname tset cntr)))
  (setq edtw (entget (cdar bent)))
  (setq	inxyz (strcat (rtos (cadr (assoc 10 edtw)))
		      ","
		      (rtos (caddr (assoc 10 edtw)))
	      ) ;_ end of strcat
  ) ;_ end of setq
  (setq xscl (cdr (assoc 41 edtw)))
  (setq yscl (cdr (assoc 42 edtw)))
  (setq zscl (cdr (assoc 43 edtw)))
  (while (/= (cdr (assoc 0 bent)) "SEQEND")
    (if	(= (cdr (assoc 0 bent)) "ATTRIB")
      (if xatlst
	(setq xatlst (append
		       xatlst
		       (list
			 (assoc 2 bent)
			 (assoc 1 bent)
		       ) ;_ end of list
		     ) ;_ end of append
	      taglst (strcat taglst " " (cdr (assoc 2 bent)))
	) ;_ end of setq
	(setq xatlst (list
		       (assoc 2 bent)
		       (assoc 1 bent)
		     ) ;_ end of list
	      taglst (cdr (assoc 2 bent))
	) ;_ end of setq
      ) ;_ end of if
    ) ;_ end of if
    (setq bent (entget (entnext (cdar bent))))
  ) ;_ end of while
  (setq inang (angtos (cdr (assoc 50 edtw)) (getvar "aunits") 8))
  (command ".insert" blknm inxyz xscl yscl inang)
  (entdel (cdar edtw))
  (setq bent (entget (entlast)))
  (setq	natcnt 0
	natlst nil
  ) ;_ end of setq
  (while (/= (cdr (assoc 0 bent)) "SEQEND")
    (if	(= (cdr (assoc 0 bent)) "ATTRIB")
      (progn
	(if (member (assoc 2 bent) xatlst)
	  (progn
	    (setq edtw
		   (subst (cadr (member (assoc 2 bent) xatlst))
			  (assoc 1 bent)
			  bent
		   ) ;_ end of subst
	    ) ;_ end of setq
	    (entmod edtw)
	  ) ;_ end of progn
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
    (setq bent (entget (entnext (cdar bent))))
  ) ;_ end of while
  (entupd (entlast))
  (setvar "LUPREC" lupr)
  (setvar "ATTREQ" attrq)
  (setvar "CLAYER" clayr)
  (princ)
) ;_ end of DEFUN


(DEFUN UBLK (blknm   /	     lupr    attrq   ent     tsln    cntr
	     inxyz   clayr   getit   natlst  taglst  inscl   inang
	     bins    attr    dblnk   att1    att2    att3    tset
	     tent    bent    xatlst
	    )
  (if clnmstd
    nil
    (load "mklayr")
  ) ;_ end of if
  (setq lupr (getvar "luprec"))
  (setq attrq (getvar "attreq"))
  (setvar "ATTREQ" 0)
  (setq clayr (getvar "clayer")
	tset  (ssget "X"
		     (list (cons -4 "<AND")
			   (cons 0 "INSERT")
			   (cons 2 blknm)
			   (cons -4 "AND>")
		     ) ;_ end of list
	      ) ;_ end of ssget
  ) ;_ end of setq
  (setq cntr 0)
  (command ".insert" (strcat blknm "="))
  (command)
  (if c:mklayr
    nil
    (load "mklayr")
  ) ;_ end of if
  (if (clnmstd)
    (if	(not (= (substr clayr 2 1) "-"))
      (setq llt "-")
    ) ;_ end of if
  ) ;_ end of if
  (setq	modf "SYMB"
	xatlst nil
  ) ;_ end of setq
  (c:mklayr)
  (setq bent (entget (ssname tset cntr)))
  (setq edtw (entget (cdar bent)))
  (setq	inxyz (strcat (rtos (cadr (assoc 10 edtw)))
		      ","
		      (rtos (caddr (assoc 10 edtw)))
	      ) ;_ end of strcat
  ) ;_ end of setq
  (setq xscl (cdr (assoc 41 edtw)))
  (setq yscl (cdr (assoc 42 edtw)))
  (setq zscl (cdr (assoc 43 edtw)))
  (while (/= (cdr (assoc 0 bent)) "SEQEND")
    (if	(= (cdr (assoc 0 bent)) "ATTRIB")
      (if xatlst
	(setq xatlst (append
		       xatlst
		       (list
			 (assoc 2 bent)
			 (assoc 1 bent)
		       ) ;_ end of list
		     ) ;_ end of append
	      taglst (strcat taglst " " (cdr (assoc 2 bent)))
	) ;_ end of setq
	(setq xatlst (list
		       (assoc 2 bent)
		       (assoc 1 bent)
		     ) ;_ end of list
	      taglst (cdr (assoc 2 bent))
	) ;_ end of setq
      ) ;_ end of if
    ) ;_ end of if
    (setq bent (entget (entnext (cdar bent))))
  ) ;_ end of while
  (setq inang (angtos (cdr (assoc 50 edtw)) (getvar "aunits") 8))
  (command ".insert" blknm inxyz xscl yscl inang)
  (entdel (cdar edtw))
  (setq bent (entget (entlast)))
  (setq	natcnt 0
	natlst nil
  ) ;_ end of setq
  (while (/= (cdr (assoc 0 bent)) "SEQEND")
    (if	(= (cdr (assoc 0 bent)) "ATTRIB")
      (progn
	(if (member (assoc 2 bent) xatlst)
	  (progn
	    (setq edtw
		   (subst (cadr (member (assoc 2 bent) xatlst))
			  (assoc 1 bent)
			  bent
		   ) ;_ end of subst
	    ) ;_ end of setq
	    (entmod edtw)
	  ) ;_ end of progn
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
    (setq bent (entget (entnext (cdar bent))))
  ) ;_ end of while
  (entupd (entlast))
  (setvar "LUPREC" lupr)
  (setvar "ATTREQ" attrq)
  (setvar "CLAYER" clayr)
  (command "'resume")
) ;_ end of DEFUN

;|«Visual LISP© Format Options» (72 2 40 2 T "end of " 60 9 0 0 0 T T nil T)
 ***Don't add text below the comment!***|;