[编程交流] 查找、剪切和粘贴文本字符串

(defun c:Test (/ ss)
;;; Tharwat 16. Nov. 2.12 www.cadTutor.com ;;;
 (if (setq ss (ssget '((0 . "*TEXT") (1 . "*/*"))))
   ((lambda (i / e sn e st po p)
      (while (setq sn (ssname ss (setq i (1+ i))))
        (setq po (vl-position
                   47
                   (vl-string->list
                     (setq st (cdr (assoc 1 (setq e (entget sn)))))
                   )
                 )
        )
        (setq p (polar (cdr (assoc 10 e))
                       (+ (cdr (assoc 50 e)) (* pi 1.5))
                       (* (cdr (assoc 40 e)) 1.2)
                )
        )
        (if (eq (cdr (assoc 0 e)) "TEXT")
          (entmakex (list (assoc 0 e)
                          (cons 1 (substr st (+ po 2)))
                          (assoc 40 e)
                          (cons 10 p)
                          (cons 11 p)
                          (assoc 50 e)
                    )
          )
          (entmakex (list (assoc 0 e)
                          '(100 . "AcDbEntity")
                          '(100 . "AcDbMText")
                          (cons 1 (substr st (+ po 2)))
                          (assoc 40 e)
                          (cons 10 p)
                          (cons 11 p)
                          (assoc 50 e)
                    )
          )
        )
        (entmod (subst (cons 1 (substr (cdr (assoc 1 e)) 1 po))
                       (assoc 1 e)
                       e
                )
        )
      )
    )
     -1
   )
 )
 (princ "\n Written by Tharwat")
 (princ)
)