;;;Custom Info, Date & Time stamp dialog routine.
;;;Uses Doslib14 or Doslib2k depending upon Acad version.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 2-2-2000
;;;>		   EDITED: 07-11-2006
;;;
(DEFUN setsclfac (/ sclfac)		;set precision for RTOS function
  (IF
    (AND
      (>= sclcalc 1)
      (EQUAL (REM sclcalc (FIX sclcalc)) 0 0.0001)
    ) ;_ end of AND
     (SETQ sclfac 0)
     (SETQ sclfac 4)
  ) ;_ end of if
) ;_ end of defun
(DEFUN C:CSTMP (/ xrstr cmde old_err_def atrreq frst_rdline)
  (IF dimscl NIL (LOAD "dimscl" "\nFile DIMSCL.LSP not found! "))
  (dimscl)
  (IF browser_help NIL (LOAD "browser_help" "\nFile BROWSER_HELP not loaded!"))
  (IF dos_about
    (SETQ dlib_loaded T)
    (COND
      ((EQ (SUBSTR (GETVAR "acadver") 1 2) "14")
       (IF (FINDFILE "doslib14.arx")
	 (PROGN
           (ARXLOAD "doslib14")(SETQ dlib_loaded T)(SETQ dlib_loaded NIL)))
      )
      ((EQ (SUBSTR (GETVAR "acadver") 1 2) "15")
       (IF (FINDFILE "doslib15.arx")
	 (PROGN
           (ARXLOAD "doslib15")(SETQ dlib_loaded T)(SETQ dlib_loaded NIL)))
      )
      ((EQ (SUBSTR (GETVAR "acadver") 1 2) "16")
       (IF (FINDFILE "doslib16.arx")
	 (PROGN
           (ARXLOAD "doslib16")(SETQ dlib_loaded T)(SETQ dlib_loaded NIL)))
      )
      ((EQ (SUBSTR (GETVAR "acadver") 1 2) "17")
       (IF (FINDFILE "doslib17.arx")
	 (PROGN
           (ARXLOAD "doslib17")(SETQ dlib_loaded T)(SETQ dlib_loaded NIL)))
      )
    ) ;_ end of COND
  ) ;_ end of if
  (if (or (eq (substr (getvar "dwgprefix") 1 2) "A:")
	  (eq (substr (getvar "dwgprefix") 1 2) "B:")
	  (eq (substr (getvar "dwgprefix") 1 2) "C:")
	  (eq (substr (getvar "dwgprefix") 1 2) "D:")
	  (eq (substr (getvar "dwgprefix") 1 2) "E:")
;;;	  (eq (substr (getvar "dwgprefix") 1 2) "L:")
      ) ;_ end of or
    (setq fs_str (strcat "  " (getenv "computername") " LOCAL DRIVE"))
    (progn
      (command ".sh"
	       (strcat "NET USE "
		       (substr (getvar "dwgprefix") 1 2)
		       " > c:\\fserv.dat"
	       ) ;_ end of strcat
      ) ;_ end of command
      (while (not frst_rdline)
	(setq fs_fil (open "c:\\fserv.dat" "r"))
	(if fs_fil
	  (if
	    (setq sd_rline (read-line fs_fil))
	     (setq frst_rdline T)
	  ) ;_ end of if
	) ;_ end of if
	(if frst_rdline
	  nil
	  (if (and fs_fil(eq (type fs_fil)'FILE))
	    (close fs_fil)
	  )
	) ;_ end of if
      ) ;_ end of while
      (while
	(setq sd_rline (read-line fs_fil))
	 (if (wcmatch sd_rline "Remote name *")
	   (progn
	     (setq fs_str (substr sd_rline 12))
	     (while (eq (substr fs_str 1 1) " ")
	       (setq fs_str (substr fs_str 2))
	     ) ;_ end of while
;;;	     (setq done_fs T)
	   ) ;_ end of progn
	 ) ;_ end of if
      ) ;_ end of while
      (close fs_fil)
;;;      (setq done_fs nil)
      (IF fs_str NIL (setq fs_str (strcat "  " (getenv "computername") " LOCAL DRIVE")))
    ) ;_ end of progn
  ) ;_ end of if
;;;  (IF dlib_loaded
;;;    (IF
;;;      (OR
;;;	(EQ (dos_drivetype (SUBSTR (GETVAR "dwgprefix") 1 2))
;;;	    "FIXED"
;;;	) ;_ end of EQ
;;;	(EQ (dos_drivetype (SUBSTR (GETVAR "dwgprefix") 1 2))
;;;	    "REMOVABLE"
;;;	) ;_ end of EQ
;;;      ) ;_ end of or
;;;      (SETQ fs_str (STRCAT "  " (dos_computer) " LOCAL DRIVE"))
;;;    )
;;;    (PROGN
;;;      (setq done_fs nil)
;;;      (COMMAND ".sh" "NET USE > c:\\fserv.dat")
;;;      (SETQ fs_fil (OPEN "c:\\fserv.dat" "r"))
;;;      (IF (AND fs_fil (EQ (TYPE fs_fil) 'FILE))
;;;	(SETQ sd_rline (READ-LINE fs_fil))
;;;	(SETQ sd_rline nil)
;;;      ) ;_ end of if
;;;      (IF sd_rline
;;;	(WHILE
;;;	  (AND (SETQ sd_rline (READ-LINE fs_fil)) (NOT done_fs))
;;;	   (IF (WCMATCH sd_rline (STRCAT "*"(SUBSTR (GETVAR "dwgprefix") 1 2)"*"))
;;;	     (PROGN
;;;	       (WHILE (WCMATCH sd_rline (STRCAT "*"(SUBSTR (GETVAR "dwgprefix") 1 2)"*"))
;;;	         (SETQ sd_rline (SUBSTR sd_rline 2))
;;;	       )
;;;	       (SETQ fs_str (SUBSTR sd_rline 3))
;;;	       (WHILE (EQ (SUBSTR fs_str 1 1) " ")
;;;		 (SETQ fs_str (SUBSTR fs_str 2))
;;;	       ) ;_ end of while
;;;	       (SETQ done_fs T)
;;;	     ) ;_ end of progn
;;;	     (SETQ done_fs nil)
;;;	   ) ;_ end of if
;;;	) ;_ end of while
;;;      ) ;_ end of if
;;;      (IF (SETQ mach_name (GETENV "MACH"))
;;;	(SETQ fs_str (STRCAT "  " mach_name " LOCAL DRIVE"))
;;;	(SETQ fs_str "  LOCAL DRIVE")
;;;      )
;;;    ) ;_ end of progn
;;;  ) ;_ end of if
  (IF dos_username
    (SETQ lognm (dos_username))
    (IF	(GETENV "LGN")
      (SETQ lognm (GETENV "LGN"))
      (SETQ lognm (ustr 1 "Username unknown, enter username for stamp" "No Username" T))
    ) ;_ end of if
  ) ;_ end of if
  (SETQ tblk (TBLNEXT "block" T))
  (WHILE
    (SETQ tbln (TBLNEXT "block"))
     (IF (SETQ xrnm (CDR (ASSOC 1 tbln)))
       (PROGN
	 (IF (WCMATCH (STRCASE xrnm) "*.DWG")
	   (SETQ xrnm (SUBSTR xrnm 1 (- (STRLEN xrnm) 4)))
	 ) ;_ end of if
	 (IF xrlst
	   (SETQ xrlst (APPEND xrlst (LIST xrnm)))
	   (SETQ xrlst (LIST xrnm))
	 ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
  ) ;_ end of while
  (SETQ image_ss (SSGET "x" '((0 . "IMAGE"))))
  (IF image_ss
    (PROGN
      (SETQ imss_len (SSLENGTH image_ss)
	    im_cnt   0
      ) ;_ end of setq
      (WHILE (< im_cnt imss_len)
	(IF xrlst
	  (SETQ	xrlst
		 (APPEND
		   xrlst
		   (LIST
		     (CDR
		       (ASSOC
			 1
			 (ENTGET
			   (CDR	(ASSOC 340
				       (ENTGET (SSNAME image_ss im_cnt))
				) ;_ end of assoc
			   ) ;_ end of cdr
			 ) ;_ end of entget
		       ) ;_ end of assoc
		     ) ;_ end of cdr
		   ) ;_ end of list
		 ) ;_ end of append
	  ) ;_ end of setq
	  (SETQ	xrlst
		 (LIST
		   (CDR
		     (ASSOC
		       1
		       (ENTGET
			 (CDR (ASSOC 340
				     (ENTGET (SSNAME image_ss im_cnt))
			      ) ;_ end of assoc
			 ) ;_ end of cdr
		       ) ;_ end of entget
		     ) ;_ end of assoc
		   ) ;_ end of cdr
		 ) ;_ end of list
	  ) ;_ end of setq
	) ;_ end of if
	(SETQ im_cnt (1+ im_cnt))
      ) ;_ end of while
    ) ;_ end of progn
  ) ;_ end of if
  (IF (SETQ xrnm (CDR (ASSOC 1 tblk)))
    (PROGN
      (IF (WCMATCH (STRCASE xrnm) "*.DWG")
	(SETQ xrnm (SUBSTR xrnm 1 (- (STRLEN xrnm) 4)))
      ) ;_ end of if
      (IF xrlst
	(SETQ xrlst (APPEND xrlst (LIST xrnm)))
	(SETQ xrlst (LIST xrnm))
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (IF xrlst
    (IF	(EQ xref_use "1")
      (PROGN
	(SETQ xrlst (ACAD_STRLSORT xrlst))
	(FOREACH n xrlst
	  (IF xrstr
	    (SETQ xrstr (STRCASE (STRCAT xrstr ", " n)))
	    (SETQ xrstr (STRCASE (STRCAT "XREF's: " n)))
	  ) ;_ end of if
	) ;_ end of foreach
      ) ;_ end of progn
      (SETQ xrstr "")
    ) ;_ end of if
    (SETQ xrstr "")
  ) ;_ end of if
  (SETQ xrlst nil)

;;;These COND sections are to cause dwgstamp to reflect the actual scale at
;;;which the drawing was plotted.  If the plot was made using my Lisp generated
;;;batch plotting utility then the variable "ftscl" will be set to effect the
;;;correct scale string for the plot. Otherwise the intended full scale is used.

  (COND
    ((= ftscl "Fullscale")
     (COND
       ((OR (EQ (GETVAR "lunits") 1) (EQ (GETVAR "lunits") 5))
	(SETQ sclcalc (ATOF (RTOS dimsc 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1:" (RTOS dimsc 2 (setsclfac))))
       )
       ((EQ (GETVAR "lunits") 2)
	(SETQ sclcalc (ATOF (RTOS dimsc 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1\"="
			   (RTOS dimsc 2 (setsclfac))
			   "' (1:"
			   (RTOS dimsc 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
       ((EQ (GETVAR "lunits") 3)
	(SETQ sclcalc (ATOF (RTOS (/ dimsc 12) 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1\"="
			   (RTOS (/ dimsc 12) 2 (setsclfac))
			   "' (1:"
			   (RTOS dimsc 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
       ((EQ (GETVAR "lunits") 4)
	(SETQ sclcalc (ATOF (RTOS (/ 12.0000 dimsc) 2 4)))
	(SETQ dscl (STRCAT "SCALE: "
			   (RTOS (/ 12.0000 dimsc) 5 (setsclfac))
			   "\"=1'-0\" (1:"
			   (RTOS dimsc 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
     ) ;_ end of cond
    )
    ((= ftscl "Halfscale")
     (COND
       ((OR (EQ (GETVAR "lunits") 1) (EQ (GETVAR "lunits") 5))
	(SETQ sclcalc (ATOF (RTOS (* dimsc 2) 2 4)))
	(SETQ
	  dscl (STRCAT "SCALE: 1:" (RTOS (* dimsc 2) 2 (setsclfac)))
	) ;_ end of setq
       )
       ((EQ (GETVAR "lunits") 2)
	(SETQ sclcalc (ATOF (RTOS (* dimsc 2) 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1\"="
			   (RTOS (* dimsc 2) 2 (setsclfac))
			   "' (1:"
			   (RTOS (* dimsc 2) 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
       ((EQ (GETVAR "lunits") 3)
	(SETQ sclcalc (ATOF (RTOS (/ dimsc 6) 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1\"="
			   (RTOS (/ dimsc 6) 2 (setsclfac))
			   "' (1:"
			   (RTOS (* dimsc 2) 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
       ((EQ (GETVAR "lunits") 4)
	(SETQ sclcalc (ATOF (RTOS (/ 6.0000 dimsc) 2 4)))
	(SETQ dscl (STRCAT "SCALE: "
			   (RTOS (/ 6.0000 dimsc) 5 (setsclfac))
			   "\"=1'-0\" (1:"
			   (RTOS (* dimsc 2) 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
     ) ;_ end of cond
    )
    ((= ftscl "Fit")
     (SETQ dscl "DO NOT SCALE, plotted to FIT")
    )
    ((OR (/= ftscl "Fit")
	 (/= ftscl "Halfscale")
	 (/= ftscl "Fullscale")
     ) ;_ end of or
     (COND
       ((OR (EQ (GETVAR "lunits") 1) (EQ (GETVAR "lunits") 5))
	(SETQ sclcalc (ATOF (RTOS dimsc 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1:" (RTOS dimsc 2 (setsclfac))))
       )
       ((EQ (GETVAR "lunits") 2)
	(SETQ sclcalc (ATOF (RTOS dimsc 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1\"="
			   (RTOS dimsc 2 (setsclfac))
			   "' (1:"
			   (RTOS dimsc 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
       ((EQ (GETVAR "lunits") 3)
	(SETQ sclcalc (ATOF (RTOS (/ dimsc 12) 2 4)))
	(SETQ dscl (STRCAT "SCALE: 1\"="
			   (RTOS (/ dimsc 12) 2 (setsclfac))
			   "' (1:"
			   (RTOS dimsc 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
       ((EQ (GETVAR "lunits") 4)
	(SETQ sclcalc (ATOF (RTOS (/ 12.0000 dimsc) 2 4)))
	(SETQ dscl (STRCAT "SCALE: "
			   (RTOS (/ 12.0000 dimsc) 5 (setsclfac))
			   "\"=1'-0\" (1:"
			   (RTOS dimsc 2 (setsclfac))
			   ")"
		   ) ;_ end of strcat
	) ;_ end of setq
       )
     ) ;_ end of cond
    )
  ) ;_ end of cond
  (SETQ datm (RTOS (GETVAR "cdate") 2 6))
  (SETQ dwgp (GETVAR "dwgprefix"))
  (SETQ dwgn (GETVAR "dwgname"))
  (IF (= (SUBSTR dwgp 1 3) (SUBSTR dwgn 1 3))
    (SETQ slen (+ (- (STRLEN dwgn) (- (STRLEN dwgn) (STRLEN dwgp))) 1))
    (SETQ slen 1)
  ) ;_ end of if
  (SETQ cstmp_dlg# (LOAD_DIALOG "cstmp"))
  (SETQ	newdlg_cstmp
	 (NEW_DIALOG
	   "cstmp"
	   cstmp_dlg#
	   (IF defact_cstmp
	     defact_cstmp
	     ""
	   ) ;_ end of if
	   (IF cstmp_loc
	     cstmp_loc
	     '(-1 -1)
	   ) ;_ end of if
	 ) ;_ end of NEW_DIALOG
  ) ;_ end of SETQ
  (IF serv_drv_use
    nil
    (SETQ serv_drv_use "1")
  ) ;_ end of if
  (IF dwg_prefix_use
    nil
    (SETQ dwg_prefix_use "1")
  ) ;_ end of if
  (IF dwg_name_use
    nil
    (SETQ dwg_name_use "1")
  ) ;_ end of if
  (IF username_use
    nil
    (SETQ username_use "1")
  ) ;_ end of if
  (IF date_use
    nil
    (SETQ date_use "1")
  ) ;_ end of if
  (IF time_use
    nil
    (SETQ time_use "1")
  ) ;_ end of if
  (IF scale_use
    nil
    (SETQ scale_use "1")
  ) ;_ end of if
  (IF xref_use
    nil
    (SETQ xref_use "1")
  ) ;_ end of if
  (IF stamp_ori
    nil
    (SETQ stamp_ori "ori_up")
  ) ;_ end of if
  (IF hgt_opt
    nil
    (SETQ hgt_opt "0")
  ) ;_ end of if
  (IF (EQ hgt_opt "0")
    (SETQ stamp_hgt (* dimsc 0.125))
  ) ;_ end of if
  (IF stamp_hgt
    nil
    (SETQ stamp_hgt (* dimsc 0.125))
  ) ;_ end of if
  (IF (AND locmethod
	   (OR (EQ locmethod "off_locn") (EQ locmethod "coord_locn"))
      ) ;_ end of and
    nil
    (SETQ locmethod "off_locn")
  ) ;_ end of if
  (set_loc_tiles)
  (IF x_coord
    nil
    (SETQ x_coord "1.25")
  ) ;_ end of if
  (IF y_coord
    nil
    (SETQ y_coord "0.5")
  ) ;_ end of if
  (IF z_coord
    nil
    (SETQ z_coord "0.0")
  ) ;_ end of if
  (IF x_off
    nil
    (SETQ x_off "off_x_left")
  ) ;_ end of if
  (IF y_off
    nil
    (SETQ y_off "off_y_bottom")
  ) ;_ end of if
  (IF x_dist
    nil
    (SETQ x_dist "1.25")
  ) ;_ end of if
  (IF y_dist
    nil
    (SETQ y_dist "0.5")
  ) ;_ end of if
  (SET_TILE "locmethod" locmethod)
  (SET_TILE "serv_drv_tog" serv_drv_use)
  (SET_TILE "dwg_prefix_tog" dwg_prefix_use)
  (SET_TILE "dwg_name_tog" dwg_name_use)
  (SET_TILE "username_tog" username_use)
  (SET_TILE "date_tog" date_use)
  (SET_TILE "time_tog" time_use)
  (SET_TILE "scale_tog" scale_use)
  (SET_TILE "xref_tog" xref_use)
  (SET_TILE "stamp_ori" stamp_ori)
  (SET_TILE "hgt_opt" hgt_opt)
  (SET_TILE "stamp_hgt" (RTOS (/ stamp_hgt dimsc) 2 4))
  (SET_TILE "X_coord" x_coord)
  (SET_TILE "Y_coord" y_coord)
  (SET_TILE "Z_coord" z_coord)
  (SET_TILE "x_off" x_off)
  (SET_TILE "y_off" y_off)
  (SET_TILE "x_dist" x_dist)
  (SET_TILE "y_dist" y_dist)
  (SET_TILE "serv_drv_txt" (STRCASE (SUBSTR fs_str 3)))
  (SET_TILE "dwg_prefix_txt" (STRCASE dwgp))
  (SET_TILE "dwg_name_txt"
	    (STRCASE
	      (STRCAT (SUBSTR dwgn slen)
		      (IF (WCMATCH (STRCASE (SUBSTR dwgn slen)) "*.DWG")
			" "
			".DWG"
		      ) ;_ end of IF
	      ) ;_ end of strcat
	    ) ;_ end of strcase
  ) ;_ end of set_tile
  (SET_TILE "username_txt"
	    (STRCASE (STRCAT "EDITED BY: " lognm))
  ) ;_ end of set_tile
  (SET_TILE "date_txt"
	    (STRCASE (STRCAT (SUBSTR datm 5 2)
			     "/"
			     (SUBSTR datm 7 2)
			     "/"
			     (SUBSTR datm 3 2)
		     ) ;_ end of strcat
	    ) ;_ end of strcase
  ) ;_ end of set_tile
  (SET_TILE "time_txt"
	    (STRCASE
	      (STRCAT (SUBSTR datm 10 2) ":" (SUBSTR datm 12 2) "+")
	    ) ;_ end of STRCASE
  ) ;_ end of set_tile
  (SET_TILE "scale_txt" (STRCASE dscl))
  (SET_TILE "xref_txt"
	    (IF	(> (STRLEN xrstr) 37)
	      (STRCAT (SUBSTR (STRCASE xrstr) 1 47) "...")
	      (STRCASE xrstr)
	    ) ;_ end of IF
  ) ;_ end of SET_TILE
  (MODE_TILE "serv_drv_txt" (ABS (- 1 (ATOI serv_drv_use))))
  (MODE_TILE "dwg_prefix_txt"
	     (ABS (- 1 (ATOI dwg_prefix_use)))
  ) ;_ end of mode_tile
  (MODE_TILE "dwg_name_txt" (ABS (- 1 (ATOI dwg_name_use))))
  (MODE_TILE "username_txt" (ABS (- 1 (ATOI username_use))))
  (MODE_TILE "date_txt" (ABS (- 1 (ATOI date_use))))
  (MODE_TILE "time_txt" (ABS (- 1 (ATOI time_use))))
  (MODE_TILE "scale_txt" (ABS (- 1 (ATOI scale_use))))
  (MODE_TILE "xref_txt" (ABS (- 1 (ATOI xref_use))))
  (IF (EQ hgt_opt "0")
    (MODE_TILE "stamp_hgt" 1)
    (MODE_TILE "stamp_hgt" 0)
  ) ;_ end of IF
  (ACTION_TILE
    "serv_drv_tog"
    "(setq serv_drv_use $value)(mode_tile\"serv_drv_txt\"(abs(- 1(atoi $value))))"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dwg_prefix_tog"
    "(setq dwg_prefix_use $value)(mode_tile\"dwg_prefix_txt\"(abs(- 1(atoi $value))))"
  ) ;_ end of action_tile
  (ACTION_TILE
    "dwg_name_tog"
    "(setq dwg_name_use $value)(mode_tile\"dwg_name_txt\"(abs(- 1(atoi $value))))"
  ) ;_ end of action_tile
  (ACTION_TILE
    "username_tog"
    "(setq username_use $value)(mode_tile\"username_txt\"(abs(- 1(atoi $value))))"
  ) ;_ end of action_tile
  (ACTION_TILE
    "date_tog"
    "(setq date_use $value)(mode_tile\"date_txt\"(abs(- 1(atoi $value))))"
  ) ;_ end of action_tile
  (ACTION_TILE
    "time_tog"
    "(setq time_use $value)(mode_tile\"time_txt\"(abs(- 1(atoi $value))))"
  ) ;_ end of action_tile
  (ACTION_TILE
    "scale_tog"
    "(setq scale_use $value)(mode_tile\"scale_txt\"(abs(- 1(atoi $value))))"
  ) ;_ end of action_tile
  (ACTION_TILE
    "xref_tog"
    "(setq xref_use $value)(mode_tile\"xref_txt\"(abs(- 1(atoi $value))))(set_loc_img)"
  ) ;_ end of action_tile
  (ACTION_TILE
    "stamp_ori"
    "(setq stamp_ori $value)(set_loc_img)"
  ) ;_ end of ACTION_TILE
  (ACTION_TILE "hgt_opt" "(setq hgt_opt $value)(get_hgt)")
  (ACTION_TILE "stamp_hgt" "(setq stamp_hgt (* dimsc (atof $value)))")
  (ACTION_TILE
    "locmethod"
    "(setq locmethod $value)(set_loc_tiles)(set_loc_img)"
  ) ;_ end of ACTION_TILE
  (ACTION_TILE
    "coord_locn"
    "(setq locmethod(get_tile\"locmethod\"))(set_loc_tiles)(set_loc_img)"
  ) ;_ end of ACTION_TILE
  (ACTION_TILE
    "off_locn"
    "(setq locmethod(get_tile\"locmethod\"))(set_loc_tiles)(set_loc_img)"
  ) ;_ end of ACTION_TILE
  (ACTION_TILE "X_coord" "(setq X_coord $value)(set_loc_img)")
  (ACTION_TILE "Y_coord" "(setq Y_coord $value)(set_loc_img)")
  (ACTION_TILE "Z_coord" "(setq Z_coord $value)(set_loc_img)")
  (ACTION_TILE "x_off" "(setq x_off $value)(set_loc_img)")
  (ACTION_TILE "y_off" "(setq y_off $value)(set_loc_img)")
  (ACTION_TILE "x_dist" "(setq x_dist $value)(set_loc_img)")
  (ACTION_TILE "y_dist" "(setq y_dist $value)(set_loc_img)")
  (ACTION_TILE
    "accept"
    "(cstmp_values)(setq cstmp_loc(done_dialog 1))"
  ) ;_ end of action_tile
  (ACTION_TILE "cancel" "(setq cstmp_loc(done_dialog 0))")
  (ACTION_TILE "help" "(browser_help \"cstmp\")")
  (set_loc_img)
  (SETQ exit_no (START_DIALOG))
  (IF (EQ exit_no 1)
    (cstmp)
    (PROGN
;;;      (princ exit_no)
      (PRINC "\nFunction cancelled, nothing to do! ")
    ) ;_ end of progn
  ) ;_ end of IF
  (UNLOAD_DIALOG cstmp_dlg#)
  (PRINC)
) ;_ end of DEFUN
(DEFUN cstmp ()
  (SETQ old_err_def *error*)
  (SETQ *error* cstmp_error)
  (SETQ old_stamps (SSGET "x" '((-4 . "<OR")
				  (2 . "DWGSTAMP")
				  (2 . "XRFSTAMP")
				  (2 . "PLTSTAMP")
				(-4 . "OR>")
				)))
  (IF old_stamps
    (PROGN
      (SETQ olds_len (SSLENGTH old_stamps))
      (SETQ del_cnt 0)
      (WHILE (< del_cnt olds_len)
        (ENTDEL (SSNAME old_stamps del_cnt))
        (SETQ del_cnt (1+ del_cnt))
      )
    )
  )
  (IF (NOT (TBLSEARCH "BLOCK" "DWGSTAMP"))
    (PROGN
      (ENTMAKE
	'((0 . "BLOCK") (2 . "DWGSTAMP") (70 . 66) (10 0.0 0.0 0.0))
      ) ;_ end of entmake
      (ENTMAKE '((0 . "ATTDEF")
		 (100 . "AcDbEntity")
		 (67 . 0)
		 (8 . "G-SHBD7IDEN")
		 (100 . "AcDbText")
		 (10 0.0 0.0 0.0)
		 (40 . 0.2)
		 (1 . "")
		 (50 . 1.5708)
		 (41 . 1.0)
		 (51 . 0.0)
		 (7 . "STANDARD")
		 (71 . 0)
		 (72 . 0)
		 (11 0.0 0.0 0.0)
		 (210 0.0 0.0 1.0)
		 (100 . "AcDbAttributeDefinition")
		 (3 . "")
		 (2 . "FILSPEC")
		 (70 . 4)
		 (73 . 0)
		 (74 . 0)
		)
      ) ;_ end of entmake
      (ENTMAKE '((0 . "ENDBLK")))
    ) ;_ end of progn
  ) ;_ end of if
  (IF (NOT (TBLSEARCH "BLOCK" "XRFSTAMP"))
    (PROGN
      (ENTMAKE
	'((0 . "BLOCK") (2 . "XRFSTAMP") (70 . 66) (10 0.0 0.0 0.0))
      ) ;_ end of entmake
      (ENTMAKE '((0 . "ATTDEF")
		 (100 . "AcDbEntity")
		 (67 . 0)
		 (8 . "G-SHBD7IDEN")
		 (100 . "AcDbText")
		 (10 0.0 0.0 0.0)
		 (40 . 0.2)
		 (1 . "")
		 (50 . 1.5708)
		 (41 . 1.0)
		 (51 . 0.0)
		 (7 . "STANDARD")
		 (71 . 0)
		 (72 . 0)
		 (11 0.0 0.0 0.0)
		 (210 0.0 0.0 1.0)
		 (100 . "AcDbAttributeDefinition")
		 (3 . "")
		 (2 . "FILSPEC")
		 (70 . 4)
		 (73 . 0)
		 (74 . 0)
		)
      ) ;_ end of entmake
      (ENTMAKE '((0 . "ENDBLK")))
    ) ;_ end of progn
  ) ;_ end of if
  (SETQ cmde (GETVAR "cmdecho"))
  (SETQ atrreq (GETVAR "attreq"))
  (SETVAR "ATTREQ" 0)
  (WHILE (NOT (SETQ found_dwg (SSGET "x" '((2 . "dwgstamp")))))
    (COMMAND ".insert" "dwgstamp" "0,0" 1 1 0)
  ) ;_ end of While
  (SETQ stamp_ent (ENTGET (SSNAME found_dwg 0)))
  (SETQ cur_ent (ENTGET (ENTNEXT (CDR (ASSOC -1 stamp_ent)))))
  (WHILE (NOT (SETQ found_xrf (SSGET "x" '((2 . "xrfstamp")))))
    (COMMAND ".insert" "xrfstamp" "0,0" 1 1 0)
  ) ;_ end of While
  (SETVAR "CMDECHO" cmde)
  (SETQ stamp_xent (ENTGET (SSNAME found_xrf 0)))
  (SETQ cur_xent (ENTGET (ENTNEXT (CDR (ASSOC -1 stamp_xent)))))
  (SETQ	maxx (CAR (GETVAR "limmax"))
	minx (CAR (GETVAR "limmin"))
	maxy (CADR (GETVAR "limmax"))
	miny (CADR (GETVAR "limmin"))
  ) ;_ end of setq
  (SETQ default_ori "Specify")
  (PROGN
    (SETQ off_x_side (SUBSTR x_off 7))
    (SETQ dist_x (ATOF x_dist))
    (COND ((EQ off_x_side "right")
	   (SETQ dist_x (+ dist_x (- maxx minx)))
	  )
    ) ;_ end of cond
    (SETQ stamp_x (+ minx dist_x))
    (SETQ off_y_side (SUBSTR y_off 7))
    (SETQ dist_y (ATOF y_dist))
    (COND ((EQ off_y_side "top")
	   (SETQ dist_y (+ dist_y (- maxy miny)))
	  )
    ) ;_ end of cond
    (SETQ stamp_y (+ miny dist_y))
    (IF	(EQ locmethod "off_locn")
      (SETQ stamp_pt (LIST stamp_x stamp_y 0))
      (SETQ
	stamp_pt (LIST (ATOF X_coord) (ATOF Y_coord) (ATOF Z_coord))
      ) ;_ end of SETQ
    ) ;_ end of IF
    (SETQ stamp_dir (SUBSTR stamp_ori 5))
    (COND
      ((EQ stamp_dir "up")
       (SETQ stamp_ang (* PI 0.5))
       (SETQ xrlst_pt (POLAR stamp_pt 0 (* 1.5 stamp_hgt)))
      )
      ((EQ stamp_dir "right")
       (SETQ stamp_ang 0)
       (SETQ xrlst_pt (POLAR stamp_pt (* PI 1.5) (* 1.5 stamp_hgt)))
      )
      ((EQ stamp_dir "down")
       (SETQ stamp_ang (* PI 1.5))
       (SETQ xrlst_pt (POLAR stamp_pt PI (* 1.5 stamp_hgt)))
      )
      ((EQ stamp_dir "left")
       (SETQ stamp_ang PI)
       (SETQ xrlst_pt (POLAR stamp_pt (* PI 0.5) (* 1.5 stamp_hgt)))
      )
    ) ;_ end of cond
  ) ;_ end of progn
  (SETQ datm (RTOS (GETVAR "cdate") 2 6))
  (SETQ
    stamp_str (STRCASE
		(STRCAT
		  (IF (EQ serv_drv_use "1")
		    (STRCAT (SUBSTR fs_str 3) " ")
		    ""
		  ) ;_ end of if
		  (IF (EQ dwg_prefix_use "1")
		    dwgp
		    ""
		  ) ;_ end of if
		  (IF (EQ dwg_name_use "1")
		    (STRCAT
		      (SUBSTR dwgn slen)
		      (IF (WCMATCH (STRCASE (SUBSTR dwgn slen)) "*.DWG")
			" "
			".DWG "
		      ) ;_ end of if
		    ) ;_ end of strcat
		    ""
		  ) ;_ end of if
		  (IF (EQ username_use "1")
		    (STRCAT
		      "EDITED BY: "
		      lognm
		      " "
		    ) ;_ end of strcat
		    ""
		  ) ;_ end of if
		  (IF (EQ date_use "1")
		    (STRCAT
		      (SUBSTR datm 5 2)
		      "/"
		      (SUBSTR datm 7 2)
		      "/"
		      (SUBSTR datm 3 2)
		      " "
		    ) ;_ end of strcat
		    ""
		  ) ;_ end of if
		  (IF (EQ time_use "1")
		    (STRCAT
		      (SUBSTR datm 10 2)
		      ":"
		      (SUBSTR datm 12 2)
		      " "
		    ) ;_ end of strcat
		    ""
		  ) ;_ end of if
		  (IF (EQ scale_use "1")
		    dscl
		    ""
		  ) ;_ end of if
		) ;_ end of strcat
	      ) ;_ end of strcase
  ) ;_ end of setq
  (IF found_dwg
    (PROGN
      (SETQ cur_ent
	     (SUBST (CONS 1 stamp_str) (ASSOC 1 cur_ent) cur_ent)
      ) ;_ end of setq
      (SETQ cur_ent
	     (SUBST (CONS 10 stamp_pt) (ASSOC 10 cur_ent) cur_ent)
      ) ;_ end of setq
      (SETQ cur_ent
	     (SUBST (CONS 40 stamp_hgt) (ASSOC 40 cur_ent) cur_ent)
      ) ;_ end of setq
      (SETQ cur_ent
	     (SUBST (CONS 50 stamp_ang) (ASSOC 50 cur_ent) cur_ent)
      ) ;_ end of setq
      (IF (AND (ENTMOD cur_ent) (ENTMOD stamp_ent))
	(PRINC "\nDrawing stamp updated. ")
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (IF found_xrf
    (PROGN
      (SETQ cur_xent
	     (SUBST (CONS 1
			  (IF xrstr
			    xrstr
			    ""
			  ) ;_ end of if
		    ) ;_ end of CONS
		    (ASSOC 1 cur_xent)
		    cur_xent
	     ) ;_ end of SUBST
      ) ;_ end of setq
      (SETQ cur_xent
	     (SUBST (CONS 10 xrlst_pt) (ASSOC 10 cur_xent) cur_xent)
      ) ;_ end of setq
      (SETQ cur_xent
	     (SUBST (CONS 40 stamp_hgt) (ASSOC 40 cur_xent) cur_xent)
      ) ;_ end of setq
      (SETQ cur_xent
	     (SUBST (CONS 50 stamp_ang) (ASSOC 50 cur_xent) cur_xent)
      ) ;_ end of setq
      (IF (AND (ENTMOD cur_xent)
	       (ENTMOD stamp_xent)
	       (/= xrstr "")
	       xrstr
	  ) ;_ end of AND
	(PRINC "\nXref list stamp updated. ")
      ) ;_ end of if
      (SETQ xrstr nil)
    ) ;_ end of progn
  ) ;_ end of if
  (SETQ *error* old_err_def)
  (IF (AND fs_fil (EQ (TYPE fs_file) 'FILE))
    (CLOSE fs_fil)
  ) ;_ end of IF
  (PRINC)
) ;_ end of defun
(DEFUN get_hgt ()
  (IF (EQ hgt_opt "0")
    (PROGN
      (MODE_TILE "stamp_hgt" 1)
      (SETQ stamp_hgt (* dimsc 0.125))
      (SET_TILE "stamp_hgt" (RTOS (/ stamp_hgt dimsc) 2 4))
    ) ;_ end of PROGN
    (PROGN
      (MODE_TILE "stamp_hgt" 0)
      (SETQ stamp_hgt (* dimsc (atof (get_tile "stamp_hgt"))))
      (SET_TILE "stamp_hgt" (RTOS (/ stamp_hgt dimsc) 2 4))
    ) ;_ end of PROGN
  ) ;_ end of IF
) ;_ end of defun
(DEFUN cstmp_values ()
  (SETQ serv_drv_use (GET_TILE "serv_drv_tog"))
  (SETQ dwg_prefix_use (GET_TILE "dwg_prefix_tog"))
  (SETQ dwg_name_use (GET_TILE "dwg_name_tog"))
  (SETQ username_use (GET_TILE "username_tog"))
  (SETQ date_use (GET_TILE "date_tog"))
  (SETQ time_use (GET_TILE "time_tog"))
  (SETQ scale_use (GET_TILE "scale_tog"))
  (SETQ xref_use (GET_TILE "xref_tog"))
  (SETQ stamp_ori (GET_TILE "stamp_ori"))
  (SETQ x_off (GET_TILE "x_off"))
  (SETQ y_off (GET_TILE "y_off"))
  (SETQ x_dist (GET_TILE "x_dist"))
  (SETQ y_dist (GET_TILE "y_dist"))
) ;_ end of defun
(DEFUN set_loc_tiles ()
  (COND
    ((EQ locmethod "coord_locn")
     (MODE_TILE "X_coord" 0)
     (MODE_TILE "Y_coord" 0)
     (MODE_TILE "Z_coord" 0)
     (MODE_TILE "x_dist" 1)
     (MODE_TILE "x_off" 1)
     (MODE_TILE "y_dist" 1)
     (MODE_TILE "y_off" 1)
    )
    ((EQ locmethod "off_locn")
     (MODE_TILE "X_coord" 1)
     (MODE_TILE "Y_coord" 1)
     (MODE_TILE "Z_coord" 1)
     (MODE_TILE "x_dist" 0)
     (MODE_TILE "x_off" 0)
     (MODE_TILE "y_dist" 0)
     (MODE_TILE "y_off" 0)
    )
  ) ;_ end of COND
) ;_ end of defun
(DEFUN set_loc_img ()
  (SETQ maxx (DIMX_TILE "rotimg"))
  (SETQ maxy (DIMY_TILE "rotimg"))
  (SETQ lim_min (GETVAR "limmin"))
  (SETQ lim_max (GETVAR "limmax"))
  (SETQ min_x (CAR lim_min))
  (SETQ min_y (CADR lim_min))
  (SETQ max_x (CAR lim_max))
  (SETQ max_y (CADR lim_max))
  (SETQ lt_x 6)
  (SETQ rt_x (- maxx 6))
  (SETQ tp_y 6)
  (SETQ bt_y (- maxy 6))
  (IF (EQ locmethod "off_locn")
    (PROGN
      (IF
	(EQ x_off "off_x_right")
	 (SETQ x_1 rt_x)
	 (SETQ x_1 lt_x)
      ) ;_ end of IF
      (IF
	(EQ y_off "off_y_top")
	 (SETQ y_1 tp_y)
	 (SETQ y_1 bt_y)
      ) ;_ end of IF
    ) ;_ end of PROGN
    (PROGN
      (SETQ x_1
	     (+	(FIX (* (- (ATOF X_coord) min_x) (/ 78 (- max_x min_x))))
		6
	     ) ;_ end of +
      ) ;_ end of SETQ
      (SETQ y_1
	     (-	maxy
		(FIX (* (- (ATOF Y_coord) min_y) (/ 78 (- max_y min_y))))
		6
	     ) ;_ end of -
      ) ;_ end of SETQ
    ) ;_ end of PROGN
  ) ;_ end of IF
  (COND
    ((EQ stamp_ori "ori_up")
     (SETQ x_2 x_1)
     (SETQ y_2 (- y_1 35))
    )
    ((EQ stamp_ori "ori_right")
     (SETQ x_2 (+ x_1 35))
     (SETQ y_2 y_1)
    )
    ((EQ stamp_ori "ori_left")
     (SETQ x_2 (- x_1 35))
     (SETQ y_2 y_1)
    )
    ((EQ stamp_ori "ori_down")
     (SETQ x_2 x_1)
     (SETQ y_2 (+ y_1 35))
    )
  ) ;_ end of COND
  (IF (EQ locmethod "off_locn")
    (PROGN
      (SETQ x_o1 (- x_1 (- 0 (FIX (* 2.0 (ATOF x_dist))))))
      (SETQ y_o1 (+ y_1 (- 0 (FIX (* 2.0 (ATOF y_dist))))))
      (SETQ x_o2 (- x_2 (- 0 (FIX (* 2.0 (ATOF x_dist))))))
      (SETQ y_o2 (+ y_2 (- 0 (FIX (* 2.0 (ATOF y_dist))))))
    ) ;_ end of PROGN
    (PROGN
      (SETQ x_o1 x_1)
      (SETQ y_o1 y_1)
      (SETQ x_o2 x_2)
      (SETQ y_o2 y_2)
    ) ;_ end of PROGN
  ) ;_ end of IF
  (START_IMAGE "rotimg")
  (FILL_IMAGE 0 0 maxx maxy -2)
  (VECTOR_IMAGE 6 (- maxy 6) 6 (- maxy 10) 7) ;limits bottom left - up
  (VECTOR_IMAGE 6 (- maxy 6) 10 (- maxy 6) 7) ;limits bottom left - right
  (VECTOR_IMAGE (- maxx 6) 6 (- maxx 10) 6 7) ;limits top right - down
  (VECTOR_IMAGE (- maxx 6) 6 (- maxx 6) 10 7) ;limits top right - left
  (VECTOR_IMAGE (- maxx 6)(- maxy 6)(- maxx 6)(- maxy 10)7);limits bottom right - up
  (VECTOR_IMAGE (- maxx 6)(- maxy 6)(- maxx 10)(- maxy 6)7);limits bottom right - left
  (VECTOR_IMAGE 6 6 10 6 7)		;limits top left - right
  (VECTOR_IMAGE 6 6 6 10 7)		;limits top left - down
  (COND
    ((OR (>= x_o1 maxx) (<= x_o1 0))
     (IF
       (<= x_o1 0)
	(SETQ x_m1 0)
     ) ;_ end of IF
     (IF
       (>= x_o1 maxx)
	(SETQ x_m1 maxx)
     ) ;_ end of IF
    )
    (T (SETQ x_m1 x_o1))
  ) ;_ end of COND
  (COND
    ((OR (>= y_o1 maxy) (<= y_o1 0))
     (IF
       (<= y_o1 0)
	(SETQ y_m1 0)
     ) ;_ end of IF
     (IF
       (>= y_o1 maxy)
	(SETQ y_m1 maxy)
     ) ;_ end of IF
    )
    (T (SETQ y_m1 y_o1))
  ) ;_ end of COND
  (COND
    ((OR (>= x_o2 maxx) (<= x_o2 0))
     (IF
       (<= x_o2 0)
	(SETQ x_m2 0)
     ) ;_ end of IF
     (IF
       (>= x_o2 maxx)
	(SETQ x_m2 maxx)
     ) ;_ end of IF
    )
    (T (SETQ x_m2 x_o2))
  ) ;_ end of COND
  (COND
    ((OR (>= y_o2 maxy) (<= y_o2 0))
     (IF
       (<= y_o2 0)
	(SETQ y_m2 0)
     ) ;_ end of IF
     (IF
       (>= y_o2 maxy)
	(SETQ y_m2 maxy)
     ) ;_ end of IF
    )
    (T (SETQ y_m2 y_o2))
  ) ;_ end of COND
  (COND
    ((AND (> x_o1 0)
	  (< x_o1 maxx)
	  (> y_o1 0)
	  (< y_o1 maxy)
	  (> x_o2 0)
	  (< x_o2 maxx)
	  (> y_o2 0)
	  (< y_o2 maxy)
     ) ;_ end of AND
     (PROGN
       (VECTOR_IMAGE x_o1 y_o1 x_o2 y_o2 1)
       (IF (EQ xref_use "1")
	 (COND
	   ((EQ stamp_ori "ori_right")
	     (VECTOR_IMAGE x_o1 (+ y_o1 2) x_o2 (+ y_o2 2) 7))
	   ((EQ stamp_ori "ori_left")
	     (VECTOR_IMAGE x_o1 (- y_o1 2) x_o2 (- y_o2 2) 7))
	   ((EQ stamp_ori "ori_up")
	     (VECTOR_IMAGE (+ x_o1 2) y_o1 (+ x_o2 2) y_o2 7))
	   ((EQ stamp_ori "ori_up")
	     (VECTOR_IMAGE (- x_o1 2) y_o1 (- x_o2 2) y_o2 7))
	 )
       )
     )
    )
    ((OR (AND (> x_o1 0) (< x_o1 maxx) (> y_o1 0) (< y_o1 maxy))
	 (AND (> x_o2 0) (< x_o2 maxx) (> y_o2 0) (< y_o2 maxy))
     ) ;_ end of OR
     (COND
       ((AND (> x_o1 0)
	     (< x_o1 maxx)
	     (> y_o1 0)
	     (< y_o1 maxy)
	     (> x_o2 0)
	     (< x_o2 maxx)
	     (> y_o2 0)
	     (< y_o2 maxy)
	) ;_ end of AND
	(VECTOR_IMAGE x_o1 y_o1 x_o2 y_o2 1)
	(IF (EQ xref_use "1")
	  (COND
	    ((EQ stamp_ori "ori_right")
	      (VECTOR_IMAGE x_o1 (+ y_o1 2) x_o2 (+ y_o2 2) 7))
	    ((EQ stamp_ori "ori_left")
	      (VECTOR_IMAGE x_o1 (- y_o1 2) x_o2 (- y_o2 2) 7))
	    ((EQ stamp_ori "ori_up")
	      (VECTOR_IMAGE (+ x_o1 2) y_o1 (+ x_o2 2) y_o2 7))
	    ((EQ stamp_ori "ori_up")
	      (VECTOR_IMAGE (- x_o1 2) y_o1 (- x_o2 2) y_o2 7))
	  )
	)
       )
       ((AND (> x_o1 0) (< x_o1 maxx) (> y_o1 0) (< y_o1 maxy))
	(IF (EQ x_o1 x_o2)
	  (PROGN
	    (VECTOR_IMAGE x_o1 y_o1 x_o2 y_m2 1)
	    (IF (EQ xref_use "1")
	      (COND
	        ((EQ stamp_ori "ori_right")
	          (VECTOR_IMAGE x_o1 (+ y_o1 2) x_o2 (+ y_m2 2) 7))
	        ((EQ stamp_ori "ori_left")
	          (VECTOR_IMAGE x_o1 (- y_o1 2) x_o2 (- y_m2 2) 7))
	        ((EQ stamp_ori "ori_up")
	          (VECTOR_IMAGE (+ x_o1 2) y_o1 (+ x_o2 2) y_m2 7))
	        ((EQ stamp_ori "ori_down")
	          (VECTOR_IMAGE (- x_o1 2) y_o1 (- x_o2 2) y_m2 7))
	      )
	    )
	  )
	  (PROGN
	    (VECTOR_IMAGE x_o1 y_o1 x_m2 y_o2 1)
	    (IF (EQ xref_use "1")
	      (COND
	        ((EQ stamp_ori "ori_right")
	          (VECTOR_IMAGE x_o1 (+ y_o1 2) x_m2 (+ y_o2 2) 7))
	        ((EQ stamp_ori "ori_left")
	          (VECTOR_IMAGE x_o1 (- y_o1 2) x_m2 (- y_o2 2) 7))
	        ((EQ stamp_ori "ori_up")
	          (VECTOR_IMAGE (+ x_o1 2) y_o1 (+ x_m2 2) y_o2 7))
	        ((EQ stamp_ori "ori_down")
	          (VECTOR_IMAGE (- x_o1 2) y_o1 (- x_m2 2) y_o2 7))
	      )
	    )
	  )
	) ;_ end of IF
       )
       (T
	(IF (EQ x_o1 x_o2)
	  (PROGN
	    (VECTOR_IMAGE x_o1 y_m1 x_o2 y_o2 1)
	    (IF (EQ xref_use "1")
	      (COND
	        ((EQ stamp_ori "ori_right")
	          (VECTOR_IMAGE x_o1 (+ y_m1 2) x_o2 (+ y_o2 2) 7))
	        ((EQ stamp_ori "ori_left")
	          (VECTOR_IMAGE x_o1 (- y_m1 2) x_o2 (- y_o2 2) 7))
	        ((EQ stamp_ori "ori_up")
	          (VECTOR_IMAGE (+ x_o1 2) y_m1 (+ x_o2 2) y_o2 7))
	        ((EQ stamp_ori "ori_down")
	          (VECTOR_IMAGE (- x_o1 2) y_m1 (- x_o2 2) y_o2 7))
	      )
	    )
	  )
	  (PROGN
	    (VECTOR_IMAGE x_m1 y_o1 x_o2 y_o2 1)
	    (IF (EQ xref_use "1")
	      (COND
	        ((EQ stamp_ori "ori_right")
	          (VECTOR_IMAGE x_m1 (+ y_o1 2) x_o2 (+ y_o2 2) 7))
	        ((EQ stamp_ori "ori_left")
	          (VECTOR_IMAGE x_m1 (- y_o1 2) x_o2 (- y_o2 2) 7))
	        ((EQ stamp_ori "ori_up")
	          (VECTOR_IMAGE (+ x_m1 2) y_o1 (+ x_o2 2) y_o2 7))
	        ((EQ stamp_ori "ori_down")
	          (VECTOR_IMAGE (- x_m1 2) y_o1 (- x_o2 2) y_o2 7))
	      )
	    )
	  )
	) ;_ end of IF
       )
     ) ;_ end of COND
    )
    (T
     (VECTOR_IMAGE
       (FIX (/ maxx 2))
       (FIX (/ maxy 2))
       (FIX (/ (+ x_m1 x_m2) 2))
       (FIX (/ (+ y_m1 y_m2) 2))
       2
     ) ;_ end of VECTOR_IMAGE
    )
  ) ;_ end of COND
  (VECTOR_IMAGE (- x_o1 2) (- y_o1 2) (+ x_o1 2) (+ y_o1 2) 7)
  (VECTOR_IMAGE (- x_o1 2) (+ y_o1 2) (+ x_o1 2) (- y_o1 2) 7)
  (END_IMAGE)
) ;_ end of defun
;;;********************************************************************
;;;********************************************************************
(DEFUN cstmp_error (msg /)
  (SETQ *error* old_err_def)
  (IF (AND fs_fil (EQ (TYPE fs_file) 'FILE))
    (CLOSE fs_fil)
  ) ;_ end of IF
  (PRINC (STRCAT msg ": Function CSTMP cancelled on error! "))
  (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!***|;