帮忙写个批量修改文本属性的lisp

石井鱼

请哪位大侠写个小程序，功能如下：

框选图中文字，将文字属性修改：对齐方式改为左对齐；字高改为300；字宽改为0.6；字体颜色改为1号色；字体样式改为“TSSD_Rein”，如果没有定义，新创建该字体样式，英中字体分别为tssdeng.shx和tssdchn.shx。

以上功能单独的程序一个个用效率低，麻烦大侠给集合至一个命令，使用起来快捷些，先谢了。

437271963

2. ;建立TSSD_Rein字体
   
3. (defun TSSD_Rein ( / newt)
   
4. (if (null (tblsearch "style" "TSSD_Rein"))
   
5.   (progn
   
6.    (if (null vlax-dump-object) (vl-load-com) )
   
7.    (setq newT (vla-add (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object))) "TSSD_Rein"))
   
8.    (vla-put-fontfile newT "tssdeng.shx")
   
9.    (vla-put-bigfontfile newT "tssdchn.shx");大字体为hztxt
   
10.    (vla-put-height newT 0);高度0
    
11.    (vla-put-width newT 0.6);宽度因子0.6
    
12.    (vla-put-obliqueAngle newT (/ (* pi 3) 180));倾斜角度3
    
13.   )
    
14. )
    
15. )
    
16. 
    
17. ;;修改文字为左对齐位置不变;;
    
18. (defun C:tes ( / #g1 &k1 &kw1 &ob1 pt1 ss1 ss2 ss3 ss4 ss5 x)
    
19. (setvar "cmdecho" 0)
    
20. (setvar "blipmode" 0)
    
21. (if (null vlax-dump-object) (vl-load-com) )  ;;加载vlax扩展函数
    
22. (setq ss5 '((62 . 1) (40 . 300) (41 . 0.6) (7 . "TSSD_Rein")))
    
23. (TSSD_Rein)
    
24. (princ "\n请选择文字")
    
25. (if (setq &kw1 (ssget '((0 . "TEXT"))));1
    
26.   (progn;;1
    
27.    (setq ss1 '(0 8) ss2 '(1 50 51))
    
28.    (while (setq &k1 (ssname &kw1 0));1
    
29.     (setq &kw1 (ssdel &k1 &kw1))
    
30.     (setq #g1 (entget &k1) &ob1 (vlax-ename->vla-object &k1))
    
31.     (setq ss3 (vl-remove-if-not '(lambda (X) (member (car x) ss1)) #g1))
    
32.     (setq ss4 (vl-remove-if-not '(lambda (X) (member (car x) ss2)) #g1))
    
33.     (setq pt1 (Vlax-SafeArray->List (Vlax-Variant-Value (vla-get-InsertionPoint &ob1))))
    
34.     (setq pt1 (list (car pt1) (cadr pt1)));坐标Z为0
    
35.     (vla-delete &ob1);删除原来的文字
    
36.     (setq ss4 (append ss5 ss4))
    
37.     (setq ss4 (cons (cons 10 pt1) ss4))
    
38.     (setq ss3 (append ss3 ss4))
    
39.     (entmake ss3);绘制文字
    
40.    );while;1
    
41.   );progn;1
    
42. );if;1
    
43. (prin1)
    
44. )

;建立TSSD_Rein字体<br /> (defun TSSD_Rein ( / newt)<br /> (if (null (tblsearch "style" "TSSD_Rein"))<br />   (progn<br />    (if (null vlax-dump-object) (vl-load-com) )<br />    (setq newT (vla-add (vla-get-TextStyles (vla-get-activedocument (vlax-get-acad-object))) "TSSD_Rein"))<br />    (vla-put-fontfile newT "tssdeng.shx")<br />    (vla-put-bigfontfile newT "tssdchn.shx");大字体为hztxt<br />    (vla-put-height newT 0);高度0<br />    (vla-put-width newT 0.6);宽度因子0.6<br />    (vla-put-obliqueAngle newT (/ (* pi 3) 180));倾斜角度3<br />   )<br /> )<br /> )<br /> <br /> ;;修改文字为左对齐位置不变;;<br /> (defun C:tes ( / #g1 &k1 &kw1 &ob1 pt1 ss1 ss2 ss3 ss4 ss5 x)<br /> (setvar "cmdecho" 0)<br /> (setvar "blipmode" 0)<br /> (if (null vlax-dump-object) (vl-load-com) )  ;;加载vlax扩展函数<br /> (setq ss5 '((62 . 1) (40 . 300) (41 . 0.6) (7 . "TSSD_Rein")))<br /> (TSSD_Rein)<br /> (princ "\n请选择文字")<br /> (if (setq &kw1 (ssget '((0 . "TEXT"))));1<br />   (progn;;1<br />    (setq ss1 '(0 8) ss2 '(1 50 51))<br />    (while (setq &k1 (ssname &kw1 0));1<br />     (setq &kw1 (ssdel &k1 &kw1))<br />     (setq #g1 (entget &k1) &ob1 (vlax-ename->vla-object &k1))<br />     (setq ss3 (vl-remove-if-not '(lambda (X) (member (car x) ss1)) #g1))<br />     (setq ss4 (vl-remove-if-not '(lambda (X) (member (car x) ss2)) #g1))<br />     (setq pt1 (Vlax-SafeArray->List (Vlax-Variant-Value (vla-get-InsertionPoint &ob1))))<br />     (setq pt1 (list (car pt1) (cadr pt1)));坐标Z为0<br />     (vla-delete &ob1);删除原来的文字<br />     (setq ss4 (append ss5 ss4))<br />     (setq ss4 (cons (cons 10 pt1) ss4))<br />     (setq ss3 (append ss3 ss4))<br />     (entmake ss3);绘制文字<br />    );while;1<br />   );progn;1<br /> );if;1<br /> (prin1)<br /> )

石井鱼

已经解决，感谢明经

haotaer

高，这个真的还有

石井鱼

437271963 发表于 2016-2-28 19:15

非常感谢437271963帮忙，辛苦编写了这段很好的程序，适用了一下，发现其他都很实现了，但是字体样式没有改过来，新字体样式是生成了，就是没有所选文字没有变，不知能否再完善一下，再次感谢！

437271963

已经重新修正。

石井鱼

OK，完美，谢谢437271963的热心帮助，感谢明经这个平台！

ly8zx2109

看看。