change Block Color

change Block Color

bahaatawfiq
Participant Participant
2,993 Views
7 Replies
Message 1 of 8

change Block Color

bahaatawfiq
Participant
Participant

Hello All i have that lisp which change the color for entire object to Specific Color But I need To Modified it ,to be Working Only For index Color, and all True Color Stay  the Same

 

 

(defun c:blcc () (pl:block-color) (princ))

(defun c:encc () (pl:block-ent-color) (princ))

;;;get from Alaspher http://forum.dwg.ru/showthread.php?t=1036

;;; http://forum.dwg.ru/showpost.php?p=166220&postcount=18

(vl-load-com)

(defun pl:block-ent-color (/ adoc blocks color ent lays)

(setq adoc (vla-get-activedocument (vlax-get-acad-object))

lays (vla-get-layers adoc)

color (acad_colordlg 256)

)

(if color

(progn (setvar "errno" 0)

(vla-startundomark adoc)

(while (and (not (vl-catch-all-error-p

(setq ent (vl-catch-all-apply

(function nentsel)

'("\nSelect entity <Exit>:")

)

)

)

)

(/= 52 (getvar "errno"))

)

(if ent

(progn (setq ent (vlax-ename->vla-object (car ent))

lay (vla-item lays (vla-get-layer ent))

)

(if (= (vla-get-lock lay) :vlax-true)

(progn (setq layloc (cons lay layloc))

(vla-put-lock lay :vlax-false)

)

)

(vl-catch-all-apply (function vla-put-color) (list ent color))

(vla-regen adoc acallviewports)

)

(princ "\nNothing selection! Try again.")

)

)

(foreach i layloc (vla-put-lock i :vlax-true))

(vla-endundomark adoc)

)

)

(princ)

)

(defun pl:block-color (/ adoc blocks color ins lays)

(setq adoc (vla-get-activedocument (vlax-get-acad-object))

blocks (vla-get-blocks adoc)

lays (vla-get-layers adoc)

color (acad_colordlg 256)

)

(if color

(progn (setvar "errno" 0)

(vla-startundomark adoc)

(while (and (not (vl-catch-all-error-p

(setq ins (vl-catch-all-apply

(function entsel)

'("\nSelect block <Exit>:")

)

)

)

)

(/= 52 (getvar "errno"))

)

(if ins

(progn (setq ins (vlax-ename->vla-object (car ins)))

(if (= (vla-get-objectname ins) "AcDbBlockReference")

(if (vlax-property-available-p ins 'path)

(princ "\nThis is external reference! Try pick other.")

(progn (_pl:block-color blocks ins color lays)

(vla-regen adoc acallviewports)

)

)

(princ "\nThis isn't block! Try pick other.")

)

)

(princ "\nNothing selection! Try again.")

)

)

(vla-endundomark adoc)

)

)

(princ)

)

(defun _pl:block-color (blocks ins color lays / lay layfrz layloc)

(vlax-for e (vla-item blocks (vla-get-name ins))

(setq lay (vla-item lays (vla-get-layer e)))

(if (= (vla-get-freeze lay) :vlax-true)

(progn (setq layfrz (cons lay layfrz)) (vla-put-freeze lay :vlax-false))

)

(if (= (vla-get-lock lay) :vlax-true)

(progn (setq layloc (cons lay layloc)) (vla-put-lock lay :vlax-false))

)

(vl-catch-all-apply (function vla-put-color) (list e color))

(if (and (= (vla-get-objectname e) "AcDbBlockReference")

(not (vlax-property-available-p e 'path))

)

(_pl:block-color blocks e color lays)

)

(foreach i layfrz (vla-put-freeze i :vlax-true))

(foreach i layloc (vla-put-lock i :vlax-true))

)

)

(progn

(princ "\BLCC - Changes color of the chosen blocks")

(princ "\nENCC - Changes color of the chosen objects (may be element of the block)")

(princ)) 

 

 

Thanks all for help 

0 Likes
Accepted solutions (1)
2,994 Views
7 Replies
Replies (7)
Message 2 of 8

paullimapa
Mentor
Mentor

Since Layers with a Truecolor property always has a 420 association pair, I decided to use this to test for Truecolor.

I added aec:chk_layer_truecolor function and inserted this test in the two sections of the code (attached). 

; chk_layer_truecolor function
; Argument: 
; layobj = vl layer object
; Returns:
; T if Layer has Truecolor Property
; nil if Layer does not have Truecolor Property
(defun aec:chk_layer_truecolor (layobj)
   (assoc 420(entget(vlax-vla-object->ename layobj)))
)

 


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 3 of 8

bahaatawfiq
Participant
Participant

Thanks Paul

Still i have the same issue , and to be more Specific I have Arch Plan With Windows Hatch have True Color (255,255,255) I need To keep it the same and change all Other Object Color to be 8 Color. This lisp file Work Great For Changing the Color but the issue it take time to change all the Window  to 255,255,255 again. 

0 Likes
Message 4 of 8

paullimapa
Mentor
Mentor

Sounds like your Window Block actually has objects that have colors (True Color) assigned and they're not Bylayer.

Perhaps you can post a drawing with the Window Block inserted for everyone to take a look to confirm?


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 5 of 8

bahaatawfiq
Participant
Participant

yes sure, this plan Sample i need to work on it ,but changing  the 255,255,255 color to 08 will make issue with  the window the Grid number so i need to make all the drawings 08 except of these 

0 Likes
Message 6 of 8

paullimapa
Mentor
Mentor
Accepted solution

Ok, if I understand you correctly, I've changed the code slightly so now it checks when the object itself is assigned a Truecolor the Color will not be changed.


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 7 of 8

bahaatawfiq
Participant
Participant
You are Great Man, Thanks It Works
0 Likes
Message 8 of 8

paullimapa
Mentor
Mentor

You are very welcome...cheers!!!


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes