Change color of Entity & Blocks [Modification on lisp]

[Yamishon_Noah]

Hi,

I have below lisp which is now converting selected entity or block color to specified.

I want to change it as multi select either entity or block in place of one by one.

Seeking expert help.

Thanks

Yomishon

(defun c:blcc () (pl:block-color) (princ))
 
(defun c:encc () (pl:block-ent-color) (princ))
 
 
(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))

[m_badran]

What about change inside block to layer 0 and select what ever you need to color which you desire.

HTH

[Yamishon_Noah]

Hello HTH,

That will not be a solution, Actually I dont want to change its layer, only color needs to be changed.

and I have many blocks in drawing.

What I want is Just execute command and select multiple utilities in CAD and change color simply.

Thanks for your reply.

Yamishon

[dbhunia]

For BLCC try this.....

(defun pl:block-color (/ adoc blocks color ins lays ss)
(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 (setq ss (ssget '((0 . "INSERT"))))
		    (/= 52 (getvar "errno"))
	       )
	       (foreach ins (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
			(progn (setq ins (vlax-ename->vla-object 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)
)

[Yamishon_Noah]

Hi Expert Debashis Bhunia..

Awesome work..! Thank you.

It converts all selected block to selected color but its not converting dimension color within the block.!

Can you help with this?

Yamishon

[Yamishon_Noah]

For an entity conversion found below code

But it is not converting dimensions...

Can anyone modify code/adding dimension property also in this code please?

Yamishon

(defun c:Ch_Color (/ clr i ss ent elst)
 (vl-load-com)

 (if (and (setq clr     (acad_colordlg 0))
          (setq i -1 ss (ssget "_:L")))
   
   (while (setq ent (ssname ss (setq i (1+ i))))
     (setq elst
       (vl-remove-if
         (function
           (lambda (x)
             (vl-position (car x) '(62 420)))) (entget ent)))

     (entmod (append elst (list (cons 62 clr))))))

 (princ ))

[dbhunia]

Both are working for me (dimensions color change)............ can you post a drawing............

[Yamishon_Noah]

Here you go drawing and lisp I used..

Yamishon

[Yamishon_Noah]

Can anybody help me to complete this?

Yamishon