Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;--------------------------------------------------------------------
- ; NOTES (EZ WORD).LSP
- ; ROUTINES TO HANDLE TEXT DATA IN AUTOCAD
- ;--------------------------------------------------------------------
- (princ "\nLoading...Please wait.")
- (terpri)
- (defun C:EZWORD ()
- (textscr)
- (princ "\nE-Z Word commands: ")
- (princ "\nDRAWTEXT - input an ascii text file")
- (princ "\nCURVETEXT - text around an arc")
- (princ "\nBOLDTEXT - copy displace text for bold effect")
- (terpri)
- (princ "\nMODTXT - modify text entities")
- (princ "\nCASECHG - globally change to upper or lower case")
- (princ "\nEDITTEXT - edit a text string; rudimentry text editor")
- (princ "\nBUSTTEXT - break a text string into 2 entities")
- (princ "\nEXPLTEXT - break a text string into individual letters")
- (terpri)
- (princ "\nLETTERING - place text as drawing blocks")
- (terpri)
- (princ "\nCopyright LANDCADD, INC. 1986,87,88")
- (princ)
- )
- (defun C:NOTES ()
- (C:EZWORD)
- )
- ; Function entry
- (defun enter ()
- (setq
- clay (getvar "CLAYER")
- ccol (getvar "CECOLOR")
- cele (getvar "ELEVATION")
- cgri (getvar "GRIDMODE")
- cblp (getvar "BLIPMODE")
- cort (getvar "ORTHOMODE")
- cthk (getvar "THICKNESS")
- csnp (getvar "SNAPANG")
- cspm (getvar "SNAPMODE")
- cosp (getvar "OSMODE")
- cmde (getvar "CMDECHO")
- tunt (getvar "LUNITS")
- uang (getvar "AUNITS")
- textsize (getvar "TEXTSIZE")
- )
- (setvar "CMDECHO" 0)
- (setvar "BLIPMODE" 0)
- (setvar "GRIDMODE" 0)
- (setvar "AUNITS" 4)
- )
- ; Function leave
- (defun leave ()
- (command
- "layer" "s" clay ""
- "color" (if (= "BYLAYER" ccol) ccol (atoi ccol))
- "elev" cele ""
- )
- (setvar "BLIPMODE" cblp)
- (setvar "GRIDMODE" cgri)
- (setvar "ORTHOMODE" cort)
- (setvar "THICKNESS" cthk)
- (setvar "SNAPANG" csnp)
- (setvar "SNAPMODE" cspm)
- (setvar "OSMODE" cosp)
- (princ)
- )
- ; EDITTEXT command - rudimentary text editor
- (defun C:EDITTEXT (/ p l n e os as ns st s nsl osl sl si chf chm cont)
- (setq chm 0 p (ssget)) ; Select objects
- (if p (progn ; If any objects selected
- (setq cont t)
- (while cont
- (setq osl (strlen (setq os (getstring "\nOld string: " t))))
- (if (= osl 0)
- (princ "Null input invalid")
- (setq cont nil)
- )
- )
- (setq nsl (strlen (setq ns (getstring "\nNew string: " t))))
- (setq l 0 n (sslength p))
- (while (< l n) ; For each selected object...
- (if (= "TEXT" ; Look for TEXT entity type (group 0)
- (cdr (assoc 0 (setq e (entget (ssname p l))))))
- (progn
- (setq chf nil si 1)
- (setq s (cdr (setq as (assoc 1 e))))
- (while (= osl (setq sl (strlen
- (setq st (substr s si osl)))))
- (if (= st os)
- (progn
- (setq s (strcat (substr s 1 (1- si)) ns
- (substr s (+ si osl))))
- (setq chf t) ; Found old string
- (setq si (+ si nsl))
- )
- (setq si (1+ si))
- )
- )
- (if chf (progn ; Substitute new string for old
- (setq e (subst (cons 1 s) as e))
- (entmod e) ; Modify the TEXT entity
- (setq chm (1+ chm))
- ))
- )
- )
- (setq l (1+ l))
- )
- ))
- (princ "Changed ") ; Print total lines changed
- (princ chm)
- (princ " text lines.")
- (terpri)
- )
- ;---------------------------------------------------------------------
- ;CURVE LETTERING
- ;---------------------------------------------------------------------
- (defun C:CURVETEXT ()
- (setvar "CMDECHO" 0)
- (getdata)
- (firstletter)
- (continueletters)
- )
- (defun GETDATA ()
- (graphscr)
- (setq point (getpoint "Show start of curve text: "))
- (TERPRI)
- (setq center (getpoint "Where is the center of the arc: "))
- (TERPRI)
- (setq radius (distance center point))
- (setq circum (* pi 2))
- (setq circum (* circum radius))
- (command "circle" center radius)
- (setq height (getdist point "Enter text height: "))
- (setq space height)
- (setq direction (getint "Enter 1 for CW lettering, 0 for CCW: "))
- (if (= direction 1)
- (setq perp (/ pi 1.921))
- (setq perp (* 1.47 pi)))
- ; (command "osnap" "near")
- ; (setq space (getdist point "How far from 1st to 2nd letter?: "))
- (setq numper (/ circum space))
- (setq anglea (/ 360 numper))
- (setq anglea (/ anglea r-d))
- (if (= direction 1)
- (setq anglea anglea)
- (setq anglea (- 0 anglea)))
- (command "erase" "l" "")
- (setq text (getstring T "Enter text: "))
- ; (command "osnap" "none")
- )
- (defun FIRSTLETTER ()
- (setq i 1)
- (setq angle1 (angle center point))
- ;find angle from center to point
- (setq point2 (polar point (- angle1 perp) space))
- ;turn 90 degrees clockwise if point is above cntr
- ;else turn 270 degrees clockwise
- ;go along that line inter-character spacing
- (setq delta anglea)
- ;measure the angular difference between the chars
- (setq textangle (* r-d (angle point point2)))
- (setq blipmode (getvar "BLIPMODE"))
- (setvar "BLIPMODE" 0)
- (command "text" "c" point height textangle (substr text i 1))
- )
- (defun CONTINUELETTERS ()
- (setq i (1+ i))
- (setq point point2)
- (setq textangle (- textangle (* r-d delta)))
- (setq angle1 (- angle1 delta))
- (setq point2 (polar point (- angle1 perp) space))
- (command "text" "c" point height textangle (substr text i 1))
- (if (< i (strlen text)) (continueletters))
- (setvar "BLIPMODE" blipmode)
- )
- (setq r-d 57.29577951)
- (setq d90 (/ pi 2))
- (setq d180 pi)
- (setq d270 (* 1.5 pi))
- ;-------------------------------------------------------------------------
- ; PURGE TEXT (remove control characters, etc.)
- ;-------------------------------------------------------------------------
- (defun purgetext (text)
- (setq length (strlen text))
- (setq new "")
- (setq n 0)
- (repeat length
- (setq n (1+ n))
- (setq character (substr text n 1))
- (if (< (ascii character) 32) (setq character ""))
- (if (> (ascii character) 126) (setq character ""))
- (setq new (strcat new character))
- )
- (setq text new)
- )
- ; modify various aspects of a selection set of text entities
- (defun C:MODTXT ()
- (setvar "CMDECHO" 0)
- (command "UNDO" "M")
- (setq old (ssget))
- (initget 1 "Change Height Width Oblique Rotation Style")
- (setq typ (getkword "\nChange: Height/Width/Oblique/Rotation/Style? "))
- (setq
- co -1
- t2 "T"
- )
- (cond
- ((= "Height" typ)
- (setq
- x 40
- ht (getdist "\nNew height: ")
- )
- )
- ((= "Oblique" typ)
- (setq
- x 51
- ht (* pi (/ (getreal "\nNew obliquing angle: ") 180.0))
- )
- )
- ((= "Rotation" typ)
- (setq
- x 50
- ht (* pi (/ (getreal "\nNew rotation angle: ") 180.0))
- )
- )
- ((= "Width" typ)
- (setq
- x 41
- ht (getreal "\nNew width: ")
- )
- )
- ((= "Style" typ)
- (setq
- x 7
- ht (getstring "\nNew style: ")
- )
- )
- )
- (while (boundp 't2)
- (progn
- (setq
- co (1+ co)
- temp (entget (ssname old co))
- oldht (assoc x temp)
- newht (cons x ht)
- newtext (subst newht oldht temp)
- t2 (ssname old (1+ co))
- )
- (entmod newtext)
- )
- )
- (princ "\nModTxt complete.")
- (princ)
- )
- ; BOLDTEXT
- ; 5/24/86
- ; LANDCADD, INC.
- (defun c:boldtext ()
- (enter)
- (setvar "BLIPMODE" 1)
- (ptsize)
- (setvar "BLIPMODE" 0)
- (replicate)
- (leave)
- (princ)
- )
- (defun ptsize ()
- (setq i 0)
- (setq points (getreal "\nSelect point size of text from menu: "))
- (setq scale (getreal "\nSelect final plotting scale from menu: "))
- (setq size (* scale points))
- (if (= tunt 2) (setq size (* size 0.083333333)))
- (graphscr)
- (setq st (getpoint "\nShow starting point for text: "))
- (setvar "LASTPOINT" st)
- (setq displace (/ size 40))
- (setq num (getint "\nEnter a boldness factor: "))
- (setq rot (getangle st "\nRotation angle? <0>"))
- (if (= rot nil) (setq rot 0))
- (setq rot2 (* rot 57.29577951))
- (setq verbage (getstring T "\nText: "))
- (setq st1 st)
- )
- (defun replicate ()
- (setq i (+ i 1))
- (command "text" st1 size rot2 verbage)
- (setq st1 (polar st rot displace))
- (setq st st1)
- (if (< i num) (replicate))
- )
- ; Routine to type in a text string and insert block letters.
- (defun C:LETTERING ()
- (enter)
- (getlet)
- (firstlet)
- (continuelet)
- (leave)
- (princ)
- )
- (defun GETLET ()
- (graphscr)
- (setq sd (getstring "Enter the directory with the text blocks <BLOCKS>: "))
- (if (= sd "") (setq sd "BLOCKS"))
- (TERPRI)
- (setq r-d 57.29577951)
- (setq point (getpoint "Show start of text: "))
- (TERPRI)
- (setq textangle (getangle point "Show rotation angle: "))
- (setq insangle (* r-d textangle))
- (setq space (getdist point "How far from 1st to 2nd letter?: "))
- (setq text (getstring T "Enter text: "))
- )
- (defun FIRSTLET ()
- (setq i 1)
- (setq letter (substr text i 1))
- (setq blk (strcat "/" sd "/" letter))
- (command "insert" blk point xs ys insangle)
- (setq point2 (polar point textangle space))
- )
- (defun CONTINUELET ()
- (setq i (1+ i))
- (setq point point2)
- (setq point2 (polar point textangle space))
- (setq letter (substr text i 1))
- (setq blk (strcat "/" sd "/" letter))
- (if (= letter " ")
- (setq point (polar point2 textangle space))
- (command "insert" blk point xs ys insangle)
- )
- (if (< i (strlen text)) (continuelet))
- )
- ; BUST TEXT.LSP
- ; Break a text string
- (defun c:busttext ()
- (setvar "CMDECHO" 0)
- (setq r-d (/ 360 pi 2))
- (setq a (ssget))
- (setq brk (getstring "Break after what word? "))
- (setq b (ssname a 0))
- (setq c (entget b))
- (setq txts (assoc '1. c))
- (setq tht (assoc '40. c))
- (setq ht (cdr tht))
- (setq rot (assoc '50. c))
- (setq rang (cdr rot))
- (setq rang (* rang r-d))
- (setq f (cdr txts))
- (setq g (substr f 1))
- (setq LB (strlen brk))
- (setq LG (strlen g))
- (setq x 0)
- (tryit)
- )
- (defun tryit ()
- ; G is the total text string, with length lg
- ; brk is the word (substring) to break after, with length lb
- ; x = beginning point of substring in g
- (setq x (+ 1 x))
- (setq test (substr g x lb))
- (if (= test brk) (contt) (tryit))
- )
- (defun contt ()
- (setq xx (+ x lb))
- (setq fl (substr g 1 xx))
- (setq yy (+ 1 xx))
- (setq sl (substr g yy lg))
- (COMMAND "CHANGE" "p" "" "" "" "" "" "" fl)
- (TERPRI)
- (setq pt (getpoint "Show starting point of remaining text: "))
- (command "TEXT" pt ht rang sl)
- (SETVAR "CMDECHO" 1)
- )
- (defun C:EXPLTEXT ()
- (enter)
- (COMMAND "STYLE" "MONO" "MONOTXT" "0" "1" "0" "N" "N" "N")
- (SETQ R-D (/ 360 PI 2 ) )
- (SETQ A (SSGET ) )
- (SETQ B (SSNAME A 0 ) )
- (SETQ C (ENTGET B ) )
- (SETQ TXTS (ASSOC (QUOTE 1.000000 ) C ) )
- (SETQ THT (ASSOC (QUOTE 40.000000 ) C ) )
- (SETQ PT1 (ASSOC (QUOTE 10.000000 ) C ) )
- (SETQ PT (CDR PT1 ) )
- (SETQ HT (CDR THT ) )
- (SETQ ROT (ASSOC (QUOTE 50.000000 ) C ) )
- (SETQ ANG (CDR ROT ) )
- (SETQ RANG (* ANG R-D ) )
- (SETQ F (CDR TXTS ) )
- (SETQ G (SUBSTR F 1 ) )
- (SETQ LG (STRLEN G ) )
- (SETQ X 0 )
- (SETQ ST1 (GETSTRING "STYLE to use for exploded text <MONO> " ) )
- (IF (= ST1 "" )
- (SETQ ST1 "mono" ) )
- (COMMAND "erase" "p" "" )
- (GOFORIT)
- (leave)
- (princ)
- )
- (defun goforit ()
- (SETQ X (+ 1 X ) )
- (SETQ TEST (SUBSTR G X 1 ) )
- (TERPRI )
- (COMMAND "text" "s" ST1 PT HT RANG TEST )
- (SETQ PT (POLAR PT ANG HT ) )
- (IF (< X LG ) (goforit))
- )
- (defun C:DRAWTEXT ()
- ;Imports ASCII text files
- (enter)
- (setq r-d (/ 360 pi 2))
- (setq txtype "L")
- (setq pt "L")
- (getfn)
- (leave)
- ) ; end function
- (defun getfn ()
- (initget 1)
- (setq fname (getstring "\nName of ASCII text file to insert: "))
- (if (= fname "") (setq fname pname))
- (setq pname fname)
- (setq va (open fname "r"))
- (if (/= va nil)
- (fa)
- (progn
- (princ "File not found - try again\007\n")
- (getfn)
- )
- ) ; end if
- )
- (defun FA ()
- ; va = filename
- ; vb = text string
- ; vc = style
- ; ve = control point
- ; vf = height
- ; vg = angle (radians)
- (terpri)
- (setq vb (read-line va))
- (findsty)
- (setq tsl (strlen vb))
- (graphscr)
- (setvar "BLIPMODE" 1)
- ;Prompt for start point or justification
- (initget 1 "Align Center Fit Middle Right")
- (setq ve (getpoint
- "\nStart point or Align/Center/Fit/Middle/Right: "
- )
- )
- (if (/= (type ve) 'LIST)
- (setq txtype (substr ve 1 1))
- (setq txtype "L")
- )
- (if (= txtype "C") (setq ve (getpoint "\nCenter point: ")))
- (if (= txtype "M") (setq ve (getpoint "\nMiddle point: ")))
- (if (= txtype "F") (setq ve (getpoint "\nStarting point: ")))
- (if (= txtype "F") (setq rpt (getpoint ve "Second point: ")))
- (if (= txtype "R") (setq ve (getpoint "\nEnding point: ")))
- (if (= txtype "A")
- (progn
- (setq
- ve (getpoint "\nStarting point: ")
- rpt (getpoint ve "Second point: ")
- d1 (distance ve rpt)
- vf (/ d1 tsl)
- );end setq
- );end progn
- );end if
- (setq vf (getdist ve
- (strcat "\nHeight <"
- (rtos
- (getvar "TEXTSIZE")
- (getvar "LUNITS")
- (getvar "LUPREC")
- )
- ">: ")
- )
- )
- (if (= vf nil) (setq vf (getvar "TEXTSIZE")))
- (if (= txtype "L") (setq vg (getangle ve "\nRotation Angle <0>: ")))
- (if (= txtype "C") (setq vg (getangle ve "\nRotation Angle <0>: ")))
- (if (= txtype "M") (setq vg (getangle ve "\nRotation Angle <0>: ")))
- (if (= txtype "R") (setq vg (getangle ve "\nRotation Angle <0>: ")))
- (if (= txtype "A") (setq vg (angle ve rpt)))
- (if (= txtype "F") (setq vg (angle ve rpt)))
- (if (or (= vg nil) (= vg "")) (setq vg 0.0))
- (terpri)
- (setq ta (* vg r-d))
- (setvar "BLIPMODE" 0)
- (command) (command)
- (if (= txtype "L") (command "TEXT" "S" vc ve vf ta vb))
- (if (= txtype "R") (command "TEXT" "S" vc txtype ve vf ta vb))
- (if (= txtype "C") (command "TEXT" "S" vc txtype ve vf ta vb))
- (if (= txtype "M") (command "TEXT" "S" vc txtype ve vf ta vb))
- (if (= txtype "A") (command "TEXT" "S" vc txtype ve rpt vb))
- (if (= txtype "F") (command "TEXT" "S" vc txtype ve rpt vf vb))
- (while (/= vb nil)
- (setq ve (polar ve (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf )))
- (if (= txtype "A") (setq rpt (polar rpt (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf ))))
- (if (= txtype "F") (setq rpt (polar rpt (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf ))))
- (setq vb (read-line va))
- (terpri)
- (if (= txtype "L") (command "TEXT" ve vf ta vb))
- (if (= txtype "R") (command "TEXT" txtype ve vf ta vb))
- (if (= txtype "C") (command "TEXT" txtype ve vf ta vb))
- (if (= txtype "M") (command "TEXT" txtype ve vf ta vb))
- (if (= txtype "A") (command "TEXT" txtype ve rpt vb))
- (if (= txtype "F") (command "TEXT" txtype ve rpt vf vb))
- )
- (close va)
- )
- (defun findsty ()
- (setq tsty (getvar "TEXTSTYLE"))
- (princ "\nStyle name <") (princ tsty)
- (setq vc (getstring ">: "))
- (if (= vc "") (setq vc tsty))
- (command "TEXT" "S" vc) (command)
- ;Check for a variable text height
- (setq ts (tblsearch "STYLE" (getvar "TEXTSTYLE")))
- (if (/= (cdr (assoc 40 ts)) 0.0)
- (progn
- (princ "\007")
- (princ "\n* Invalid * style must contain a variable text height; i.e. = 0")
- (findsty)
- )
- )
- (command)
- )
- ;(defun *error* (st)
- ; (prompt (strcat "error: " st "\007\n"))
- ;)
- (defun c:casechg ()
- (SETVAR "CMDECHO" 0)
- (TERPRI)
- (SETQ R-D (/ 360 PI 2))
- (SETQ A (SSGET))
- (INITGET 1 "Upper Lower")
- (SETQ W (GETKWORD "Change to Upper/Lower case? " ) )
- (SETQ X -1 )
- (SETQ TOT (SSLENGTH A))
- (SETQ TOT (- TOT 1))
- (IF (= W "Lower")
- (LOWER)
- (UPPER))
- (princ)
- )
- (defun lower ()
- (SETQ X (+ 1 X))
- (nextstring)
- (SETQ G (STRCASE G "T"))
- (COMMAND "CHANGE" B "" "" "" "" "" "" G)
- (IF (< X TOT ) (LOWER))
- )
- (defun upper ()
- (SETQ X (+ 1 X))
- (nextstring)
- (SETQ G (STRCASE G))
- (COMMAND "CHANGE" B "" "" "" "" "" "" G)
- (IF (< X TOT ) (upper))
- )
- (defun nextstring ()
- (SETQ B (SSNAME A X))
- (SETQ C (ENTGET B))
- (SETQ TXTS (ASSOC (QUOTE 1.000000 ) C))
- (SETQ THT (ASSOC (QUOTE 40.000000 ) C))
- (SETQ HT (CDR THT))
- (SETQ ROT (ASSOC (QUOTE 50.000000 ) C))
- (SETQ RANG (CDR ROT))
- (SETQ RANG (* RANG R-D))
- (SETQ F (CDR TXTS))
- (SETQ G (SUBSTR F 1))
- )
- (princ)
- (defun C:EZEDIT()
- (enter)
- (prompt "\nSelect a group of text to edit: ")
- (setq ss (ssget))
- ; write text entites to a temporary file...temp.ez
- (setq va (open "temp.ez" "w"))
- (setq x (sslength ss))
- (setq x (- x 1))
- (setq b (ssname ss x))
- (setq c (entget b))
- (setq txts (assoc (quote 1.000000 ) c))
- (setq f (cdr txts)) ; the actual text string
- (setq tht (assoc (quote 40.000000 ) c))
- (setq ht (cdr tht)) ; the text height
- (setq rot (assoc (quote 50.000000 ) c))
- (setq rang (cdr rot)) ; rotation angle in radians
- (setq r-d 57.29577951)
- (setq rang (* rang r-d)) ; rot ang converted to degrees
- (setq xypt (assoc (quote 10.000000 ) c))
- (setq xypt (cdr xypt)) ; insertion point
- (setq tstyl (assoc (quote 7.000000 ) c))
- (setq tstyl (cdr tstyl)) ; text style
- (princ f va)
- (while (> x 0)
- (princ "\n" va)
- (setq x (- x 1))
- (setq b (ssname ss x))
- (setq c (entget b))
- (setq txts (assoc (quote 1.000000 ) c))
- (setq f (cdr txts)) ; the actual text string
- (princ f va)
- )
- (princ "\n" va)
- (close va)
- ; call your favorite text editor through the shell
- (command "EZED" "temp.ez")
- ; erase previous text entities from your drawing
- (command "erase" "p" "")
- ; insert modified text file
- (setq fp (open "temp.ez" "r"))
- (setq txts (read-line fp))
- (command "TEXT" "S" tstyl xypt ht rang txts)
- (while (/= txts nil)
- ;(setq ve (polar ve (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf )))
- (setq txts (read-line fp))
- (command "TEXT" "" txts)
- )
- (close fp)
- (leave)
- (princ)
- )
- (princ "Loaded: TEXT UTILITIES @ 1986 LANDCADD, INC.")
- (princ)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement