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 >
Wrap
Lisp/Scheme
|
1989-09-06
|
2KB
|
59 lines
;=======================================================================
; Allegro TABLET TOOLS LISP file
; CONTEXT.LSP
; Routine for continuing existing text
; (c) 1988 Robert McNeel & Assoc.
; 1310 Ward St.
; Seattle, WA, 98109
; 206-628-8822
; This prompts for you to pick an existing line of text and continues
; below it with the same style, layer, ht, justification, etc. and
; uses the line spacing of the style.
; It will keep placing lines of text as long as you keep typing them.
;=======================================================================
(defun val (x ent) (cdr (assoc x ent)))
;=======================================================================
; Continuing text routine
;=======================================================================
(defun c:contxt (/ fht ent inpt align str)
(setvar "cmdecho" 0)
(and
(setq ent (entsel "\nLast line of text: "))
(setq ent (entget (car ent)))
(= (val 0 ent) "TEXT") ;check selection to be text
(or (/= (val '72 ent) 3) ;don't allow aligned
(prompt "\nDoesn't work on ALIGNED text.")
)
(or (/= (val '72 ent) 5) ;or fit text
(prompt "\nDoesn't work on FIT text.")
)
(progn
(setq
inpt (val 10 ent) ;find insert pt of existing text
fht (/= 0.0 (val 40 (tblsearch "STYLE" (val 7 ent)))) ;fixed ht style?
)
;SET LAYER TO SAME AS SELECTED TEXT
(if (/= (val 8 ent) (getvar "clayer"))
(command ".layer" "s" (val 8 ent) "")
)
;DETERMINE TEXT ALIGNMENT
(setq align (val (val 72 ent) '((1 . "c") (2 . "r") (4 . "m"))))
(if align
(setq inpt (val 11 ent)) ;use secondary point if not LEFT
)
;INSERT A BLANK LINE AT INPT OF LAST LINE OF TEXT THEN CONTINUE TEXT
(command ".text" "s" (val 7 ent)) ;set style
(if align (command align)) ;alignment if not LEFT
(command inpt)
(if (not fht) (command (val 40 ent))) ;height if not fixed height style
(command (angtos (val 50 ent)) " ")
(while (/= "" (setq str (getstring T "\nText: ")))
(command ".text" "" str)
) ;continue next text line while not = ""
)
)
(setvar "cmdecho" 1)
(princ)
)