[LISP程序]：免费供送改文字的好东东

flfuthpss

[php](defun chgterr (s)
   (if (/= s "Function cancelled")   ; If an error (such as CTRL-C) occurs
      (princ (strcat "\nError: " s)) ; while this command is active...
   )
   (setq p nil)                      ; Free selection set
   (setq *error* olderr)             ; Restore old *error* handler
   (princ)
)

(Defun C:RRT ()
  (setvar "cmdecho" 0)
  (princ "请选择原文字：")
  (setq dat1 (entget (car (entsel))))
  (setq dat2 (cdr (assoc 1 dat1)))
  (setq        a (ssget '((-4 . "<OR")
                   (0 . "text")
                   (0 . "Mtext")
                   (-4 . "OR>"))
                  )
          )
        (setq L        0
              N        (sslength a)
        )
         (While        (< L N)
           (setq b (ssname a L))
           (setq Vdat (entget b))
           (setq Vtext (assoc 1 Vdat))
           (setq Rutext (cdr Vtext))
           (setq Rutext dat2)
           (setq Rutext (cons 1 Rutext))
           (setq Vdat (subst Rutext Vtext Vdat))
           (entmod Vdat)
           (setq L (1+ L))
         )
        (setvar "cmdecho" 1)
        (setq *error* olderr)
  )[/php]

以上内容来此http://jzldl.123ye.com 飞龙成长网