[编程交流] LISP例程到全局编辑te

(defun c:MODT () (c:ModifyText))
(defun c:ModifyText  (/ *error* option string pattern _PutString)
 ;; © RenderMan, 2011
 (princ "\rMODIFYTEXT")
 (vl-load-com)
 (defun *error*  (msg)
   (and oldNomutt (setvar 'nomutt oldNomutt))
   (if acDoc
     (vla-endundomark acDoc))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))                 ; Fatal error, display it
   (princ))
 (initget "PREFIX REPLACE SUFFIX")
 (if
   (and
     (setq option
            (getkword "\nEnter option [PREFIX/REPLACE/SUFFIX]: "))
     (/= "" (setq string (getstring "\nEnter text to add: ")))
     (cond
       ((= "PREFIX" option)
        (defun _PutString  (oText)
          (vla-put-textstring
            oText
            (strcat string (vla-get-textstring oText)))))
       ((and (= "REPLACE" option)
             (setq
               pattern
                (getstring
                  T
                  "\nEnter text to replace (case sensitive): ")))
        (defun _PutString  (oText)
          (vla-put-textstring
            oText
            (vl-string-subst
              string
              pattern
              (vla-get-textstring oText)))))
       ((= "SUFFIX" option)
        (defun _PutString  (oText)
          (vla-put-textstring
            oText
            (strcat (vla-get-textstring oText) string))))))
    ((lambda (acDoc oldNomutt / ss)
       (vla-startundomark acDoc)
       (prompt
         "\nSelect entity on desired layer(s) to modify all text: ")
       (setvar 'nomutt 1)
       (while (and (/= nil (setq ss (ssget ":S:E:L")))
                   (cond (pattern
                          (setq ss
                                 (ssget
                                   "_X"
                                   (list
                                     '(0 . "MTEXT,TEXT")
                                     (cons 1 (strcat "*" pattern "*"))
                                     (cons 8
                                           (vla-get-layer
                                             (vlax-ename->vla-object
                                               (ssname ss 0))))))))
                         ((setq ss
                                 (ssget
                                   "_X"
                                   (list
                                     '(0 . "MTEXT,TEXT")
                                     (cons 8
                                           (vla-get-layer
                                             (vlax-ename->vla-object
                                               (ssname ss 0))))))))))
         (vlax-for oText
                   (setq ss (vla-get-activeselectionset acDoc))
           (_PutString oText))
         (vla-delete ss))
       (*error* nil))
      (vla-get-activedocument (vlax-get-acad-object))
      (getvar 'nomutt))
    (progn
      (cond
        (option
         (prompt "\n** Invalid input: Must enter a text string ** "))
        ((prompt "\n** Invalid input: Must select an option ** ")))
      (princ))))

;; (TextLayerEdit "YourLayer" "Text to Add" <mode>)
;; <mode> = 0  -  replace
;;        = 1  -  prefix
;;        = 2  -  suffix
;; <layer> can use wildcards.
(defun TextLayerEdit ( layer newtext mode / e i s v )
   (if (setq s (ssget "_X" (list '(0 . "TEXT,MTEXT") (cons 8 layer))))
       (repeat (setq i (sslength s))
           (setq e (entget (ssname s (setq i (1- i))))
                 v (assoc 1 e)
           )
           (entmod
               (subst
                   (cons 1
                       (cond
                           (   (= 0 mode) newtext)
                           (   (= 1 mode) (strcat newtext (cdr v)))
                           (   (strcat (cdr v) newtext))
                       )
                   )
                   v e
               )
           )
       )
   )
   (princ)
)

(TextLayerEdit "YourLayerName" "%%159" 2)

;; (TextLayerEdit "YourLayer" "Text to Add" <mode>)
;; <mode> = 0  -  replace
;;        = 1  -  prefix
;;        = 2  -  suffix
;; <layer> can use wildcards.
(defun TextLayerEdit ( layer newtext mode / e f i s v )
   (setq f
       (eval
           (list 'lambda '( s )
               (cond
                   (   (= 0 mode) newtext)
                   (   (= 1 mode) (list 'strcat newtext 's))
                   (   (list 'strcat 's newtext))
               )
           )
       )
   )
   (if (setq s (ssget "_X" (list '(0 . "TEXT,MTEXT") (cons 8 layer))))
       (repeat (setq i (sslength s))
           (setq e (entget (ssname s (setq i (1- i))))
                 v (assoc 1 e)
           )
           (entmod (subst (cons 1 (f (cdr v))) v e))
       )
   )
   (princ)
)