;;;Label lines and polylines with segment distance.
;;;
;;;	AUTHOR: HENRY C. FRANCIS
;;;		425 N. Ashe Street
;;;		Southern Pines, NC 28387
;;;              
;;;		All rights reserved without prejudice.
;;;
;;;	Copyright:	1996-2001
;;;	Edited:		2-20-2001
;;;
(DEFUN c:lbld (/       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_aup (GETVAR "auprec"))
  (SETQ old_lup (GETVAR "luprec"))
  (SETQ old_cecolor (GETVAR "cecolor"))
  (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 do_remlt (ukword 1
                                  "Yes No"
                                  "Place as Note and Leader?"
                                  (IF do_remlt
                                    do_remlt
                                    "No"
                                  ) ;_ end of if
                          ) ;_ end of ukword
           ) ;_ end of SETQ
    ) ;_ end of PROGN
  ) ;_ end of IF
  (IF getstyle
    nil
    (LOAD "getstyle")
  ) ;_ end of if
  (getstyle "A")
  (SETVAR "OSMODE" 0)
  (IF do_cmud
    (SETQ thts "100")
    (SETQ thts (ustr 1
                     "\n\"Leroy Template Size\" or Standard(=87.5) "
                     (IF thts
                       thts
                       "Standard"
                     ) ;_ end of if
                     nil
               ) ;_ end of ustr
    ) ;_ end of setq
  ) ;_ end of IF
  (COND ((OR (EQ (SUBSTR thts 1 1) "S") (EQ (SUBSTR thts 1 1) "s"))
         (IF do_cmud
           (SETQ colr "2")
           (SETQ colr "3")
         ) ;_ end of SETQ
        )
        ((<= (ATOF thts) 80) (SETQ colr "2"))
        ((AND do_cmud (<= (ATOF thts) 100)) (SETQ colr "1"))
        ((<= (ATOF thts) 125) (SETQ colr "3"))
        ((< (ATOF thts) 200) (SETQ colr "4"))
        ((>= (ATOF thts) 200)
         (SETQ colr "5") ;_ end of SETQ
        )
        (thts
         (SETQ colr "3") ;_ end of SETQ
        )
  )            ;cond
  (IF gvpno
    nil
    (LOAD "gvpno")
  ) ;_ end of if
  (gvpno)
  (SETQ mjrg "C"
        llt  "-"
        modf "DIMS"
  ) ;_ end of setq
  (IF do_cmud
    nil
    (c:mklayr)
  ) ;_ end of IF
  (IF (OR (EQ (SUBSTR thts 1 1) "S") (EQ (SUBSTR thts 1 1) "s"))
    (SETQ txtht (* 0.0875 dimsc))
    (SETQ txtht (* (* (ATOI thts) 0.001) dimsc))
  )            ;if
  (SETVAR "TEXTSIZE" txtht)
  (SETQ lblstr (ukword 1
                       "BEaring Distance BOth"
                       "BEaring, Distance or BOth?"
                       (IF lblstr
                         lblstr
                         "BOth"
                       ) ;_ end of if
               ) ;_ end of ukword
  ) ;_ end of setq
  (WHILE (AND (SETQ sel1 (NENTSELP "\nSelect Line:"))
              (OR (EQ "LINE" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))
                  (EQ "VERTEX" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))
              ) ;or
         )     ;and
    (PROGN (SETQ tstpt (LIST (CAR (CADR sel1)) (CADADR sel1) 0.0))
           (SETQ rawp1 (CDR (ASSOC 10 (ENTGET (CAR sel1)))))
           (SETQ endp1 (TRANS (LIST (CAR rawp1) (CADR rawp1) 0.0) 0 1))
           (IF (EQ "LINE" (CDR (ASSOC 0 (ENTGET (CAR sel1)))))
             (SETQ rawp2 (CDR (ASSOC 11 (ENTGET (CAR sel1))))
                   endp2 (TRANS (LIST (CAR rawp2) (CADR rawp2) 0.0) 0 1)
             ) ;_ end of setq
             (SETQ rawp2 (CDR (ASSOC 10 (ENTGET (ENTNEXT (CAR sel1)))))
                   endp2 (TRANS (LIST (CAR rawp2) (CADR rawp2) 0.0) 0 1)
             ) ;_ end of setq
           )   ;if
           (SETQ lang   (ANGLE endp1 endp2)
                 chkang (+ lang (GETVAR "viewtwist"))
                 ldist  (DISTANCE (LIST (CAR endp1) (CADR endp1)) (LIST (CAR endp2) (CADR endp2)))
           ) ;_ end of setq
           (IF (AND (> chkang 1.868) (< chkang 5.01))
             (SETQ tang    (ANGTOS (+ PI lang) 1 4)
                   tentang (+ PI lang)
                   osang   (+ (* PI 1.5) lang)
             ) ;_ end of setq
             (SETQ tang    (ANGTOS lang 1 4)
                   tentang lang
                   osang   (+ (* PI 0.5) lang)
             ) ;_ end of setq
           )   ;if
           (SETQ ptabv  (POLAR (POLAR endp1 lang (DISTANCE endp1 tstpt)) ;polar
                               osang
                               (* 1.1 txtht)
                        ) ;polar
                 ptabv2 (POLAR ptabv osang (* 1.5 txtht))
                 ptblw  (POLAR (POLAR endp1 lang (DISTANCE endp1 tstpt)) ;polar
                               (+ osang PI)
                               (* 1.1 txtht)
                        ) ;polar
                 ptblw2 (POLAR ptblw (+ osang PI) (* 1.5 txtht))
           )   ;setq
           (IF do_cmud
             (PROGN (SETQ survang nil)
                    (IF srvang
                      nil
                      (LOAD "srvang")
                    ) ;_ end of IF
                    (srvang lang)
             ) ;_ end of PROGN
             (PROGN (SETQ srvang nil)
                    (IF survang
                      nil
                      (LOAD "survang")
                    ) ;_ end of IF
                    (survang lang)
             ) ;_ end of PROGN
           ) ;_ end of if
           (IF gvpno
             nil
             (LOAD "gvpno")
           ) ;_ end of if
           (gvpno)
           (SETQ adtentl (IF do_cmud
                           "PS"
                           (STRCAT "C-"
                                   (IF prod
                                     prod
                                     "DINF"
                                   ) ;_ end of if
                                   (IF colr
                                     colr
                                     "3"
                                   ) ;_ end of IF
                                   "DIMS"
                           ) ;_ end of strcat
                         ) ;_ end of IF
           ) ;_ end of SETQ
           (COND ((EQ lblstr "BEaring") (SETQ txstr anglt) txstr1 nil txstr2 nil)
                 ((EQ lblstr "Distance") (SETQ txstr (STRCAT (RTOS ldist 2 2) "'")) txstr1 nil txstr2 nil)
                 ((EQ lblstr "BOth")
                  (SETQ txstr  (STRCAT anglt " " (RTOS ldist 2 2) "'")
                        txstr1 anglt
                        txstr2 (STRCAT (RTOS ldist 2 2) "'")
                  ) ;_ end of setq
                 )
           ) ;_ end of cond
           (IF (<= (DISTANCE ptblw tstpt) (DISTANCE ptabv tstpt))
             (SETQ txtpt  ptblw
                   txtpt2 ptblw2
             ) ;_ end of setq
             (SETQ txtpt  ptabv
                   txtpt2 ptabv2
             ) ;_ end of setq
           )   ;if
           (SETQ adtent (LIST (CONS 0 "TEXT")
                              (CONS 72 1)
                              (CONS 73 2)
                              (CONS 1 txstr)
                              (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 tentang)
                              (CONS 10 (LIST 0 0 0))
                              (CONS 11 txtpt)
                              (CONS 40 txtht)
                        ) ;list
           )   ;setq
           (SETQ tentlen (CAADR (TEXTBOX adtent)))
           (SETQ ldlblss (SSADD))
           (IF (AND (>= tentlen (* 2 (MIN (DISTANCE txtpt endp1) (DISTANCE txtpt endp2)))) txstr1 txstr2)
             (PROGN (SETQ adtent1 (LIST (CONS 0 "TEXT")
                                        (CONS 72 1)
                                        (CONS 73 2)
                                        (CONS 1 txstr1)
                                        (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 tentang)
                                        (CONS 10 (LIST 0 0 0))
                                        (CONS 11 txtpt)
                                        (CONS 40 txtht)
                                  ) ;list
                    ) ;setq
                    (ENTMAKE adtent1)
                    (SSADD (ENTLAST) ldlblss)
                    (SETQ adtent2 (LIST (CONS 0 "TEXT")
                                        (CONS 72 1)
                                        (CONS 73 2)
                                        (CONS 1 txstr2)
                                        (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 tentang)
                                        (CONS 10 (LIST 0 0 0))
                                        (CONS 11 txtpt2)
                                        (CONS 40 txtht)
                                  ) ;list
                    ) ;setq
                    (ENTMAKE adtent2)
                    (SSADD (ENTLAST) ldlblss)
             ) ;_ end of progn
             (PROGN (ENTMAKE adtent) (SSADD (ENTLAST) ldlblss))
           ) ;_ end of if
           (IF (AND (EQ do_remlt "Yes") do_cmud)
             (SETQ from_lbld T)
             (SETQ from_lbld nil)
           ) ;_ end of IF
           (IF (EQ do_remlt "Yes")
             (c:remlt)
           ) ;_ end of IF
           (PRINC "\nSelect Line: ")
    )          ;progn
  )            ;while
  (c:rslayr)
  (SETQ do_remlt nil)
  (SETVAR "auprec" old_aup)
  (SETVAR "luprec" old_lup)
  (SETVAR "cecolor" old_cecolor)
  (getstyle "")
)              ;defun

;|«Visual LISP© Format Options» (120 2 15 2 T "end of " 100 9 2 1 0 nil nil T T)
 ***Don't add text below the comment!***|;