;;;Copy most entities from Blocks or XREFs.
;;;
;;;
;;;
;;;
;;;	Requirements: ukword.lsp, transpt.lsp
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 1996-2000
;;;>		   EDITED: 02-14-2005
;;;
(defun c:cpl (/ exornew)
					;       (/ plstrt plnxt xplent selent plv lnndx cur_la nplhe plent)
  (setq blk_lst nil)
  (if ukword
    nil
    (load "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of if
  (if ustr
    nil
    (load "ustr" "\nFile USTR.LSP not loaded! ")
  ) ;_ end of if
  (setq	ctokwd (ukword 1
		       "Current Entity"
		       "Copy to <C>urrent or <E>ntity layer? "
		       (if ctokwd
			 ctokwd
			 "Current"
		       ) ;_ end of if
	       ) ;_ end of ukword
  ) ;_ end of setq
  (while
    (setq plii (nentsel))
     (setq pliii  plii
	   plstrt (entnext (nth 0 plii))
	   xplent (cdr (entget (nth 0 plii)))
	   selent (cdr (assoc 0 xplent))
     ) ;_ end of setq
     (princ "\n")
     (princ selent)
    (IF (EQ selent "MLINE")
      (PROGN
;;;	(princ "\n\t\tCopying MLINEs produces corrupt MLINEs that AutoCAD CANNOT detect\n\t\t(Fatal exceptions even after no errors were found in database.) ")
	(princ "\n\t\tMLINEs CANNOT be copied! (AutoCAD will allow it but it corrupts the drawing beyond repair.")
	(princ)
      )
     (if (> (length plii) 2)
       (progn
	 (setq insent (entget (caar (reverse plii)))
	       insang (cdr (assoc 50 insent))
	 ) ;_ end of setq
	 (if (eq selent "VERTEX")
	   (setq plv   (entget (entnext plstrt))
		 plnxt (cdr (assoc -1 plv))
	   ) ;_ end of setq
	 ) ;_ end of if
	 (if transpt
	   nil
	   (load "transpt" "\nFile TRANSPT.LSP not loaded! ")
	 ) ;_ end of if
	 (if (eq selent "VERTEX")
	   (progn
	     (while
	       (/= (cdr (assoc 0 (entget plnxt))) "SEQEND")
		(setq plv   (entget (entnext plnxt))
		      plnxt (cdr (assoc -1 plv))
		) ;_ end of setq
	     ) ;_ end of while
	     (setq nplhe (entget (cdr (assoc -2 (entget plnxt))))
		   plnxt (entnext (cdr (assoc -1 nplhe)))
	     ) ;_ end of setq
	     (if (assoc 6 nplhe)
	       (if (wcmatch (cdr (assoc 6 nplhe)) "*|*")
		 (progn
		   (setq lnndx 1)
		   (while
		     (/= (substr (cdr (assoc 6 nplhe)) lnndx 1) "|")
		      (setq lnndx (1+ lnndx))
		   ) ;_ end of while
		   (setq
		     cur_lt (substr (cdr (assoc 6 nplhe)) (1+ lnndx))
		   ) ;_ end of setq
		 ) ;_ end of progn
		 (setq cur_lt (cdr (assoc 6 nplhe)))
	       ) ;_ end of if
	       (progn
		 (setq cur_lt
			(cdr (assoc
			       6
			       (tblsearch "LAYER" (cdr (assoc 8 nplhe)))
			     ) ;_ end of assoc
			) ;_ end of cdr
		 ) ;_ end of setq
		 (if (wcmatch cur_lt "*|*")
		   (progn
		     (setq lnndx 1)
		     (while (/= (substr cur_lt lnndx 1) "|")
		       (setq lnndx (1+ lnndx))
		     ) ;_ end of while
		     (setq cur_lt (substr cur_lt (1+ lnndx)))
		   ) ;_ end of progn
		 ) ;_ end of if
	       ) ;_ end of progn
	     ) ;_ end of if
	     (cond
	       ((eq ctokwd "Entity")
		(if (wcmatch (cdr (assoc 8 nplhe)) "*|*")
		  (progn
		    (setq cur_la (cdr (assoc 8 nplhe)))
		    (while
		      (wcmatch cur_la "*|*")
		       (setq cur_la (substr cur_la 2))
		    ) ;_ end of while
		  ) ;_ end of progn
		  (setq cur_la (cdr (assoc 8 nplhe)))
		) ;_ end of if
	       )
	       ((eq ctokwd "Current")
		(setq cur_la (getvar "clayer"))
	       )
	     ) ;_ end of cond
	     (setq nplhe
		    (subst
		      (cons 8 cur_la)
		      (assoc 8 nplhe)
		      nplhe
		    ) ;_ end of subst
	     ) ;_ end of setq
	     (if (assoc 6 nplhe)
	       (setq nplhe
		      (subst
			(cons 6 cur_lt)
			(assoc 6 nplhe)
			nplhe
		      ) ;_ end of subst
	       ) ;_ end of setq
	     ) ;_ end of if
	     (SETQ NPLHEMOD
		    (append
		      (list (assoc 0 nplhe))
		      (member (assoc 100 nplhe) nplhe)
		    ) ;_ end of append
	     ) ;_ end of SETQ
					;	 (PRINC nplhe)
					;	 (PRINC
;;;	     (entmake (cdr nplhe))
;;;	     (entmake
;;;	       (list
;;;		 (assoc 0 nplhe)
;;;		 (assoc 6 nplhe)
;;;		 (assoc 8 nplhe)
;;;		 (assoc 10 nplhe)
;;;		 (assoc 40 nplhe)
;;;		 (assoc 41 nplhe)
;;;		 (assoc 62 nplhe)
;;;		 (assoc 66 nplhe)
;;;		 (assoc 67 nplhe)
;;;		 (assoc 70 nplhe)
;;;		 (assoc 71 nplhe)
;;;		 (assoc 72 nplhe)
;;;		 (assoc 73 nplhe)
;;;		 (assoc 74 nplhe)
;;;		 (assoc 75 nplhe)
;;;		 (assoc 100 nplhe)
;;;		 (assoc 210 nplhe)
;;;		))
	     (IF
	       (entmake nplhemod)
		(PRINC "\n  Made Replicate Polyline header! ")
		(PROGN
		  (IF
		    (entmake '((0 . "POLYLINE")))
		     (PRINC "\n  Made Basic Polyline header! ")
		     (PRINC "\n  Did NOT Make Basic Polyline header! ")
		  ) ;_ end of IF
		) ;_ end of PROGN
	     ) ;_ end of IF
;;;	     (princ "\n  NPLHEMOD ENTITY DATA:\n")
;;;	     (princ nplhemod)
;;;	     (princ)
					;	 )
	     (while
	       (/= (cdr (assoc 0 (entget plnxt))) "SEQEND")
		(setq
		  newdpt (transpt plii (cdr (assoc 10 (entget plnxt))))
		) ;_ end of setq
		(setq plent (entget plnxt))
		(if (assoc 6 plent)
		  (setq	plent
			 (subst
			   (cons 6 cur_lt)
			   (assoc 6 plent)
			   plent
			 ) ;_ end of subst
		  ) ;_ end of setq
		) ;_ end of if
		(setq plent
		       (subst
			 (cons 8 cur_la)
			 (assoc 8 plent)
			 plent
		       ) ;_ end of subst
		) ;_ end of setq
		(setq plent
		       (subst
			 (cons 10 newdpt)
			 (assoc 10 plent)
			 plent
		       ) ;_ end of subst
		) ;_ end of setq
					;	   (PRINC plent)
					;	    (PRINC
		(entmake plent)
;;;	     (princ "\n  PLENT ENTITY DATA:\n")
;;;	     (princ plent)
;;;	     (princ)
;;;	       (SETQ PLENTMOD 
;;;	       (append
;;;		 (list(assoc 0 plent))
;;;		 (member(assoc 100 plent)plent)
;;;	       ))
;;; ;;;		 (assoc 100 plent)
;;; ;;;		 (assoc 67 plent)
;;; ;;;		 (assoc 410 plent)
;;; ;;;		 (assoc 8 plent)
;;; ;;;		 (assoc 62 plent)
;;; ;;;		 (assoc 6 plent)
;;; ;;;		 (assoc 100 (cdr(member(assoc 100 plent)plent)))
;;; ;;;		 (assoc 100 (cdr(member(assoc 100 (cdr(member(assoc 100 plent)plent)))plent)))
;;; ;;;		 (assoc 10 plent)
;;; ;;;		 (assoc 40 plent)
;;; ;;;		 (assoc 41 plent)
;;; ;;;		 (assoc 42 plent)
;;; ;;;		 (assoc 70 plent)
;;; ;;;		 (assoc 50 plent)
;;; ;;;		))
;;; ;;;	     (IF
;;; ;;;               (entmake PLENTMOD)
;;; ;;;	       (PRINC "\n  Made Polyline vertex! ")
;;; ;;;	       (PROGN
;;; ;;;		 (IF
;;;;;;                   (entmake (LIST(CONS 0 "VERTEX")(assoc 8 plent)(ASSOC 10 plent)(CONS 70 0)))
;;; ;;;                   (PRINC "\n  Made Polyline vertex! ")
;;; ;;;                   (PRINC "\n  Did NOT Make Polyline vertex! ")
;;; ;;;		 )
;;; ;;;	       )
;;; ;;;	     )
					;	    )
		(setq plnxt (entnext (cdr (assoc -1 (entget plnxt)))))
	     ) ;_ end of while
					;	 (PRINC (list (cons 0 "SEQEND")))
					;	 (PRINC
	     (entmake (list (cons 0 "SEQEND")))
					;	 )
	   ) ;_ end of progn
	   (if
	     (and
	       (eq (cdr (assoc 0 (entget (car (nth 0 (reverse plii))))))
		   "INSERT"
	       ) ;_ end of eq
	       (> (length (nth 0 (reverse plii))) 1)
	     ) ;_ end of and
	      (progn
		(setq ins_def (entget (car (nth 0 (reverse plii)))))
		(setq blk_def (tblsearch "block" (cdr (assoc 2 ins_def))))
		(setq
		  blk_def (subst (cons 70 0) (assoc 70 blk_def) blk_def)
		) ;_ end of setq
		(setq old_bname (cdr (assoc 2 blk_def)))
		(if (wcmatch old_bname "*|*")
		  (progn
		    (setq new_bname (substr old_bname 2))
		    (while (wcmatch new_bname "*|*")
		      (setq new_bname (substr new_bname 2))
		    ) ;_ end of while
		    (if	(tblsearch "block" new_bname)
		      (progn
			(setq redef_blk
			       (ukword
				 1
				 "Yes No"
				 (strcat
				   "*** WARNING *** Block "
				   new_bname
				   " exists. Do you want to redefine it?"
				 ) ;_ end of strcat
				 "No"
			       ) ;_ end of ukword
			) ;_ end of setq
			(if (eq redef_blk "No")
			  (setq	exornew
				 (ukword
				   1
				   "Existing New"
				   "Make New block definition or use Existing?"
				   "Existing"
				 ) ;_ end of ukword
			  ) ;_ end of setq
			  (if (eq exornew "New")
			    (progn
			      (while
				(tblsearch "block"
					   (setq new_bname
						  (ustr
						    1
						    (strcat
						      "*** WARNING *** Block "
						      new_bname
						      " exists. Enter a new name."
						    ) ;_ end of strcat
						    new_bname
						    nil
						  ) ;_ end of ustr
					   ) ;_ end of setq
				) ;_ end of tblsearch
			      ) ;_ end of while
			      (setq blk_def (subst (cons 2 new_bname)
						   (assoc 2 blk_def)
						   blk_def
					    ) ;_ end of subst
			      ) ;_ end of setq
			      (setq new_def
				     (reverse (cdr (reverse blk_def)))
			      ) ;_ end of setq
			      (setq blk_lst (list new_def))
			    ) ;_ end of progn
			    (setq blk_def (tblsearch "block" new_bname))
			  ) ;_ end of if
			) ;_ end of if
		      ) ;_ end of progn
		      (progn
			(setq blk_def (subst (cons 2 new_bname)
					     (assoc 2 blk_def)
					     blk_def
				      ) ;_ end of subst
			) ;_ end of setq
			(setq new_def (reverse (cdr (reverse blk_def))))
			(setq blk_lst (list new_def))
		      ) ;_ end of progn
		    ) ;_ end of if
		  ) ;_ end of progn
		) ;_ end of if
		(setq nextent (entget (cdr (assoc -2 blk_def))))
		(while
		  (and nextent (/= (cdr (assoc 0 nextent)) "INSERT"))
		   (if (assoc 6 nextent)
		     (progn
		       (setq old_eltyp (cdr (assoc 6 nextent)))
		       (if (wcmatch old_eltyp "*|*")
			 (progn
			   (setq new_eltyp (substr old_eltyp 2))
			   (while (wcmatch new_eltyp "*|*")
			     (setq new_eltyp (substr new_eltyp 2))
			   ) ;_ end of while
			   (setq nextent (subst	(cons 6 new_eltyp)
						(assoc 6 nextent)
						nextent
					 ) ;_ end of subst
			   ) ;_ end of setq
			 ) ;_ end of progn
		       ) ;_ end of if
		     ) ;_ end of progn
		   ) ;_ end of if
		   (setq old_elayr (cdr (assoc 8 insent)))
		   (if (and (wcmatch old_elayr "*|*") (eq useoldlay T))
		     (progn
		       (setq new_elayr (substr old_elayr 2))
		       (while (wcmatch new_elayr "*|*")
			 (setq new_elayr (substr new_elayr 2))
		       ) ;_ end of while
		       (setq nextent (subst (cons 8 new_elayr)
					    (assoc 8 nextent)
					    nextent
				     ) ;_ end of subst
		       ) ;_ end of setq
		     ) ;_ end of progn
		     (setq nextent (subst (cons 8 "0")
					  (assoc 8 nextent)
					  nextent
				   ) ;_ end of subst
		     ) ;_ end of setq
		   ) ;_ end of if
		   (setq blk_lst (append blk_lst (list nextent)))
		   (if (entnext (cdr (assoc -1 nextent)))
		     (setq nextent
			    (entget (entnext (cdr (assoc -1 nextent))))
		     ) ;_ end of setq
		     (setq nextent nil)
		   ) ;_ end of if
		) ;_ end of while
		(if nextent
		  (princ "\nCannot process nested blocks ")
		  (progn
		    (setq blk_lst
			   (append blk_lst (list (list (cons 0 "ENDBLK"))))
		    ) ;_ end of setq
		    (setq old_ilayr (cdr (assoc 8 ins_def)))
		    (if	(wcmatch old_ilayr "*|*")
		      (progn
			(setq new_ilayr (substr old_ilayr 2))
			(while (wcmatch new_ilayr "*|*")
			  (setq new_ilayr (substr new_ilayr 2))
			) ;_ end of while
			(if (eq ctokwd "Entity")
			  (setq	ins_def	(subst (cons 8 new_ilayr)
					       (assoc 8 ins_def)
					       ins_def
					) ;_ end of subst
			  ) ;_ end of setq
			  (setq
			    ins_def (subst (cons 8 (getvar "clayer"))
					   (assoc 8 ins_def)
					   ins_def
				    ) ;_ end of subst
			  ) ;_ end of setq
			) ;_ end of if
		      ) ;_ end of progn
		    ) ;_ end of if
		    (setq ins_def (subst (cons 2 new_bname)
					 (assoc 2 ins_def)
					 ins_def
				  ) ;_ end of subst
		    ) ;_ end of setq
		    (if	(or (eq exornew "New")
			    (not (tblsearch "block" new_bname))
			) ;_ end of or
		      (foreach n blk_lst (entmake n))
		    ) ;_ end of if
		    (if	(eq (car (nth 0 ins_def)) -1)
		      (setq ins_def (cdr ins_def))
		    ) ;_ end of if
		    (if	(assoc 66 ins_def)
		      (setq ins_def
			     (append
			       (reverse	(cdr (member (assoc 66 ins_def)
						     (reverse ins_def)
					     ) ;_ end of member
					) ;_ end of cdr
			       ) ;_ end of reverse
			       (cdr (member (assoc 66 ins_def) ins_def)
			       ) ;_ end of cdr
			     ) ;_ end of append
		      ) ;_ end of setq
		    ) ;_ end of if
		    (entmake)
		    (if	(entmake ins_def)
		      (progn
			(princ
			  (strcat "\nInsert of " new_bname " created ")
			) ;_ end of princ
			(entmake)
		      ) ;_ end of progn
		      (progn
			(princ "\nInsert NOT created ")
			(entmake)
		      ) ;_ end of progn
		    ) ;_ end of if
;;;		(setq pline_cnt 1			;This section makes plines of Aerial "Water" blocks.
;;;		      stopents nil)
;;;		(entmake)
;;;		(foreach n blk_lst
;;;		  (if stopents nil
;;;		  (if (eq pline_cnt 1)
;;;		    (progn
;;;		      (entmake n)
;;;		      (entmake (list
;;;			       (cons 0 "polyline")
;;;			       (cons 8 "water")
;;;			       (cons 66 1)
;;;			       (cons 10 (cdr (assoc 10 n)))
;;;			     )
;;;		      )
;;;		    )
;;;		    (if (equal(car n)(cons 0 "ENDBLK"))
;;;		      (progn
;;;			(if
;;;		          (entmake (list(cons 0 "SEQEND")))
;;;			)
;;;			(entmake (list(cons 0 "ENDBLK")))
;;;			(if (entmake ins_def)
;;;			) ;_ end of if
;;;			(setq stopents T)
;;;		      )
;;;		      (progn
;;;			(princ "\n")
;;;			(princ n)
;;;		        (entmake (list
;;;			           (cons 0 "vertex")
;;;			           (cons 8 "water")
;;;			           (cons 10 (cdr(assoc 10 n)))
;;;			         )
;;;		        )
;;;		        (entmake (list
;;;			           (cons 0 "vertex")
;;;			           (cons 8 "water")
;;;			           (cons 10 (cdr(assoc 11 n)))
;;;			         )
;;;		        )
;;;		      )
;;;		    )
;;;		  )
;;;		  )
;;;		  (setq pline_cnt (1+ pline_cnt))
;;;		)
		    (princ
		      "\nRemember, Aerial Survey \"water\" blocks can be made into plines. "
		    ) ;_ end of princ
		    (entmake)
		  ) ;_ end of progn
		) ;_ end of if
	      ) ;_ end of progn
	      (progn
		(cond
		  ((eq ctokwd "Entity")
		   (if
		     (wcmatch (setq xplayr (cdr (assoc 8 xplent))) "*|*")
		      (progn
			(while
			  (wcmatch xplayr "*|*")
			   (setq xplayr (substr xplayr 2))
			) ;_ end of while
			(setq cur_la xplayr) ;_ end of setq
		      ) ;_ end of progn
		      (setq cur_la xplayr)
		   ) ;_ end of if
		  )
		  ((eq ctokwd "Current")
		   (setq cur_la (getvar "clayer"))
		  )
		) ;_ end of cond
		(IF (EQ selent "LWPOLYLINE")
		  (PROGN
		    (SETQ xplent (APPEND (LIST (CONS 0 "LWPOLYLINE")
					       (CONS 100 "AcDbEntity")
;;;					       (CONS 8 cur_la)
					       (CONS 67 0)
					 ) ;_ end of LIST
					 (CDDDDR (CDR XPLENT))
				 ) ;_ end of APPEND
		    ) ;_ end of SETQ
		    (SETQ xplent (SUBST (CONS 8 cur_la)(ASSOC 8 xplent)xplent))
		    (ENTMAKE xplent)
;;;	     (princ "\n  XPLENT ENTITY DATA:\n")
;;;	     (princ xplent)
;;;	     (princ)

		  ) ;_ end of PROGN
		  (PROGN
		    (if	(assoc 6 xplent)
		      (if (wcmatch (cdr (assoc 6 xplent)) "*|*")
			(progn
			  (setq cur_lt (cdr (assoc 6 xplent)))
			  (while
			    (wcmatch cur_lt "*|*")
			     (setq cur_lt (substr cur_lt 2))
			  ) ;_ end of while
			  (IF
			    (AND
			      (NOT (TBLSEARCH "LTYPE" cur_lt))
			      (FINDFILE "acad.lin")
			      (NOT (EQ (STRCASE (GETVAR "dwgname"))
				       "DRAWING.DWG"
				   ) ;_ end of EQ
			      ) ;_ end of NOT
			    ) ;_ end of AND
			     (COMMAND ".linetype" "load"
				      cur_lt	  "acad.lin"
				      ""
				     ) ;_ end of COMMAND
 ;_ end of COMMAND
 ;_ end of command
			  ) ;_ end of IF
			  (IF (NOT (TBLSEARCH "LTYPE" cur_lt))
			    (SETQ cur_lt "continuous")
			  ) ;_ end of IF
			) ;_ end of progn
			(setq cur_lt (cdr (assoc 6 xplent)))
		      ) ;_ end of if
		      (progn
			(setq cur_lt
			       (cdr
				 (assoc	6
					(tblsearch "LAYER"
						   (cdr (assoc 8 xplent))
					) ;_ end of tblsearch
				 ) ;_ end of assoc
			       ) ;_ end of cdr
			) ;_ end of setq
			(if (wcmatch cur_lt "*|*")
			  (progn
			    (while
			      (wcmatch cur_lt "*|*")
			       (setq cur_lt (substr cur_lt 2))
			    ) ;_ end of while
			    (IF
			      (AND
				(NOT (TBLSEARCH "LTYPE" cur_lt))
				(FINDFILE "acad.lin")
				(NOT (EQ (STRCASE (GETVAR "dwgname"))
					 "DRAWING.DWG"
				     ) ;_ end of EQ
				) ;_ end of NOT
			      ) ;_ end of AND
			       (COMMAND	".linetype" "load"
					cur_lt	    "acad.lin"
					""
				       ) ;_ end of COMMAND
 ;_ end of COMMAND
			    ) ;_ end of IF
			    (IF	(NOT (TBLSEARCH "LTYPE" cur_lt))
			      (progn
				(setq cur_lt "CONTINUOUS")
				(princ
				  (strcat
				    "\nLinetype "
				    cur_lt
				    " not found, changed entity linetype to CONTINUOUS "
				  ) ;_ end of strcat
				) ;_ end of princ
			      ) ;_ end of progn
			    ) ;_ end of IF
			  ) ;_ end of progn
			) ;_ end of if
		      ) ;_ end of progn
		    ) ;_ end of if
		    (if
		      (not (tblsearch "ltype" cur_lt))
		       (progn
			 (setq cur_lt "CONTINUOUS")
			 (princ
			   (strcat
			     "\nLinetype "
			     cur_lt
			     " not found, changed entity linetype to CONTINUOUS "
			   ) ;_ end of strcat
			 ) ;_ end of princ
		       ) ;_ end of progn
		    ) ;_ end of if
		    (if	(assoc 6 xplent)
		      (setq xplent
			     (subst
			       (cons 6 cur_lt)
			       (assoc 6 xplent)
			       xplent
			     ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 7 xplent)
		      (progn
			(if (wcmatch (cdr (assoc 7 xplent)) "*|*")
			  (progn
			    (setq stylname (cdr (assoc 7 xplent)))
			    (while (wcmatch stylname "*|*")
			      (setq stylname (substr stylname 2))
			    ) ;_ end of while
			    (if	(not (tblsearch "style" stylname))
			      (setq stylname "STANDARD")
			    ) ;_ end of if
			  ) ;_ end of progn
			  (if
			    (not (tblsearch "style" (cdr (assoc 7 xplent)))
			    ) ;_ end of not
			     (progn
			       (setq stylname "STANDARD")
			       (princ "\nStyle was set")
			     ) ;_ end of progn
			  ) ;_ end of if
			) ;_ end of if
			(if stylname
			  (setq	xplent
				 (subst
				   (cons 7 stylname)
				   (assoc 7 xplent)
				   xplent
				 ) ;_ end of subst
			  ) ;_ end of setq
			  (setq	xplent
				 (subst
				   (cons 7 "STANDARD")
				   (assoc 7 xplent)
				   xplent
				 ) ;_ end of subst
			  ) ;_ end of setq
			) ;_ end of if
		      ) ;_ end of progn
		    ) ;_ end of if
		    (setq xplent
			   (subst
			     (cons 8 cur_la)
			     (assoc 8 xplent)
			     xplent
			   ) ;_ end of subst
		    ) ;_ end of setq
		    (setq newp10 (transpt plii (cdr (assoc 10 xplent))))
		    (setq xplent
			   (subst
			     (cons 10 newp10)
			     (assoc 10 xplent)
			     xplent
			   ) ;_ end of subst
		    ) ;_ end of setq
		    (if	(assoc 11 xplent)
		      (setq newp11 (transpt plii (cdr (assoc 11 xplent)))
			    xplent
				   (subst
				     (cons 11 newp11)
				     (assoc 11 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 12 xplent)
		      (setq newp12 (transpt plii (cdr (assoc 12 xplent)))
			    xplent
				   (subst
				     (cons 12 newp12)
				     (assoc 12 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 13 xplent)
		      (setq newp13 (transpt plii (cdr (assoc 13 xplent)))
			    xplent
				   (subst
				     (cons 13 newp13)
				     (assoc 13 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 14 xplent)
		      (setq newp14 (transpt plii (cdr (assoc 14 xplent)))
			    xplent
				   (subst
				     (cons 14 newp14)
				     (assoc 14 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 15 xplent)
		      (setq newp15 (transpt plii (cdr (assoc 15 xplent)))
			    xplent
				   (subst
				     (cons 15 newp15)
				     (assoc 15 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 16 xplent)
		      (setq newp16 (transpt plii (cdr (assoc 16 xplent)))
			    xplent
				   (subst
				     (cons 16 newp16)
				     (assoc 16 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 17 xplent)
		      (setq newp17 (transpt plii (cdr (assoc 17 xplent)))
			    xplent
				   (subst
				     (cons 17 newp17)
				     (assoc 17 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 18 xplent)
		      (setq newp18 (transpt plii (cdr (assoc 18 xplent)))
			    xplent
				   (subst
				     (cons 18 newp18)
				     (assoc 18 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(assoc 40 xplent)
		      (setq newp40 (* (max (cdr (assoc 41 insent))
					   (cdr (assoc 42 insent))
				      ) ;_ end of max
				      (cdr (assoc 40 xplent))
				   ) ;_ end of *
			    xplent
				   (subst
				     (cons 40 newp40)
				     (assoc 40 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(and (assoc 41 xplent)
			     (eq (cdr (assoc 0 xplent)) "TEXT")
			) ;_ end of and
		      (setq newp41 (* (/ (cdr (assoc 41 insent))
					 (cdr (assoc 42 insent))
				      ) ;_ end of /
				      (cdr (assoc 41 xplent))
				   ) ;_ end of *
			    xplent
				   (subst
				     (cons 41 newp41)
				     (assoc 41 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(and (assoc 50 xplent)
			     (not (equal (sin insang) 0 0.00001))
			     (eq (cdr (assoc 0 xplent)) "ARC")
			) ;_ end of and
		      (setq newp50 (+ (cdr (assoc 50 xplent)) insang)
			    xplent (subst
				     (cons 50 newp50)
				     (assoc 50 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (if	(and (assoc 51 xplent)
			     (not (equal (sin insang) 0 0.00001))
			     (eq (cdr (assoc 0 xplent)) "ARC")
			) ;_ end of and
		      (setq newp51 (+ (cdr (assoc 51 xplent)) insang)
			    xplent (subst
				     (cons 51 newp51)
				     (assoc 51 xplent)
				     xplent
				   ) ;_ end of subst
		      ) ;_ end of setq
		    ) ;_ end of if
		    (entmake xplent)
		  ) ;_ end of PROGN
		) ;_ end of IF
	      ) ;_ end of progn
	   ) ;_ end of if
	 ) ;_ end of if
	 (if xplent
	   (grvecs (list
		     7
		     (polar (cdr (assoc 10 xplent))
			    (* pi 0.5)
			    (/ (getvar "viewsize") 400)
		     ) ;_ end of polar
		     (polar (cdr (assoc 10 xplent))
			    (* pi 1.5)
			    (/ (getvar "viewsize") 400)
		     ) ;_ end of polar
		     7
		     (polar (cdr (assoc 10 xplent))
			    (* pi 0)
			    (/ (getvar "viewsize") 400)
		     ) ;_ end of polar
		     (polar (cdr (assoc 10 xplent))
			    (* pi 1)
			    (/ (getvar "viewsize") 400)
		     ) ;_ end of polar
		   ) ;_ end of list
	   ) ;_ end of grvecs
	 ) ;_ end of if
       ) ;_ end of progn
       (if (eq (cdr (assoc 0 (entget (car plii)))) "ATTRIB")
	 (progn
	   (setq
	     xpl1 (reverse
		    (cdr (member (assoc 2 xplent) (reverse xplent)))
		  ) ;_ end of reverse
	   ) ;_ end of setq
	   (setq xpl2
		  (reverse
		    (cdr
		      (member
			(assoc 70 xplent)
			(reverse (cdr (member (assoc 2 xplent) xplent)))
		      ) ;_ end of member
		    ) ;_ end of cdr
		  ) ;_ end of reverse
	   ) ;_ end of setq
	   (setq xpl3 (cdr (member (assoc 70 xplent) xplent)))
	   (setq newxpl (append xpl1 xpl2 xpl3))
	   (setq newxpl (subst (cons 0 "TEXT") (assoc 0 newxpl) newxpl))
	   (setq
	     newxpl1 (reverse (cdr (member (cons 100 "AcDbAttribute")
					   (reverse newxpl)
				   ) ;_ end of member
			      ) ;_ end of cdr
		     ) ;_ end of reverse
	   ) ;_ end of setq
	   (setq
	     newxpl2 (cdr (member (cons 100 "AcDbAttribute") newxpl))
	   ) ;_ end of setq
	   (setq newxpl (append newxpl1 newxpl2))
	   (setq newxpl1
		  (reverse
		    (cdr (member (assoc 74 newxpl) (reverse newxpl)))
		  ) ;_ end of reverse
	   ) ;_ end of setq
	   (setq newxpl2 (cdr (member (assoc 74 newxpl) newxpl)))
	   (setq newxpl (append newxpl1 newxpl2))
	   (if (entmake newxpl)
	     (princ (strcat " used to create \"" (cdr(assoc 1 NEWXPL)) "\" TEXT entity "))
	   ) ;_ end of if
	 ) ;_ end of progn
	 (princ "\nEntity selected is not in a block or xref. ")
       ) ;_ end of if
       )

     ) ;_ end of if
  ) ;_ end of while
  (princ)
) ;_ 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!***|;