;;;Automatically stamp drawing with file/user/time/scale information.
;;;	as a string in an attribute called FILSPEC in a block
;;;	named DWGSTAMP.  This block must exist in the drawing or the
;;;        drawing must exist in a directory included in the ACAD= environment
;;;        variable and it must contain an attribute with the tag FILSPEC.
;;;        The attribute is positioned and rotated to fit just inside the
;;;        "binding edge" of any standard sheet size.  Currently all sheet
;;;        sizes except 8.5" x 11" will be stamped	along the short side of
;;;        the sheet in all cases.  The 8.5" x 11"	sheet will be stamped
;;;        along the long side of the sheet.  The "sheet" is defined by
;;;        setting AutoCAD's "limits".
;;;		
;;;	AUTHOR: HENRY C. FRANCIS
;;;		425 N. ASHE ST.
;;;		SOUTHERN PINES, NC 28387
;;;		All rights reserved without prejudice.
;;;
;;;	LBL.LSP	Copyright:  1991-1995
;;;                   Edited:  11-28-95
;;;                The items are, in order,
;;;       Filespec:          (path\filename)          (dwgprefix + dwgname + .DWG)
;;;       Edited By:         user login name          (environment var.)
;;;       Date:              mm/dd/yy                 (from cdate)
;;;       Time:              hh:mm	                  (from cdate)
;;;       Scale:             nn"=1'-0" or 1"=nn'      (from dimscale and lunits)
;;;       Xref names:        name1, name2, etc.       (from table search)
;;;
(defun C:LBL (/	      rang    linp    locn    found   attdia  flatland
	      frst_rdline     dsdir   slen    dscl    datm    dwgp
	      dwgn    dstp    adjm    tscf    maxx    maxy    minx
	      miny    xrlst   tblk    tbln    xrnm    pt      xrent
	      xrstr   done_fs image_ss
	     )
  (setq cmde (getvar "cmdecho"))
  (if dimscl nil
    (load "dimscl" "\nFile DIMSCL.LSP not found! ")
  )
  (dimscl)
  (setq atrreq (getvar "attreq"))
  (setvar "ATTREQ" 0)
  (prompt "\n  Searching for filespec/date stamp.")
  (setvar "cmdecho" 0)
  (if (getvar "flatland")
    (progn
      (setq flatland (getvar "flatland"))
      (setvar "flatland" 0)
    ) ;_ end of progn
    nil
  ) ;_ end of if
  (if (setq found (ssget "x" '((2 . "dwgstamp"))))
    (command ".erase" (eval found) "")
  ) ;_ end of if
  (if (setq found (ssget "x" '((2 . "pltstamp"))))
    (command ".erase" (eval found) "")
  ) ;_ end of if
;;;  (if mach
;;;    nil
;;;    (if	(setq mach (getenv "LGN"))
;;;      nil
;;;      (setq mach (getstring T "\n  Enter Username: "))
;;;    ) ;_ end of if
;;;  ) ;_ end of if
  (setq	maxx (car (getvar "limmax"))
	minx (car (getvar "limmin"))
	maxy (cadr (getvar "limmax"))
	miny (cadr (getvar "limmin"))
  ) ;_ end of setq
;;;setq
;;;
;;;The variable "locn" determines which edge of the sheet that the stamp will be placed
;;;on.  The variable "rang" determines the angle of the attribute text.
;;;
  (cond	((< (abs (- (/ (- maxx minx) (- maxy miny)) 1.5455)) 0.01)
					; B size landscape
	 (if (or(eq (- maxx minx) 34)(eq (- maxx minx) 36))
	   (setq locn "LEFT"
		 rang 0
		 pprsiz	"D"
	   ) ;_ end of setq
	   (setq locn "LEFT"
		 rang 0
		 pprsiz	"B"
	   ) ;_ end of setq
	 ) ;_ end of if
	)
	((< (abs (- (/ (- maxx minx) (- maxy miny)) 1.5)) 0.01)
					; 24x36 size landscape
	 (setq locn "LEFT"
	       rang 0
	       pprsiz "D"
	 ) ;_ end of setq
	)
	((< (abs (- (/ (- maxx minx) (- maxy miny)) 1.4)) 0.01)
					; E size landscape
	 (setq locn "LEFT"
	       rang 0
	       pprsiz "E"
	 ) ;_ end of setq
	)
	((< (abs (- (/ (- maxx minx) (- maxy miny)) 1.2941)) 0.01)
					; A or C size landscape
	 (if (< (abs (- (/ (- maxx minx) dimsc) 11.0)) 0.01)
	   (setq locn ""
		 rang 270
		 pprsiz	"A"
	   ) ;_ end of setq
	   (setq locn "LEFT"
		 rang 0
		 pprsiz	"C"
	   ) ;_ end of setq
	 ) ;_ end of if
	)
	((< (abs (- (/ (- maxx minx) (- maxy miny)) 0.7727)) 0.01)
					; A or C size portrait
	 (if (< (abs (- (/ (- maxx minx) dimsc) 8.5)) 0.01)
	   (setq locn "LEFT"
		 rang 0
		 pprsiz	"A"
	   ) ;_ end of setq
	   (setq locn "BOTM"
		 rang 90
		 pprsiz	"C"
	   ) ;_ end of setq
	 ) ;_ end of if
	)
	((>= (/ (- maxx minx) (- maxy miny)) 1.0)
	 (setq locn   "LEFT"
	       rang   0
	       pprsiz "UNK"
	 ) ;_ end of setq
	)
	((< (/ (- maxx minx) (- maxy miny)) 1.0)
	 (setq locn   ""
	       rang   270
	       pprsiz "UNK"
	 ) ;_ end of setq
	)
  ) ;_ end of cond
  (if found
    (prompt "\n  Updating filespec/date stamp.")
    (prompt "\n  Inserting filespec/date stamp.")
  ) ;_ end of if
  (setq dsdir "DWGSTAMP")
  (setq attdia (getvar "attdia"))
  (setvar "attdia" 0)

;;;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 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
      )
      (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))))))))))
	   (setq xrlst (list (cdr(assoc 1(entget(cdr(assoc 340(entget(ssname image_ss im_cnt)))))))))
	 ) ;_ end of if
	 (setq im_cnt (1+ im_cnt))
      )
    )
  )
  (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
    (progn
      (setq xrlst (acad_strlsort xrlst))
      (foreach n xrlst
	(if xrstr
	  (setq xrstr (strcat xrstr ", " n))
	  (setq xrstr (strcat "XREF's: " n))
	) ;_ end of if
      ) ;_ end of foreach
      (setq xrlst nil)
    ) ;_ end of progn
    (setq xrstr "") ;_ end of setq
  ) ;_ end of if
  (if c:mklayr
    nil
    (load "mklayr")
  ) ;_ end of if
  (c:svlayr)
  (if dos_help
    nil
    (arxload "doslib14")
  ) ;_ end of if
  (if (and dos_username (dos_username))
    (setq mach (dos_username))
    (setq mach "Unknown")
  )
  (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) "W:")
      ) ;_ 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 command
      (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 "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
	     (SETQ done_fs nil)
	   ) ;_ end of if
	) ;_ end of while
        (setq fs_str (strcat "  " (getenv "computername") " LOCAL DRIVE"))
      ) ;_ end of if
      (IF fs_str NIL (setq fs_str (strcat "  " (getenv "computername") " LOCAL DRIVE")))
    ) ;_ end of progn
  ) ;_ end of if
