[求助]：那位高手能不能编个可以替换标注样式和文字样式的Lisp程序

xlf25

比喻说我的图中所有为HZ的文字样式的文字全部替换成TSSD_AXIC这个样式！
标注样式也一样！

似水无痕

替换文字
[php](defun c:text5 (/ ss1 slth n en ent)
  (princ "\n请选择：")
  (setq        ss1  (ssget '((7 . "HZ")))
        slth (sslength ss1)
        n    0
  )
  (if ss1
    (progn
      (repeat slth
        (setq en  (ssname ss1 n)
              n          (1+ n)
              ent (entget en)
        )
        (entmod (subst '(7 . "TSSD_AXIC") (assoc 7 ent) ent))
      )
    )
    (princ "\n未选中：")
  )
)[/php]
标注文字更改：
[php];;;加载activex支持功能
(vl-load-com)


;;;加载*modelspace*及*paperspace*空间参数
(setq acad-object (vlax-get-acad-object))
(setq active-document (vla-get-activedocument acad-object))
(setq mspace (vla-get-modelspace active-document))
(setq pspace (vla-get-paperspace active-document))
(setq activelayer (vla-get-activelayer active-document))


(defun c:text6 (/ ss1 slth n en ent obj1 txt)
  (princ "\n请选择：")
  (setq        ss1  (ssget '((0 . "DIMENSION")))
        slth (sslength ss1)
        n    0
  )
  (if ss1
    (progn
      (repeat slth
        (setq en   (ssname ss1 n)
              n           (1+ n)
              ent  (entget en)
              obj1 (vlax-ename->vla-object en)
        )
        (if (= (setq txt (vla-get-textstyle obj1)) "HZ")
          (vla-put-textstyle obj1 "TSSD_AXIC")

        )
      )
    )
  )
  (princ "\n未选中：")
)[/php]

xlf25

谢谢楼上朋友的程序，可是你的程序只能改一个啊！
不能自己输入要改的文字样式和要改为的文字样式！
例如这样：
输入命令   回车
选择文字   
输入要改的文字样式：（以前的文字样式，最好列出你已经有的文字样式，不用去输文字样式的全称，按对应数字键选对应的样式，比喻说 HZ（1），HZTXT（2）……）  回车
输入要改为的文字样式：（替换为新的文字样式 好列出你已经有的文字样式，不用去输文字样式的全称，按对应数字键选对应的样式，比喻说 HZ（1），HZTXT（2）……）

似水无痕

没有来得及仔细改，试了一下，你看可行？
你可以一步一步运行程序自己改一下么！

2. (defun c:text5 (/ ss1 slth n en ent tstyle1 tstyle2)
   
3.   (setq        tstyle1        (getstring "\n请输入更改前的文字样式：")
   
4.         tstyle2        (getstring "\n请输入更改后的文字样式：")
   
5.   )
   
6.   (princ "\n请选择：")
   
7.   (setq        ss1  (ssget)
   
8.         slth (sslength ss1)
   
9.         n    0
   
10.   )
    
11.   (repeat slth
    
12.     (setq en          (ssname ss1 n)
    
13.           n          (1+ n)
    
14.           ent          (entget en)
    
15.           object1 (vlax-ename->vla-object en)
    
16.     )
    
17.     (setq tstyle (vla-get-stylename object1))
    
18.     (if        (= tstyle tstyle1)
    
19.       (progn
    
20.         (vla-put-stylename object1 tstyle2)
    
21.       )
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )

(defun c:text5 (/ ss1 slth n en ent tstyle1 tstyle2)<br />   (setq        tstyle1        (getstring "\n请输入更改前的文字样式：")<br />         tstyle2        (getstring "\n请输入更改后的文字样式：")<br />   )<br />   (princ "\n请选择：")<br />   (setq        ss1  (ssget)<br />         slth (sslength ss1)<br />         n    0<br />   )<br />   (repeat slth<br />     (setq en          (ssname ss1 n)<br />           n          (1+ n)<br />           ent          (entget en)<br />           object1 (vlax-ename->vla-object en)<br />     )<br />     (setq tstyle (vla-get-stylename object1))<br />     (if        (= tstyle tstyle1)<br />       (progn<br />         (vla-put-stylename object1 tstyle2)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

weijin822

<a target=blank href=http://wpa.qq.com/msgrd?V=1&Uin=123497032&Site=Pet.com&Menu=yes><img border="0" SRC=http://wpa.qq.com/pa?p=1:123497032:11 alt="点击这里给我发消息"></a>

xlf25

谢谢似水无痕 ！
不过好象不能用！我第一次能用，但后面就用不了了！
2002里能用，R14里用不了，而且大小写有区别的

似水无痕

第一次已经更改过来了，第二次当然没有了！不知道你说的什么意思！（程序运行过程中出现选择界面时，你框选所有图元就可以吧，不知你在楼上说的是不是这个意思）我用过的最低版本是AUTOCAD2000，现在是2005！
还有，你要取得字体样式，可以用(setq tstyle (tblnext "style" nil))试试！具体到程序可以自己编写一下！

yedajiang

朋友们，这样的程序还太简单了，要彻底替换文字样式，还要考虑块中的对象，包括块中块还有标注中的文字。
最好是直接把样式拿来改了。

xlf25

文字样式替换在探索者中有了！
标注样式我现在是这样改的：（当图纸很大不容易选的情况）
把要替换为的标注样式置为当前
先输入FILTER过滤选择要替换的样式
然后标注更新，选对象的时候按P键（就是过滤选择的对象）

WHGF

我有一个功能全的，是以前做的给你
;;====================================================================
;;        CTXT  整批转换TEXT字串参数
;;====================================================================
(defun c:CTXT (/ Len i lm P New mod Os K Ns)
        (prompt "\n ===== 整批转换字串参数(16:25 99-06-17) =====")
        (setq i (getreal "\n修改(0:新字串 1:高度 2:宽高比 3:角度 4:倾角 5:字型 6:比例字高 7:改Z坐标)--->"))
        (if (Or (> i 7) (< i 0) ) (setq i 1))                ; 于上一行最大选择数保持一致
        (setq p (ssget))                                ; 选择注释对象
        (setq K 0)
        (if(= i 0) (setq new(getstring"\n新字串: ")        mod 1 ))
        (if(= i 1) (setq new(getreal"\n高度: "  )        mod 40))
        (if(= i 2) (setq new(getreal"\n宽高比: ")        mod 41))
        (if(= i 3) (setq new(getangle"\n角度: " )        mod 50))
        (if(= i 4) (setq new(getangle"\n字串倾角: ")        mod 51))
        (if(= i 5) (setq new(getstring"\n字型(键入字型名): ") mod 7))
        (if(= i 6) (setq new(getreal"\n字高比例: ")        mod 40  K 99 ))
        (if(= i 7) (setq new(getreal"\n新Z坐标: ")        mod 10  K 88 ))
        (setvar "CMDECHO" 0)                        ; 使执行过程没有回应
        (setq Len (sslength p) i 0  Ns New)
        (repeat Len
                (setq lm (entget (ssname p i)))
                (setq i (+ i 1))
                ;;(setq ename(ssname p I))
                ;;(setq Lm(entget ename))
                ;;(print Lm)
                (if(= "TEXT" (cdr (assoc 0 lm)))                ; 取对象名,判断该对象是否是 TEXT
                   (Progn
                        ;;( setq Os ( assoc mod lm  ))                ; 取原字体高
                        ;;( setq Ns ( cons  mod new ))                ; 作用相同
                        ;;( setq lm ( subst Ns Os lm ))                ; 改新参数
        (If(= K 99) (setq Os (cdr (assoc Mod Lm)) New (* OS Ns)))                ; 取原字体高
        (IF(= K 88) (Progn
                (setq Os (assoc Mod Lm))                ; 取原字串坐标
                ( Setq New (List (cadr Os) (caddr Os) Ns) )        ; 改新坐标
                ;;(Princ New)
                    ) ; Progn
        ) ; End if
                        (setq lm (subst (cons mod new) (assoc mod lm) lm));改新参数

                        (entmod lm)                                ; 更新对象
                   );; <--- End Progn
                );; <-- End if
        );; <--- End Repeat
        (command "Redraw" )
        (setvar "CMDECHO" 1)
)
========================================================

xlf25

谢谢楼上的朋友！
但是你的东西探索者里都有了！而且我们讲的样式！