;PTEXT.lsp      Places text along any specified path(polyline)  Viji Varghese Kerala India March '99

(defun
     *ERROR* (MSG)
  (if (= *PWORD "*INPTEXT")
    (progn
      (setvar "clayer" *CLAYER)
      (setvar "Aunits" *AUNITS)
      (setvar "Angdir" *ANGDIR)
      (setvar "Angbase" *ANGBASE)
      (setvar "cmdecho" *CMDECHO)
      (setvar "pdmode" *PDMOD)
      (setvar "blipmode" *BLIPMODE)
      (setvar "textstyle" *CSTYLE)
      (setq *PWORD NIL)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

(defun
     C:PTEXT (/ TEXP PAT H STY STYL FPOT1 ELI1 IFTN POI FPT FHT WF LR B
              SST FPO FPOT VA SSET VB PTA PTB VT LAPOT CUE SOPT TX VTA
              NAE SB SSET NIC ELIS LAPT POI1 NAE1 SPT NMP KI MEMB MVAL
              NEWC TN1 NOS ROA ROTANG ELI PLIN ENA LENG CYC LIS
             )
  (setq *PWORD "*INPTEXT")
  (setq *ANGDIR (getvar "Angdir"))
  (setq *ANGBASE (getvar "Angbase"))
  (setq *AUNITS (getvar "Aunits"))
  (setq *CMDECHO (getvar "cmdecho"))
  (setq *BLIPMODE (getvar "blipmode"))
  (setq *CLAYER (getvar "Clayer"))
  (setq *CSTYLE (getvar "textstyle"))
  (setq *PDMOD (getvar "pdmode"))
  (setvar "Angdir" 0)
  (setvar "Aunits" 0)
  (setvar "Angbase" 0)
  (initget "Start Fit")
  (setq TEXP (getkword "\nOption? Start/<Fit>: "))
  (if (= TEXP NIL)
    (setq TEXP "Fit")
  ) ;_ end of if
  (while (= PLIN NIL)
    (setq PLIN (entsel "\nSelect the path (polyline):"))
  ) ;_ end of while
  (setq ENA (car PLIN))
  (setq ELIS (entget ENA))
  (setq ELI (cdr (assoc 0 ELIS)))
  (setq ELI1 (cdr (assoc 70 ELIS)))
  (if (= ELI "LWPOLYLINE")
    (progn
      (setq LENG (length ELIS))
      (setq CYC 0)
      (setq LIS (list '(1)))
      (repeat LENG
        (setq MEMB (nth CYC ELIS))
        (setq IFTN (car MEMB))
        (if (= IFTN 10)
          (progn
            (setq MEMB (list MEMB))
            (setq LIS (append LIS MEMB))
            (setq FPT (cdr (nth 1 LIS)))
            (setq LAPOT (cdr (last LIS)))
          ) ;_ end of progn
        ) ;_ end of if
        (setq CYC (1+ CYC))
      ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
  (while (and (/= ELI "LWPOLYLINE") (/= ELI "POLYLINE"))
    (princ "\nSelected entity is not a polyline. ")
    (setq PLIN NIL)
    (while (= PLIN NIL)
      (setq PLIN (entsel "Select the path (polyline):"))
    ) ;_ end of while
    (setq ENA (car PLIN))
    (setq ELIS (entget ENA))
    (setq ELI (cdr (assoc 0 ELIS)))
    (setq ELI1 (cdr (assoc 70 ELIS)))
  ) ;_ end of while
  (setq PAT (ssadd))
  (setq PAT (ssadd ENA PAT))
  (if (= ELI "POLYLINE")
    (setq ENA (entnext ENA))
  ) ;_ end of if
  (if (and (/= ENA NIL) (= ELI "POLYLINE"))
    (progn
      (setq POI (entget ENA))
      (setq FPT (cdr (assoc 10 POI)))
    ) ;_ end of progn
  ) ;_ end of if
  (setq LAPT "VERTEX")
  (while (and (= LAPT "VERTEX") (= ELI "POLYLINE"))
    (setq POI1 (entget ENA))
    (setq ENA (entnext ENA))
    (setq LAPT (cdr (assoc 0 (entget ENA))))
  ) ;_ end of while
  (if (= ELI "POLYLINE")
    (setq LAPOT (cdr (assoc 10 POI1)))
  ) ;_ end of if
  (if (= ELI1 1)
    (setq LAPOT FPT)
  ) ;_ end of if
  (if (or (= TEXP "Start") (= TEXP "S"))
    (progn
      (if (= *HEIGHT NIL)
        (setq *HEIGHT 0.2000)
      ) ;_ end of if
      (setq H *HEIGHT)
      (initget (+ 2 4))
      (setq *HEIGHT
             (getdist
               FPT
               (strcat
                 "\nHeight of text <"
                 (rtos H 2 4)
                 ">:"
               ) ;_ end of strcat
             ) ;_ end of getdist
      ) ;_ end of setq
      (if (= *HEIGHT NIL)
        (setq *HEIGHT H)
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (setq STY (getstring (strcat "\nText Style<" *CSTYLE ">:")))
  (if (= STY "")
    (setq STY *CSTYLE)
  ) ;_ end of if
  (setq STYL (tblsearch "style" STY))
  (while (= STYL NIL)
    (princ (strcat "Style " STY " not defined."))
    (setq STY (getstring (strcat "\nText Style<" *CSTYLE ">:")))
    (if (= STY "")
      (setq STY *CSTYLE)
    ) ;_ end of if
    (setq STYL (tblsearch "style" STY))
  ) ;_ end of while
  (setq FHT (assoc 40 STYL))
  (setq WF (cdr (assoc 41 STYL)))
  (while (or (not (equal FHT '(40 . 0.0)))
             (and (> WF 1) (or (= TEXP "Fit") (= TEXP "F")))
         ) ;_ end of or
    (while (not (equal FHT '(40 . 0.0)))
      (setq STY (getstring
                  (strcat
                    "\nFixed height defined for style " STY
                    ". Select a different style. Text Style<" *CSTYLE
                    ">:"
                   ) ;_ end of strcat
                ) ;_ end of getstring
      ) ;_ end of setq
      (if (= STY "")
        (setq STY *CSTYLE)
      ) ;_ end of if
      (setq STYL (tblsearch "style" STY))
      (while (= STYL NIL)
        (princ (strcat "Style " STY " not defined."))
        (setq STY (getstring (strcat "\nText Style<" *CSTYLE ">:")))
        (if (= STY "")
          (setq STY *CSTYLE)
        ) ;_ end of if
        (setq STYL (tblsearch "style" STY))
      ) ;_ end of while
      (setq FHT (assoc 40 STYL))
    ) ;_ end of while
    (setq WF (cdr (assoc 41 STYL)))
    (while (and (> WF 1) (or (= TEXP "Fit") (= TEXP "F")))
      (setq STY
             (getstring
               (strcat
                 "\nSelect a style with width factor less than or equal to 1. Text Style<"
                 *CSTYLE
                 ">:"
               ) ;_ end of strcat
             ) ;_ end of getstring
      ) ;_ end of setq
      (if (= STY "")
        (setq STY *CSTYLE)
      ) ;_ end of if
      (setq STYL (tblsearch "style" STY))
      (while (= STYL NIL)
        (princ (strcat "Style " STY " not defined."))
        (setq STY (getstring (strcat "\nText Style<" *CSTYLE ">:")))
        (if (= STY "")
          (setq STY *CSTYLE)
        ) ;_ end of if
        (setq STYL (tblsearch "style" STY))
      ) ;_ end of while
      (setq WF (cdr (assoc 41 STYL)))
    ) ;_ end of while
    (setq FHT (assoc 40 STYL))
  ) ;_ end of while
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setvar "pdmode" 1)
  (setvar "blipmode" 0)
  (setq LR (tblsearch "layer" "PTEXT"))
  (if (and (= LR NIL) (= ELI "LWPOLYLINE"))
    (command "-layer" "m" "PTEXT" "")
  ) ;_ end of if
  (if (and (/= LR NIL) (= ELI "LWPOLYLINE"))
    (command "-layer" "t" "PTEXT" "m" "PTEXT" "")
  ) ;_ end of if
  (if (and (= LR NIL) (= ELI "POLYLINE"))
    (command "layer" "m" "PTEXT" "")
  ) ;_ end of if
  (if (and (/= LR NIL) (= ELI "POLYLINE"))
    (command "layer" "t" "PTEXT" "m" "PTEXT" "")
  ) ;_ end of if
  (setq TX "")
  (setq TX (getstring t "\nText: "))
  (setq TN1 (strlen TX))
  (while (> TN1 125)
    (setq TX "")
    (setq
      TX (getstring t "\nRestrict the string length to 125. Text: ")
    ) ;_ end of setq
    (setq TN1 (strlen TX))
  ) ;_ end of while
  (if (or (= TEXP "Fit") (= TEXP "F"))
    (progn
      (while (< TN1 3)
        (setq TX "")
        (setq TX
               (getstring t "\nMinimum string length should be 3. Text: ")
        ) ;_ end of setq
        (setq TN1 (strlen TX))
      ) ;_ end of while
    ) ;_ end of progn
  ) ;_ end of if
  (while (= TX "")
    (setq TX (getstring t "\nText: "))
  ) ;_ end of while
  (setq TN1 (strlen TX))
  (if (/= TX "")
    (progn
      (setq SST (ssadd))
      (command "_point" FPT)
      (setq FPO (entlast))
      (command "_text" FPT "" "" ".")
      (setq ROA (entlast))
      (setq ROTANG (cdr (assoc 50 (entget ROA))))
      (setq ROTANG (cvunit ROTANG "radian" "degree"))
      (command "_erase" ROA "")
      (setq SST (ssadd FPO SST))
      (if (or (= TEXP "Start") (= TEXP "S"))
        (progn
          (setq MVAL (* *HEIGHT WF))
          (command "_measure" (princ PAT) MVAL)
        ) ;_ end of progn
      ) ;_ end of if
      (if (or (= TEXP "Fit") (= TEXP "F"))
        (command "_divide" (princ PAT) TN1)
      ) ;_ end of if
      (setq FPOT (entnext FPO))
      (setq FPOT1 (entnext FPOT))
      (setq NEWC FPOT)
      (setq NEWNOM 1)
      (while (/= NEWC NIL)
        (setq NMP (cdr (assoc 10 (entget NEWC))))
        (setq SST (ssadd NEWC SST))
        (setq NEWC (entnext NEWC))
        (setq NEWNOM (1+ NEWNOM))
      ) ;_ end of while
      (if (<= NEWNOM (1- TN1))
        (progn
          (initget "Yes No")
          (setq CUE
                 (getkword
                   "\nPolyline length insufficient. Continue? Yes/<No>: "
                 ) ;_ end of getkword
          ) ;_ end of setq
          (if (= CUE NIL)
            (setq CUE "No")
          ) ;_ end of if
        ) ;_ end of progn
      ) ;_ end of if
      (if (or (= CUE "Yes") (= CUE "Y") (= CUE NIL))
        (progn
          (setq SPT (cdr (assoc 10 (entget FPOT))))
          (setq SOPT (cdr (assoc 10 (entget FPOT1))))
          (setq VA (open "vc.txt" "w"))
          (write-line TX VA)
          (close VA)
          (setvar "textstyle" STY)
          (if (= *NO NIL)
            (setq *NO 1)
          ) ;_ end of if
          (setq SSET (ssadd))
          (setq VB (open "vc.txt" "r"))
          (if (or (= TEXP "Fit") (= TEXP "F"))
            (setq *HEIGHT (distance FPT SPT))
          ) ;_ end of if
          (if (or (= *HEIGHT 0) (= ELI1 1))
            (progn
              (setq KI 1)
              (setq *HEIGHT (distance SPT SOPT))
            ) ;_ end of progn
          ) ;_ end of if
          (setq PTA FPT)
          (setq PTB SPT)
          (setq NOS 0)
          (while (< NOS TN1)
            (setq VTA (read-char VB))
            (setq VT (chr VTA))
            (if (or (= VT "I")
                    (= VT "i")
                    (= VT ".")
                    (= VT "'")
                    (= VT "!")
                    (= VT ":")
                    (= VT ";")
                    (= VT "j")
                    (= VT ";")
                ) ;_ end of or
              (setq
                PTA (list (/ (+ (* 3 (car PTA)) (* 1 (car PTB))) 4)
                          (/ (+ (* 3 (cadr PTA)) (* 1 (cadr PTB))) 4)
                    ) ;_ end of list
              ) ;_ end of setq
            ) ;_ end of if
            (setq NAE (angle PTA PTB))
            (if (= KI 1)
              (progn
                (setq NAE (angle SPT SOPT))
                (setq FPOT FPOT1)
                (setq PTB SOPT)
                (setq KI NIL)
              ) ;_ end of progn
            ) ;_ end of if
            (setq NAE1 (cvunit NAE "radian" "degree"))
            (command "text" PTA *HEIGHT NAE1 VT)
            (if (/= VT " ")
              (progn
                (setq SB (entlast))
                (setq SSET (ssadd SB SSET))
              ) ;_ end of progn
            ) ;_ end of if
            (setq PTA PTB)
            (if (equal PTA NMP)
              (progn
                (setq SPT LAPOT)
                (setq NOS (- TN1 2))
              ) ;_ end of progn
              (progn
                (setq FPOT (entnext FPOT))
                (setq SPT (cdr (assoc 10 (entget FPOT))))
              ) ;_ end of progn
            ) ;_ end of if
            (setq PTB SPT)
            (setq NOS (1+ NOS))
          ) ;_ end of while
          (close VB)
          (setq NIC (strcat "PTEXT$_30061967" (rtos *NO 2 0)))
          (command "_group" "" (princ NIC) "" (princ SSET) "")
          (setq *NO (1+ *NO))
        ) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
  (command "_text" FPT *HEIGHT ROTANG ".")
  (setq SB (entlast))
  (setq SST (ssadd SB SST))
  (if (= ELI "LWPOLYLINE")
    (command "-layer" "m" *CLAYER "")
  ) ;_ end of if
  (if (= ELI "POLYLINE")
    (command "-layer" "m" *CLAYER "")
  ) ;_ end of if
  (command "_erase" (princ SST) "")
  (command "_undo" "e")
  (setvar "cmdecho" *CMDECHO)
  (setvar "Angdir" *ANGDIR)
  (setvar "Aunits" *AUNITS)
  (setvar "Angbase" *ANGBASE)
  (setvar "blipmode" *BLIPMODE)
  (setvar "textstyle" *CSTYLE)
  (setvar "pdmode" *PDMOD)
  (setq *PWORD NIL)
  (princ
    "\nPTEXT.lsp - Written by Viji Varghese, Kerala, India. March '99"
  ) ;_ end of princ
  (princ)
) ;_ end of defun