Jump to content
xpr0

Need modification-Block & Entity Color Change

Recommended Posts

xpr0
Posted (edited)
(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 by xpr0

Share this post


Link to post
Share on other sites
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 by Emmanuel Delay

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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)
)

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...