[编程交流] 懒惰的打字员文本编辑：

(defun c:MidSentence (/ CDiaStr ListBoxDia CollectStr 
                     StringList StrListS a RepStr b fnSTR)
(defun CDiaStr  ()
      (setq StrDiaFnme (vl-filename-mktemp "tmp.DCL"))
      (setq fnSTR (open StrDiaFnme "a"))
      (write-line
            "dcl_settings : default_dcl_settings { audit_level = 3; }
 MidSentence : dialog 
 { label = ""; key= "Taytol";
 : list_box { key = "StrListS"; multiple_select =
 true; width = 20; height = 20; } spacer ;
 ok_cancel;
 }"  fnSTR)
             (close fnSTR) T
      )
;;;       List Box Dialog ;;;
(defun ListBoxDia (DiaName DiaKey Title Lst)
       (setq StrDIA (load_dialog StrDiaFnme))
 (if (not (new_dialog DiaName StrDIA))
  (exit)
    )
 (start_list DiaKey)
  (mapcar 'add_list Lst)
  (end_list)
       (set_tile "Taytol" Title)
 (action_tile DiaKey (vl-prin1-to-string
        (quote (set (setq dd (read DiaKey)) (get_tile $key)))))
 (action_tile "accept" "(done_dialog 1)")
   (action_tile "cancel" "(done_dialog 0)")
 (start_dialog)
   (unload_dialog StrDIA)
       (mapcar '(lambda (x)
                              (atoi (chr x)))
                       (vl-remove
                             32
                             (vl-string->list (eval (read DiaKey)))))
        )
;;;      Collect String from List ;;;
(defun CollectStr  (LstS LstC)
     (apply 'Strcat
            (mapcar '(lambda (y) (strcat (nth y LstC) " ")) LstS))
     )      
;;;  String To List  ;;;
(defun StringList (ent / Str i Lst)
 (setq Str (cdr (assoc 1 (entget  (ssname ent 0)))))
  (while
        (setq i (vl-string-search " " str))
          (setq Lst (cons (substr str 1 i) Lst))
          (setq str (substr str (+ 2 i)))
        )
  (reverse (cons str Lst)))
            (cond ((and
 (setq a (ssget "_+.:S:E:L" '((0 . "*TEXT"))))
               (setq StrList (StringList a))
 (CDiaStr)
       (Setq RepStr (CollectStr
                                  (ListBoxDia
                                        "MidSentence"
                                        "StrListS"
                                        "Select String to Follow"
                                        StrList)
                                  StrList))
               (setq b (ssget "_+.:S:E:L" '((0 . "*TEXT"))))
               (setq StrList (StringList b))
(vla-put-textstring
      (setq a (vlax-ename->vla-object (ssname a 0)))
      (vl-string-subst
            (strcat RepStr (CollectStr
                  (ListBoxDia
                        "MidSentence"
                        "StrListS"
                        "Select String to Insert"
                        StrList)
                  StrList))
            RepStr
            (vla-get-textstring a)))
               (vl-file-delete StrDiaFnme)
               ))
             )
)

(defun _breakup (s / foo l i d l1 l2)
 (defun foo (s / f n)
   (setq s (strcase s))
   (foreach x '("\\N" " " "\\P")
     (and (setq f (vl-string-search x s)) (setq n (cons (list f x) n)))
   )
   n
 )
 (while
   (setq i (caar (setq l (vl-sort (foo s) '(lambda (a b) (< (car a) (car b))))))
         d (cadar l)
   )
    (setq l1 (cons (substr s 1 i) l1)
          l2 (cons (substr s (1+ i) (strlen d)) l2)
          s  (substr s (+ i 1 (strlen d)))
    )
 )
 (if l2
   (mapcar 'reverse (list (cons s l1) l2))
   s
 )
)
(defun c:REPF (/ _reunion text string replacement)
 ;; Alan J. Thompson, 06.20.11
;;;  (defun _breakup (s / i d l1 l2)
;;;    (while
;;;      (setq i (vl-some '(lambda (x) (vl-string-search (setq d x) (strcase s))) '("\\N" " " "\\P")))
;;;       (setq l1 (cons (substr s 1 i) l1)
;;;             l2 (cons (substr s (1+ i) (strlen d)) l2)
;;;             s  (substr s (+ i 1 (strlen d)))
;;;       )
;;;    )
;;;    (mapcar 'reverse (list (cons s l1) l2))
;;;  )
 (defun _reunion (lst)
   (apply 'strcat
          (apply 'append
                 (mapcar '(lambda (a b) (list a b))
                         (car lst)
                         (if (> (length (car lst)) (length (cadr lst)))
                           (append (cadr lst) (list ""))
                           (cadr lst)
                         )
                 )
          )
   )
 )
 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect text to replace first word: "
       (lambda (x)
         (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ATTDEF,ATTRIB,MTEXT,MULTILEADER,TEXT")
           (setq text   (vlax-ename->vla-object (car x))
                 string (_breakup (AT:TextString (car x)))
           )
         )
       )
     )
     (not (vl-position
            (setq replacement (AT:GetString "Specify replacement string" (caar string)))
            (list "" nil (caar string))
          )
     )
   )
    (vla-put-textstring text (_reunion (list (cons replacement (cdar string)) (cadr string))))
 )
 (princ)
)
(defun c:Test (/ _reunion text string replacement)
 (defun _reunion (lst)
   (apply 'strcat
          (apply 'append
                 (mapcar '(lambda (a b) (list a b))
                         (car lst)
                         (if (> (length (car lst)) (length (cadr lst)))
                           (append (cadr lst) (list ""))
                           (cadr lst)
                         )
                 )
          )
   )
 )
 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect text to replace first word: "
       (lambda (x)
         (if (wcmatch (cdr (assoc 0 (entget (car x)))) "ATTDEF,ATTRIB,MTEXT,MULTILEADER,TEXT")
           (setq text   (vlax-ename->vla-object (car x))
                 string (_breakup (AT:TextString (car x)))
           )
         )
       )
     )
     (setq replacement (dos_proplist "" "" (mapcar '(lambda (x) (cons x x)) (car string))))
   )
    (vla-put-textstring text (_reunion (list (mapcar 'cdr replacement) (cadr string))))
 )
 (princ)
)
(defun AT:GetSel (meth msg fnc / ent)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'ERRNO 0)
 (while
   (progn (setq ent (meth (cond (msg)
                                ("\nSelect object: ")
                          )
                    )
          )
          (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                ((eq (type (car ent)) 'ENAME)
                 (if (and fnc (not (fnc ent)))
                   (princ "\nInvalid object!")
                 )
                )
          )
   )
 )
 ent
)
(defun AT:GetString (#Title #Default / #FileName #FileOpen #DclID #NewString)
 ;; Getstring Dialog Box
 ;; #Title - Title of dialog box
 ;; #Default - Default string within edit box
 ;; Alan J. Thompson, 08.25.09
 (setq #FileName (vl-filename-mktemp "" "" ".dcl")
       #FileOpen (open #FileName "W")
 )
 (foreach x '("TempEditBox : dialog {"                      "key = "Title";"
              "label = "";"        "initial_focus = "Edit";"
              "spacer;"              ": row {"              ": column {"
              "alignment = centered;"                       "fixed_width = true;"
              ": text {"             "label = "";"        "}"
              "}"                    ": edit_box {"         "key = "Edit";"
              "allow_accept = true;" "edit_width = 40;"     "fixed_width = true;"
              "}"                    "}"                    "spacer;"
              ": row {"              "fixed_width = true;"  "alignment = centered;"
              ": ok_button {"        "width = 11;"          "}"
              ": cancel_button {"    "width = 11;"          "}"
              "}"                    "}//"
             )
   (write-line x #FileOpen)
 )
 (close #FileOpen)
 (setq #DclID (load_dialog #FileName))
 (new_dialog "TempEditBox" #DclID)
 (set_tile "Title" #Title)
 (set_tile "Edit" #Default)
 (action_tile "accept" "(setq #NewString (get_tile "Edit"))(done_dialog)")
 (action_tile "cancel" "(done_dialog)")
 (start_dialog)
 (unload_dialog #DclID)
 (vl-file-delete #FileName)
 #NewString
)
(defun AT:TextString (Obj)
 ;; Extract textstring (with symbols) from text object
 ;; Works on: Attrib, Attdef, MText, Multileader, Text
 ;; Obj - Object to extract textstring from
 ;; Alan J. Thompson, 11.24.09 / 04.13.10
 (if Obj
   ((lambda (e)
      (cond ((eq (cdr (assoc 0 e)) "MULTILEADER") (cdr (assoc 304 e)))
            ((vl-position (cdr (assoc 0 e)) '("ATTDEF" "ATTRIB" "TEXT")) (cdr (assoc 1 e)))
            ((eq (cdr (assoc 0 e)) "MTEXT")
             (apply (function strcat)
                    (mapcar (function (lambda (x)
                                        (if (vl-position (car x) '(1 3))
                                          (cdr x)
                                          ""
                                        )
                                      )
                            )
                            e
                    )
             )
            )
      )
    )
     (entget (cond ((vl-consp Obj) (car Obj))
                   ((eq (type Obj) 'ENAME) Obj)
                   ((eq (type Obj) 'VLA-ObjECT) (vlax-vla-object->ename Obj))
             )
     )
   )
 )
)