象WORD那样修改图中文字

　

---

 

　　CAD中修改文字的各种方法，都有一个学缺陷，就是你必须找到这个文字的位置才行。我编了一个小程序，可以对图中的所有文字进行搜索，并修改制定的文本，就象WORD中的“替换”命令一样，同时也可以进行“整字修改”或“任意修改”。

程序如下:

(defun myerror (s)
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setq *error* olderr)
  (if (= st "Y")
   (progn
    (command "view" "r" "view_s")
    (setvar "ucsicon" ucs_ic)
   )
  )
  (command "undo" "e")
  (setvar "cmdecho" 1)
  (princ)
)
(defun c:xg(/ txt ntxt s leng i nr si loop swtest ntest ucs_ic name
              num pt test olderr long high st pt1 pt2 st1 nlen ang)
 (if (not ch)
  (load"ch")
 )
 (setvar "cmdecho" 0)
 (command "undo" "g")
 (setq olderr *error*
       *error* myerror)
 (setq s (ssget "x" '((-4 . "<or")
                       (0 . "text")
                       (0 . "mtext")
                      (-4 . "or>"))))
 (if (not s)
  (princ "\n没有选中任何文本!")
  (progn
   (princ "\n请输入需修改的文字:)
   (setq txt (getstring t))
   (princ "\n是否整字修改(Y/N)?<N>:")
   (initget "Y N")
   (setq swtest (getkword))
   (if (not swtest) (setq swtest "N"))
   (princ "\n是否需要查看(Y/N)?<Y>:")
   (initget "Y N")
   (setq st (getkword))
   (if (not st) (setq st "Y"))
   (if (= st "Y")
    (command "view" "s" "view_s")
   )
   (setq leng (sslength s))
   (setq i 0 num 0)
   (repeat leng
    (setq si (entget (ssname s i)))
    (setq nr (assoc '1 si))
    (setq nr (cdr nr))
    (if (wcmatch nr (strcat "*" txt "*"))
     (progn
      (if (= swtest "N")
       (progn
        (setq num (1+ num))
        (setq nlen (tech nr))
        (setq pt (cdr (assoc '10 si)))
        (setq ang (cdr (assoc '50 si)))
        (princ (strcat "\n文字插入点:" (rtos (car pt)) "," (rtos (cadr pt))))
        (setq nr (cdr (assoc '1 si)))
        (princ (strcat " \n\t\t旧文字:< " nr " >"))
        (if (= st "Y")
         (progn
          (if (not ucs_ic)
           (progn
            (setq ucs_ic (getvar "ucsicon"))
            (setvar "ucsicon" 2)
           )
          )
          (setq high (cdr (assoc '40 si)))
          (setq long (* high 18))
          (command "zoom" "c" pt long)
          (setq name (cdr (assoc '-1 si)))
          (redraw name 3)
          (princ "\n是否修改(Y/N)?<Y>:")
          (initget "Y N")
          (setq st1 (getkword))
         )
        )
        (if (not st1) (setq st1 "Y"))
        (if (= st1 "Y")
         (progn
          (if (= txt "`*") (setq txt "*"))   ;用于修改乘号
          (setq nr (ch nr txt ntxt))
          (if (= txt "*") (setq txt "`*"))   ;用于修改乘号
          (setq nr (cons 1 nr))
          (setq si (subst nr (assoc '1 si) si))
          (entmod si)
          (setq nr (cdr (assoc '1 si)))
          (princ (strcat " \n\t\t新文字:< " nr " >"))
         )
         (progn
          (setq num (- num 1))
          (redraw name 4)
         )
        )
       )
       (progn
        (if (= txt "`*") (setq txt "*"))   ;用于修改乘号
        (if (= nr txt)
         (progn
          (setq num (1+ num))
          (setq pt (cdr (assoc '10 si)))
          (setq ang (cdr (assoc '50 si)))
          (setq nlen (tech nr))
          (princ (strcat "\n文字插入点:" (rtos (car pt)) "," (rtos (cadr pt))))
          (setq nr (cdr (assoc '1 si)))
          (princ (strcat " \n\t\t旧文字:< " nr " >"))
          (if (= st "Y")
           (progn
            (if (not ucs_ic)
             (progn
              (setq ucs_ic (getvar "ucsicon"))
              (setvar "ucsicon" 2)
             )
            )
            (setq high (cdr (assoc '40 si)))
            (setq long (* high 18))
            (command "zoom" "c" pt long)
            (setq name (cdr (assoc '-1 si)))
            (redraw name 3)
            (princ "\n是否修改(Y/N)?<Y>:")
            (initget "Y N")
            (setq st1 (getkword))
           )
          )
          (if (not st1) (setq st1 "Y"))
          (if (= st1 "Y")
           (progn
            (setq nr ntxt)
            (setq nr (cons 1 nr))
            (setq si (subst nr (assoc '1 si) si))
            (entmod si)
            (setq nr (cdr (assoc '1 si)))
            (princ (strcat " \n\t\t新文字:< " nr " >"))
           )
           (setq num (- num 1))
          )
         )
        )
       )
      )
     )
    )
   (setq i (1+ i))
   )
   (if (= num 0)
    (progn
     (princ "\n没有被修改的文字!")
     (setq ucs_ic (getvar "ucsicon"))
    )
    (princ (strcat "\n共有 " (itoa num) " 处文字被修改!"))
   )
  )
 )
 (setq *error* olderr)
 (if (= st "Y")
  (progn
   (command "view" "r" "view_s")
   (setvar "ucsicon" ucs_ic)
  )
 )
 (command "undo" "e")
 (setvar "cmdecho" 1)
 (princ)
)