[编程申请]：求改颜色LSP。

Dream.Fei

目的：改变“增强属性块”内“文字”的“颜色”。

手段：只需要在运行命令后再选择块，然后被提示输入颜色值即可（这个块被多重嵌套，至少2层）。

要求：不能炸开块，即使因为运行需要而不得不炸开，命令执行后也必须使它成为一个块。

HuaiYu

用 VLISP 做了一个，请参考...

2. 
   
3. (Defun C:test (/ *AcadDocument* blocks lstTxt en color)
   
4.   (VL-LOAD-COM)
   
5.   ;;        init the variables                .
   
6.   (setq        *AcadDocument* (vla-Get-ActiveDocument (vlax-get-acad-object))
   
7.         blocks               (vla-get-blocks *AcadDocument*)
   
8.         lstTxt               '()
   
9.   )
   
10.   ;;        get the block                .
    
11.   (setq en (vl-catch-all-apply 'EntSel (list "\nPlease select a block ojbect: ")))
    
12.   (if (or (vl-catch-all-error-p en) (null en) (/= (cdr (assoc 0 (entget (car en)))) "INSERT"))
    
13.     (vl-exit-with-value 0)
    
14.   )
    
15.   (setq vn (vlax-ename->vla-object (car en)))
    
16.   ;;        get the color                .
    
17.   (setq color (vl-catch-all-apply 'getInt (list "\nPlease input the text color (0 - 254)<1>:")))
    
18.   (cond        ((vl-catch-all-error-p color) (vl-exit-with-value 0))
    
19.         ((or (null color) (> color 254) (< color 0)) (setq color 1))
    
20.   )
    
21.   ;;        get the text object        .
    
22.   (subFuc vn)
    
23.   ;;        put the color to the text                .
    
24.   (foreach txt lstTxt (princ "\n") (princ (vla-get-TextString txt)) (vla-put-color txt color))
    
25.   (setvar "cmdecho" 0)
    
26.   (command "_.regen")
    
27.   (prin1)
    
28. )
    
29. ;;        递归函数求Text                .
    
30. (Defun subFuc (blk)
    
31.   (vlax-for en (vla-item blocks (vla-get-name blk))
    
32.     (cond ((= (vla-get-objectName en) "AcDbBlockReference") (subFuc en))
    
33.           ((= (vla-get-objectName en) "AcDbText") (setq lstTxt (cons en lstTxt)))
    
34.     )
    
35.   )
    
36. )
    
37. ;;       

<br /> (Defun C:test (/ *AcadDocument* blocks lstTxt en color)<br />   (VL-LOAD-COM)<br />   ;;        init the variables                .<br />   (setq        *AcadDocument* (vla-Get-ActiveDocument (vlax-get-acad-object))<br />         blocks               (vla-get-blocks *AcadDocument*)<br />         lstTxt               '()<br />   )<br />   ;;        get the block                .<br />   (setq en (vl-catch-all-apply 'EntSel (list "\nPlease select a block ojbect: ")))<br />   (if (or (vl-catch-all-error-p en) (null en) (/= (cdr (assoc 0 (entget (car en)))) "INSERT"))<br />     (vl-exit-with-value 0)<br />   )<br />   (setq vn (vlax-ename->vla-object (car en)))<br />   ;;        get the color                .<br />   (setq color (vl-catch-all-apply 'getInt (list "\nPlease input the text color (0 - 254)<1>:")))<br />   (cond        ((vl-catch-all-error-p color) (vl-exit-with-value 0))<br />         ((or (null color) (> color 254) (< color 0)) (setq color 1))<br />   )<br />   ;;        get the text object        .<br />   (subFuc vn)<br />   ;;        put the color to the text                .<br />   (foreach txt lstTxt (princ "\n") (princ (vla-get-TextString txt)) (vla-put-color txt color))<br />   (setvar "cmdecho" 0)<br />   (command "_.regen")<br />   (prin1)<br /> )<br /> ;;        递归函数求Text                .<br /> (Defun subFuc (blk)<br />   (vlax-for en (vla-item blocks (vla-get-name blk))<br />     (cond ((= (vla-get-objectName en) "AcDbBlockReference") (subFuc en))<br />           ((= (vla-get-objectName en) "AcDbText") (setq lstTxt (cons en lstTxt)))<br />     )<br />   )<br /> )<br /> ;;       

                .

eachy

vl-catch-all-apply 用的多了，还可以用的更好些， 主程序写成函数，用 vl-catch-all-apply 执行，这样就不需要 *error* 处理

Dream.Fei

测试发现不行啊！

HuaiYu

最初由 eachy 发布
[B]vl-catch-all-apply 用的多了，还可以用的更好些， 主程序写成函数，用 vl-catch-all-apply 执行，这样就不需要 *error* 处理 [/B]

真诚请 eachy 斑竹明示，谢谢------!!!!


请楼主将 AcDbText 改成你你想要的类型就可以的...

eachy

2. 
   
3. (defun c:tt (/ chgcolor oldos subFuc)
   
4.   (Defun subFuc        (blk color)
   
5.     (vlax-for en (vla-item blocks (vla-get-name blk))
   
6.       (cond ((= (vla-get-objectName en) "AcDbBlockReference")
   
7.              (subFuc en)
   
8.             )
   
9.             ((= (vla-get-objectName en) "AcDbText")
   
10.              ;;(setq lstTxt (cons en lstTxt))
    
11.              (vla-put-color en color)
    
12.             )
    
13.       )
    
14.     )
    
15.   )
    
16.   (defun chgcolor (/ e col)
    
17.     (if        (and (setq e (entsel "\nSelect Object: "))
    
18.              (setq col (getint "\nInput Color: "))
    
19.         )
    
20.       (subFuc (vlax-ename->vla-object (car e)) col)
    
21.     )
    
22.   )
    
23.   ;;Main
    
24.   (setq oldos (getvar "osmode"))
    
25.   (setvar "osmode" 0)
    
26.   (vl-catch-all-apply 'chgcolor)
    
27.   (setvar "osmode" oldos) ;_大家可以测试前面 CANCEL 后这句是否执行
    
28.   (princ)
    
29. )

<br /> (defun c:tt (/ chgcolor oldos subFuc)<br />   (Defun subFuc        (blk color)<br />     (vlax-for en (vla-item blocks (vla-get-name blk))<br />       (cond ((= (vla-get-objectName en) "AcDbBlockReference")<br />              (subFuc en)<br />             )<br />             ((= (vla-get-objectName en) "AcDbText")<br />              ;;(setq lstTxt (cons en lstTxt))<br />              (vla-put-color en color)<br />             )<br />       )<br />     )<br />   )<br />   (defun chgcolor (/ e col)<br />     (if        (and (setq e (entsel "\nSelect Object: "))<br />              (setq col (getint "\nInput Color: "))<br />         )<br />       (subFuc (vlax-ename->vla-object (car e)) col)<br />     )<br />   )<br />   ;;Main<br />   (setq oldos (getvar "osmode"))<br />   (setvar "osmode" 0)<br />   (vl-catch-all-apply 'chgcolor)<br />   (setvar "osmode" oldos) ;_大家可以测试前面 CANCEL 后这句是否执行 <br />   (princ)<br /> )

HuaiYu

衷心感谢，回去好好学习
受教了.....

Dream.Fei

为什么我的还是改不了啊？版主！