;;;Place formatted northing and easting coordinates with a leader
;;;at the selected point.  The coordinates are first placed on
;;;the selected point and then selected to be moved to the desired location.
;;;Only two entry points are required, the point to label and the "move to"
;;;location for the label.  The coordinates may be placed to the right or left
;;;of the point and a leader will be placed to correspond.
;;;
;;;To place coordinate labels horizontal to the WCS while using values from
;;;a UCS just save your UCS to a name and make it active.
;;;
;;;Limitations:
;;;	OSNAP should be set to NONE, single overides may be used.
;;;	Decimal places are set by UNITS
;;;	Text size is set by current value of sys variable TEXTSIZE.
;;;	Style must have "0" as the text height
;;;		
;;;	AUTHOR:    Henry C. Francis
;;;	COPYRIGHT: 3-11-1992
;;;	EDITED:	   3-2-1999
;;;
(DEFUN C:CLAB (/)			;ipt nor sou tpt txs int0 int1 int2 int3 ss tlen)
  (SETVAR "cecolor" "bylayer")
  (SETVAR "cmdecho" 0)
  (SETQ txht (GETVAR "textsize"))
;;;  (SETQ old_osmode (GETVAR "OSMODE"))
;;;  (SETVAR "OSMODE" 32)
  (IF dimscl
    nil
    (LOAD "dimscl")
  ) ;_ end of if
  (dimscl)
  (IF getstyle
    (getstyle "A")
    (PROGN (LOAD "getstyle") (getstyle "A"))
  ) ;_ end of if
  (SETQ adja (- 0 (GETVAR "viewtwist")))
  (SETQ	corprec	(uint 1
		      ""
		      "Number of decimal places?"
		      (IF corprec
			corprec
			2
		      ) ;_ end of if
		) ;_ end of uint
	cor_stat (ukword 1 "Design Existing" "Design or Existing coordinate labels?" (if cor_stat cor_stat "Existing"))
	cor_txt_layr (if (eq cor_stat "Existing") "CECOOR7NOTE" "C-COOR3NOTE")
	cor_lin_layr (if (eq cor_stat "Existing") "CECOOR7NOTE" "C-COOR2NOTE")
	cor_obliq (if (eq cor_stat "Existing") 0.26179939 0)
  ) ;_ end of setq
  (WHILE
    (SETQ ipt (upoint 0 "" "\nPick point to label.  " nil nil))
     (PROGN
       (SETQ nor  (STRCAT "N " (RTOS (CADR ipt) 2 corprec))
	     sou  (STRCAT "E " (RTOS (CAR ipt) 2 corprec))
	     txs  (* dimsc 0.0875)
	     int0 (POLAR ipt (+ adja (/ PI 2)) (* txs 0.5))
	     int3 (POLAR ipt (+ adja (* PI 1.5)) (* txs 1.5))
       ) ;_ end of setq
       (ENTMAKE	(LIST (CONS 0 "TEXT")
		      (CONS 7 "STANDARD")
		      (CONS 8 cor_txt_layr)
		      (CONS 10 (TRANS int0 1 0))
		      (CONS 11 (TRANS (LIST 0 0 0) 1 0))
		      (CONS 40 txs)
		      (CONS 50 adja)
		      (CONS 51 cor_obliq)
		      (CONS 62 256)
		      (CONS 1 nor)
		) ;_ end of list
       ) ;_ end of entmake
       (SETQ ent1 (ENTLAST)
	     ss	  (SSADD)
       ) ;_ end of setq
       (SSADD ent1 ss)
       (SETQ tlen (DISTANCE (CAR (TEXTBOX (ENTGET ent1)))
			    (CADR (TEXTBOX (ENTGET ent1)))
		  ) ;_ end of distance
       ) ;_ end of setq
       (ENTMAKE	(LIST (CONS 0 "TEXT")
		      (CONS 7 "STANDARD")
		      (CONS 8 cor_txt_layr)
		      (CONS 10 (TRANS int3 1 0))
		      (CONS 11 (TRANS (LIST 0 0 0) 1 0))
		      (CONS 40 txs)
		      (CONS 50 adja)
		      (CONS 51 cor_obliq)
		      (CONS 62 256)
		      (CONS 1 sou)
		) ;_ end of list
       ) ;_ end of entmake
       (SETQ ent2 (ENTLAST))
       (SSADD ent2 ss)
       (SETQ tlen (MAX tlen
		       (DISTANCE (CAR (TEXTBOX (ENTGET ent2)))
				 (CADR (TEXTBOX (ENTGET ent2)))
		       ) ;_ end of distance
		  ) ;_ end of max
       ) ;_ end of setq
;;;       (SETVAR "OSMODE" 0)
       (COMMAND ".move" ss "" ipt pause)
;;;       (SETVAR "OSMODE" old_osmode)
       (SETQ lstpt (POLAR (GETVAR "lastpoint") (+ adja PI) txs))
       (SETQ rtpt (POLAR lstpt adja (+ tlen (* 2 txs))))
       (IF (< (DISTANCE ipt lstpt) (DISTANCE ipt rtpt))
	 (PROGN
	   (ENTMAKE (LIST (CONS 0 "LINE")
			  (CONS 8 cor_lin_layr)
			  (CONS 10 (TRANS ipt 1 0))
			  (CONS 11 (TRANS lstpt 1 0))
			  (CONS 62 256)
		    ) ;_ end of list
	   ) ;_ end of entmake
	   (ENTMAKE (LIST (CONS 0 "LINE")
			  (CONS 8 cor_lin_layr)
			  (CONS 10 (TRANS lstpt 1 0))
			  (CONS 11 (TRANS rtpt 1 0))
			  (CONS 62 256)
		    ) ;_ end of list
	   ) ;_ end of entmake
	 ) ;_ end of PROGN
	 (PROGN
	   (ENTMAKE (LIST (CONS 0 "LINE")
			  (CONS 8 cor_lin_layr)
			  (CONS 10 (TRANS ipt 1 0))
			  (CONS 11 (TRANS rtpt 1 0))
			  (CONS 62 256)
		    ) ;_ end of list
	   ) ;_ end of entmake
	   (ENTMAKE (LIST (CONS 0 "LINE")
			  (CONS 8 cor_lin_layr)
			  (CONS 10 (TRANS rtpt 1 0))
			  (CONS 11 (TRANS lstpt 1 0))
			  (CONS 62 256)
		    ) ;_ end of list
	   ) ;_ end of entmake
	 ) ;_ end of PROGN
    ) ;_ end of if
     ) ;_ end of progn
  ) ;_ end of while
  (IF(OR(tblsearch "LAYER" "CECOOR7NOTE")(tblsearch "LAYER" "C-COOR7NOTE"))
    (command ".layer" "c" "7" "CECOOR7*" "")
  )
  (IF(tblsearch "LAYER" "C-COOR3NOTE")
    (command ".layer" "c" "3" "C-COOR3*" "")
  )
  (IF(tblsearch "LAYER" "C-COOR2NOTE")
    (command ".layer" "c" "2" "C-COOR2*" "")
  )
  (getstyle "")
;;;  (SETVAR "OSMODE" old_osmode)
  (SETVAR "cmdecho" 1)
  (SETVAR "clayer" clayr)
  (princ)
) ;_ end of defun

;|«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!***|;