[LISP程序]：修改属性块中各属性的特性

sundyy

2. 
   
3. ;;程序名称：修改属性块中各属性的特性
   
4. ;;执行命令：TT
   
5. ;;程序功能：将选定的属性块对象中的各属性的特性，如字体、颜色等改变。
   
6. ;;作者：SUNDYY
   
7. ;;
   
8. (defun c:TT (/ selobjs)
   
9.   (setq selobjs (ssget))  ;修改用户选择集中属性块的属性
   
10.   ;;(setq selobjs (ssget "X" '((0 . "INSERT"))));自动修改所有属性块的属性
    
11.   (if (not selobjs)
    
12.     (princ "\n没有选择对象！")
    
13.     (change-att selobjs)
    
14.   )
    
15.   (princ)
    
16. )
    
17. (defun change-att (selobjs / ss_count ss_name ss_att)
    
18.   (vl-load-com)
    
19.   (setq ss_count 0)
    
20.   (repeat (sslength selobjs)
    
21.     (setq ss_name (ssname selobjs ss_count))
    
22.     (if        (and (setq ss_att (entget ss_name))
    
23.              (= (cdr (assoc 0 ss_att)) "INSERT")
    
24.         )
    
25.       (progn
    
26.         (if (= (cdr (assoc 66 ss_att)) 1)
    
27.           (progn                        ;下面是设置属性(针对增强属性编辑器中的文字选项和特性），可以使用变量，由用户输入
    
28.             (mapcar '(lambda (x)
    
29.                        (vla-put-layer x "text-en")  ;设置层为text-en
    
30.                        (vla-put-color x acbylayer)  ;设置颜色随层
    
31.                        (vla-put-stylename x "ENTXT");设置字体样式为自定义的ENTXT
    
32.                        (vla-put-height x 3)            ;设置字体高度为3，此处可以加一个图纸比例
    
33.                        (vla-put-scalefactor x 0.7)  ;设置宽度比例为0.7
    
34.                                                     ;......
    
35.                      )
    
36.                     (safearray-value
    
37.                       (variant-value
    
38.                         (vla-getattributes
    
39.                           (vlax-ename->vla-object ss_name)
    
40.                         )
    
41.                       )
    
42.                     )
    
43.             )
    
44.           )
    
45.         )
    
46.       )
    
47.     )
    
48.     (setq ss_count (1+ ss_count))
    
49.   )
    
50. )
    
51. (princ "\n程序已加载，输入TT命令执行。")
    

<br /> ;;程序名称：修改属性块中各属性的特性<br /> ;;执行命令：TT<br /> ;;程序功能：将选定的属性块对象中的各属性的特性，如字体、颜色等改变。<br /> ;;作者：SUNDYY<br /> ;;<br /> (defun c:TT (/ selobjs)<br />   (setq selobjs (ssget))  ;修改用户选择集中属性块的属性<br />   ;;(setq selobjs (ssget "X" '((0 . "INSERT"))));自动修改所有属性块的属性<br />   (if (not selobjs)<br />     (princ "\n没有选择对象！")<br />     (change-att selobjs)<br />   )<br />   (princ)<br /> )<br /> (defun change-att (selobjs / ss_count ss_name ss_att)<br />   (vl-load-com)<br />   (setq ss_count 0)<br />   (repeat (sslength selobjs)<br />     (setq ss_name (ssname selobjs ss_count))<br />     (if        (and (setq ss_att (entget ss_name))<br />              (= (cdr (assoc 0 ss_att)) "INSERT")<br />         )<br />       (progn<br />         (if (= (cdr (assoc 66 ss_att)) 1)<br />           (progn                        ;下面是设置属性(针对增强属性编辑器中的文字选项和特性），可以使用变量，由用户输入<br />             (mapcar '(lambda (x)<br />                        (vla-put-layer x "text-en")  ;设置层为text-en<br />                        (vla-put-color x acbylayer)  ;设置颜色随层<br />                        (vla-put-stylename x "ENTXT");设置字体样式为自定义的ENTXT<br />                        (vla-put-height x 3)            ;设置字体高度为3，此处可以加一个图纸比例<br />                        (vla-put-scalefactor x 0.7)  ;设置宽度比例为0.7<br />                                                     ;......<br />                      )<br />                     (safearray-value<br />                       (variant-value<br />                         (vla-getattributes<br />                           (vlax-ename->vla-object ss_name)<br />                         )<br />                       )<br />                     )<br />             )<br />           )<br />         )<br />       )<br />     )<br />     (setq ss_count (1+ ss_count))<br />   )<br /> )<br /> (princ "\n程序已加载，输入TT命令执行。")<br />

可以加一个对话框，由用户输入各属性值，比如增强属性编辑器，请高手指点。

killer9806

的确不错，可以好好练习一下哦

pxr201419

学习了，顶一个...

kyky1002

我在win10 64位 cad2020 提示Automation 错误。 未找到主键