home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / GR / GR505.ZIP / LSP.EXE / CONTEX.LSP < prev    next >
Lisp/Scheme  |  1989-09-06  |  2KB  |  59 lines
  1. ;=======================================================================
  2. ; Allegro TABLET TOOLS LISP file
  3. ; CONTEXT.LSP
  4. ; Routine for continuing existing text
  5. ; (c) 1988 Robert McNeel & Assoc.
  6. ;     1310 Ward St.
  7. ;     Seattle, WA, 98109
  8. ;     206-628-8822
  9. ; This prompts for you to pick an existing line of text and continues 
  10. ;   below it with the same style, layer, ht, justification, etc. and 
  11. ;   uses the line spacing of the style.
  12. ; It will keep placing lines of text as long as you keep typing them.
  13. ;=======================================================================
  14. (defun val (x ent) (cdr (assoc x ent)))
  15. ;=======================================================================
  16. ; Continuing text routine
  17. ;=======================================================================
  18. (defun c:contxt (/ fht ent inpt align str)
  19.   (setvar "cmdecho" 0)
  20.   (and
  21.     (setq ent (entsel "\nLast line of text: "))
  22.     (setq ent (entget (car ent)))
  23.     (= (val 0 ent) "TEXT") ;check selection to be text
  24.     (or (/= (val '72 ent) 3)      ;don't allow aligned 
  25.         (prompt "\nDoesn't work on ALIGNED text.")
  26.     )
  27.     (or (/= (val '72 ent) 5)      ;or fit text
  28.         (prompt "\nDoesn't work on FIT text.")
  29.     )
  30.     (progn
  31.       (setq 
  32.         inpt (val 10 ent)        ;find insert pt of existing text
  33.         fht (/= 0.0 (val 40 (tblsearch "STYLE" (val 7 ent)))) ;fixed ht style?
  34.       )
  35.     ;SET LAYER TO SAME AS SELECTED TEXT
  36.       (if (/= (val 8 ent) (getvar "clayer")) 
  37.         (command ".layer" "s" (val 8 ent) "")
  38.       )
  39.     ;DETERMINE TEXT ALIGNMENT
  40.       (setq align (val (val 72 ent) '((1 . "c") (2 . "r") (4 . "m"))))
  41.       (if align
  42.         (setq inpt (val 11 ent))  ;use secondary point if not LEFT
  43.       )
  44.     ;INSERT A BLANK LINE AT INPT OF LAST LINE OF TEXT THEN CONTINUE TEXT
  45.       (command ".text" "s" (val 7 ent))  ;set style
  46.       (if align (command align))  ;alignment if not LEFT
  47.       (command inpt)
  48.       (if (not fht) (command (val 40 ent))) ;height if not fixed height style
  49.       (command (angtos (val 50 ent)) " ") 
  50.       (while (/= "" (setq str (getstring T "\nText: ")))
  51.         (command ".text" "" str)
  52.       ) ;continue next text line while not = ""       
  53.     )
  54.   )
  55.   (setvar "cmdecho" 1)
  56.   (princ)
  57. )
  58.  
  59.