;;;Update block insertions and preserve attributes. (uses MKLAYR.LSP, UKWORD.LSP)
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 12-20-94
;;;>		   EDITED: 02-20-2006
;;;
(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
  (C:SVLAYR)
  (setq lupr (getvar "luprec"))
  (setq attrq (getvar "attreq"))
  (setvar "ATTREQ" 0)
  (setq old_osmode (getvar "osmode"))
  (setvar "osmode" 0)
  (setq clayr (getvar "clayer"))
  (setq	ent   (entget (car (entsel "Select block to update. ")))
	blknm (cdr (assoc 2 ent))
	blkla (cdr (assoc 8 ent))
	tset  (ssadd (cdr (assoc -1 ent)))
  ) ;_ end of setq
  (setvar "clayer" blkla)
  (setq cntr 0)
  (command ".insert" (strcat blknm "="))
  (command)
  (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)))
  (SETQ anewbent T)
  (while (AND anewbent (/= (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
    (IF (entnext (cdar bent))
      (setq bent (entget (entnext (cdar bent))))
      (setq anewbent NIL)
    )      
  ) ;_ 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
  (SETQ anewbent T)
  (while (AND anewbent (/= (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
    (IF (entnext (cdar bent))
      (setq bent (entget (entnext (cdar bent))))
      (SETQ anewbent NIL)
    )
  ) ;_ end of while
  (SETQ anewbent NIL)
  (entupd (entlast))
  (setvar "LUPREC" lupr)
  (setvar "ATTREQ" attrq)
  (setvar "osmode" old_osmode)
  (c:rslayr)
  (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 (and bent (/= (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
    (if (setq nxtentname (entnext (cdar bent)))
      (setq bent (entget nxtentname))
      (setq bent nil)
    )
  ) ;_ 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!***|;