使用Visual Lisp 修改 TrueColor 特性

Free-Lancer

Accessing the TrueColor property using Visual LISP                                                        By Philippe Leefsma
  Q:
  How to access the TrueColor property of an entity in AutoCAD? Also, is there a way to set an object's color back to "ByLayer"?
  
  A:
  First, it is necessary to access the object's TrueColor property, using vlax-get-property.  The RGB (Red, Green and Blue) values of TrueColor are read-only, so you can not individually modify them.  You must invoke the SetRGB method and set all three values at once.  Then, using vlax-put-property, you can set the object's TrueColor property to reflect the new RGB values.  You will notice that an object whose color is "ByLayer" returns RGB values of R=0, G=0, B=0.  However, setting these values explicitly, with SetRGB, will not restore the color to "ByLayer".  To reset the color to "ByLayer", it is necessary to set TrueColor's ColorIndex property to acBylayer.  The example below creates a line, whose color is initially "ByLayer".  We then change it to blue, and finally back to ByLayer:

1. (defun c:TestTrueClr()
   
2.    (vl-load-com)
   
3.    (setq oApp (vlax-get-Acad-Object)
   
4.            oDoc (vla-get-ActiveDocument oApp)
   
5.            oMSp (vla-get-ModelSpace oDoc)
   
6.    )
   
7.    ;; Add a Line
   
8.    (setq oLine (vla-AddLine oMSp  (vlax-3d-point '(1.0 1.0 0.0))  (vlax-3d-point '(10.0 10.0 0.0))))
   
9.     (vla-update oLine)
   
10. 
    
11.    ;; Get the current color values
    
12.    (setq oColor (vlax-get-property oLine 'TrueColor)
    
13.            clrR (vlax-get-property oColor 'Red)
    
14.            clrG (vlax-get-property oColor 'Green)
    
15.            clrB (vlax-get-property oColor 'Blue)
    
16.    )
    
17.    (alert (strcat "Old Color - Red: " (itoa clrR) " Green: " (itoa clrG) " Blue: " (itoa clrB)))
    
18. 
    
19.    ;; Set TrueColor to blue (R=0, G=101, B=204)
    
20.    (vlax-invoke-method oColor 'SetRGB 0 101 204)
    
21.    (vlax-put-property oLine 'TrueColor oColor)
    
22.    (vla-update oLine)
    
23. 
    
24.    ;; Inspect the new color values
    
25.    (setq oColor (vlax-get-property oLine 'TrueColor)
    
26.            clrR (vlax-get-property oColor 'Red)
    
27.            clrG (vlax-get-property oColor 'Green)
    
28.            clrB (vlax-get-property oColor 'Blue)
    
29.    )
    
30.    (alert (strcat "New Color - Red: " (itoa clrR) " Green: " (itoa clrG) " Blue: " (itoa clrB)))
    
31.   
    
32.    ;; Reset color to acBylayer
    
33.    (vlax-put-property oColor 'ColorIndex acByLayer)
    
34.    (vlax-put-property oLine 'TrueColor oColor)
    
35.    (vla-update oLine)
    
36. 
    
37.    ;; Inspect the color values
    
38.    (setq oColor (vlax-get-property oLine 'TrueColor)
    
39.            clrR (vlax-get-property oColor 'Red)
    
40.            clrG (vlax-get-property oColor 'Green)
    
41.            clrB (vlax-get-property oColor 'Blue)
    
42.    )
    
43.    (alert (strcat "New Color - Red: " (itoa clrR) " Green: " (itoa clrG) " Blue: " (itoa clrB)))
    
44. )
    

(defun c:TestTrueClr()<br />    (vl-load-com)<br />    (setq oApp (vlax-get-Acad-Object)<br />            oDoc (vla-get-ActiveDocument oApp)<br />            oMSp (vla-get-ModelSpace oDoc)<br />    )<br />    ;; Add a Line<br />    (setq oLine (vla-AddLine oMSp  (vlax-3d-point '(1.0 1.0 0.0))  (vlax-3d-point '(10.0 10.0 0.0))))<br />     (vla-update oLine)<br /> <br />    ;; Get the current color values<br />    (setq oColor (vlax-get-property oLine 'TrueColor)<br />            clrR (vlax-get-property oColor 'Red)<br />            clrG (vlax-get-property oColor 'Green)<br />            clrB (vlax-get-property oColor 'Blue)<br />    )<br />    (alert (strcat "Old Color - Red: " (itoa clrR) " Green: " (itoa clrG) " Blue: " (itoa clrB)))<br /> <br />    ;; Set TrueColor to blue (R=0, G=101, B=204)<br />    (vlax-invoke-method oColor 'SetRGB 0 101 204)<br />    (vlax-put-property oLine 'TrueColor oColor)<br />    (vla-update oLine)<br /> <br />    ;; Inspect the new color values<br />    (setq oColor (vlax-get-property oLine 'TrueColor)<br />            clrR (vlax-get-property oColor 'Red)<br />            clrG (vlax-get-property oColor 'Green)<br />            clrB (vlax-get-property oColor 'Blue)<br />    )<br />    (alert (strcat "New Color - Red: " (itoa clrR) " Green: " (itoa clrG) " Blue: " (itoa clrB)))<br />   <br />    ;; Reset color to acBylayer<br />    (vlax-put-property oColor 'ColorIndex acByLayer)<br />    (vlax-put-property oLine 'TrueColor oColor)<br />    (vla-update oLine)<br /> <br />    ;; Inspect the color values<br />    (setq oColor (vlax-get-property oLine 'TrueColor)<br />            clrR (vlax-get-property oColor 'Red)<br />            clrG (vlax-get-property oColor 'Green)<br />            clrB (vlax-get-property oColor 'Blue)<br />    )<br />    (alert (strcat "New Color - Red: " (itoa clrR) " Green: " (itoa clrG) " Blue: " (itoa clrB)))<br /> )<br />