;;;Open selected XREF for editing. (In which case it is then the active drawing.) (uses UKWORD)
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 
;;;>		   EDITED: 12-14-2006
;;;
(DEFUN c:xrswap	(/ rtnswp dwg_changed)
;;;  (IF (EQ (GETVAR "loginname") "CFrancis")
;;;    (VLR-REMOVE-ALL)
;;;  ) ;_ end of if
  (SETQ	princprfx (IF princprfx
		    (STRCAT princprfx "  ")
		    "[DEBUG]  "
		  ) ;_ end of IF
  ) ;_ end of SETQ
  (IF princdebugstrs
    NIL
    (LOAD "princdebugstrs"
	  "\nFile PRINCDEBUGSTRS.LSP not loaded! "
    ) ;_ end of LOAD
  ) ;_ end of IF
  (princdebugstrs
    (LIST (STRCAT "DBMOD = "
		  (ITOA (GETVAR "DBMOD"))
		  " Beginning XRSWAP.\n"
	  ) ;_ end of STRCAT
    ) ;_ end of LIST
  ) ;_ end of princdebugstrs
  (SETQ	xrswap_pt1 NIL
	xrswap_pt2 NIL
	xrswap_pt3 NIL
	xrswap_pt4 NIL
  ) ;_ end of SETQ
  (IF ukword
    NIL
    (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of IF
  (IF MYOPENCMD
    NIL
    (LOAD "MYOPENCMD" "\nFile MYOPENCMD.LSP not loaded! ")
  ) ;_ end of IF
;;;  (SETQ oldswap_error *ERROR*)
;;;  (SETQ *ERROR* swaperr)
  (IF (EQUAL (GETVAR "VIEWTWIST") 0.0 0.1)
    (SETQ doxrtwist "No")
    (SETQ doxrtwist "Yes")
  ) ;_ end of IF
  (SETQ xroffset '(0.0 0.0 0.0))
  (SETQ re_mode (GETVAR "REGENMODE"))
  (SETQ xrdwgn (GETVAR "dwgname"))
  (SETQ xrprfx (GETVAR "dwgprefix"))
  (IF (EQ xrprfx (SUBSTR xrdwgn 1 (STRLEN xrprfx)))
    (SETQ xrdwgn (SUBSTR xrdwgn (1+ (STRLEN xrprfx))))
  ) ;_ end of if
  (IF (EQ (GETVAR "acadver") "14.01")
    (SETQ xrfile1 (STRCAT "\"" xrprfx xrdwgn "\""))
    (SETQ xrfile1 (STRCAT "\"" xrprfx xrdwgn "\""))
  ) ;_ end of if
  (SETQ xrswpn "c:\\xrswapbk.scr")
  (IF (FINDFILE xrswpn)
    (PROGN
      (SETQ xrswpo (OPEN xrswpn "r"))
      (SETQ xrswp_l1 (READ-LINE xrswpo)
	    xrswp_l2 (READ-LINE xrswpo)
      ) ;_ end of setq
      (IF (AND (EQ (TYPE xrswp_l2) 'STR)
	       (EQ (STRCASE xrswp_l2) (STRCASE xrfile1))
	  ) ;_ end of AND
	(IF (EQ	"Yes"
		(SETQ rtnswp (ukword 1
				     "Yes No"
				     (STRCAT "Return to " xrswp_l1 " ? ")
				     "Yes"
			     ) ;_ end of ukword
		) ;_ end of setq
	    ) ;_ end of eq
	  (SETQ xrfile xrswp_l1)
	) ;_ end of if
	(SETQ rtnswp "No")
      ) ;_ end of if
      (CLOSE xrswpo)
    ) ;_ end of progn
    (SETQ rtnswp "No")
  ) ;_ end of if
  (IF (EQ "No" rtnswp)
    (PROGN
      (IF (SETQ xrent (NENTSEL "\nPick XREF to edit. "))
	(PROGN
	  (IF (EQ (GETVAR "dbmod") 0)
	    (PROGN
	      (princdebugstrs (LIST "DBMOD = 0 in XRSWAP 1.\n"))
	      (SETQ dwg_changed NIL)
	    ) ;_ end of PROGN
	    (PROGN
	      (princdebugstrs
		(LIST (STRCAT "DBMOD = "
			      (ITOA (GETVAR "DBMOD"))
			      " in XRSWAP 1. "
		      ) ;_ end of STRCAT
		) ;_ end of LIST
	      ) ;_ end of princdebugstrs
	      (SETQ dwg_changed T)
	    ) ;_ end of PROGN
	  ) ;_ end of IF
	  (princdebugstrs
	    (LIST (STRCAT "DBMOD = "
			  (ITOA (GETVAR "DBMOD"))
			  " in XRSWAP 1A. "
		  ) ;_ end of STRCAT
	    ) ;_ end of LIST
	  ) ;_ end of princdebugstrs
	  (xrvp_stuff)
	  (princdebugstrs
	    (LIST (STRCAT "DBMOD = "
			  (ITOA (GETVAR "DBMOD"))
			  " in XRSWAP 1B. "
		  ) ;_ end of STRCAT
	    ) ;_ end of LIST
	  ) ;_ end of princdebugstrs
	  (SETQ	prixrent (ENTGET (CAAR (REVERSE (CDR xrent))))
		altxrent (IF (> (LENGTH (CAR (REVERSE (CDR xrent)))) 1)
			   (ENTGET (CADAR (REVERSE (CDR xrent))))
			   (ENTGET (CAAR (REVERSE (CDR xrent))))
			 ) ;_ end of if
	  ) ;_ end of setq
	  (IF
	    (AND
	      xrent
	      (= "INSERT"
		 (CDR
		   (ASSOC
		     0
		     prixrent
		   ) ;_ end of assoc
		 ) ;_ end of cdr
	      ) ;_ end of =
	    ) ;_ end of AND
	     (PROGN
	       (SETQ prixrname (CDR (ASSOC 2 prixrent)))
	       (SETQ altxrname (CDR (ASSOC 2 altxrent)))
	       (TBLNEXT "block" T)
	       (SETQ pritblent (TBLSEARCH "block" prixrname))
	       (SETQ alttblent (TBLSEARCH "block" altxrname))
	       (IF
		 (AND
		   (OR (NOT pritblent)
		       (EQ (BOOLE 1 (CDR (ASSOC 70 pritblent)) 4) 0)
		   ) ;_ end of OR
		   (OR (NOT alttblent)
		       (EQ (BOOLE 1 (CDR (ASSOC 70 alttblent)) 4) 0)
		   ) ;_ end of OR
		 ) ;_ end of AND
		  (PROGN
		    (IF	(AND pritblent
			     (ASSOC 2 pritblent)
			     (SETQ prixrname (CDR (ASSOC 2 pritblent)))
			) ;_ end of AND
		      (PROGN
			(PRINC (STRCAT "\n" prixrname " is Not an XREF. ")
			) ;_ end of PRINC
			(IF
			  (AND alttblent
			       (ASSOC 2 alttblent)
			       (SETQ altxrname (CDR (ASSOC 2 alttblent)))
			  ) ;_ end of AND
			   (PRINC
			     (STRCAT "\n" altxrname " is Not an XREF. ")
			   ) ;_ end of PRINC
			) ;_ end of IF
		      ) ;_ end of PROGN
		      (IF (AND alttblent
			       (ASSOC 2 alttblent)
			       (SETQ altxrname (CDR (ASSOC 2 alttblent)))
			  ) ;_ end of AND
			(PRINC (STRCAT "\n" altxrname " is Not an XREF. ")
			) ;_ end of PRINC
			(PRINC "\nNo XREF selected. ")
		      ) ;_ end of IF
		    ) ;_ end of IF
		  ) ;_ end of PROGN
		  (PROGN
		    (IF	(EQ (BOOLE 1 (CDR (ASSOC 70 pritblent)) 4) 4)
		      (SETQ xrfname (CDR (ASSOC 1 pritblent)))
		      (SETQ xrfname (CDR (ASSOC 1 alttblent)))
		    ) ;_ end of IF
		    (WHILE (WCMATCH xrfname "..\\*")
		      (SETQ xrfname (SUBSTR xrfname 4))
		    ) ;_ end of WHILE
		    (WHILE (WCMATCH xrfname "\\*")
		      (SETQ xrfname (SUBSTR xrfname 2))
		    ) ;_ end of WHILE
		    (SETQ do_xrscr NIL)
		    (WHILE (AND (/= do_xrscr "Yes") (/= do_xrscr "Quit"))
		      (SETQ
			do_xrscr (ukword 1
					 "Yes No Quit"
					 (STRCAT "Really want to open "
						 xrfname
					;(CDR (ASSOC 1 pritblent))
						 "?"
					 ) ;_ end of STRCAT
					 "Yes"
				 ) ;_ end of ukword
		      ) ;_ end of SETQ
		      (COND
			((EQ do_xrscr "Yes") nil)
			((OR
			   (EQ (STRCASE xrfname) (STRCASE altxrname))
			   (AND
			     (WCMATCH (STRCASE xrfname) "*.DWG")
			     (EQ
			       (STRCASE
				 (SUBSTR xrfname 1 (- (STRLEN xrfname) 4))
			       ) ;_ end of STRCASE
			       (STRCASE altxrname)
			     ) ;_ end of EQ
			   ) ;_ end of AND
			   (NOT altxrname)
			 ) ;_ end of OR
			 (SETQ do_xrscr "Quit")
			)
			((AND (EQ do_xrscr "No") altxrname)
			 (SETQ xrfname altxrname)
			)
			(T (SETQ do_xrscr "Quit"))
		      ) ;_ end of COND
		    ) ;_ end of WHILE
		    (IF	(EQ do_xrscr "Yes")
		      (PROGN
;;;			(if onam nil (setq onam (dos_username)))
;;;		        (setq fstr "  Xrswap................:  ")
;;;		        (dlog)
			(SETQ onam nil)
			(IF
			  (SETQ	sxrentss (SSGET	"x"
						(LIST (CONS 0 "insert")
						      (ASSOC 2 altxrent)
						) ;_ end of list
					 ) ;_ end of ssget
			  ) ;_ end of setq
			   NIL
			   (IF
			     (SETQ
			       sxrentss	(SSGET "x"
					       (LIST (CONS 0 "insert")
						     (ASSOC 2 prixrent)
					       ) ;_ end of list
					) ;_ end of ssget
			     ) ;_ end of setq
			      NIL
			   ) ;_ end of IF
			) ;_ end of IF
			(IF sxrentss
			  (PROGN
			    (SETQ sxrent (ENTGET (SSNAME sxrentss 0)))
			    (SETQ xrinspt (CDR (ASSOC 10 sxrent)))
			    (SETQ
			      xroffset (TRANS xrinspt
					      0
					      (SSNAME sxrentss 0)
				       ) ;_ end of TRANS
			    ) ;_ end of SETQ
			  ) ;_ end of PROGN
			) ;_ end of IF
			(COND
			  ((IF
			     (FINDFILE
			       (IF (WCMATCH (STRCASE xrfname) "*.DWG")
				 xrfname
				 (STRCAT xrfname ".dwg")
			       ) ;_ end of IF
			     ) ;_ end of FINDFILE
			      (SETQ xrfile
				     (STRCAT "\""
					     (FINDFILE
					       (IF (WCMATCH (STRCASE xrfname)
							    "*.DWG"
						   ) ;_ end of WCMATCH
						 xrfname
						 (STRCAT xrfname ".dwg")
					       ) ;_ end of IF
					     ) ;_ end of FINDFILE
					     "\""
				     ) ;_ end of STRCAT
			      ) ;_ end of SETQ
			     (IF xrfname
			       (SETQ xrfile
				    (FINDFILE (strcat (nth 2 (dos_splitpath xrfname))(nth 3 (dos_splitpath xrfname))))
		               )
			     )
			   ) ;_ end of IF
			  )
			  ((AND
			     (ASSOC 1 pritblent)
			     (FINDFILE
			       (IF
				 (WCMATCH
				   (STRCASE (CDR (ASSOC 1 pritblent)))
				   "*.DWG"
				 ) ;_ end of WCMATCH
				  (CDR (ASSOC 1 pritblent))
				  (STRCAT (CDR (ASSOC 1 pritblent)) ".dwg")
			       ) ;_ end of IF
			     ) ;_ end of FINDFILE
			     (WCMATCH (CDR (ASSOC 1 pritblent))
				      (STRCAT "*" xrfname "*")
			     ) ;_ end of WCMATCH
			   ) ;_ end of AND
			   (SETQ xrfile
				  (STRCAT
				    "\""
				    (FINDFILE
				      (IF
					(WCMATCH
					  (STRCASE (CDR (ASSOC 1 pritblent))
					  ) ;_ end of STRCASE
					  "*.DWG"
					) ;_ end of WCMATCH
					 (CDR (ASSOC 1 pritblent))
					 (STRCAT (CDR (ASSOC 1 pritblent))
						 ".dwg"
					 ) ;_ end of strcat
				      ) ;_ end of IF
				    ) ;_ end of FINDFILE
				    "\""
				  ) ;_ end of STRCAT
			   ) ;_ end of SETQ
			  )
			  ((AND
			     (ASSOC 1 alttblent)
			     (FINDFILE
			       (IF
				 (WCMATCH
				   (STRCASE (CDR (ASSOC 1 alttblent)))
				   "*.DWG"
				 ) ;_ end of WCMATCH
				  (CDR (ASSOC 1 alttblent))
				  (STRCAT (CDR (ASSOC 1 alttblent)) ".dwg")
			       ) ;_ end of IF
			     ) ;_ end of FINDFILE
			     (WCMATCH (CDR (ASSOC 1 alttblent))
				      (STRCAT "*" xrfname "*")
			     ) ;_ end of WCMATCH
			   ) ;_ end of AND
			   (SETQ xrfile
				  (STRCAT
				    "\""
				    (FINDFILE
				      (IF
					(WCMATCH
					  (STRCASE (CDR (ASSOC 1 alttblent))
					  ) ;_ end of STRCASE
					  "*.DWG"
					) ;_ end of WCMATCH
					 (CDR (ASSOC 1 alttblent))
					 (STRCAT (CDR (ASSOC 1 alttblent))
						 ".dwg"
					 ) ;_ end of strcat
				      ) ;_ end of IF
				    ) ;_ end of FINDFILE
				    "\""
				  ) ;_ end of STRCAT
			   ) ;_ end of SETQ
			  )
			) ;_ end of COND
			(SETQ xrswpo (OPEN xrswpn "w"))
			(WRITE-LINE xrfile1 xrswpo)
			(WRITE-LINE xrfile xrswpo)
			(CLOSE xrswpo)
			(IF dwg_changed
			  (PROGN
			    (IF
			      (EQ (SETQ	discardit
					 (ukword
					   1
					   "Yes No"
					   (STRCAT
					     "Really want to discard changes to "
					     (GETVAR "dwgname")
					     "?"
					   ) ;_ end of strcat
					   "No"
					 ) ;_ end of ukword
				  ) ;_ end of SETQ
				  "No"
			      ) ;_ end of EQ
			       (PROGN
				 (IF c:qsave
				   (PROGN
				     (princdebugstrs
				       (LIST
					 "C:QSAVE TYPE="
					 (TYPE c:qsave)
					 "\nExecute (C:QSAVE) from inside XRSWAP.\n"
				       ) ;_ end of LIST
				     ) ;_ end of princdebugstrs
				     (IF onam
				       nil
				       (SETQ onam (DOS_USERNAME))
				     ) ;_ end of if
				     (SETQ
				       fstr "  Xrswap................:  "
				     ) ;_ end of setq
				     (dlog)
				     (C:QSAVE)
				     (princdebugstrs
				       (LIST
					 "Done executing (C:QSAVE) from inside XRSWAP.\n"
				       ) ;_ end of LIST
				     ) ;_ end of princdebugstrs
				   ) ;_ end of progn
				   (PROGN
				     (princdebugstrs
				       (LIST
					 "Execute (COMMAND \".QSAVE\") from inside XRSWAP.\n"
				       ) ;_ end of LIST
				     ) ;_ end of princdebugstrs
				     (IF onam
				       nil
				       (SETQ onam (DOS_USERNAME))
				     ) ;_ end of if
				     (SETQ
				       fstr "  Xrswap................:  "
				     ) ;_ end of setq
				     (dlog)
				     (COMMAND ".qsave")
				     (SETQ
				       fstr "  Qsaved................:  "
				     ) ;_ end of setq
				     (dlog)
				     (princdebugstrs
				       (LIST
					 "Done executing (COMMAND \".QSAVE\") from inside XRSWAP.\n"
				       ) ;_ end of LIST
				     ) ;_ end of princdebugstrs
				   ) ;_ end of PROGN
				 ) ;_ end of IF
				 (SETQ what_to_do 6)
			       ) ;_ end of PROGN
			       (PROGN
				 (IF onam
				   nil
				   (SETQ onam (DOS_USERNAME))
				 ) ;_ end of if
				 (SETQ fstr "  Xrswap................:  ")
				 (dlog)
				 (SETQ what_to_do 3)
			       ) ;_ end of PROGN
			    ) ;_ end of IF
			  ) ;_ end of PROGN
			  (PROGN
			    (IF	onam
			      nil
			      (SETQ onam (DOS_USERNAME))
			    ) ;_ end of if
			    (SETQ fstr "  Xrswap................:  ")
			    (dlog)
			  ) ;_ end of PROGN
			) ;_ end of IF
			(IF (EQ doxrtwist "Yes")
			  (SETQ	doxrtwist
				 (ukword
				   1
				   "Yes No"
				   "Dview/twist Xref to match this view?"
				   (IF doxrtwist
				     doxrtwist
				     "No"
				   ) ;_ end of IF
				 ) ;_ end of ukword
			  ) ;_ end of SETQ
			) ;_ end of IF
			(PROGN
			  (IF (> (GETVAR "dbmod") 0)
			    (PROGN
			      (princdebugstrs
				(LIST (STRCAT "DBMOD = "
					      (ITOA (GETVAR "DBMOD"))
					      " in XRSWAP 2.\n"
				      ) ;_ end of STRCAT
				) ;_ end of LIST
			      ) ;_ end of princdebugstrs
			      (IF MYOPENCMD
				NIL
				(LOAD "MYOPENCMD"
				      "\nFile MYOPENCMD.LSP not loaded! "
				) ;_ end of LOAD
			      ) ;_ end of IF
			      (princdebugstrs
                                (IF (VLR-REACTORS)
                                  (APPEND
                                    (LIST
                                      "Call (MYOPENCMD XRFILE) from inside XRSWAP function 1.\n"
				      "REACTORS:\n"
                                    ) ;_ end of LIST
				    (VLR-REACTORS)
				  )
                                  (LIST
                                    "Call (MYOPENCMD XRFILE) from inside XRSWAP function 1.\n"
				    "(VLR-REACTORS) lists no reactors!\n"
				  )
				)
			      ) ;_ end of princdebugstrs
			      (SETQ myopenfrom "xrswap")
			      (MYOPENCMD XRFILE)
			      (SETQ myopenfrom NIL)
;;;			  (c:xrswp_vctr)
			    ) ;_ end of PROGN
			    (PROGN
			      (princdebugstrs
				(LIST (STRCAT "DBMOD = "
					      (ITOA (GETVAR "DBMOD"))
					      " in XRSWAP 3.\n"
				      ) ;_ end of STRCAT
				) ;_ end of LIST
			      ) ;_ end of princdebugstrs
			      (IF MYOPENCMD
				NIL
				(LOAD "MYOPENCMD"
				      "\nFile MYOPENCMD.LSP not loaded! "
				) ;_ end of LOAD
			      ) ;_ end of IF
			      (princdebugstrs
                                (IF (VLR-REACTORS)
                                  (APPEND
                                    (LIST
                                      "Call (MYOPENCMD XRFILE) from inside XRSWAP function 2.\n"
				      "REACTORS:\n"
                                    ) ;_ end of LIST
				    (VLR-REACTORS)
				  )
                                  (LIST
                                    "Call (MYOPENCMD XRFILE) from inside XRSWAP function 2.\n"
				    "(VLR-REACTORS) lists no reactors!\n"
				  )
				)
			      ) ;_ end of princdebugstrs
			      (SETQ myopenfrom "xrswap")
			      (MYOPENCMD XRFILE)
			      (SETQ myopenfrom NIL)
;;;			  (c:xrswp_vctr)
			    ) ;_ end of PROGN
			  ) ;_ end of IF
			) ;_ end of PROGN
		      ) ;_ end of PROGN
		      (PROGN
			(PRINC "\nCommand cancelled! ")
			(PRINC)
		      ) ;_ end of PROGN
		    ) ;_ end of IF
		  ) ;_ end of progn
	       ) ;_ end of IF
	     ) ;_ end of PROGN
	     (COND
	       ((AND prixrent
		     (ASSOC 2 prixrent)
		     (SETQ xrname (CDR (ASSOC 2 prixrent)))
		) ;_ end of AND
		(PRINC (STRCAT "\n" xrname " is Not an XREF. "))
		(PRINC)
	       )
	       ((AND altxrent
		     (ASSOC 2 altxrent)
		     (SETQ xrname (CDR (ASSOC 2 altxrent)))
		) ;_ end of AND
		(PRINC (STRCAT "\n" xrname " is Not an XREF. "))
		(PRINC)
	       )
	       (T (PRINC "\nNo XREF selected. ") (PRINC))
	     ) ;_ end of COND
	  ) ;_ end of IF
	) ;_ end of PROGN
	(PRINC "\nNothing selected. ")
      ) ;_ end of IF
    ) ;_ end of PROGN
;;;    (IF	(EQ do_xrscr "Yes")
    (PROGN
;;;	(PRINC "\n(1) DBMOD=")
;;;	(PRINC (getvar "dbmod"))
;;;	(princ)
;;;      (if onam nil (setq onam (dos_username)))
;;;      (setq fstr "  Xrswap................:  ")
;;;      (dlog)
      (SETQ onam nil)
      (princdebugstrs (LIST "Beginning XRVP_STUFF.\n"))
      (xrvp_stuff)
      (princdebugstrs (LIST "Done with XRVP_STUFF.\n"))
      (IF (EQ (GETVAR "dbmod") 0)
	(SETQ dwg_changed NIL)
	(SETQ dwg_changed T)
      ) ;_ end of IF
      (IF (OR dwg_changed (> (GETVAR "dbmod") 0))
	(PROGN
	  (princdebugstrs
	    (LIST (STRCAT "DBMOD = "
			  (ITOA (GETVAR "DBMOD"))
			  " in XRSWAP 4. "
		  ) ;_ end of STRCAT
	    ) ;_ end of LIST
	  ) ;_ end of princdebugstrs
	  (IF
	    (EQ	(SETQ reallyquery
		       (ukword 1
			       "Yes No"
			       (STRCAT "Really want to discard changes to "
				       (GETVAR "dwgname")
				       "?"
			       ) ;_ end of strcat
			       "No"
		       ) ;_ end of ukword
		) ;_ end of SETQ
		"No"
	    ) ;_ end of =
	     (PROGN
	       (IF (> (GETVAR "dbmod") 0)
		 (PROGN
		   (IF c:qsave
		     (PROGN
		       (princdebugstrs
			 (LIST "C:QSAVE TYPE="
			       (TYPE c:qsave)
			       "Execute (C:QSAVE) from inside XRSWAP 2.\n"
			 ) ;_ end of LIST
		       ) ;_ end of princdebugstrs
		       (IF onam
			 nil
			 (SETQ onam (DOS_USERNAME))
		       ) ;_ end of if
		       (SETQ fstr "  Xrswap................:  ")
		       (dlog)
		       (C:QSAVE)
		       (princdebugstrs
			 (LIST
			   "Done executing (C:QSAVE) from inside XRSWAP 2.\n"
			 ) ;_ end of LIST
		       ) ;_ end of princdebugstrs
		     ) ;_ end of progn
		     (PROGN
		       (princdebugstrs
			 (LIST
			   "Execute (COMMAND \".QSAVE\") from inside XRSWAP 2.\n"
			 ) ;_ end of LIST
		       ) ;_ end of princdebugstrs
		       (COMMAND ".qsave")
		       (princdebugstrs
			 (LIST
			   "Done executing (COMMAND \".QSAVE\") from inside XRSWAP 2.\n"
			 ) ;_ end of LIST
		       ) ;_ end of princdebugstrs
		     ) ;_ end of PROGN
		   ) ;_ end of IF
		   (IF MYOPENCMD
		     NIL
		     (LOAD "MYOPENCMD"
			   "\nFile MYOPENCMD.LSP not loaded! "
		     ) ;_ end of LOAD
		   ) ;_ end of IF
		   (princdebugstrs
		     (IF (VLR-REACTORS)
		       (APPEND
			 (LIST
			   "Call (MYOPENCMD XRFILE) from inside XRSWAP function 3.\n"
			   "REACTORS:\n"
			 ) ;_ end of LIST
			 (VLR-REACTORS)
		       ) ;_ end of APPEND
		       (LIST
			 "Call (MYOPENCMD XRFILE) from inside XRSWAP function 3.\n"
			 "(VLR-REACTORS) lists no reactors!\n"
		       ) ;_ end of LIST
		     ) ;_ end of IF
		   ) ;_ end of princdebugstrs
		   (SETQ what_to_do 6)
		   (MYOPENCMD xrfile)
		 ) ;_ end of PROGN
	       ) ;_ end of IF
	     ) ;_ end of progn
	     (PROGN
	       (SETQ what_to_do NIL)
	       (IF MYOPENCMD
		 NIL
		 (LOAD "MYOPENCMD" "\nFile MYOPENCMD.LSP not loaded! ")
	       ) ;_ end of IF
	       (princdebugstrs
		 (IF (VLR-REACTORS)
		   (APPEND
		     (LIST
		       "Call (MYOPENCMD XRFILE) from inside XRSWAP function 4.\n"
		       "REACTORS:\n"
		     ) ;_ end of LIST
		     (VLR-REACTORS)
		   ) ;_ end of APPEND
		   (LIST
		     "Call (MYOPENCMD XRFILE) from inside XRSWAP function 4.\n"
                     "(VLR-REACTORS) lists no reactors!\n"
		   ) ;_ end of LIST
		 ) ;_ end of IF
	       ) ;_ end of princdebugstrs
	       (SETQ what_to_do 3)
	       (MYOPENCMD xrfile)
	     ) ;_ end of PROGN
	  ) ;_ end of IF
	) ;_ end of PROGN
	(PROGN
	  (princdebugstrs
	    (LIST (STRCAT "DBMOD = "
			  (ITOA (GETVAR "DBMOD"))
			  " in XRSWAP 5.\n"
		  ) ;_ end of STRCAT
	    ) ;_ end of LIST
	  ) ;_ end of princdebugstrs
	  (IF MYOPENCMD
	    NIL
	    (LOAD "MYOPENCMD" "\nFile MYOPENCMD.LSP not loaded! ")
	  ) ;_ end of IF
	  (princdebugstrs
	    (IF	(VLR-REACTORS)
	      (APPEND
		(LIST
		  "Call (MYOPENCMD XRFILE) from inside XRSWAP function 5.\n"
		  "REACTORS:\n"
		) ;_ end of LIST
		(VLR-REACTORS)
	      ) ;_ end of APPEND
	      (LIST
	        "Call (MYOPENCMD XRFILE) from inside XRSWAP function 5.\n"
                "(VLR-REACTORS) lists no reactors!\n"
	      ) ;_ end of LIST
	    ) ;_ end of IF
	  ) ;_ end of princdebugstrs
	  (MYOPENCMD xrfile)
	) ;_ end of PROGN
      ) ;_ end of IF
    ) ;_ end of PROGN
;;;    )
  ) ;_ end of IF
  (SETQ	princprfx
	 (COND
	   ((AND princprfx (WCMATCH princprfx "`[DEBUG`]   *"))
	    (SUBSTR princprfx 1 (- (STRLEN princprfx) 2))
	   )
	   (T "[DEBUG]  ")
	 ) ;_ end of COND
  ) ;_ end of SETQ
  (PRINC)
) ;_ end of DEFUN
(DEFUN c:xrswp_vctr (/)
  (SETQ	princprfx (IF (AND debug_princs princprfx)
		    (STRCAT princprfx "  ")
		    (IF	debug_princs
		      "[DEBUG]  "
		      ""
		    ) ;_ end of IF
		  ) ;_ end of IF
  ) ;_ end of SETQ
  (princdebugstrs
    (LIST "Begin execution of C:XRSWP_VCTR function.\n")
  ) ;_ end of princdebugstrs
  (IF (AND (OR
	     (TBLSEARCH "BLOCK" "huattbats")
	     (TBLSEARCH "BLOCK" "hclttbats")
	     (TBLSEARCH "BLOCK" "hfbttbats")
	   ) ;_ end of OR
	   (IF (SSGET "X" '((2 . "???ttbats")))
	     (>= (SSLENGTH (SSGET "X" '((2 . "???ttbats")))) 1)
	   ) ;_ end of IF
      ) ;_ end of AND
    (SETVAR "DIMSCALE" 0)
  ) ;_ end of IF
  (IF (OR (AND (EQ (GETVAR "TILEMODE") curtilemode)
	       (EQ curtilemode 1)
	  ) ;_ end of AND
	  (AND (NOT (EQ (GETVAR "TILEMODE") curtilemode))
	       (EQ curtilemode 1)
	       (> (GETVAR "CVPORT") 1)
	  ) ;_ end of AND
	  (AND (EQ (GETVAR "TILEMODE") curtilemode)
	       (EQ curtilemode 0)
	       (> (GETVAR "CVPORT") 1)
	  ) ;_ end of AND
	  (AND (NOT (EQ (GETVAR "TILEMODE") curtilemode))
	       (EQ curtilemode 0)
	       (> (GETVAR "CVPORT") 1)
	  ) ;_ end of AND
      ) ;_ end of OR
    (PROGN
      (IF (OR
	    (EQ (GETVAR "viewtwist") curvwtwist)
	    (EQ doxrtwist "No")
	  ) ;_ end of OR
	NIL
	(COMMAND "_.dview" "" "TW" (* (/ curvwtwist PI) 180.0) "")
      ) ;_ end of IF
      (SETQ xrswap_pt2 (TRANS xrswap_pt2 0 1))
      (SETQ xrswap_pt4 (TRANS xrswap_pt4 0 1))
      (COMMAND "_.zoom"
	       (STRCAT (RTOS (-	(CAR xrswap_pt2)
				(IF xroffset
				  (CAR xroffset)
				  0
				) ;_ end of IF
			     ) ;_ end of -
			     2
			     2
		       ) ;_ end of RTOS
		       ","
		       (RTOS (-	(CADR xrswap_pt2)
				(IF xroffset
				  (CADR xroffset)
				  0
				) ;_ end of IF
			     ) ;_ end of -
			     2
			     2
		       ) ;_ end of RTOS
	       ) ;_ end of strcat
	       (STRCAT (RTOS (-	(CAR xrswap_pt4)
				(IF xroffset
				  (CAR xroffset)
				  0
				) ;_ end of IF
			     ) ;_ end of -
			     2
			     2
		       ) ;_ end of RTOS
		       ","
		       (RTOS (-	(CADR xrswap_pt4)
				(IF xroffset
				  (CADR xroffset)
				  0
				) ;_ end of IF
			     ) ;_ end of -
			     2
			     2
		       ) ;_ end of RTOS
	       ) ;_ end of strcat
      ) ;_ end of COMMAND
    ) ;_ end of PROGN
  ) ;_ end of IF
  (princdebugstrs
    (LIST "END execution of C:XRSWP_VCTR function.\n")
  ) ;_ end of princdebugstrs
  (SETQ	princprfx
	 (COND
	   ((AND princprfx (WCMATCH princprfx "`[DEBUG`]   *"))
	    (SUBSTR princprfx 1 (- (STRLEN princprfx) 2))
	   )
	   (T "[DEBUG]  ")
	 ) ;_ end of COND
  ) ;_ end of SETQ
  (PRINC)
) ;_ end of DEFUN
(DEFUN xrvp_stuff ()
  (SETQ	princprfx (IF princprfx
		    (STRCAT princprfx "  ")
		    "[DEBUG]  "
		  ) ;_ end of IF
  ) ;_ end of SETQ
  (princdebugstrs
    (LIST "Begin xrvp_stuff function in XRSWAP.\n")
  ) ;_ end of princdebugstrs
  (SETQ curtilemode (GETVAR "TILEMODE"))
  (SETQ curcvport (GETVAR "CVPORT"))
;;;  (REGAPP "ACAD")
  (SETQ cvpss (SSGET "X" (LIST (CONS 69 curcvport))))
  (IF cvpss
    (PROGN
      (SETQ cvpent (ENTGET (SSNAME cvpss 0) (LIST "ACAD")))
      (SETQ cvphgt (GETVAR "viewsize"))
      (SETQ cvpctr (GETVAR "viewctr"))
      (IF (EQ cvpctr (TRANS cvpctr 1 0))
	(SETQ cvputw (- (* PI 2) (GETVAR "viewtwist")))
	(SETQ cvputw (- (* PI 2) (ANGLE cvpctr (TRANS cvpctr 1 0))))
      ) ;_ end of IF
      (SETQ cvpa40 (CDR (ASSOC 40 cvpent)))
      (SETQ cvpa41 (CDR (ASSOC 41 cvpent)))
      (SETQ cvpwid (* (/ cvpa40 cvpa41) cvphgt))
      (SETQ xrswap_pt1 (TRANS (POLAR
				(POLAR cvpctr cvputw (/ cvpwid 2))
				(- cvputw (/ PI 2))
				(/ cvphgt 2)
			      ) ;_ end of POLAR
			      1
			      0
		       ) ;_ end of polar
	    xrswap_pt2 (POLAR xrswap_pt1 (+ cvputw (/ PI 2)) cvphgt)
	    xrswap_pt3 (POLAR xrswap_pt2 (+ cvputw PI) cvpwid)
	    xrswap_pt4 (POLAR xrswap_pt3 (- cvputw (/ PI 2)) cvphgt)
      ) ;_ end of setq
    ) ;_ end of PROGN
    (PROGN
      (SETQ cvphgt (GETVAR "viewsize"))
      (SETQ cvpctr (GETVAR "viewctr"))
      (IF (EQ cvpctr (TRANS cvpctr 1 0))
	(SETQ cvputw (- (* PI 2) (GETVAR "viewtwist")))
	(SETQ cvputw (- (* PI 2) (ANGLE cvpctr (TRANS cvpctr 1 0))))
      ) ;_ end of IF
      (SETQ cvpwid cvphgt)
      (SETQ xrswap_pt1 (TRANS (POLAR
				(POLAR cvpctr cvputw (/ cvpwid 2))
				(- cvputw (/ PI 2))
				(/ cvphgt 2)
			      ) ;_ end of POLAR
			      1
			      0
		       ) ;_ end of polar
	    xrswap_pt2 (POLAR xrswap_pt1 (+ cvputw (/ PI 2)) cvphgt)
	    xrswap_pt3 (POLAR xrswap_pt2 (+ cvputw PI) cvpwid)
	    xrswap_pt4 (POLAR xrswap_pt3 (- cvputw (/ PI 2)) cvphgt)
      ) ;_ end of setq
    ) ;_ end of PROGN
  ) ;_ end of IF
  (SETQ curvwtwist (GETVAR "VIEWTWIST"))
  (princdebugstrs
    (LIST "End xrvp_stuff function in XRSWAP.\n")
  ) ;_ end of princdebugstrs
  (SETQ	princprfx
	 (COND
	   ((AND princprfx (WCMATCH princprfx "`[DEBUG`]   *"))
	    (SUBSTR princprfx 1 (- (STRLEN princprfx) 2))
	   )
	   (T "[DEBUG]  ")
	 ) ;_ end of COND
  ) ;_ end of SETQ
  (PRINC)
) ;_ end of defun
(PRINC)

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