Requesting to update the code, from "ALL TO Selected"

Anonymous · ‎06-16-2020

Dear Experts,

I need a small help. The below code can update "all elements inside the blocks to ZERO layer" in entire autocad drawing. But the requirement is code should ask the user for "multiple block selections" instead of applying to entire autocad drawing.

(defun C:nestblockzero (/ BLKDATA NEWCOLOR NEWCOLOR NEWLAYER LAYER XREFFLAG XDEPFLAG BLKENTNAME
COUNT ENTDATA ENTNAME ENTTYPE OLDCOLOR OLDLAYER SSCOUNT SS)

(command ".undo" "group")
(setq BLKDATA (tblnext "BLOCK" t))
(setq NEWCOLOR (cons 62 256)) ;this will set 62 (color) to bylayer
(setq NEWLAYER (cons 8 "0")) ;this will set 8 (layer) to 0
; While there is an entry in the block table to process, continue
(while BLKDATA
(prompt "\nRedefining colors for block: ")
(princ (cdr (assoc 2 BLKDATA)))
; Check to see if block is an XREF or is XREF dependent
(setq XREFFLAG (assoc 1 BLKDATA))
(setq XDEPFLAG (cdr (assoc 70 BLKDATA)))
; If block is not XREF or XREF dependent, i.e., regular block, then proceed.
(if (and (not XREFFLAG) (/= (logand XDEPFLAG 32) 32))
(progn
(setq BLKENTNAME (cdr (assoc -2 BLKDATA)))
(setq COUNT 1)
(terpri)
; As long as we haven't reached the end of the block's defintion, get the data
; for each entity and change its color assignment to BYLAYER.
(while BLKENTNAME
(princ COUNT)
(princ "\r")
(setq ENTDATA (entget BLKENTNAME)); get entities data 
(setq OLDCOLOR (assoc 62 ENTDATA)) ;get entities old color value
(setq OLDLAYER (assoc 8 ENTDATA)) ;get entities old layer value
(if OLDCOLOR ; if value exist (null = bylayer)
(entmod (subst NEWCOLOR oldcolor ENTDATA)) ; substitute old color to byblock
(entmod (cons NEWCOLOR ENTDATA)) ; modify ent data w/ byblock values
)
(if OLDLAYER ; if value exist (null = bylayer)
(entmod (subst newlayer oldlayer ENTDATA)) ; substitute old color to byblock
(entmod (cons newlayer ENTDATA)) ; modify ent data w/ byblock values
)
(setq BLKENTNAME (entnext BLKENTNAME)) ;if attributes exist, then edit next one
(setq COUNT (+ COUNT 1));
) ;end while for attribute trap
) ;progn
(progn
(princ " XREF...skipping!")
) ;progn
);end if not an Xref
(setq BLKDATA (tblnext "BLOCK")) ;next block please
) ;end while loop of blk data available to edit
(command ".undo" "end")
(command ".regen")
(PROMPT "\nDone... ")
(princ)
)

Thanks in advance.

roland.r71 · ‎06-16-2020

Try this (untested)

It should allow you to select first and then call the function. Everything selected should be processed.

or just call the function and select the objects to be processed.

-or- you can use the "zerolay" function (passing a selection as argument) from a lisp routine.

I'm unable to test it myself at the moment though.

