;;;Update or Replace an existing block. (uses USTR UKWORD)
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 1991 - 2005
;;;>		   EDITED: 12-08-2006
;;;
(defun c:rblk (/)
  (if (AND ustr ukword)
    NIL
    (load "uutils" "\nFile UUTILS.LSP not loaded! ")
  ) ;_ end of IF
  (setq lupr (getvar "luprec"))
  (setq attrq (getvar "attreq"))
  (command ".undo" "begin")
  (setvar "ATTREQ" 0)
					;(princ "\n     MODIFIED FOR SINGLE USE - UNMODIFY TO RESTORE     ")
  (if roru
    (setq ent	(entget (car (entsel "Select block to update: ")))
	  blknm	(cdr (assoc 2 ent))
    ) ;_ end of setq
					;  (setq ent (entget(ssname(ssget "x" '((-4 . "<and")(0 . "INSERT")(2 . "*TTBAT")(-4 . "AND>")))0))
					;        blknm "POMTTBAT")
    (setq ent	(entget (car (entsel "Select block to replace: ")))
	  blknm	(ustr 1
		      (strcat "Block name to replace "
			      (cdr (assoc 2 ent))
			      " with"
		      ) ;_ end of strcat
		      blknm
		      nil
		) ;_ end of ustr
    ) ;_ end of setq
  )					;if
  (setq	r_mode (ukword 1
		       "One Many All"
		       "Replace Block Mode (One, Many or All)"
		       r_mode
	       ) ;_ end of ukword
  ) ;_ end of setq
					;(setq r_mode "One")
;;;(princ (cons 2 (strcat "\`" (cdr (assoc 2 ent)))))
  (cond
    ((eq r_mode "All")
     (setq getit (list
		   (cons -4 "<AND")
		   (cons 0 "INSERT")
;;;                   (if (eq (substr (cdr (assoc 2 ent)) 1 1) "*")
;;;                     (cons 2 (strcat "\`" (cdr (assoc 2 ent))))
		   (assoc 2 ent)
;;;                   )
		   (cons -4 "AND>")
		 ) ;_ end of list
     ) ;_ end of setq
     (setq tset (ssget "x" getit))
    )
    ((eq r_mode "One")
;;;     (if (eq (substr (cdr (assoc 2 ent)) 1 1) "*")
;;;       (setq tset (ssget "x" (list (assoc 0 ent)(assoc 8 ent)(cons 2 (strcat "\`" (cdr (assoc 2 ent))))(assoc 10 ent))))
     (setq tset	(ssget "x"
		       (list (assoc 0 ent)
			     (assoc 8 ent)
			     (assoc 2 ent)
			     (assoc 10 ent)
		       ) ;_ end of list
		) ;_ end of ssget
     ) ;_ end of setq
;;;     )
    )
    ((eq r_mode "Many")
     (setq getit (list
		   (cons -4 "<AND")
		   (cons 0 "INSERT")
;;;                   (if (eq (substr (cdr (assoc 2 ent)) 1 1) "*")
;;;                     (cons 2 (strcat "\`" (cdr (assoc 2 ent))))
		   (assoc 2 ent)
;;;                   )
		   (cons -4 "AND>")
		 ) ;_ end of list
     ) ;_ end of setq
     (setq tset (ssget getit))
    )
  ) ;_ end of cond
  (if tset
    (progn
      (setq tsln (sslength tset))
      (setq cntr 0)
    ) ;_ end of progn
  ) ;_ end of if
;;;(command ".insert" (strcat blknm "="))
;;;(command)
  (if c:svlayr
    (c:svlayr)
    (progn
      (load "mklayr")
      (c:svlayr)
    ) ;_ end of progn
  ) ;_ end of if
					;(if clnmstd nil (load"mklayr"))
					;(if(clnmstd)
					;  (if(not(=(substr clayr 2 1)"-"))
					;    (setq llt "-")
					;  );if
					;);if
					;(setq modf "SYMB")
					;(c:mklayr)
  (while
    (if	(and (< cntr tsln) tset)
      (setq tent (entget (ssname tset cntr)))
    )					;if
     (progn
       (setq edtw  (entget (cdar tent))
	     xent  (ssname tset cntr)
	     inxyz (strcat (rtos (cadr (assoc 10 edtw)) 2 8)
			   ","
			   (rtos (caddr (assoc 10 edtw)) 2 8)
		   ) ;_ end of strcat
	     xscl  (cdr (assoc 41 edtw))
	     yscl  (cdr (assoc 42 edtw))
	     zscl  (cdr (assoc 43 edtw))
	     elay  (cdr (assoc 8 edtw))
	     inang (angtos (cdr (assoc 50 edtw)) (getvar "aunits") 8)
       )				;SETQ
       (setvar "clayer" elay)
       (command ".insert" blknm inxyz xscl yscl inang)
       (setq tent (entlast))
       (setq bins (entlast))
     )					;progn
     (while
       (and
	 (setq attr (entnext xent))
	 (not (eq (cdr (assoc 0 (entget attr))) "SEQEND"))
	 (not (eq (cdr (assoc 0 (entget attr))) "INSERT"))
       )				;and
	(if (eq (cdr (assoc 0 (entget attr))) "ATTRIB")
	  (set (read (cdr (assoc 2 (entget attr))))
	       (assoc 1 (entget attr))
	  ) ;_ end of set
	)				;if
	(setq xent (entnext xent))

     )					;while
     (while
       (and
	 (setq attr (entnext bins))
	 (not (eq (cdr (assoc 0 (entget attr))) "SEQEND"))
	 (not (eq (cdr (assoc 0 (entget attr))) "INSERT"))
       )				;and
	(setq bins (entnext bins))
	(setq edtw (entget attr))
	(cond
	  ((and
	     (eq (cdr (assoc 2 edtw)) "SEC/DET_REF")
	     (eq (cdr (assoc 0 edtw)) "ATTRIB")
	     att1
	     att2
	     att3
	   )				;and
	   (progn
	     (setq edtw
		    (subst att1
			   (assoc 1 edtw)
			   edtw
		    )			;subst
	     )				;setq
	     (entmod edtw)
	     (entmod (entget tent))
	   ) ;_ end of progn
	  )				;and & progn
	  ((and
	     (eq (cdr (assoc 2 edtw)) "SHT_CALL_ON")
	     (eq (cdr (assoc 0 edtw)) "ATTRIB")
	     att1
	     att2
	     att3
	   )				;and
	   (progn
	     (setq edtw
		    (subst att2
			   (assoc 1 edtw)
			   edtw
		    )			;subst
	     )				;setq
	     (entmod edtw)
	     (entmod (entget tent))
	   ) ;_ end of progn
	  )				;and & progn
	  ((and
	     (eq (cdr (assoc 2 edtw)) "SHT_DRWN_ON")
	     (eq (cdr (assoc 0 edtw)) "ATTRIB")
	     att1
	     att2
	     att3
	   )				;and
	   (progn
	     (setq edtw
		    (subst att3
			   (assoc 1 edtw)
			   edtw
		    )			;subst
	     )				;setq
	     (entmod edtw)
	     (entmod (entget tent))
	   ) ;_ end of progn
	  )				;and & progn
	)				;cond
     )					;while
     (setq cntr (1+ cntr))
     (entdel (cdar edtw))
  )					;while
  (setvar "LUPREC" lupr)
  (setvar "ATTREQ" attrq)
  (c:rslayr)
  (command ".undo" "end")
  (princ)
					;(command ".resume")
)					;DEFUN
;|«Visual LISP© Format Options»
(72 2 40 2 T "end of " 60 9 1 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;