;;;Label lines and polylines with segment distance.
;;;
;;;              
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 2-24-96
;;;>		   EDITED: 09-21-2005
;;;
(DEFUN slope_error (msg /)
  (IF old_osmode
    (SETVAR "osmode" old_osmode)
  )
  (IF old_aup (SETVAR "auprec" old_aup))
  (IF old_lup (SETVAR "luprec" old_lup))
  (SETQ *error* (IF old_slopeerror
                  old_slopeerror
                  NIL
                ) ;_ end of IF
  ) ;_ end of SETQ
  (PRINC "\n")
  (PRINC msg)
;;;  (princ "\n")
;;;  (princ dopt)
  (PRINC)
) ;_ end of DEFUN
;;;********************************************************************
(DEFUN C:SLOPE (/	pt1	bkp1b	bkp1m	bkp1r	bkp1l	bkp1a
		bkp2b	bkp2m	bkp2r	bkp2l	bkp2a	bkp3b	bkp3m
		bkp3r	bkp3l	bkp3a	grrval	tstpt	ldist	ptabv
		ptblw	lang	tang	osang	endp1	endp2	txstr
	       )
  (SETQ old_slopeerror *error*)
  (SETQ *error* slope_error)
  (SETQ old_aup (GETVAR "auprec"))
  (SETQ old_lup (GETVAR "luprec"))
  (SETVAR "auprec" 8)
  (SETVAR "luprec" 8)
  (IF c:mklayr
    nil
    (LOAD "mklayr")
  ) ;_ end of if
  (c:svlayr)
  (IF dimscl
    nil
    (LOAD "dimscl")
  ) ;_ end of if
  (dimscl)
  (IF do_cmud
    (PROGN
      (COMMAND "-layer" "m" "PS" "c" "2" "PS" "")
      (COMMAND "-style" "ROMAND" "romand.shx" 0 1 15 "N" "N" "N")
      (SETQ adtentl "PS")
    ) ;_ end of PROGN
  ) ;_ end of IF
  (IF getstyle
    nil
    (LOAD "getstyle")
  ) ;_ end of if
  (getstyle "A")
  (SETVAR "OSMODE" 0)
  (IF ureal NIL (LOAD "ureal" "\nFile UREAL.LSP not loaded! "))
  (IF uint NIL (LOAD "uint" "\nFile UINT.LSP not loaded! "))
  (IF ustr NIL (LOAD "ustr" "\nFile USTR.LSP not loaded! "))
  (IF ukword NIL (LOAD "ukword" "\nFile UKWORD.LSP not loaded! "))
  (SETQ v_fact (ureal 1 "" "Vertical scale factor?" (if v_fact v_fact 10)))
  (IF do_cmud
    (SETQ thts "100")
    (SETQ thts (ustr 1
		     "\n\"Leroy Template Size\" or Standard(=110) "
		     (IF thts
		       thts
		       "Standard"
		     ) ;_ end of if
		     nil
	       ) ;_ end of ustr
    ) ;_ end of setq
  ) ;_ end of IF
  (SETQ	sl_prec	(uint 1
		      ""
		      "Slope units of precision"
		      (IF sl_prec
			sl_prec
			4
		      ) ;_ end of IF
		) ;_ end of uint
  ) ;_ end of SETQ
  (SETQ	ld_opt (ukword 1
		       "Label Display"
		       "<L>abel w/ display or just <D>isplay?"
		       (IF ld_opt
			 ld_opt
			 "Label"
		       ) ;_ end of if
	       ) ;_ end of ukword
  ) ;_ end of SETQ
  (COND	((OR (EQ (SUBSTR thts 1 1) "S") (EQ (SUBSTR thts 1 1) "s"))
	 (SETQ colr "2") ;_ end of SETQ
	)
	((<= (ATOF thts) 80)
	 (SETQ colr "1")
	)
	((AND do_cmud (<= (ATOF thts) 100))
	 (SETQ colr "1")
	)
	((<= (ATOF thts) 125)
	 (SETQ colr "2")
	)
	((< (ATOF thts) 200)
	 (SETQ colr "3")
	)
	((>= (ATOF thts) 200)
	 (SETQ colr "5") ;_ end of SETQ
	)
	(thts
	 (SETQ colr "2") ;_ end of SETQ
	)
  ) ;_ end of COND
  (IF gvpno
    nil
    (LOAD "gvpno")
  ) ;_ end of if
  (gvpno)
  (SETQ	mjrg "C"
	llt  "-"
	modf "DIMS"
  ) ;_ end of setq
  (IF do_cmud
    nil
    (PROGN
      (c:mklayr)
      (SETQ adtentl (GETVAR "clayer"))
    ) ;_ end of PROGN
  ) ;_ end of IF
  (IF (OR (EQ (SUBSTR thts 1 1) "S") (EQ (SUBSTR thts 1 1) "s"))
    (SETQ txtht (* 0.110 dimsc))
    (SETQ txtht (* (* (ATOI thts) 0.001) dimsc))
  ) ;_ end of IF
  (SETVAR "TEXTSIZE" txtht)
  (WHILE
    (AND
      (SETQ sel_ent (NENTSELP "\nSelect Line:"))
      (OR
        (EQ "LINE" (CDR (ASSOC 0 (ENTGET (CAR sel_ent)))))
        (EQ "VERTEX" (CDR (ASSOC 0 (ENTGET (CAR sel_ent)))))
      )
    ) ;_ end of AND
     (PROGN
       (SETQ entdata (ENTGET (CAR sel_ent)))
       (SETQ pickpt (CAR (REVERSE sel_ent)))
;;;       (SETQ max_x  (MAX (CADR (ASSOC 10 entdata)) (CADR (ASSOC 11 entdata)))
;;;	     max_y  (MAX (CADDR (ASSOC 10 entdata))
;;;			 (CADDR (ASSOC 11 entdata))
;;;		    ) ;_ end of MAX
;;;	     min_x  (MIN (CADR (ASSOC 10 entdata)) (CADR (ASSOC 11 entdata)))
;;;	     min_y  (MIN (CADDR (ASSOC 10 entdata))
;;;			 (CADDR (ASSOC 11 entdata))
;;;		    ) ;_ end of MIN
;;;	     sl_ang (ANGLE (LIST min_x min_y 0) (LIST max_x max_y 0))
;;;       ) ;_ end of SETQ
       (COND ((EQ (CDR (ASSOC 0 entdata)) "VERTEX")
	      (SETQ tstang
		     (ANGLE
		       (LIST (CADR (ASSOC 10 entdata))
			     (/ (CADDR (ASSOC 10 entdata)) 10)
			     0
		       ) ;_ end of list
		       (LIST
			 (CADR (ASSOC
				 10
				 (ENTGET (ENTNEXT (CDR (ASSOC -1 entdata))))
			       ) ;_ end of assoc
			 ) ;_ end of cadr
			 (/ (CADDR
			      (ASSOC
				10
				(ENTGET (ENTNEXT (CDR (ASSOC -1 entdata))))
			      ) ;_ end of assoc
			    ) ;_ end of caddr
			    10
			 ) ;_ end of /
			 0
		       ) ;_ end of list
		     ) ;_ end of angle
	      ) ;_ end of setq
	      (SETQ sl_ang
		     (ANGLE
		       (LIST (CADR (ASSOC 10 entdata))
			     (CADDR (ASSOC 10 entdata))
			     0
		       ) ;_ end of list
		       (LIST
			 (CADR (ASSOC
				 10
				 (ENTGET (ENTNEXT (CDR (ASSOC -1 entdata))))
			       ) ;_ end of assoc
			 ) ;_ end of cadr
			 (CADDR
			      (ASSOC
				10
				(ENTGET (ENTNEXT (CDR (ASSOC -1 entdata))))
			      ) ;_ end of assoc
			    ) ;_ end of caddr
			 0
		       ) ;_ end of list
		     ) ;_ end of angle
	      ) ;_ end of setq
	     )
	     ((EQ (CDR (ASSOC 0 entdata)) "LINE")
	      (SETQ tstang (ANGLE (LIST	(CADR (ASSOC 10 entdata))
					(/ (CADDR (ASSOC 10 entdata)) (IF v_fact v_fact 10))
					0
				  ) ;_ end of list
				  (LIST	(CADR (ASSOC 11 entdata))
					(/ (CADDR (ASSOC 11 entdata)) (IF v_fact v_fact 10))
					0
				  ) ;_ end of list
			   ) ;_ end of angle
	      ) ;_ end of setq
	      (SETQ sl_ang (ANGLE (LIST	(CADR (ASSOC 10 entdata))
					(CADDR (ASSOC 10 entdata))
					0
				  ) ;_ end of list
				  (LIST	(CADR (ASSOC 11 entdata))
					(CADDR (ASSOC 11 entdata))
					0
				  ) ;_ end of list
			   ) ;_ end of angle
	      ) ;_ end of setq
	     )
       ) ;_ end of cond
       (IF tstang
	 (PROGN
	   (SETQ tstslope (/ (SIN tstang) (COS tstang)))
	   (PRINC (STRCAT "Slope=" (RTOS tstslope 2 8)))
	   (SETQ
	     linpt (POLAR
		     (LIST (CADR (ASSOC 10 entdata))
			   (CADDR (ASSOC 10 entdata))
			   0
		     ) ;_ end of list
		     sl_ang
		     (DISTANCE (LIST (CADR (ASSOC 10 entdata))
				     (CADDR (ASSOC 10 entdata))
				     0
			       ) ;_ end of list
			       (LIST (CAR pickpt) (CADR pickpt) 0)
		     ) ;_ end of DISTANCE
		   ) ;_ end of POLAR
	   ) ;_ end of SETQ
	   (SETQ txtpt (POLAR linpt (- sl_ang (/ PI 2)) (* txtht 1.75)))
	 ) ;_ end of progn
	 (PRINC "\nNo Line selected. ")
       ) ;_ end of if
     ) ;_ end of progn
     (IF (EQ ld_opt "Display")
       NIL
       (PROGN
	 (SETQ adtent1
		(LIST (CONS 0 "TEXT")
		      (CONS 72 1)
		      (CONS 73 2)
		      (CONS 1 (STRCAT "S=" (RTOS tstslope 2 sl_prec)))
		      (CONS 7
			    (IF	do_cmud
			      "ROMAND"
			      (GETVAR "textstyle")
			    ) ;_ end of IF
		      ) ;_ end of CONS
		      (CONS 51
			    (IF	do_cmud
			      0.26179939
			      0
			    ) ;_ end of IF
		      ) ;_ end of CONS
		      (CONS 8 adtentl)
		      (CONS 50 sl_ang)
		      (CONS 10 (LIST 0 0 0))
		      (CONS 11 txtpt)
		      (CONS 40 txtht)
		)			;list
	 )				;setq
	 (ENTMAKE adtent1)
       ) ;_ end of progn
     ) ;_ end of IF
  ) ;_ end of WHILE
  (c:rslayr)
  (SETVAR "auprec" old_aup)
  (SETVAR "luprec" old_lup)
  (getstyle "")
) ;_ 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!***|;