[编程交流] 批处理文本编辑器

;;;
;;; Change the text of an entity.
;;;
(defun cht_te ()
 (setq sslen (sslength sset))
 (initget "Globally Individually Retype")
 (setq ans (getkword 
   "\nSearch and replace text.  Individually/Retype/<Globally>:"))
 (setq cht_ot (getvar "texteval"))
 (setvar "texteval" 1)
 (cond 
   ((= ans "Individually")
     (if (= (getvar "popups") 1)
       (progn
         (initget "Yes No")
         (setq ans (getkword "\nEdit text in dialogue? <Yes>:"))
       )
       (setq ans "No")
     )
 
     (while (> sslen 0)
       (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)
       (setq ss (ssadd))
       (ssadd (ssname sset sslen) ss)
       (if (= ans "No") 
         (chgtext ss)
         (command "_.DDEDIT" sn "")
       )
       (redraw sn 1)
     )
   )
   ((= ans "Retype")
     (while (> sslen 0)
       (setq ent (entget(ssname sset (setq sslen (1- sslen)))))
       (redraw (cdr(assoc -1 ent)) 3)
       (prompt (strcat "\nOld text: " (cdr(assoc 1 ent))))
       (setq nt (getstring  T "\nNew text: "))
       (redraw (cdr(assoc -1 ent)) 1)
       (if (> (strlen nt) 0)
         (entmod (subst (cons 1 nt) (assoc 1 ent) ent))
       )
     )
   )
   (T
     (chgtext sset)                  ; Change 'em all
   )
 )
 (setvar "texteval" cht_ot)
)
;;;
;;; The old CHGTEXT command - rudimentary text editor
;;;
;;;
(defun C:CHGTEXT () (chgtext nil))
(defun chgtext (objs / last_o tot_o ent o_str n_str st s_temp 
                      n_slen o_slen si chf chm cont ans)
 (if (null objs)
   (setq objs (ssget))               ; Select objects if running standalone
 )
 (setq chm 0)
 (if objs 
   (progn                   ; If any objects selected
     (if (= (type objs) 'ENAME) 
       (progn
         (setq ent (entget objs))
         (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
       )
       (if (= (sslength objs) 1)
         (progn
           (setq ent (entget (ssname objs 0)))
           (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
         )
       )
     )
     (setq o_str (getstring "\nMatch string   : " t))
     (setq o_slen (strlen o_str))
     (if (/= o_slen 0)
       (progn
         (setq n_str (getstring "\nNew string     : " t))
         (setq n_slen (strlen n_str))
         (setq last_o 0 
               tot_o  (if (= (type objs) 'ENAME)
                        1
                        (sslength objs)
                      )
         )
         (while (< last_o tot_o)     ; For each selected object...
           (if (= "TEXT"             ; Look for TEXT entity type (group 0)
                  (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
             (progn
               (setq chf nil si 1)
               (setq s_temp (cdr (assoc 1 ent)))
               (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
                 (if (= st o_str)
                   (progn
                     (setq s_temp (strcat 
                                    (if (> si 1)
                                      (substr s_temp 1 (1- si)) 
                                      ""
                                    )
                                    n_str
                                    (substr s_temp (+ si o_slen))
                                  )
                     )
                     (setq chf t)    ; Found old string
                     (setq si (+ si n_slen))
                   )
                   (setq si (1+ si))
                 )
               )
               (if chf 
                 (progn              ; Substitute new string for old
                   ; Modify the TEXT entity
                   (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
                   (setq chm (1+ chm))
                 )
               )
             )
           )
           (setq last_o (1+ last_o))
         )
       )
       ;; else go on to the next line...
     )
   )
 )
 (if (/= (type objs) 'ENAME)
   (if (/= (sslength objs) 1)        ; Print total lines changed
     (princ (strcat "Changed "
                    (rtos chm 2 0)
                    " text lines."
            )
     )
   )
 )
 (terpri)
)
;;;
;;; Main procedure for manipulating text entities
;;; ARGUMENTS:
;;;   typ   -- Type of operation to perform
;;;   prmpt -- Partial prompt string to insert in standard prompt line
;;;   fld   -- Assoc field to be changed
;;; GLOBALS:
;;;   sset  -- The selection set of text entities
;;;
(defun cht_pe (typ prmpt fld / temp ow nw ent tw sty w hw lw 
                             sslen n sn ssl)
 (if (= (sslength sset) 1)           ; Special case if there is only
                                     ; one entity selected
   ;; Process one entity.
   (cht_p1)
   ;; Else
   (progn
     ;; Set prompt string.
     (cht_sp)
     (if (= nw "List")
       ;; Process List request.
       (cht_pl)
       (if (= nw "Individual")
         ;; Process Individual request.
         (cht_pi)
         (if (= nw "Select")
           ;; Process Select request.
           (cht_ps)
           ;; Else
           (progn
             (if (= typ "Rotation")
               (setq nw (* (/ nw 180.0) pi))
             )
             (if (= (type nw) 'STR)
               (if (not (tblsearch "style" nw))
                 (progn
                   (princ (strcat "\nStyle " nw " not found. "))
                 )
                 (cht_pa)
               )
               (cht_pa)
             )
           )
         )
       )
     )
   )
 )
)
;;;
;;; Change all of the entities in the selection set.
;;;
(defun cht_pa (/ cht_oh temp)
 (setq sslen (sslength sset))
 (setq cht_oh (getvar "highlight"))
 (setvar "highlight" 0)
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
   
 )
 (setvar "highlight" cht_oh)
)
;;;
;;; Change one text entity.
;;;
(defun cht_p1 ()
 (setq temp (ssname sset 0))
 (setq ow (cdr(assoc fld (entget temp))))
 (if (= opt "Rotation")
   (setq ow (/ (* ow 180.0) pi))
 )
 (redraw (cdr(assoc -1 (entget temp))) 3)
 (initget 0)
 (if (= opt "Style")
   (setq nw (getstring (strcat "\nNew " prmpt ". <"
                             ow ">: ")))
   (setq nw (getreal (strcat "\nNew " prmpt ". <"
                             (rtos ow 2) ">: ")))
 )
 (if (or (= nw "") (= nw nil))
   (setq nw ow)
 )
 (redraw (cdr(assoc -1 (entget temp))) 1)
 (if (= opt "Rotation")
   (setq nw (* (/ nw 180.0) pi))
 )
 (if (= opt "Style")
   (if (null (tblsearch "style" nw))
     (princ (strcat "\nStyle " nw " not found. "))
     
     (entmod (subst (cons fld nw)
                    (assoc fld (setq ent (entget temp)))
                    ent
             )
     )
   )
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
 )
)
;;;
;;; Set the prompt string.
;;;
(defun cht_sp ()
 (if (= typ "Style")
   (progn
     (initget "Individual List New Select ")
     (setq nw (getkword (strcat "\nIndividual/List/Select style/<New "
                                prmpt
                                " for all text entities>: ")))
     (if (or (= nw "") (= nw nil) (= nw "Enter"))
       (setq nw (getstring (strcat "\nNew "
                                   prmpt
                                   " for all text entities: ")))
     )
   )
   (progn
     (initget "List Individual" 1)
     (setq nw (getreal (strcat "\nIndividual/List/<New "
                                prmpt
                                " for all text entities>: ")))
   )
 )
)
;;;
;;; Process List request.
;;;
(defun cht_pl ()
 (setq unctr (1- unctr))
 (setq sslen (sslength sset))
 (setq tw 0)
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (if (= typ "Style")
     (progn
       (if (= tw 0)
         (setq tw (list (cdr(assoc fld (entget temp)))))
         (progn
           (setq sty (cdr(assoc fld (entget temp))))
           (if (not (member sty tw))
             (setq tw (append tw (list sty)))
           )
         )
       )
     )
     (progn
       (setq tw (+ tw (setq w (cdr(assoc fld (entget temp))))))
       (if (= (sslength sset) (1+ sslen)) (setq lw w hw w))
       (if (< hw w) (setq hw w))
       (if (> lw w) (setq lw w))
     )
   )
 )
 (if (= typ "Rotation")
   (setq tw (* (/ tw pi) 180.0)
         lw (* (/ lw pi) 180.0)
         hw (* (/ hw pi) 180.0))
 )
 (if (= typ "Style")
   (progn
     (princ (strcat "\n"
                    typ
                    "(s) -- "))
     (princ tw)
   )
   (princ (strcat "\n"
                    typ
                    " -- Min: "
                    (rtos lw 2)
                    "\t Max: "
                    (rtos hw 2)
                    "\t Avg: "
                    (rtos (/ tw (sslength sset)) 2) ))
 )
)
;;;
;;; Process Individual request.
;;;
(defun cht_pi ()
 (setq sslen (sslength sset))
 (while (> sslen 0)
   (setq temp (ssname sset (setq sslen (1- sslen))))
   (setq ow (cdr(assoc fld (entget temp))))
   (if (= typ "Rotation")
     (setq ow (/ (* ow 180.0) pi))
   )
   (initget 0)
   (redraw (cdr(assoc -1 (entget temp))) 3)
   (if (= typ "Style")
     (progn
       (setq nw (getstring (strcat "\nNew "
                                  prmpt
                                  ". <"
                                  ow ">: ")))
     )
     (progn
       (setq nw (getreal (strcat "\nNew "
                                  prmpt
                                  ". <"
                               (rtos ow 2) ">: ")))
     )
   )
   (if (or (= nw "") (= nw nil))
     (setq nw ow)
   )
   (if (= typ "Rotation")
     (setq nw (* (/ nw 180.0) pi))
   )
   (entmod (subst (cons fld nw)
                  (assoc fld (setq ent (entget temp)))
                  ent
           )
   )
   (redraw (cdr(assoc -1 (entget temp))) 1)
 )
)
;;;
;;; Process the Select option.
;;;
(defun cht_ps ()
 (princ "\nSearch for which Style name?  <*>: ")
 (setq sn  (strcase (getstring))
       n   -1
       nsset (ssadd)
       ssl (1- (sslength sset))
       )
 (if (or (= sn "*") (null sn) (= sn ""))
   (setq nsset sset sn "*")
   (while (and sn (< n ssl))
     (setq temp (ssname sset (setq n (1+ n))))
     (if (= (cdr(assoc 7 (entget temp))) sn)
       (ssadd temp nsset)
     )
   )
 )
 (setq ssl (sslength nsset))  
 (princ "\nFound ")
 (princ ssl)
 (princ " text entities with STYLE of ")
 (princ sn)
 (princ ". ")
)
;;;
;;; The C: function definition.
;;;
(defun c:cht    () (chtxt))
(princ "\n\tc:CHText loaded.  Start command with CHT.")
(princ)