home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p024 / 6.img / BONUS1.LIB / CHTEXT.LSP < prev    next >
Encoding:
Text File  |  1993-02-09  |  22.5 KB  |  755 lines
  1. ;;;   CHTEXT.lsp
  2. ;;;   (C) ¬⌐┼v 1988-1992  Autodesk ñ╜Ñq
  3. ;;;
  4. ;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
  5. ;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
  6. ;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
  7. ;;;
  8. ;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
  9. ;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
  10. ;;;
  11. ;;;
  12. ;;;
  13. ;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
  14. ;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
  15. ;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
  16. ;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
  17. ;;;
  18. ;;;
  19. ;;;   by Jan S. Yoder
  20. ;;;   09 March  1990
  21. ;;;
  22. ;;;   REVISIONS
  23. ;;;   1.01  22 May 1991  DTP -- Minor bug fixes.
  24. ;;;   1.02  18 June 1991  JSY, DTP -- Minor bug fixes.
  25. ;;;
  26. ;;;--------------------------------------------------------------------------;
  27. ;;; DESCRIPTION
  28. ;;;   This is a "text processor" which operates in a global manner
  29. ;;;   on all of the text entities that the user selects; i.e., the
  30. ;;;   Height, Justification, Location, Rotation, Style, Text, and
  31. ;;;   Width can all be changed globally or individually, and the
  32. ;;;   range of values for a given parameter can be listed.
  33. ;;;
  34. ;;;   The command is called with CHT from the command line at which
  35. ;;;   time the user is asked to select the objects to change.
  36. ;;;
  37. ;;;     Select text to change.
  38. ;;;     Select objects:
  39. ;;;
  40. ;;;   If nothing is selected the message "ERROR: Nothing selected."
  41. ;;;   is displayed and the command is terminated.  If more than 25
  42. ;;;   entities are selected the following message is displayed while
  43. ;;;   the text entities are sorted out from the non-text entities.
  44. ;;;   A count of the text entities found is then displayed.
  45. ;;;
  46. ;;;     Verifying the selected entities -- please wait.
  47. ;;;     nnn  text entities found.
  48. ;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width:
  49. ;;;
  50. ;;;   A typical example of the prompts you may encounter follows:
  51. ;;;
  52. ;;;   If you select a single text entity to change and ask to change
  53. ;;;   the height, the prompt looks like this:
  54. ;;;
  55. ;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width:
  56. ;;;     New text height for text entity. <0.08750000>:
  57. ;;;
  58. ;;;   If you select more than one text entity to change and ask to change
  59. ;;;   the height, the prompt looks like this:
  60. ;;;
  61. ;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width:
  62. ;;;     Individual/List/<New height for all entities>:
  63. ;;;
  64. ;;;   Typing "L" at this prompt returns a prompt showing you the range of
  65. ;;;   values that you are using for your text.
  66. ;;;
  67. ;;;     Height -- Min: 0.05000000  Max: 0.10000000  Ave: 0.08392857
  68. ;;;
  69. ;;;   Typing "I" at this prompt puts you in a loop, processing the text
  70. ;;;   entities you have selected one at a time, and giving the same prompt
  71. ;;;   you get for a single text entity shown above.
  72. ;;;
  73. ;;;   Pressing RETURN at this point puts you back at the Command: prompt.
  74. ;;;   Selecting any of the other options allows you to change the text
  75. ;;;   entities selected.
  76. ;;;
  77. ;;;   All of the Release 11 text alignment options have been supported.
  78. ;;;   This is based on the system variable "DIMCLRD" being present.
  79. ;;;   If it is not present, then only the  Release 10 alignment options
  80. ;;;   are allowed.
  81. ;;;
  82. ;;;---------------------------------------------------------------------------;
  83. ;;;
  84. ;;; Main function -- no arguments
  85. ;;;
  86. (defun chtxt (/ sset opt ssl nsset temp unctr ct_ver cht_er cht_oe
  87.                 sslen style hgt rot txt ent cht_oc cht_ot cht_oh
  88.                 loc loc1 justp justq orthom )
  89.  
  90.   (setq ct_ver "1.02")                ; Reset this local if you make a change.
  91.   ;;
  92.   ;; Internal error handler defined locally
  93.   ;;
  94.   (defun cht_er (s)                   ; If an error (such as CTRL-C) occurs
  95.                                       ; while this command is active...
  96.     (if (/= s "Function cancelled")
  97.       (if (= s "quit / exit abort")
  98.         (princ)
  99.         (princ (strcat "\n┐∙╗~: " s))
  100.       )
  101.     )
  102.     (eval(read U:E))
  103.     (if cht_oe                        ; If an old error routine exists
  104.       (setq *error* cht_oe)           ; then, reset it
  105.     )
  106.     (if temp (redraw temp 1))
  107.     (if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing
  108.     (if cht_ot (setvar "texteval" cht_ot))
  109.     (if cht_oh (setvar "highlight" cht_oh))
  110.     (princ)
  111.   )
  112.   ;;
  113.   ;; Body of function
  114.   ;;
  115.   (if *error*                         ; Set our new error handler
  116.     (setq cht_oe *error* *error* cht_er)
  117.     (setq *error* cht_er)
  118.   )
  119.  
  120.   ;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E))
  121.   (setq U:G "(command \"undo\" \"group\")"
  122.         U:E "(command \"undo\" \"en\")"
  123.   )
  124.  
  125.   (setq cht_oc (getvar "cmdecho"))
  126.   (setq cht_oh (getvar "highlight"))
  127.   (setvar "cmdecho" 0)
  128.  
  129.   (eval(read U:G))
  130.  
  131.   (princ (strcat "\níuº≤¡╫ñσªrív ¬⌐Ñ╗ " ct_ver
  132.                  ", (c) 1990-1991 Autodesk ñ╜ÑqíC"))
  133.   (prompt "\n┐∩╛▄╣w│╞º≤¡╫¬║ñσªríC")
  134.   (setq sset (ssget))
  135.   (if (null sset)
  136.     (progn
  137.       (princ "\n┐∙╗~: Ñ╝┐∩¿∞íuñσªrívíC")
  138.       (exit)
  139.     )
  140.   )
  141.   ;; Verify the entity set.
  142.   (cht_ve)
  143.   ;; This is the main option loop.
  144.   (cht_ol)
  145.  
  146.   (if cht_oe (setq *error* cht_oe))   ; Reset old error function if error
  147.   (eval(read U:E))
  148.   (if cht_ot (setvar "texteval" cht_ot))
  149.   (if cht_oh (setvar "highlight" cht_oh))
  150.   (if cht_oc (setvar "cmdecho" cht_oc)) ; Reset command echoing
  151.   (princ)
  152. )
  153. ;;;
  154. ;;; Verify and sort out non-text entities from the selection set.
  155. ;;;
  156. (defun cht_ve ()
  157.   (setq ssl   (sslength sset)
  158.         nsset (ssadd))
  159.   (if (> ssl 25)
  160.     (princ "\n╣∩┐∩⌐w¬║╣╧ñ╕╢iªµíu╜T╗{ív-- ╜╨╡y¡╘íC")
  161.   )
  162.   (while (> ssl 0)
  163.     (setq temp (ssname sset (setq ssl (1- ssl))))
  164.     (if (= (cdr(assoc 0 (entget temp))) "TEXT")
  165.       (ssadd temp nsset)
  166.     )
  167.   )
  168.   (setq ssl (sslength nsset)
  169.         sset nsset
  170.         unctr 0
  171.   )
  172.   (princ "ºΣ¿∞ ")
  173.   (princ ssl)
  174.   (princ " ¡╙íuñσªrív╣╧ñ╕íC")
  175. )
  176. ;;;
  177. ;;; The option loop.
  178. ;;;
  179. (defun cht_ol ()
  180.   (setq opt T)
  181.   (while (and opt (> ssl 0))
  182.     (setq unctr (1+ unctr))
  183.     (command "_.UNDO" "_GROUP")
  184.     (initget "Location Justification Style Height Rotation Width Text Undo")
  185.     (setq opt (getkword
  186.       "\nHªr░¬/J╜╒╗⌠/Lª∞╕m/R▒█┬α/Sªr½¼/Tñσªr/U░hª^/W╝e½╫: "))
  187.     (if opt
  188.       (cond
  189.         ((= opt "Undo")
  190.           (cht_ue)                    ; Undo the previous command.
  191.         )
  192.         ((= opt "Location")
  193.           (cht_le)                    ; Change the location.
  194.         )
  195.         ((= opt "Justification")
  196.           (cht_je)                    ; Change the justification.
  197.         )
  198.         ((= opt "Style")    (cht_pe "Style"    "ªr½¼ªW║┘"      7) )
  199.         ((= opt "Height")   (cht_pe "Height"   "ªr░¬"         40) )
  200.         ((= opt "Rotation") (cht_pe "Rotation" "▒█┬α¿ñ"       50) )
  201.         ((= opt "Width")    (cht_pe "Width"    "╝e½╫½Y╝╞"     41) )
  202.         ((= opt "Text")
  203.           (cht_te)                    ; Change the text.
  204.         )
  205.       )
  206.       (setq opt nil)
  207.     )
  208.     (command "_.UNDO" "_END")
  209.   )
  210. )
  211. ;;;
  212. ;;; Undo an entry.
  213. ;;;
  214. (defun cht_ue ()
  215.   (if (> unctr 1)
  216.     (progn
  217.       (command "_.UNDO" "_END")
  218.       (command "_.UNDO" "2")
  219.       (setq unctr (- unctr 2))
  220.     )
  221.     (progn
  222.       (princ "\nñw¿Sª│ñ░╗≥Ñiíu░hª^ívñFíC")
  223.       (setq unctr (- unctr 1))
  224.     )
  225.   )
  226. )
  227. ;;;
  228. ;;; Change the location of an entry.
  229. ;;;
  230. (defun cht_le ()
  231.   (setq sslen (sslength sset)
  232.         style ""
  233.         hgt   ""
  234.         rot   ""
  235.         txt   ""
  236.   )
  237.   (command "_.CHANGE" sset "" "")
  238.   (while (> sslen 0)
  239.     (setq ent (entget(ssname sset (setq sslen (1- sslen))))
  240.           opt (list (cadr (assoc 11 ent))
  241.                     (caddr (assoc 11 ent))
  242.                     (cadddr (assoc 11 ent)))
  243.     )
  244.     (prompt "\nñσªr¬║íu╖sª∞╕mív: ")
  245.     (command pause)
  246.     (if (null loc)
  247.       (setq loc opt)
  248.     )
  249.     (command style hgt rot txt)
  250.   )
  251.   (command)
  252. )
  253. ;;;
  254. ;;; Change the justification of an entry.
  255. ;;;
  256. (defun cht_je ()
  257.   (if (getvar "DIMCLRD")
  258.     (initget (strcat "TLeft TCenter TRight "
  259.                      "MLeft MCenter MRight "
  260.                      "BLeft BCenter BRight "
  261.                      "Aligned Center Fit Left Middle Right ?"))
  262.     (initget "Aligned Center Fit Left Middle Right ?")
  263.   )
  264.   (setq sslen (sslength sset))
  265.   (setq justp (getkword (strcat "\n╜╒╗⌠┬I - "
  266.               "A╣∩╗⌠/Cññ/F╢±╗⌠/LѬ/MÑ┐ññ/RÑk/<?>: ")))
  267.   (cond
  268.     ((= justp "Left")    (setq justp 0 justq 0) )
  269.     ((= justp "Center")  (setq justp 1 justq 0) )
  270.     ((= justp "Right")   (setq justp 2 justq 0) )
  271.     ((= justp "Aligned") (setq justp 3 justq 0) )
  272.     ((= justp "Fit")     (setq justp 5 justq 0) )
  273.     ((= justp "TLeft")   (setq justp 0 justq 3) )
  274.     ((= justp "TCenter") (setq justp 1 justq 3) )
  275.     ((= justp "TRight")  (setq justp 2 justq 3) )
  276.     ((= justp "MLeft")   (setq justp 0 justq 2) )
  277.     ((= justp "Middle")  (setq justp 4 justq 0) )
  278.     ((= justp "MCenter") (setq justp 1 justq 2) )
  279.     ((= justp "MRight")  (setq justp 2 justq 2) )
  280.     ((= justp "BLeft")   (setq justp 0 justq 1) )
  281.     ((= justp "BCenter") (setq justp 1 justq 1) )
  282.     ((= justp "BRight")  (setq justp 2 justq 1) )
  283.     ((= justp "?")       (setq justp nil)       )
  284.     (T                   (setq justp nil)       )
  285.   )
  286.   (if justp
  287.     (justpt) ; Process them...
  288.     (justpn) ; List options...
  289.   )
  290.   (command)
  291. )
  292. ;;;
  293. ;;; Get alignment points for "aligned" or "fit" text.
  294. ;;;
  295. (defun justpt ()
  296.   (while (> sslen 0)
  297.     (setq ent (entget(ssname sset (setq sslen (1- sslen))))
  298.           ent (subst (cons 72 justp) (assoc 72 ent) ent)
  299.           opt (trans (list (cadr (assoc 11 ent))
  300.                            (caddr (assoc 11 ent))
  301.                            (cadddr (assoc 11 ent)))
  302.                      (cdr(assoc -1 ent)) ; from ECS
  303.                      1)               ; to current UCS
  304.     )
  305.     (if (getvar "DIMCLRD")
  306.       (setq ent (subst (cons 73 justq) (assoc 73 ent) ent))
  307.     )
  308.     (cond
  309.       ((or (= justp 3) (= justp 5))
  310.         (prompt "\nñσªr¬║íu╖s╣∩╗⌠┬Iív: ")
  311.         (if (= (setq orthom (getvar "orthomode")) 1)
  312.           (setvar "orthomode" 0)
  313.         )
  314.         (redraw (cdr(assoc -1 ent)) 3)
  315.         (initget 1)
  316.         (setq loc (getpoint))
  317.         (initget 1)
  318.         (setq loc1 (getpoint loc))
  319.         (redraw (cdr(assoc -1 ent)) 1)
  320.         (setvar "orthomode" orthom)
  321.         (setq ent (subst (cons 10 loc) (assoc 10 ent) ent))
  322.         (setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))
  323.       )
  324.       ((or (/= justp 0) (/= justq 0))
  325.         (redraw (cdr(assoc -1 ent)) 3)
  326.         (prompt "\nñσªr¬║íu╖sª∞╕mív: ")
  327.         (if (= (setq orthom (getvar "orthomode")) 1)
  328.           (setvar "orthomode" 0)
  329.         )
  330.         (setq loc (getpoint opt))
  331.         (setvar "orthomode" orthom)
  332.         (redraw (cdr(assoc -1 ent)) 1)
  333.         (if (null loc)
  334.           (setq loc opt)
  335.           (setq loc (trans loc 1 (cdr(assoc -1 ent))))
  336.         )
  337.         (setq ent (subst (cons 11 loc) (assoc 11 ent) ent))
  338.       )
  339.     )
  340.     (entmod ent)
  341.   )
  342. )
  343. ;;;
  344. ;;; List the options.
  345. ;;;
  346. (defun justpn ()
  347.   (if (getvar "DIMCLRD") (textpage))
  348.   (princ "\n╜╒╗⌠┐∩╢╡: ")
  349.   (princ "\n\t TL│╗Ѭ   TC│╗ññ   TR│╗Ñk ")
  350.   (princ "\n\t ML╕yѬ   MC╕yññ   MR╕yÑk ")
  351.   (princ "\n\t BL⌐│Ѭ   BC⌐│ññ   BR⌐│Ñk ")
  352.   (princ "\n\t  LѬ      Cññ      RÑk ")
  353.   (princ "\n\t  A╣∩╗⌠    MÑ┐ññ    F╢±╗⌠ ")
  354.   (if (not (getvar "DIMCLRD")) (textscr))
  355.   (princ "\n\n½÷Ñ⌠╖N┴ΣÑH¬≡ª^╣╧º╬╡e¡▒íC")
  356.   (grread)
  357.   (princ "\r                                           ")
  358.   (graphscr)
  359. )
  360. ;;;
  361. ;;; Change the text of an entity.
  362. ;;;
  363. (defun cht_te ()
  364.   (setq sslen (sslength sset))
  365.   (initget "Globally Individually Retype")
  366.   (setq ans (getkword
  367.     "\níu╖j┤Mívñ╬íu╕m┤½ívñσªr - I¡╙ºO/R¡½╖s┴ΣñJ/<G╛π┼Θ>:"))
  368.   (setq cht_ot (getvar "texteval"))
  369.   (setvar "texteval" 1)
  370.   (cond
  371.     ((= ans "Individually")
  372.       (if (= (getvar "popups") 1)
  373.         (progn
  374.           (initget "Yes No")
  375.           (setq ans (getkword "\n│z╣Líu╣∩╕▄«╪ív╜s┐Φñσªr? <Yes>:"))
  376.         )
  377.         (setq ans "No")
  378.       )
  379.  
  380.       (while (> sslen 0)
  381.         (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
  382.         (setq ss (ssadd))
  383.         (ssadd (ssname sset sslen) ss)
  384.         (if (= ans "No")
  385.           (chgtext ss)
  386.           (command "_.DDEDIT" sn "")
  387.         )
  388.         (redraw sn 1)
  389.       )
  390.     )
  391.     ((= ans "Retype")
  392.       (while (> sslen 0)
  393.         (setq ent (entget(ssname sset (setq sslen (1- sslen)))))
  394.         (redraw (cdr(assoc -1 ent)) 3)
  395.         (prompt (strcat "\n┬┬ñσªr: " (cdr(assoc 1 ent))))
  396.         (setq nt (getstring  T "\n╖sñσªr: "))
  397.         (redraw (cdr(assoc -1 ent)) 1)
  398.         (if (> (strlen nt) 0)
  399.           (entmod (subst (cons 1 nt) (assoc 1 ent) ent))
  400.         )
  401.       )
  402.     )
  403.     (T
  404.       (chgtext sset)                  ; Change 'em all
  405.     )
  406.   )
  407.   (setvar "texteval" cht_ot)
  408. )
  409. ;;;
  410. ;;; The old CHGTEXT command - rudimentary text editor
  411. ;;;
  412. ;;;
  413. (defun C:CHGTEXT () (chgtext nil))
  414.  
  415. (defun chgtext (objs / last_o tot_o ent o_str n_str st s_temp
  416.                        n_slen o_slen si chf chm cont ans)
  417.   (if (null objs)
  418.     (setq objs (ssget))               ; Select objects if running standalone
  419.   )
  420.   (setq chm 0)
  421.   (if objs
  422.     (progn                   ; If any objects selected
  423.       (if (= (type objs) 'ENAME)
  424.         (progn
  425.           (setq ent (entget objs))
  426.           (princ (strcat "\n▓{ª│¬║ªrªΩ: " (cdr (assoc 1 ent))))
  427.         )
  428.         (if (= (sslength objs) 1)
  429.           (progn
  430.             (setq ent (entget (ssname objs 0)))
  431.             (princ (strcat "\n▓{ª│¬║ªrªΩ: " (cdr (assoc 1 ent))))
  432.           )
  433.         )
  434.       )
  435.       (setq o_str (getstring "\n▓┼ªXªrªΩ  : " t))
  436.       (setq o_slen (strlen o_str))
  437.       (if (/= o_slen 0)
  438.         (progn
  439.           (setq n_str (getstring "\n╖sªrªΩ    : " t))
  440.           (setq n_slen (strlen n_str))
  441.           (setq last_o 0
  442.                 tot_o  (if (= (type objs) 'ENAME)
  443.                          1
  444.                          (sslength objs)
  445.                        )
  446.           )
  447.           (while (< last_o tot_o)     ; For each selected object...
  448.             (if (= "TEXT"             ; Look for TEXT entity type (group 0)
  449.                    (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
  450.               (progn
  451.                 (setq chf nil si 1)
  452.                 (setq s_temp (cdr (assoc 1 ent)))
  453.                 (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
  454.                   (if (= st o_str)
  455.                     (progn
  456.                       (setq s_temp (strcat
  457.                                      (if (> si 1)
  458.                                        (substr s_temp 1 (1- si))
  459.                                        ""
  460.                                      )
  461.                                      n_str
  462.                                      (substr s_temp (+ si o_slen))
  463.                                    )
  464.                       )
  465.                       (setq chf t)    ; Found old string
  466.                       (setq si (+ si n_slen))
  467.                     )
  468.                     (setq si (1+ si))
  469.                   )
  470.                 )
  471.                 (if chf
  472.                   (progn              ; Substitute new string for old
  473.                     ; Modify the TEXT entity
  474.                     (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
  475.                     (setq chm (1+ chm))
  476.                   )
  477.                 )
  478.               )
  479.             )
  480.             (setq last_o (1+ last_o))
  481.           )
  482.         )
  483.         ;; else go on to the next line...
  484.       )
  485.     )
  486.   )
  487.   (if (/= (type objs) 'ENAME)
  488.     (if (/= (sslength objs) 1)        ; Print total lines changed
  489.       (princ (strcat "ñw┼▄º≤ "
  490.                      (rtos chm 2 0)
  491.                      " ▓╒íuñσªr╜uívíC"
  492.              )
  493.       )
  494.     )
  495.   )
  496.   (terpri)
  497. )
  498. ;;;
  499. ;;; Main procedure for manipulating text entities
  500. ;;; ARGUMENTS:
  501. ;;;   typ   -- Type of operation to perform
  502. ;;;   prmpt -- Partial prompt string to insert in standard prompt line
  503. ;;;   fld   -- Assoc field to be changed
  504. ;;; GLOBALS:
  505. ;;;   sset  -- The selection set of text entities
  506. ;;;
  507. (defun cht_pe (typ prmpt fld / temp ow nw ent tw sty w hw lw
  508.                               sslen n sn ssl)
  509.   (if (= (sslength sset) 1)           ; Special case if there is only
  510.                                       ; one entity selected
  511.     ;; Process one entity.
  512.     (cht_p1)
  513.     ;; Else
  514.     (progn
  515.       ;; Set prompt string.
  516.       (cht_sp)
  517.       (if (= nw "List")
  518.         ;; Process List request.
  519.         (cht_pl)
  520.         (if (= nw "Individual")
  521.           ;; Process Individual request.
  522.           (cht_pi)
  523.           (if (= nw "Select")
  524.             ;; Process Select request.
  525.             (cht_ps)
  526.             ;; Else
  527.             (progn
  528.               (if (= typ "Rotation")
  529.                 (setq nw (* (/ nw 180.0) pi))
  530.               )
  531.               (if (= (type nw) 'STR)
  532.                 (if (not (tblsearch "style" nw))
  533.                   (progn
  534.                     (princ (strcat "\nºΣñú¿∞íu" nw "ívªr½¼íC"))
  535.                   )
  536.                   (cht_pa)
  537.                 )
  538.                 (cht_pa)
  539.               )
  540.             )
  541.           )
  542.         )
  543.       )
  544.     )
  545.   )
  546. )
  547. ;;;
  548. ;;; Change all of the entities in the selection set.
  549. ;;;
  550. (defun cht_pa (/ cht_oh temp)
  551.   (setq sslen (sslength sset))
  552.   (setq cht_oh (getvar "highlight"))
  553.   (setvar "highlight" 0)
  554.   (while (> sslen 0)
  555.     (setq temp (ssname sset (setq sslen (1- sslen))))
  556.     (entmod (subst (cons fld nw)
  557.                    (assoc fld (setq ent (entget temp)))
  558.                    ent
  559.             )
  560.     )
  561.  
  562.   )
  563.   (setvar "highlight" cht_oh)
  564. )
  565. ;;;
  566. ;;; Change one text entity.
  567. ;;;
  568. (defun cht_p1 ()
  569.   (setq temp (ssname sset 0))
  570.   (setq ow (cdr(assoc fld (entget temp))))
  571.   (if (= opt "Rotation")
  572.     (setq ow (/ (* ow 180.0) pi))
  573.   )
  574.   (redraw (cdr(assoc -1 (entget temp))) 3)
  575.   (initget 0)
  576.   (if (= opt "Style")
  577.     (setq nw (getstring (strcat "\n╖s¬║íu" prmpt "ív- <"
  578.                               ow ">: ")))
  579.     (setq nw (getreal (strcat "\n╖s¬║íu" prmpt "ív- <"
  580.                               (rtos ow 2) ">: ")))
  581.   )
  582.   (if (or (= nw "") (= nw nil))
  583.     (setq nw ow)
  584.   )
  585.   (redraw (cdr(assoc -1 (entget temp))) 1)
  586.   (if (= opt "Rotation")
  587.     (setq nw (* (/ nw 180.0) pi))
  588.   )
  589.   (if (= opt "Style")
  590.     (if (null (tblsearch "style" nw))
  591.       (princ (strcat "\nºΣñú¿∞íu" nw "ívªr½¼íC"))
  592.  
  593.       (entmod (subst (cons fld nw)
  594.                      (assoc fld (setq ent (entget temp)))
  595.                      ent
  596.               )
  597.       )
  598.     )
  599.     (entmod (subst (cons fld nw)
  600.                    (assoc fld (setq ent (entget temp)))
  601.                    ent
  602.             )
  603.     )
  604.   )
  605. )
  606. ;;;
  607. ;;; Set the prompt string.
  608. ;;;
  609. (defun cht_sp ()
  610.   (if (= typ "Style")
  611.     (progn
  612.       (initget "Individual List New Select ")
  613.       (setq nw (getkword (strcat "\nI¡╙ºO/LªCÑ▄/S┐∩╛▄ªr½¼/<N╖síu"
  614.                                  prmpt
  615.                                  "íví╨╛π┼Θñσªr╣╧ñ╕>: ")))
  616.       (if (or (= nw "") (= nw nil) (= nw "Enter"))
  617.         (setq nw (getstring (strcat "\n╖síu"
  618.                                     prmpt
  619.                                     "íví╨╛π┼Θñσªr╣╧ñ╕: ")))
  620.       )
  621.     )
  622.     (progn
  623.       (initget "List Individual" 1)
  624.       (setq nw (getreal (strcat "\nI¡╙ºO/LªCÑ▄/<╖síu"
  625.                                  prmpt
  626.                                  "íví╨╛π┼Θñσªr╣╧ñ╕>: ")))
  627.     )
  628.   )
  629. )
  630. ;;;
  631. ;;; Process List request.
  632. ;;;
  633. (defun cht_pl ()
  634.   (setq unctr (1- unctr))
  635.   (setq sslen (sslength sset))
  636.   (setq tw 0)
  637.   (while (> sslen 0)
  638.     (setq temp (ssname sset (setq sslen (1- sslen))))
  639.     (if (= typ "Style")
  640.       (progn
  641.         (if (= tw 0)
  642.           (setq tw (list (cdr(assoc fld (entget temp)))))
  643.           (progn
  644.             (setq sty (cdr(assoc fld (entget temp))))
  645.             (if (not (member sty tw))
  646.               (setq tw (append tw (list sty)))
  647.             )
  648.           )
  649.         )
  650.       )
  651.       (progn
  652.         (setq tw (+ tw (setq w (cdr(assoc fld (entget temp))))))
  653.         (if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
  654.         (if (< hw w) (setq hw w))
  655.         (if (> lw w) (setq lw w))
  656.       )
  657.     )
  658.   )
  659.   (if (= typ "Rotation")
  660.     (setq tw (* (/ tw pi) 180.0)
  661.           lw (* (/ lw pi) 180.0)
  662.           hw (* (/ hw pi) 180.0))
  663.   )
  664.   (if (= typ "Style")
  665.     (progn
  666.       (princ (strcat "\n"
  667.                      typ
  668.                      "(s) -- "))
  669.       (princ tw)
  670.     )
  671.     (princ (strcat "\n"
  672.                      typ
  673.                      " -- │╠ñp: "
  674.                      (rtos lw 2)
  675.                      "\t │╠ñj: "
  676.                      (rtos hw 2)
  677.                      "\t Ñ¡ºí: "
  678.                      (rtos (/ tw (sslength sset)) 2) ))
  679.   )
  680. )
  681. ;;;
  682. ;;; Process Individual request.
  683. ;;;
  684. (defun cht_pi ()
  685.   (setq sslen (sslength sset))
  686.   (while (> sslen 0)
  687.     (setq temp (ssname sset (setq sslen (1- sslen))))
  688.     (setq ow (cdr(assoc fld (entget temp))))
  689.     (if (= typ "Rotation")
  690.       (setq ow (/ (* ow 180.0) pi))
  691.     )
  692.     (initget 0)
  693.     (redraw (cdr(assoc -1 (entget temp))) 3)
  694.     (if (= typ "Style")
  695.       (progn
  696.         (setq nw (getstring (strcat "\n╖síu"
  697.                                    prmpt
  698.                                    "ív- <"
  699.                                    ow ">: ")))
  700.       )
  701.       (progn
  702.         (setq nw (getreal (strcat "\n╖síu"
  703.                                    prmpt
  704.                                    "ív- <"
  705.                                 (rtos ow 2) ">: ")))
  706.       )
  707.     )
  708.     (if (or (= nw "") (= nw nil))
  709.       (setq nw ow)
  710.     )
  711.     (if (= typ "Rotation")
  712.       (setq nw (* (/ nw 180.0) pi))
  713.     )
  714.     (entmod (subst (cons fld nw)
  715.                    (assoc fld (setq ent (entget temp)))
  716.                    ent
  717.             )
  718.     )
  719.     (redraw (cdr(assoc -1 (entget temp))) 1)
  720.   )
  721. )
  722. ;;;
  723. ;;; Process the Select option.
  724. ;;;
  725. (defun cht_ps ()
  726.   (princ "\n╖j┤Míuªr½¼ªW║┘ív?  <*>: ")
  727.   (setq sn  (strcase (getstring))
  728.         n   -1
  729.         nsset (ssadd)
  730.         ssl (1- (sslength sset))
  731.         )
  732.   (if (or (= sn "*") (null sn) (= sn ""))
  733.     (setq nsset sset sn "*")
  734.     (while (and sn (< n ssl))
  735.       (setq temp (ssname sset (setq n (1+ n))))
  736.       (if (= (cdr(assoc 7 (entget temp))) sn)
  737.         (ssadd temp nsset)
  738.       )
  739.     )
  740.   )
  741.   (setq ssl (sslength nsset))
  742.   (princ "\nºΣ¿∞ ")
  743.   (princ ssl)
  744.   (princ " ¡╙▒─Ñ╬íu")
  745.   (princ sn)
  746.   (princ "ívªr½¼¬║íuñσªrív╣╧ñ╕")
  747.   (princ "íC")
  748. )
  749. ;;;
  750. ;;; The C: function definition.
  751. ;;;
  752. (defun c:cht    () (chtxt))
  753. (princ "\n\tc:CHText ñw╕ⁿñJ; ╜╨ÑHíuCHTív▒╥░╩½ⁿÑOíC")
  754. (princ)
  755.