API tools faq
paste
Advertisement
btronic

ez Word lsp

btronic
Jun 25th, 2012
2,779
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
CAD Lisp 18.64 KB | None | 0 0
raw download clone embed print report
  1. ;--------------------------------------------------------------------
  2. ; NOTES (EZ WORD).LSP
  3. ; ROUTINES TO HANDLE TEXT DATA IN AUTOCAD
  4. ;--------------------------------------------------------------------
  5.  
  6. (princ "\nLoading...Please wait.")
  7. (terpri)
  8.  
  9. (defun C:EZWORD ()
  10.    (textscr)
  11.    (princ "\nE-Z Word commands: ")
  12.    (princ "\nDRAWTEXT  - input an ascii text file")
  13.    (princ "\nCURVETEXT - text around an arc")
  14.    (princ "\nBOLDTEXT  - copy displace text for bold effect")
  15.    (terpri)
  16.    (princ "\nMODTXT    - modify text entities")
  17.    (princ "\nCASECHG   - globally change to upper or lower case")
  18.    (princ "\nEDITTEXT  - edit a text string; rudimentry text editor")
  19.    (princ "\nBUSTTEXT  - break a text string into 2 entities")
  20.    (princ "\nEXPLTEXT  - break a text string into individual letters")
  21.    (terpri)
  22.    (princ "\nLETTERING - place text as drawing blocks")
  23.    (terpri)
  24.    (princ "\nCopyright LANDCADD, INC. 1986,87,88")
  25.    (princ)
  26. )
  27.  
  28. (defun C:NOTES ()
  29.   (C:EZWORD)
  30. )
  31.  
  32. ; Function entry
  33. (defun enter ()
  34.     (setq
  35.         clay (getvar "CLAYER")
  36.         ccol (getvar "CECOLOR")
  37.         cele (getvar "ELEVATION")
  38.         cgri (getvar "GRIDMODE")
  39.                 cblp (getvar "BLIPMODE")
  40.                 cort (getvar "ORTHOMODE")
  41.                 cthk (getvar "THICKNESS")
  42.                 csnp (getvar "SNAPANG")
  43.                 cspm (getvar "SNAPMODE")
  44.                 cosp (getvar "OSMODE")
  45.                 cmde (getvar "CMDECHO")
  46.                 tunt (getvar "LUNITS")
  47.                 uang (getvar "AUNITS")
  48.                 textsize (getvar "TEXTSIZE")
  49.     )
  50.     (setvar "CMDECHO" 0)
  51.     (setvar "BLIPMODE" 0)
  52.     (setvar "GRIDMODE" 0)
  53.     (setvar "AUNITS" 4)
  54. )
  55.  
  56. ; Function leave
  57. (defun leave ()
  58.     (command
  59.         "layer" "s" clay ""
  60.         "color" (if (= "BYLAYER" ccol) ccol (atoi ccol))
  61.         "elev" cele ""
  62.     )
  63.     (setvar "BLIPMODE" cblp)
  64.     (setvar "GRIDMODE" cgri)
  65.         (setvar "ORTHOMODE" cort)
  66.         (setvar "THICKNESS" cthk)
  67.         (setvar "SNAPANG" csnp)
  68.         (setvar "SNAPMODE" cspm)
  69.         (setvar "OSMODE" cosp)
  70.         (princ)
  71. )
  72.  
  73.  
  74. ; EDITTEXT command - rudimentary text editor
  75.  
  76. (defun C:EDITTEXT (/ p l n e os as ns st s nsl osl sl si chf chm cont)
  77.    (setq chm 0 p (ssget))            ; Select objects
  78.    (if p (progn                      ; If any objects selected
  79.       (setq cont t)
  80.       (while cont
  81.          (setq osl (strlen (setq os (getstring "\nOld string: " t))))
  82.          (if (= osl 0)
  83.             (princ "Null input invalid")
  84.             (setq cont nil)
  85.          )
  86.       )
  87.       (setq nsl (strlen (setq ns (getstring "\nNew string: " t))))
  88.       (setq l 0 n (sslength p))
  89.       (while (< l n)                 ; For each selected object...
  90.          (if (= "TEXT"               ; Look for TEXT entity type (group 0)
  91.                 (cdr (assoc 0 (setq e (entget (ssname p l))))))
  92.             (progn
  93.                (setq chf nil si 1)
  94.                (setq s (cdr (setq as (assoc 1 e))))
  95.                (while (= osl (setq sl (strlen
  96.                              (setq st (substr s si osl)))))
  97.                   (if (= st os)
  98.                       (progn
  99.                         (setq s (strcat (substr s 1 (1- si)) ns
  100.                                         (substr s (+ si osl))))
  101.                         (setq chf t)    ; Found old string
  102.                         (setq si (+ si nsl))
  103.                       )
  104.                       (setq si (1+ si))
  105.                   )
  106.                )
  107.                (if chf (progn        ; Substitute new string for old
  108.                   (setq e (subst (cons 1 s) as e))
  109.                   (entmod e)         ; Modify the TEXT entity
  110.                   (setq chm (1+ chm))
  111.                ))
  112.             )
  113.          )
  114.          (setq l (1+ l))
  115.       )
  116.    ))
  117.    (princ "Changed ")                ; Print total lines changed
  118.    (princ chm)
  119.    (princ " text lines.")
  120.    (terpri)
  121. )
  122.  
  123.  
  124. ;---------------------------------------------------------------------
  125. ;CURVE LETTERING
  126. ;---------------------------------------------------------------------
  127.  
  128. (defun C:CURVETEXT ()  
  129.     (setvar "CMDECHO" 0)
  130.     (getdata)
  131.     (firstletter)
  132.     (continueletters)
  133. )
  134.  
  135. (defun GETDATA ()
  136.    (graphscr)
  137.    (setq point (getpoint "Show start of curve text: "))
  138.    (TERPRI)
  139.    (setq center (getpoint "Where is the center of the arc: "))
  140.    (TERPRI)
  141.    (setq radius (distance center point))
  142.    (setq circum (* pi 2))
  143.    (setq circum (* circum radius))
  144.    (command "circle" center radius)
  145.    (setq height (getdist point "Enter text height: "))
  146.    (setq space height)
  147.    (setq direction (getint "Enter 1 for CW lettering, 0 for CCW: "))
  148.    (if (= direction 1)
  149.                 (setq perp (/ pi 1.921))    
  150.                 (setq perp (* 1.47 pi)))
  151. ;   (command "osnap" "near")
  152. ;   (setq space (getdist point "How far from 1st to 2nd letter?: "))
  153.    (setq numper (/ circum space))
  154.    (setq anglea (/ 360 numper))
  155.    (setq anglea (/ anglea r-d))
  156.    (if (= direction 1)
  157.                 (setq anglea anglea)    
  158.                 (setq anglea (- 0 anglea)))
  159.    (command "erase" "l" "")
  160.    (setq text (getstring T "Enter text: "))
  161. ;   (command "osnap" "none")
  162. )  
  163.  
  164. (defun FIRSTLETTER ()
  165.    (setq i 1)
  166.    (setq angle1 (angle center point))
  167.                              ;find angle from center to point
  168.    (setq point2 (polar point (- angle1 perp) space))
  169.                              ;turn 90 degrees clockwise if point is above cntr
  170.                              ;else turn 270 degrees clockwise
  171.                              ;go along that line inter-character spacing
  172.    (setq delta anglea)
  173.                              ;measure the angular difference between the chars
  174.    (setq textangle (* r-d (angle point point2)))
  175.    (setq blipmode (getvar "BLIPMODE"))
  176.    (setvar "BLIPMODE" 0)
  177.    (command "text" "c" point height textangle (substr text i 1))
  178. )
  179.  
  180. (defun CONTINUELETTERS ()
  181.    (setq i (1+ i))
  182.    (setq point point2)
  183.    (setq textangle (- textangle (* r-d delta)))
  184.    (setq angle1 (- angle1 delta))
  185.    (setq point2 (polar point (- angle1 perp) space))
  186.    (command "text" "c" point height textangle (substr text i 1))
  187.    (if (< i (strlen text)) (continueletters))
  188.    (setvar "BLIPMODE" blipmode)
  189.  
  190. )
  191.  
  192. (setq r-d 57.29577951)
  193. (setq d90 (/ pi 2))
  194. (setq d180 pi)
  195. (setq d270 (* 1.5 pi))
  196.  
  197.  
  198. ;-------------------------------------------------------------------------
  199. ; PURGE TEXT  (remove control characters, etc.)
  200. ;-------------------------------------------------------------------------
  201. (defun purgetext (text)
  202.   (setq length (strlen text))
  203.   (setq new "")
  204.   (setq n 0)
  205.   (repeat length
  206.      (setq n (1+ n))
  207.      (setq character (substr text n 1))
  208.      (if (< (ascii character) 32) (setq character ""))
  209.      (if (> (ascii character) 126) (setq character ""))
  210.      (setq new (strcat new character))
  211.   )
  212.   (setq text new)
  213. )
  214.  
  215.  
  216.  
  217. ; modify various aspects of a selection set of text entities
  218.  
  219. (defun C:MODTXT ()
  220.     (setvar "CMDECHO" 0)
  221.     (command "UNDO" "M")
  222.     (setq old (ssget))
  223.     (initget 1 "Change Height Width Oblique Rotation Style")
  224.     (setq typ (getkword "\nChange: Height/Width/Oblique/Rotation/Style? "))
  225.     (setq
  226.         co -1
  227.         t2 "T"
  228.     )
  229.     (cond
  230.         ((= "Height" typ)
  231.             (setq
  232.                 x 40
  233.                 ht (getdist "\nNew height: ")
  234.             )
  235.         )
  236.         ((= "Oblique" typ)
  237.             (setq
  238.                 x 51
  239.                 ht (* pi (/ (getreal "\nNew obliquing angle: ") 180.0))
  240.             )
  241.         )
  242.         ((= "Rotation" typ)
  243.             (setq
  244.                 x 50
  245.                 ht (* pi (/ (getreal "\nNew rotation angle: ") 180.0))
  246.             )
  247.         )
  248.         ((= "Width" typ)
  249.             (setq
  250.                 x 41
  251.                 ht (getreal "\nNew width: ")
  252.             )
  253.         )
  254.         ((= "Style" typ)
  255.             (setq
  256.                 x 7
  257.                 ht (getstring "\nNew style: ")
  258.             )
  259.         )
  260.     )
  261.     (while (boundp 't2)
  262.         (progn
  263.         (setq  
  264.             co (1+ co)
  265.             temp (entget (ssname old co))
  266.             oldht (assoc x temp)
  267.             newht (cons x ht)
  268.             newtext (subst newht oldht temp)
  269.             t2 (ssname old (1+ co))
  270.         )
  271.         (entmod newtext)
  272.         )
  273.     )
  274.     (princ "\nModTxt complete.")
  275.     (princ)
  276. )
  277.  
  278.  
  279.  
  280.  
  281. ; BOLDTEXT
  282. ; 5/24/86
  283. ; LANDCADD, INC.
  284.  
  285. (defun c:boldtext ()
  286.    (enter)
  287.    (setvar "BLIPMODE" 1)
  288.    (ptsize)
  289.    (setvar "BLIPMODE" 0)
  290.    (replicate)
  291.    (leave)
  292.    (princ)
  293. )
  294.  
  295. (defun ptsize ()
  296.    (setq i 0)
  297.    (setq points (getreal "\nSelect point size of text from menu: "))
  298.    (setq scale (getreal "\nSelect final plotting scale from menu: "))
  299.    (setq size (* scale points))
  300.    (if (= tunt 2) (setq size (* size 0.083333333)))
  301.    (graphscr)
  302.    (setq st (getpoint "\nShow starting point for text: "))
  303.    (setvar "LASTPOINT" st)
  304.    (setq displace (/ size 40))
  305.    (setq num (getint "\nEnter a boldness factor: "))
  306.    (setq rot (getangle st "\nRotation angle? <0>"))
  307.    (if (= rot nil) (setq rot 0))
  308.    (setq rot2 (* rot 57.29577951))
  309.    (setq verbage (getstring T "\nText: "))
  310.    (setq st1 st)
  311. )
  312.  
  313. (defun replicate ()
  314.    (setq i (+ i 1))
  315.    (command "text" st1 size rot2 verbage)
  316.    (setq st1 (polar st rot displace))
  317.    (setq st st1)
  318.    (if (< i num) (replicate))
  319. )
  320.  
  321.  
  322. ; Routine to type in a text string and insert block letters.
  323.  
  324. (defun C:LETTERING ()
  325.     (enter)
  326.     (getlet)
  327.     (firstlet)
  328.     (continuelet)
  329.     (leave)
  330.     (princ)
  331. )
  332.  
  333. (defun GETLET ()
  334.    (graphscr)
  335.    (setq sd (getstring "Enter the directory with the text blocks <BLOCKS>: "))
  336.    (if (= sd "") (setq sd "BLOCKS"))
  337.    (TERPRI)
  338.    (setq r-d 57.29577951)
  339.    (setq point (getpoint "Show start of text: "))
  340.    (TERPRI)
  341.    (setq textangle (getangle point "Show rotation angle: "))
  342.    (setq insangle (* r-d textangle))
  343.    (setq space (getdist point "How far from 1st to 2nd letter?: "))
  344.    (setq text (getstring T "Enter text: "))
  345. )  
  346.  
  347. (defun FIRSTLET ()
  348.    (setq i 1)
  349.    (setq letter (substr text i 1))
  350.    (setq blk (strcat "/" sd "/" letter))
  351.    (command "insert" blk point xs ys insangle)
  352.    (setq point2 (polar point textangle space))
  353. )
  354.  
  355. (defun CONTINUELET ()
  356.    (setq i (1+ i))
  357.    (setq point point2)
  358.    (setq point2 (polar point textangle space))
  359.    (setq letter (substr text i 1))
  360.    (setq blk (strcat "/" sd "/" letter))
  361.    (if (= letter " ")
  362.       (setq point (polar point2 textangle space))
  363.       (command "insert" blk point xs ys insangle)
  364.    )
  365.    (if (< i (strlen text)) (continuelet))
  366. )
  367.  
  368.  
  369. ; BUST TEXT.LSP
  370. ; Break a text string
  371.  
  372. (defun c:busttext ()
  373.   (setvar "CMDECHO" 0)
  374.   (setq r-d (/ 360 pi 2))
  375.   (setq a (ssget))
  376.   (setq brk (getstring "Break after what word? "))
  377.   (setq b (ssname a 0))
  378.   (setq c (entget b))
  379.   (setq txts (assoc '1. c))
  380.   (setq tht (assoc '40. c))
  381.   (setq ht (cdr tht))
  382.   (setq rot (assoc '50. c))
  383.   (setq rang (cdr rot))
  384.   (setq rang (* rang r-d))
  385.   (setq f (cdr txts))
  386.   (setq g (substr f 1))
  387.   (setq LB (strlen brk))
  388.   (setq LG (strlen g))
  389.   (setq x 0)
  390.   (tryit)
  391. )
  392.  
  393. (defun tryit ()
  394. ; G is the total text string, with length lg
  395. ; brk is the word (substring) to break after, with length lb
  396. ; x = beginning point of substring in g
  397.   (setq x (+ 1 x))
  398.   (setq test (substr g x lb))
  399.   (if (= test brk) (contt) (tryit))
  400. )
  401.  
  402. (defun contt ()
  403.   (setq xx (+ x lb))
  404.   (setq fl (substr g 1 xx))
  405.   (setq yy (+ 1 xx))
  406.   (setq sl (substr g yy lg))
  407.   (COMMAND "CHANGE" "p" "" "" "" "" "" "" fl)
  408.   (TERPRI)
  409.   (setq pt (getpoint "Show starting point of remaining text: "))
  410.   (command "TEXT" pt ht rang sl)
  411.   (SETVAR "CMDECHO" 1)
  412. )
  413.  
  414.  
  415. (defun C:EXPLTEXT ()
  416.    (enter)
  417.       (COMMAND "STYLE" "MONO" "MONOTXT" "0" "1" "0" "N" "N" "N")
  418.       (SETQ R-D (/ 360 PI 2 ) )
  419.       (SETQ A (SSGET ) )
  420.       (SETQ B (SSNAME A 0 ) )
  421.       (SETQ C (ENTGET B ) )
  422.       (SETQ TXTS (ASSOC (QUOTE 1.000000 ) C ) )
  423.       (SETQ THT (ASSOC (QUOTE 40.000000 ) C ) )
  424.       (SETQ PT1 (ASSOC (QUOTE 10.000000 ) C ) )
  425.       (SETQ PT (CDR PT1 ) )
  426.       (SETQ HT (CDR THT ) )
  427.       (SETQ ROT (ASSOC (QUOTE 50.000000 ) C ) )
  428.       (SETQ ANG (CDR ROT ) )
  429.       (SETQ RANG (* ANG R-D ) )
  430.       (SETQ F (CDR TXTS ) )
  431.       (SETQ G (SUBSTR F 1 ) )
  432.       (SETQ LG (STRLEN G ) )
  433.       (SETQ X 0 )
  434.       (SETQ ST1 (GETSTRING "STYLE to use for exploded text <MONO> " ) )
  435.       (IF (= ST1 "" )
  436.          (SETQ ST1 "mono" ) )
  437.       (COMMAND "erase" "p" "" )
  438.       (GOFORIT)
  439.       (leave)
  440.       (princ)
  441. )
  442.  
  443.  
  444. (defun goforit ()
  445.       (SETQ X (+ 1 X ) )
  446.       (SETQ TEST (SUBSTR G X 1 ) )
  447.       (TERPRI )
  448.       (COMMAND "text" "s" ST1 PT HT RANG TEST )
  449.       (SETQ PT (POLAR PT ANG HT ) )
  450.       (IF (< X LG ) (goforit))
  451. )
  452.  
  453.  
  454. (defun C:DRAWTEXT ()
  455. ;Imports ASCII text files
  456.     (enter)
  457.     (setq r-d (/ 360 pi 2))
  458.     (setq txtype "L")
  459.     (setq pt "L")
  460.     (getfn)
  461.     (leave)
  462. ) ; end function
  463.  
  464. (defun getfn ()
  465.     (initget 1)
  466.     (setq fname (getstring "\nName of ASCII text file to insert: "))
  467.     (if (= fname "") (setq fname pname))
  468.     (setq pname fname)
  469.     (setq va (open fname "r"))
  470.     (if (/= va nil)
  471.         (fa)
  472.         (progn
  473.            (princ "File not found - try again\007\n")
  474.            (getfn)
  475.         )
  476.     ) ; end if
  477. )
  478.  
  479.  
  480. (defun FA ()
  481. ; va = filename
  482. ; vb = text string
  483. ; vc = style
  484. ; ve = control point
  485. ; vf = height
  486. ; vg = angle (radians)
  487.  
  488.     (terpri)
  489.     (setq vb (read-line va))
  490.     (findsty)
  491.     (setq tsl (strlen vb))
  492.     (graphscr)
  493.     (setvar "BLIPMODE" 1)
  494.  
  495.  
  496.       ;Prompt for start point or justification
  497.       (initget 1 "Align Center Fit Middle Right")
  498.       (setq ve (getpoint
  499.                  "\nStart point or Align/Center/Fit/Middle/Right: "
  500.                )
  501.       )
  502.       (if (/= (type ve) 'LIST)
  503.           (setq txtype (substr ve 1 1))
  504.           (setq txtype "L")
  505.       )
  506.  
  507.     (if (= txtype "C") (setq ve (getpoint "\nCenter point: ")))
  508.     (if (= txtype "M") (setq ve (getpoint "\nMiddle point: ")))
  509.     (if (= txtype "F") (setq ve (getpoint "\nStarting point: ")))
  510.     (if (= txtype "F") (setq rpt (getpoint ve "Second point: ")))
  511.     (if (= txtype "R") (setq ve (getpoint "\nEnding point: ")))
  512.     (if (= txtype "A")
  513.        (progn
  514.         (setq
  515.             ve (getpoint "\nStarting point: ")
  516.             rpt (getpoint ve "Second point: ")
  517.             d1 (distance ve rpt)
  518.             vf (/ d1 tsl)
  519.         );end setq
  520.        );end progn
  521.     );end if
  522.  
  523.     (setq vf (getdist ve
  524.            (strcat "\nHeight <"
  525.             (rtos
  526.                 (getvar "TEXTSIZE")
  527.                 (getvar "LUNITS")
  528.                 (getvar "LUPREC")
  529.             )
  530.             ">: ")
  531.            )
  532.     )
  533.     (if (= vf nil) (setq vf (getvar "TEXTSIZE")))
  534.     (if (= txtype "L") (setq vg (getangle ve "\nRotation Angle <0>: ")))
  535.     (if (= txtype "C") (setq vg (getangle ve "\nRotation Angle <0>: ")))
  536.     (if (= txtype "M") (setq vg (getangle ve "\nRotation Angle <0>: ")))
  537.     (if (= txtype "R") (setq vg (getangle ve "\nRotation Angle <0>: ")))
  538.     (if (= txtype "A") (setq vg (angle ve rpt)))
  539.     (if (= txtype "F") (setq vg (angle ve rpt)))
  540.     (if (or (= vg nil) (= vg "")) (setq vg 0.0))
  541.     (terpri)
  542.     (setq ta (* vg r-d))
  543.     (setvar "BLIPMODE" 0)
  544.     (command) (command)
  545.     (if (= txtype "L") (command "TEXT" "S" vc ve vf ta vb))
  546.     (if (= txtype "R") (command "TEXT" "S" vc txtype ve vf ta vb))
  547.     (if (= txtype "C") (command "TEXT" "S" vc txtype ve vf ta vb))
  548.     (if (= txtype "M") (command "TEXT" "S" vc txtype ve vf ta vb))
  549.     (if (= txtype "A") (command "TEXT" "S" vc txtype ve rpt vb))
  550.     (if (= txtype "F") (command "TEXT" "S" vc txtype ve rpt vf vb))
  551.     (while (/= vb nil)
  552.        (setq ve (polar ve (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf )))
  553.        (if (= txtype "A") (setq rpt (polar rpt (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf ))))
  554.        (if (= txtype "F") (setq rpt (polar rpt (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf ))))
  555.        (setq vb (read-line va))
  556.        (terpri)
  557.             (if (= txtype "L") (command "TEXT" ve vf ta vb))
  558.             (if (= txtype "R") (command "TEXT" txtype ve vf ta vb))
  559.             (if (= txtype "C") (command "TEXT" txtype ve vf ta vb))
  560.             (if (= txtype "M") (command "TEXT" txtype ve vf ta vb))
  561.             (if (= txtype "A") (command "TEXT" txtype ve rpt vb))
  562.             (if (= txtype "F") (command "TEXT" txtype ve rpt vf vb))
  563.     )
  564.     (close va)
  565. )
  566.  
  567.  
  568. (defun findsty ()
  569.     (setq tsty (getvar "TEXTSTYLE"))
  570.     (princ "\nStyle name <") (princ tsty)
  571.     (setq vc (getstring ">: "))
  572.     (if (= vc "") (setq vc tsty))
  573.     (command "TEXT" "S" vc) (command)
  574.         ;Check for a variable text height
  575.         (setq ts (tblsearch "STYLE" (getvar "TEXTSTYLE")))
  576.         (if (/= (cdr (assoc 40 ts)) 0.0)
  577.        (progn
  578.           (princ "\007")
  579.           (princ "\n* Invalid * style must contain a variable text height; i.e. = 0")
  580.           (findsty)
  581.        )
  582.     )
  583.     (command)
  584. )
  585.  
  586. ;(defun *error* (st)
  587. ;   (prompt (strcat "error: " st "\007\n"))
  588. ;)
  589.  
  590.  
  591. (defun c:casechg ()
  592.    (SETVAR "CMDECHO" 0)
  593.    (TERPRI)
  594.    (SETQ R-D (/ 360 PI 2))
  595.    (SETQ A (SSGET))
  596.    (INITGET 1 "Upper Lower")
  597.    (SETQ W (GETKWORD "Change to Upper/Lower case? " ) )
  598.    (SETQ X -1 )
  599.    (SETQ TOT (SSLENGTH A))
  600.    (SETQ TOT (- TOT 1))
  601.    (IF (= W "Lower")
  602.       (LOWER)
  603.       (UPPER))
  604.    (princ)
  605. )
  606.  
  607. (defun lower ()
  608.       (SETQ X (+ 1 X))
  609.       (nextstring)
  610.       (SETQ G (STRCASE G "T"))
  611.       (COMMAND "CHANGE" B "" "" "" "" "" "" G)
  612.       (IF (< X TOT ) (LOWER))
  613. )
  614.  
  615. (defun upper ()
  616.          (SETQ X (+ 1 X))
  617.      (nextstring)
  618.          (SETQ G (STRCASE G))
  619.          (COMMAND "CHANGE" B "" "" "" "" "" "" G)
  620.          (IF (< X TOT ) (upper))
  621. )
  622.  
  623. (defun nextstring ()
  624.       (SETQ B (SSNAME A X))
  625.       (SETQ C (ENTGET B))
  626.       (SETQ TXTS (ASSOC (QUOTE 1.000000 ) C))
  627.       (SETQ THT (ASSOC (QUOTE 40.000000 ) C))
  628.       (SETQ HT (CDR THT))
  629.       (SETQ ROT (ASSOC (QUOTE 50.000000 ) C))
  630.       (SETQ RANG (CDR ROT))
  631.       (SETQ RANG (* RANG R-D))
  632.       (SETQ F (CDR TXTS))
  633.       (SETQ G (SUBSTR F 1))
  634. )
  635.  
  636. (princ)
  637.  
  638. (defun C:EZEDIT()
  639.     (enter)
  640.     (prompt "\nSelect a group of text to edit: ")
  641.     (setq ss (ssget))
  642. ; write text entites to a temporary file...temp.ez
  643.     (setq va (open "temp.ez" "w"))
  644.     (setq x (sslength ss))
  645.     (setq x (- x 1))
  646.     (setq b (ssname ss x))
  647.     (setq c (entget b))
  648.     (setq txts (assoc (quote 1.000000 ) c))
  649.     (setq f (cdr txts))   ; the actual text string
  650.     (setq tht (assoc (quote 40.000000 ) c))
  651.     (setq ht (cdr tht))   ; the text height
  652.     (setq rot (assoc (quote 50.000000 ) c))
  653.     (setq rang (cdr rot)) ; rotation angle in radians
  654.     (setq r-d 57.29577951)
  655.     (setq rang (* rang r-d))  ; rot ang converted to degrees
  656.     (setq xypt (assoc (quote 10.000000 ) c))
  657.     (setq xypt (cdr xypt)) ; insertion point
  658.     (setq tstyl (assoc (quote 7.000000 ) c))
  659.     (setq tstyl (cdr tstyl)) ; text style
  660.     (princ f va)
  661.     (while (> x 0)
  662.         (princ "\n" va)
  663.         (setq x (- x 1))
  664.         (setq b (ssname ss x))
  665.         (setq c (entget b))
  666.         (setq txts (assoc (quote 1.000000 ) c))
  667.         (setq f (cdr txts))   ; the actual text string
  668.         (princ f va)
  669.     )
  670.     (princ "\n" va)
  671.     (close va)
  672. ; call your favorite text editor through the shell
  673.     (command "EZED" "temp.ez")
  674. ; erase previous text entities from your drawing
  675.     (command "erase" "p" "")
  676. ; insert modified text file
  677.     (setq fp (open "temp.ez" "r"))
  678.     (setq txts (read-line fp))
  679.     (command "TEXT" "S" tstyl xypt ht rang txts)
  680.     (while (/= txts nil)
  681.        ;(setq ve (polar ve (+ vg (* 1.5 pi)) (* (/ 5.0 3.0) vf )))
  682.        (setq txts (read-line fp))
  683.        (command "TEXT" "" txts)
  684.     )
  685.     (close fp)
  686.  
  687.     (leave)
  688.     (princ)
  689. )
  690.  
  691.  
  692. (princ "Loaded: TEXT UTILITIES @ 1986 LANDCADD, INC.")
  693. (princ)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!