;;;
;;;The portions in double quotes and on a line by themselves below are hard coded strings.
;;;All else are variables.
;;;
  (setq	dstp (strcase
	       (strcat (substr fs_str 3)
		       " "
		       dwgp
		       (substr dwgn slen)
		       (if (eq (substr (getvar "acadver") 1 2) "14")
			 ""
			 ".DWG"
		       ) ;_ end of if
		       " EDITED BY: "
		       mach
		       " "
		       (substr datm 5 2)
		       "/"
		       (substr datm 7 2)
		       "/"
		       (substr datm 3 2)
		       " "
		       (substr datm 10 2)
		       ":"
		       (substr datm 12 2)
		       " "
		       dscl
	       ) ;_ end of strcat
	     ) ;_ end of strcase
;;;
;;;The following variables are for my modified implementation of the CAD Layering
;;;Guidelines (CLG) published by the AIA.  It is modified to permit differentiating
;;;layers by both color and linetype.
;;;
	mjrg "G"			;major group
	llt  "-"			;linetype code (- = continuous)
	prod "SHBD"			;minor group
	colr "7"			;color code (alphanumeric single char.)
	modf "IDEN"			;modifier group
  ) ;_ end of setq
;;;
;;;my auto layer making utility (c:mklayr)
;;;
  (if (eq (getvar "dwgprefix") "H:\\CD9601\\")
    nil
    (progn
      (c:mklayr)
      (command ".insert"
	       dsdir
	       (append (getvar "limmin") (list (* dimsc 1002)))
	       ""
	       ""
	       rang
      ) ;_ end of command
      (command ".insert"
	       dsdir
	       (append (getvar "limmin") (list (* dimsc 1002)))
	       ""
	       ""
	       rang
      ) ;_ end of command
      (setvar "attdia" attdia)
      (setvar "cmdecho" 1)
      (setq ent (ssget "X" '((2 . "dwgstamp"))))
      (setq tscf (* dimsc 0.065))
;;;
;;;The following calculated number adjm determines the horiz. location relative
;;;to the limits (limits define the edge of the sheet).
;;;
      (setq adjm (* tscf -0.75))	;WAS (- 0.0 ....2.5)
      (setq bent (entnext (ssname ent 0)))
      (entmod
	(subst (cons 1 dstp) (assoc 1 (entget bent)) (entget bent))
      ) ;_ end of entmod
      (if (or (= pprsiz "A") (= pprsiz "B")) (setq tscf (/ tscf 2)))
      (entmod (subst (cons 40 tscf)
		     (assoc 40 (entget bent))
		     (entget bent)
	      ) ;_ end of subst
      ) ;_ end of entmod
      (if (eq locn "LEFT")
	(if (and (/= pprsiz "A") (/= pprsiz "B"))
	  (entmod
	    (subst
	      (cons
		10
		(list (+ (car (getvar "limmin")) adjm tscf (* dimsc 0.9))
		      (+ (cadr (getvar "limmin")) (* dimsc 1.25))
		      (* dimsc 1002)
		) ;_ end of list
	      ) ;_ end of cons
	      (assoc 10 (entget bent))
	      (entget bent)
	    ) ;_ end of subst
	  ) ;_ end of entmod
	  (entmod
	    (subst
	      (cons
		10
		(list (+ (car (getvar "limmin"))
			 (* adjm 12)
			 (* tscf 6.5)
			 (* dimsc 0.9)
		      ) ;_ end of +
		      (+ (cadr (getvar "limmin")) (* dimsc 1.25))
		      (* dimsc 1002)
		) ;_ end of list
	      ) ;_ end of cons
	      (assoc 10 (entget bent))
	      (entget bent)
	    ) ;_ end of subst
	  ) ;_ end of entmod
	) ;_ end of if
	(if (eq locn "")
	  (if (and (/= pprsiz "A") (/= pprsiz "B"))
	    (entmod
	      (subst (cons 10
			   (list (- (car (getvar "limmin")) adjm)
				 (+ (cadr (getvar
					    "limmax"
					  ) ;_ end of getvar
				    ) ;_ end of cadr
				    (* 0.5 (+ adjm tscf))
				 ) ;_ end of +
				 (* dimsc 1002)
			   ) ;_ end of list
		     ) ;_ end of cons
		     (assoc 10 (entget bent))
		     (entget bent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	    (entmod
	      (subst
		(cons
		  10
		  (list	(- (car (getvar "limmin")) (- adjm (* 11 tscf)))
			(+ (cadr (getvar
				   "limmax"
				 ) ;_ end of getvar
			   ) ;_ end of cadr
			   (+ (* adjm 7.5) tscf)
			) ;_ end of +
			(* dimsc 1002)
		  ) ;_ end of list
		) ;_ end of cons
		(assoc 10 (entget bent))
		(entget bent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	  ) ;_ end of if
	  (if (and (/= pprsiz "A") (/= pprsiz "B"))
	    (entmod
	      (subst (cons 10
			   (list (car (getvar "limmax"))
				 (+ (cadr (getvar
					    "limmin"
					  ) ;_ end of getvar
				    ) ;_ end of cadr
				    adjm
				    tscf
				    (* dimsc 0.9)
				 ) ;_ end of +
				 (* dimsc 1002)
			   ) ;_ end of list
		     ) ;_ end of cons
		     (assoc 10 (entget bent))
		     (entget bent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	    (entmod
	      (subst (cons 10
			   (list (car (getvar "limmax"))
				 (+ (cadr (getvar
					    "limmin"
					  ) ;_ end of getvar
				    ) ;_ end of cadr
				    (* adjm 12)
				    tscf
				    (* dimsc 0.9)
				 ) ;_ end of +
				 (* dimsc 1002)
			   ) ;_ end of list
		     ) ;_ end of cons
		     (assoc 10 (entget bent))
		     (entget bent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	  ) ;_ end of if
	) ;_ end of if
      ) ;_ end of if
      (entupd bent)
      (setq adjm (* tscf 1.25))		;WAS 6.75
      (setq xrent (entnext (ssname ent 1)))
      (entmod (subst (cons 1 (strcase xrstr))
		     (assoc 1 (entget xrent))
		     (entget xrent)
	      ) ;_ end of subst
      ) ;_ end of entmod
      (entmod (subst (cons 40 tscf)
		     (assoc 40 (entget xrent))
		     (entget xrent)
	      ) ;_ end of subst
      ) ;_ end of entmod
      (if (eq locn "LEFT")
	(if (and (/= pprsiz "A") (/= pprsiz "B"))
	  (entmod
	    (subst
	      (cons
		10
		(list (+ (car (getvar "limmin")) adjm tscf (* dimsc 0.9))
		      (+ (cadr (getvar "limmin")) (* dimsc 1.25))
		      (* dimsc 1002)
		) ;_ end of list
	      ) ;_ end of cons
	      (assoc 10 (entget xrent))
	      (entget xrent)
	    ) ;_ end of subst
	  ) ;_ end of entmod
	  (entmod
	    (subst
	      (cons
		10
		(list (+ (car (getvar "limmin"))
			 (- 0 (* adjm 5.5))
			 (* tscf -2.5)
			 (* dimsc 0.9)
		      ) ;_ end of +
		      (+ (cadr (getvar "limmin")) (* dimsc 1.25))
		      (* dimsc 1002)
		) ;_ end of list
	      ) ;_ end of cons
	      (assoc 10 (entget xrent))
	      (entget xrent)
	    ) ;_ end of subst
	  ) ;_ end of entmod
	) ;_ end of if
	(if (eq locn "")
	  (if (and (/= pprsiz "A") (/= pprsiz "B"))
	    (entmod
	      (subst
		(cons
		  10
		  (list	(- (car (getvar "limmin")) (- adjm (* 2 tscf)))
			(+ (cadr (getvar
				   "limmax"
				 ) ;_ end of getvar
			   ) ;_ end of cadr
			   (+ adjm tscf)
			) ;_ end of +
			(* dimsc 1002)
		  ) ;_ end of list
		) ;_ end of cons
		(assoc 10 (entget xrent))
		(entget xrent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	    (entmod
	      (subst
		(cons
		  10
		  (list	(- (car (getvar "limmin")) (- adjm (* 13 tscf)))
			(+ (cadr (getvar
				   "limmax"
				 ) ;_ end of getvar
			   ) ;_ end of cadr
			   (+ (* adjm -6) tscf)
			) ;_ end of +
			(* dimsc 1002)
		  ) ;_ end of list
		) ;_ end of cons
		(assoc 10 (entget xrent))
		(entget xrent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	  ) ;_ end of if
	  (if (and (/= pprsiz "A") (/= pprsiz "B"))
	    (entmod
	      (subst (cons 10
			   (list (car (getvar "limmax"))
				 (+ (cadr (getvar
					    "limmin"
					  ) ;_ end of getvar
				    ) ;_ end of cadr
				    adjm
				    tscf
				    (* dimsc 0.9)
				 ) ;_ end of +
				 (* dimsc 1002)
			   ) ;_ end of list
		     ) ;_ end of cons
		     (assoc 10 (entget xrent))
		     (entget xrent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	    (entmod
	      (subst (cons 10
			   (list (car (getvar "limmax"))
				 (+ (cadr (getvar
					    "limmin"
					  ) ;_ end of getvar
				    ) ;_ end of cadr
				    (* adjm 12)
				    tscf
				    (* dimsc 0.9)
				 ) ;_ end of +
				 (* dimsc 1002)
			   ) ;_ end of list
		     ) ;_ end of cons
		     (assoc 10 (entget xrent))
		     (entget xrent)
	      ) ;_ end of subst
	    ) ;_ end of entmod
	  ) ;_ end of if
	) ;_ end of if
      ) ;_ end of if
      (entupd xrent)
      (if flatland
	(setvar "flatland" flatland)
	nil
      ) ;_ end of if
      (prompt "\n  Filespec/date stamped on binding edge.\n")
      (c:rslayr)
      (setvar "cmdecho" cmde)
      (setvar "ATTREQ" atrreq)
;;;
;;;If the LBL is called from my Lisp generated batch plotting utility its
;;;execution is from the associated script file.  The resume command is to
;;;overcome the break in script execution caused by this function.
;;;
      (if ftscl
	(command "resume")
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
;;;
;;;The function (f_name) updates the value of the FILENAME attribute in the title Block
;;;named "CDMTTBAT"
;;;
  (f_name)
;;;
;;;The function (f_date) updates the value of the DATE attribute in the title Block
;;;named "CDMTTBAT"
;;;
  (f_date)
  (if entss
    (entupd fnatn)
  ) ;_ end of if
  (dos_delete "c:/fserv.dat")
  (princ)
) ;_ end of defun
(defun f_name ()
  (setq	entss (ssget "x"
		     '((-4 . "<AND")
		       (0 . "INSERT")
		       (2 . "CDMTTBAT")
		       (-4 . "AND>")
		      )
	      ) ;_ end of ssget
  ) ;_ end of setq
  (if entss
    (progn
      (setq fnatn (ssname entss 0))
      (setq fnate (entget fnatn))
      (while
	(and
	  (/= (cdr (assoc 2 fnate)) "FILENAME")
	  (/= (cdr (assoc 2 fnate)) "SEQEND")
	) ;_ end of and
	 (setq fnate (entget (entnext (cdar fnate))))
      ) ;_ end of while
      (setq fnate
	     (subst (cons 1 (substr dwgn slen)) (assoc 1 fnate) fnate)
      ) ;_ end of setq
      (entmod fnate)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(defun f_date ()
  (setq	entss (ssget "x"
		     '((-4 . "<AND")
		       (0 . "INSERT")
		       (2 . "CDMTTBAT")
		       (-4 . "AND>")
		      )
	      ) ;_ end of ssget
  ) ;_ end of setq
;;;
;;;  The following are locations that I want to exclude from application of the (f_date) function
;;;  
  (if (or
	(wcmatch (getvar "dwgprefix") "?:\\2455\\2172#\\0CAD\\")
	(wcmatch (getvar "dwgprefix") "?:\\2068\\11388\\0CAD\\")
	(wcmatch (getvar "dwgprefix") "?:\\2887\\22424\\0CAD\\")
	(wcmatch (getvar "dwgprefix") "?:\\10674\\25038\\0CAD\\")
	(wcmatch (getvar "dwgprefix") "?:\\8385\\25468\\0CAD\\")
	skip_date_up
      ) ;_ end of or
    (setq statdate " ")
    (setq statdate nil)
  ) ;_ end of if
  (if entss
    (progn
      (setq fdatn (ssname entss 0))
      (setq fdate (entget fdatn))
;;;      (setq month_lst '("" "JANUARY" "FEBRUARY" "MARCH" "APRIL" "MAY" "JUNE" "JULY" "AUGUST" "SEPTEMBER" "OCTOBER" "NOVEMBER" "DECEMBER"))
      (setq month_lst '("" "1/" "2/" "3/" "4/" "5/" "6/" "7/" "8/" "9/" "10/" "11/" "12/"))
      (setq curdate  (itoa (fix (getvar "cdate")))
	    curyear  (substr curdate 3 2)			;was (substr curdate 3 2)
	    curmonth (nth (atoi (substr curdate 5 2)) month_lst);was (itoa (atoi (substr curdate 5 2)))
	    curday   (itoa (atoi (substr curdate 7 2)))
      ) ;_ end of setq
      (while
	(and
	  (/= (cdr (assoc 2 fdate)) "DATE")
	  (/= (cdr (assoc 2 fdate)) "SEQEND")
	) ;_ end of and
	 (setq fdate (entget (entnext (cdar fdate))))
      ) ;_ end of while
      (if statdate
	(setq fdate (subst
		      (cons 1 statdate)
		      (assoc 1 fdate)
		      fdate
		    ) ;_ end of subst
	) ;_ end of setq
	(setq
	  fdate	(subst
		  (cons 1 "")
;		  (cons 1 (strcat curmonth curyear));was (cons 1 (strcat curmonth "-" curday "-" curyear))
		  (assoc 1 fdate)
		  fdate
		) ;_ end of subst
	) ;_ end of setq
      ) ;_ end of if
      (entmod fdate)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(defun setsclfac ()
  (if (equal (rem sclcalc (if (>= sclfac 1)(fix sclcalc)sclcalc)) 0 0.0001)
    (setq sclfac 0)
    (setq sclfac 4)
  ) ;_ end of if
) ;_ 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!***|;