(defun c:nestblockzero ( / ss )
   (if (setq ss (ssget "i"))
      (zerolay ss)
   ; else
      (progn
         ; --- Code by Lee Mac
         (setq ss 
            (LM:ssget "\nSelect blocks to change: "
               (list "_:L"
                  (append '((0 . "INSERT"))
                     (
                        (lambda ( / def lst )
                           (while (setq def (tblnext "block" (null def)))
                              (if (= 4 (logand 4 (cdr (assoc 70 def))))
                                 (setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
                              )
                           )
                           (if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
                        )
                     )
                     (if (= 1 (getvar 'cvport))
                         (list (cons 410 (getvar 'ctab)))
                         '((410 . "Model"))
                     )
                  )
               )
            )
         )
         ; --- End code by Lee Mac

         (if zerolay
            (zerolay ss)
            (prompt "\nNothing selected")
         )
      )
   )
)

(defun LM:ssget ( msg arg / sel )
   ;; ssget  -  Lee Mac
   ;; A wrapper for the ssget function to permit the use of a custom selection prompt
   ;; msg - [str] selection prompt
   ;; arg - [lst] list of ssget arguments
   (princ msg)
   (setvar 'nomutt 1)
   (setq sel (vl-catch-all-apply 'ssget arg))
   (setvar 'nomutt 0)
   (if (not (vl-catch-all-error-p sel)) sel)
)

(defun zerolay ( ss / i blkdata )
   ; ss = selectionset with blocks
   (command ".undo" "group")
   (setq i 0)
   (while (< i (sslength ss))
      (setq BLKDATA (entget (ssname ss i)))

      ; --- Original code by nanaji130285
      (prompt "\nRedefining colors for block: ")
      (princ (cdr (assoc 2 BLKDATA)))
      ; Check to see if block is an XREF or is XREF dependent
      (setq XREFFLAG (assoc 1 BLKDATA))
      (setq XDEPFLAG (cdr (assoc 70 BLKDATA)))
      ; If block is not XREF or XREF dependent, i.e., regular block, then proceed.
      (if (and (not XREFFLAG) (/= (logand XDEPFLAG 32) 32))
         (progn
            (setq BLKENTNAME (cdr (assoc -2 BLKDATA)))
            (setq COUNT 1)
            (terpri)
            ; As long as we haven't reached the end of the block's defintion, get the data
            ; for each entity and change its color assignment to BYLAYER.
            (while BLKENTNAME
               (princ COUNT)
               (princ "\r")
               (setq ENTDATA (entget BLKENTNAME)); get entities data 
               (setq OLDCOLOR (assoc 62 ENTDATA)) ;get entities old color value
               (setq OLDLAYER (assoc 8 ENTDATA)) ;get entities old layer value
               (if OLDCOLOR ; if value exist (null = bylayer)
                  (entmod (subst NEWCOLOR oldcolor ENTDATA)) ; substitute old color to byblock
                  (entmod (cons NEWCOLOR ENTDATA)) ; modify ent data w/ byblock values
               )
               (if OLDLAYER ; if value exist (null = bylayer)
                  (entmod (subst newlayer oldlayer ENTDATA)) ; substitute old color to byblock
                  (entmod (cons newlayer ENTDATA)) ; modify ent data w/ byblock values
               )
               (setq BLKENTNAME (entnext BLKENTNAME)) ;if attributes exist, then edit next one
               (setq COUNT (+ COUNT 1));
            ) ;end while for attribute trap
         ) ;progn
         (progn
            (princ " XREF...skipping!")
         ) ;progn
      );end if not an Xref
      ; --- End original code by nanaji130285

      (setq i (1+ i))
   )
   (command ".undo" "end")
   (command ".regen")
   (PROMPT "\nDone... ")
   (princ)
)

Kent1Cooper · ‎06-16-2020

My routine to do that is >here<. And it's not the only solution in that thread -- check out the rest.

Kent Cooper, AIA

roland.r71 · ‎06-16-2020

         ; --- End code by Lee Mac

         (if zerolay
            (zerolay ss)
            (prompt "\nNothing selected")
         )

Should of course be:

         ; --- End code by Lee Mac

         (if ss
            (zerolay ss)
            (prompt "\nNothing selected")
         )

marko_ribar · ‎06-16-2020

It won't work because you removed dotted pairs NEWCOLOR and NEWLAYER from OP's original code...

Marko Ribar, d.i.a. (graduated engineer of architecture)

roland.r71 · ‎06-16-2020

😬you're right...

Let's see…

(defun zerolay ( ss / i blkdata )
; ss = selectionset with blocks
(command ".undo" "group")
(setq i 0)
(setq NEWCOLOR (cons 62 256)) ;this will set 62 (color) to bylayer
(setq NEWLAYER (cons 8 "0")) ;this will set 8 (layer) to 0
(while (< i (sslength ss))
(setq BLKDATA (entget (ssname ss i)))

; and so on...

alexKoshman · ‎06-16-2020

(defun C:nestblockzero (/ BLKDATA NEWCOLOR NEWCOLOR NEWLAYER LAYER XREFFLAG XDEPFLAG BLKENTNAME
COUNT ENTDATA ENTNAME ENTTYPE OLDCOLOR OLDLAYER SSCOUNT
                          SS J sslen next blk_list name 
                       )

(command ".undo" "group")

(princ "\nSelect blocks to redefine layers to ZERO or press ENTER to redefine ALL of them...")
(setq ss (ssget (list (cons 0 "INSERT"))))

(if ss
(progn
(setq sslen (sslength ss))
(setq j 0)
(while (< j sslen)
  (PRINC J)(TERPRI)
  (setq name (cdr (assoc 2 (entget (ssname ss j)))))
  (PRINC "\nname: ")(PRINC name)
  (if (not (member name blk_list)) (setq blk_list (append (list name) blk_list)))
  (setq j (1+ j))
)
)
)

(setq BLKDATA (tblnext "BLOCK" t))
(setq NEWCOLOR (cons 62 256)) ;this will set 62 (color) to bylayer
(setq NEWLAYER (cons 8 "0")) ;this will set 8 (layer) to 0
; While there is an entry in the block table to process, continue
(while BLKDATA

(setq name (cdr (assoc 2 BLKDATA)))

(if (member name blk_list)
(PROGN

(princ (strcat "\nRedefining colors for block: " (cdr (assoc 2 BLKDATA))))
; Check to see if block is an XREF or is XREF dependent
(setq XREFFLAG (assoc 1 BLKDATA))
(setq XDEPFLAG (cdr (assoc 70 BLKDATA)))
; If block is not XREF or XREF dependent, i.e., regular block, then proceed.
(if (and (not XREFFLAG) (/= (logand XDEPFLAG 32) 32))
(progn
(setq BLKENTNAME (cdr (assoc -2 BLKDATA)))
(setq COUNT 1)
(terpri)
; As long as we haven't reached the end of the block's defintion, get the data
; for each entity and change its color assignment to BYLAYER.
(while BLKENTNAME
(princ COUNT)
(princ "\r")
(setq ENTDATA (entget BLKENTNAME)); get entities data 
(setq OLDCOLOR (assoc 62 ENTDATA)) ;get entities old color value
(setq OLDLAYER (assoc 8 ENTDATA)) ;get entities old layer value
(if OLDCOLOR ; if value exist (null = bylayer)
(entmod (subst NEWCOLOR oldcolor ENTDATA)) ; substitute old color to byblock
(entmod (cons NEWCOLOR ENTDATA)) ; modify ent data w/ byblock values
)
(if OLDLAYER ; if value exist (null = bylayer)
(entmod (subst newlayer oldlayer ENTDATA)) ; substitute old color to byblock
(entmod (cons newlayer ENTDATA)) ; modify ent data w/ byblock values
)
(setq BLKENTNAME (entnext BLKENTNAME)) ;if attributes exist, then edit next one
(setq COUNT (+ COUNT 1));
) ;end while for attribute trap
) ;progn
(progn
(princ " XREF...skipping!")
) ;progn
);end if not an Xref

) ;end PROGN
) ;end IF

;MOVED HERE
(setq BLKDATA (tblnext "BLOCK")) ;next block please

) ;end while loop of blk data available to edit




(command ".undo" "end")
(command ".regen")
(PROMPT "\nDone... ")
(princ)
)

Anonymous · ‎06-16-2020

Dear Sir,

I have applied your code to my drawing, but not able to update all nested blocks to layer zero. Please find the attached drawing. There you can find a vehicle (small car, a nestsed block) on right-hand side.

I am not able to update that vehicle (nested block) to zero layers. I am requesting you to, Please apply to this drawing and check.

But my original code is working on that exactly as below. The only problem from my original code is , I am not able to select the required block. It's working for entire drawing.

Sir, The Original code is below

(defun C:nestblockzero (/ BLKDATA NEWCOLOR NEWCOLOR NEWLAYER LAYER XREFFLAG XDEPFLAG BLKENTNAME
COUNT ENTDATA ENTNAME ENTTYPE OLDCOLOR OLDLAYER SSCOUNT SS)

(command ".undo" "group")
(setq BLKDATA (tblnext "BLOCK" t))
(setq NEWCOLOR (cons 62 256)) ;this will set 62 (color) to bylayer
(setq NEWLAYER (cons 8 "0")) ;this will set 8 (layer) to 0
; While there is an entry in the block table to process, continue
(while BLKDATA
(prompt "\nRedefining colors for block: ")
(princ (cdr (assoc 2 BLKDATA)))
; Check to see if block is an XREF or is XREF dependent
(setq XREFFLAG (assoc 1 BLKDATA))
(setq XDEPFLAG (cdr (assoc 70 BLKDATA)))
; If block is not XREF or XREF dependent, i.e., regular block, then proceed.
(if (and (not XREFFLAG) (/= (logand XDEPFLAG 32) 32))
(progn
(setq BLKENTNAME (cdr (assoc -2 BLKDATA)))
(setq COUNT 1)
(terpri)
; As long as we haven't reached the end of the block's defintion, get the data
; for each entity and change its color assignment to BYLAYER.
(while BLKENTNAME
(princ COUNT)
(princ "\r")
(setq ENTDATA (entget BLKENTNAME)); get entities data 
(setq OLDCOLOR (assoc 62 ENTDATA)) ;get entities old color value
(setq OLDLAYER (assoc 8 ENTDATA)) ;get entities old layer value
(if OLDCOLOR ; if value exist (null = bylayer)
(entmod (subst NEWCOLOR oldcolor ENTDATA)) ; substitute old color to byblock
(entmod (cons NEWCOLOR ENTDATA)) ; modify ent data w/ byblock values
)
(if OLDLAYER ; if value exist (null = bylayer)
(entmod (subst newlayer oldlayer ENTDATA)) ; substitute old color to byblock
(entmod (cons newlayer ENTDATA)) ; modify ent data w/ byblock values
)
(setq BLKENTNAME (entnext BLKENTNAME)) ;if attributes exist, then edit next one
(setq COUNT (+ COUNT 1));
) ;end while for attribute trap
) ;progn
(progn
(princ " XREF...skipping!")
) ;progn
);end if not an Xref
(setq BLKDATA (tblnext "BLOCK")) ;next block please
) ;end while loop of blk data available to edit
(command ".undo" "end")
(command ".regen")
(PROMPT "\nDone... ")
(princ)
)

roland.r71 · ‎06-16-2020

Yep.

Actually that's not so strange.

If you do ALL blocks, that will include the nested ones.

BUT, if you select a block (or a few) it will NOT include nested blocks, as you need to edit that block, too.

However, these functions (mine included) do not check if there are any nested blocks, so they don't get changed. Not that it can't be done ...

edit: Did you try @Kent1Cooper 's function?

That one should include all nested blocks.

Anonymous · ‎06-16-2020

Sir, I understood that code can't be changed as per my requirement.

Thanks a lot for confirming.

roland.r71 · ‎06-16-2020

No, it can.

But it will take a bit more code, to check each block selected for any nested blocks. Which can have nested blocks itself.

It's just that the current code only changes the selected block(s) or all, but not blocks inside blocks.

Anonymous · ‎06-16-2020

Thank you Sir,

Waiting for your reply with Exact solution.

alexKoshman · ‎06-16-2020

Yes, yes, guys, you are right, It can be done, but I can't make the good recursive LISP functions!..

: ((

roland.r71 · ‎06-16-2020

Did you check the thread @Kent1Cooper posted?

There's one by his hand, but also a nice small one by Lee Mac. >this one< ( for just the layer, but it's easy to expand)

Anonymous · ‎06-16-2020

Thanks a million Sir.

Community

Requesting to update the code, from &quot;ALL TO Selected&quot;