Need modification-Block & Entity Color Change

[xpr0]

(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))

Hello friends, I downloaded this lisp from https://autocadtips1.com/2011/05/01/autolisp-block-entity-color-change/ and i want some modification. it only allows the user to select/pick one entity/block at a time it doesnt allow window selection. plz could someone edit it so that it would also allow the user to select through window selection(solid & crossing). thank you

Edited August 16, 2019 by xpr0

[Emmanuel Delay]

(wow, that lack of indentation hurt my eyes ... not your fault, I mean the original post)

 

I added a command BLSS (SS for ssget), which invokes a new function pl:block-color-ssget.

There's a double while loop, so you can change 1 selection of blocks and press enter and the color will be changed,

then you can make another selection, ... or press enter to end the loop.

 

You can still use c:blcc for single select.

And you can still use c:encc for nentsel subentity select.

 

Happy with this?

 

(defun c:blss () (pl:block-color-ssget) (princ))
(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)


;; Emmanuel Delay
(defun pl:block-color-ssget (/ adoc blocks color ins lays ss i blocks_done blockname)
  (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)
    (setq blocks_done (list))
    (princ "\nSelect block objects, then press Enter: ")
    (while  (setq ss (ssget (list (cons 0 "INSERT"))))
      (setq i 0)
      (while (setq ins (ssname ss i))
        (progn
          (setq ins (vlax-ename->vla-object ins))   ;; we don't need the car here, because (car (entsel)) removes the pick point ...
          (if (= (vla-get-objectname ins) "AcDbBlockReference")
            (if (vlax-property-available-p ins 'path)
              (princ "\nThis is external reference! Try pick other.")
              (progn
                ;; let's skip duplicates
                (setq blockname (vla-get-name ins))
                (if (member blockname blocks_done)  ;; if we already did this block, we skip it
                  (progn
                    (princ "\nSkipping block: ")
                    (princ blockname)
                  )
                  (progn
                    (princ "\n")
                    (setq blocks_done (append blocks_done (list blockname)))
                    (_pl:block-color blocks ins color lays)
                    (vla-regen adoc acallviewports)
                  )
                )
              )
            )
            (princ "\nThis isn't block! Try pick other.")
          )
        )
        (setq i (+ i 1))
      )
    )  ;; / while
    (vla-endundomark adoc)
    )
  )
  (princ)
)
 
(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 "\nBLSS - Changes color of a window selection of blocks")
  (princ "\nBLCC - Changes color of the chosen blocks")
  (princ "\nENCC - Changes color of the chosen objects (may be element of the block)")
  (princ)
)

Edited August 16, 2019 by Emmanuel Delay

[xpr0]

Thankyou Emmanuel for your effort it works great on blocks. but i also want it to work on all other objects as well, i think i should've been more clear when i said 'entity' in the 1st post i meant line, pline, mtext, text, arcs etc. in other words 'encc' with the option of window selection. plz could you modify it accordingly.

[Emmanuel Delay]

Okay

 

(defun c:blss () (pl:block-color-ssget) (princ))
(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-color-ssget (/ adoc blocks color ins lays ss i blocks_done blockname)
  (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)
    (setq blocks_done (list))
    (princ "\nSelect block objects, then press Enter: ")
    (while  (setq ss (ssget))  ;;  (list (cons 0 "INSERT"))
      (setq i 0)
      (while (setq ins (ssname ss i))
        (if (= "INSERT" (cdr (assoc 0 (entget ins))))
          (progn
            (setq ins (vlax-ename->vla-object ins))   ;; we don't need the car here, because (car (entsel)) removes the pick point ...
            (if (= (vla-get-objectname ins) "AcDbBlockReference")
              (if (vlax-property-available-p ins 'path)
                (princ "\nThis is external reference! Try pick other.")
                (progn
                  ;; let's skip duplicates
                  (setq blockname (vla-get-name ins))
                  (if (member blockname blocks_done)  ;; if we already did this block, we skip it
                    (progn
                      (princ "\nSkipping block: ")
                      (princ blockname)
                    )
                    (progn
                      (princ "\n")
                      (setq blocks_done (append blocks_done (list blockname)))
                      (_pl:block-color blocks ins color lays)
                      (vla-regen adoc acallviewports)
                    )
                  )
                )
              )
              (princ "\nThis isn't block! Try pick other.")
            )
          )
          ;; else, put the color to the entity
          (progn
            (vla-put-color (vlax-ename->vla-object ins) color)
          )
        )
        (setq i (+ i 1))
      )
    )  ;; / while
    (vla-endundomark adoc)
    )
  )
  (princ)
)
 
(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 "\nBLSS - Changes color of a window selection of blocks")
  (princ "\nBLCC - Changes color of the chosen blocks")
  (princ "\nENCC - Changes color of the chosen objects (may be element of the block)")
  (princ)
)

[xpr0]

On 8/19/2019 at 3:03 PM, Emmanuel Delay said:

Okay

 

 

(defun c:blss () (pl:block-color-ssget) (princ))
(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-color-ssget (/ adoc blocks color ins lays ss i blocks_done blockname)
  (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)
    (setq blocks_done (list))
    (princ "\nSelect block objects, then press Enter: ")
    (while  (setq ss (ssget))  ;;  (list (cons 0 "INSERT"))
      (setq i 0)
      (while (setq ins (ssname ss i))
        (if (= "INSERT" (cdr (assoc 0 (entget ins))))
          (progn
            (setq ins (vlax-ename->vla-object ins))   ;; we don't need the car here, because (car (entsel)) removes the pick point ...
            (if (= (vla-get-objectname ins) "AcDbBlockReference")
              (if (vlax-property-available-p ins 'path)
                (princ "\nThis is external reference! Try pick other.")
                (progn
                  ;; let's skip duplicates
                  (setq blockname (vla-get-name ins))
                  (if (member blockname blocks_done)  ;; if we already did this block, we skip it
                    (progn
                      (princ "\nSkipping block: ")
                      (princ blockname)
                    )
                    (progn
                      (princ "\n")
                      (setq blocks_done (append blocks_done (list blockname)))
                      (_pl:block-color blocks ins color lays)
                      (vla-regen adoc acallviewports)
                    )
                  )
                )
              )
              (princ "\nThis isn't block! Try pick other.")
            )
          )
          ;; else, put the color to the entity
          (progn
            (vla-put-color (vlax-ename->vla-object ins) color)
          )
        )
        (setq i (+ i 1))
      )
    )  ;; / while
    (vla-endundomark adoc)
    )
  )
  (princ)
)
 
(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 "\nBLSS - Changes color of a window selection of blocks")
  (princ "\nBLCC - Changes color of the chosen blocks")
  (princ "\nENCC - Changes color of the chosen objects (may be element of the block)")
  (princ)
)

sorry for the late reply. and thanx for editing the lisp it works as intended but there is a problem, when i used 'BLSS' and select diff. object through window selection and hit enter the drawing slows down and starts to stutter, blink and its takes 3-5 seconds to complete the task. and one more thing it doesnt work on hatch with gradient, if you fix this two issues it'll be great.

thank you once again for your time.

 

[Dayananda]

This is the code I try to find out.

Edited November 13, 2019 by Dayananda