;;;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
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 3-11-1992
;;;>		   EDITED: 12-14-2005
;;;
(DEFUN C:CLAB (/)			;ipt nor sou tpt txs int0 int1 int2 int3 ss tlen)
  (SETVAR "cecolor" "bylayer")
  (SETVAR "cmdecho" 0)
  (IF txtsize NIL (LOAD "txtsize" "\nFile TXTSIZE.LSP not loaded! "))
  (txtsize nil)
;;;  (SETQ txtht (GETVAR "textsize"))
;;;  (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")))
  (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded! "))
  (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-COOR6NOTE")
	cor_lin_layr (if (eq cor_stat "Existing") "CECOOR7NOTE" "C-COOR7NOTE")
	cor_obliq (if (eq cor_stat "Existing") 0.26179939 0)
  ) ;_ end of setq
  (SETQ old_osmode (GETVAR "OSMODE"))
  (IF upoint NIL (LOAD "upoint" "\nFile UPOINT.LSP not loaded! "))
  (WHILE
    (SETQ ipt (upoint 0 "" "\nPick point to label.  " nil nil))
     (PROGN
       (SETVAR "osmode" 0)
       (SETQ nor  (RTOS (CADR ipt) 2 corprec)
	     sou  (RTOS (CAR ipt) 2 corprec)
       )
       (COND
	 ((AND (> corprec 0)(NOT(WCMATCH nor "*#.########*")))
	  (COND
	    ((NOT (WCMATCH nor "*.*"))
	     (SETQ prec_cnt corprec)
             (SETQ nor (STRCAT nor "."))
	     (WHILE (> prec_cnt 0)
	       (SETQ nor (STRCAT nor "0"))
	       (SETQ prec_cnt (1- prec_cnt))
	     ))
	    ((NOT(WCMATCH nor "*#.########*"))
	     (SETQ posn_cnt 1)
	     (SETQ nor_len (STRLEN nor))
	     (WHILE (NOT (WCMATCH (SUBSTR nor posn_cnt) ".*"))
	       (SETQ posn_cnt (1+ posn_cnt))
	     )
	     (SETQ prec_cnt (- corprec(- nor_len posn_cnt)))
	     (WHILE (> prec_cnt 0)
	       (SETQ nor (STRCAT nor "0"))
	       (SETQ prec_cnt (1- prec_cnt))
	     ))
	  ))
       )
       (COND
	 ((AND (> corprec 0)(NOT(WCMATCH sou "*#.########*")))
	  (COND
	    ((NOT (WCMATCH sou "*.*"))
	     (SETQ prec_cnt corprec)
             (SETQ sou (STRCAT sou "."))
	     (WHILE (> prec_cnt 0)
	       (SETQ sou (STRCAT sou "0"))
	       (SETQ prec_cnt (1- prec_cnt))
	     ))
	    ((NOT(WCMATCH sou "*#.########*"))
	     (SETQ posn_cnt 1)
	     (SETQ sou_len (STRLEN sou))
	     (WHILE (NOT (WCMATCH (SUBSTR sou posn_cnt) ".*"))
	       (SETQ posn_cnt (1+ posn_cnt))
	     )
	     (SETQ prec_cnt (- corprec(- sou_len posn_cnt)))
	     (WHILE (> prec_cnt 0)
	       (SETQ sou (STRCAT sou "0"))
	       (SETQ prec_cnt (1- prec_cnt))
	     ))
	  ))
       )
       (SETQ nor  (STRCAT "N " nor)
	     sou  (STRCAT "E " sou)
;;;	     txs  (* dimsc 0.125)
	     int0 (POLAR ipt (+ adja (/ PI 2)) dis3)
	     int3 (POLAR ipt (+ adja (* PI 1.5)) dis2)
       ) ;_ 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 txtht)
		      (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 txtht)
		      (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) txtht))
       (SETQ rtpt (POLAR lstpt adja (+ tlen (* 2 txtht))))
       (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
    (SETVAR "OSMODE" old_osmode)
  ) ;_ end of while
  (IF(OR(tblsearch "LAYER" "CECOOR1NOTE")(tblsearch "LAYER" "C-COOR1NOTE"))
    (command ".layer" "c" "1" "C?COOR1*" "")
  )
  (IF(tblsearch "LAYER" "C-COOR3NOTE")
    (command ".layer" "c" "3" "C-COOR3*" "")
  )
  (IF(tblsearch "LAYER" "C-COOR6NOTE")
    (command ".layer" "c" "6" "C-COOR6*" "")
  )
  (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!***|;