Set objects of a specific layer to the colour from block

[Philipp]

If I change that, it will not find a block to select, I tried the following but it changes all elements again:

 

(defun err-ubc (s)              ; If an error (such as CTRL-C) occurs
 
; while this command is active...
 
(if (/= s "Function cancelled")
 
(princ (strcat "\nError: " s))
 
)
 
(setq *error* olderr)           ; Restore old *error* handler
 
(princ)
 
);err-ubc
 
(DEFUN C:BBL (/ *error* BLK CBL CBL2 C ACL ALY NLY NCL)

	(defun *error*  (s)              ; Localized *error* for if an error (such as CTRL-C) occurs
	; while this command is active...
		(if (/= s "Function cancelled")
			(princ (strcat "\nError: " s))
		)
		(princ)
	);*error*

	(initget "?")
	(while
		(or (eq (setq C (getint "\nEnter new color number/<?>: ")) "?")
		(null C)
		(> C 256)
		(< C 0)
		);or
		(textscr)
		(princ "\n                                                     ")
		(princ "\n                 Color number   |   Standard meaning ")
		(princ "\n                ________________|____________________")
		(princ "\n                                |                    ")
		(princ "\n                       0        |      <BYBLOCK>     ")
		(princ "\n                       1        |      Red           ")
		(princ "\n                       2        |      Yellow        ")
		(princ "\n                       3        |      Green         ")
		(princ "\n                       4        |      Cyan          ")
		(princ "\n                       5        |      Blue          ")
		(princ "\n                       6        |      Magenta       ")
		(princ "\n                       7        |      White         ")
		(princ "\n                    8...255     |      -Varies-      ")
		(princ "\n                      256       |      <BYLAYER>     ")
		(princ "\n                                               \n\n\n") (initget "?") 
	);while
	(PROMPT "\nPick blocks to update. ")
	(SETQ SS (SSGET '((0 . "INSERT"))))
	(SETQ K 0) 
		(WHILE (< K (SSLENGTH SS))
		(setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K))))))) 
		(SETQ CBL2 (CDR (ASSOC -2 CBL)))
			(WHILE (BOUNDP 'CBL2) 
			(SETQ EE (ENTGET CBL2))
			;Update layer value
			(SETQ NCL (CONS 62 C))
			(SETQ ACL (ASSOC 62 EE))
			(IF (= ACL nil)
				(SETQ NEWE (APPEND EE (LIST NCL)))
				(SETQ NEWE (SUBST NCL ACL EE))
			);if
			(or(=(cdr(ASSOC 8 EE))(2 . "ET_SYMB_BLOCK"))(ENTMOD NEWE))
			(SETQ CBL2 (ENTNEXT CBL2))
			);end while
			(ENTUPD BLK)
			(SETQ K (1+ K))
	);end while
	(setq *error* olderr)
	(princ)
);end BBL

 

[ronjonp]

Are you using dynamic blocks?

[Philipp]

yes and no, the program from tombu works in some way for my configuration, except for it does quite the opposite I want it and  affects all but not a specific layer.

 

Unfortunatly I cant tell the programm to affect 1 specific layer, or write it the other way around to not! affect more than one layer.

[marko_ribar]

(defun c:bbl ( / *error* ss k blk cbl cbl2 ee c acl aly nly ncl )

  (defun *error* ( s ) ; localized *error* for if an error (such as ctrl-c) occurs
    ; while this command is active...
    (if (/= s "function cancelled")
      (princ (strcat "\nError: " s))
    )
    (princ)
  ) ; *error*

  (while
    (or
      (textscr)
      (princ "\n                                                     ")
      (princ "\n                 color number   |   standard meaning ")
      (princ "\n                ________________|____________________")
      (princ "\n                                |                    ")
      (princ "\n                       0        |      <byblock>     ")
      (princ "\n                       1        |      red           ")
      (princ "\n                       2        |      yellow        ")
      (princ "\n                       3        |      green         ")
      (princ "\n                       4        |      cyan          ")
      (princ "\n                       5        |      blue          ")
      (princ "\n                       6        |      magenta       ")
      (princ "\n                       7        |      white         ")
      (princ "\n                    8...255     |      -varies-      ")
      (princ "\n                      256       |      <bylayer>     ")
      (princ "\n                                               \n\n\n")
      (progn (initget "?") (setq c (getint "\nEnter new color number <?> : ")) nil)
      (or (not c) (= c "?"))
      (and c (not (<= 0 c 256)))
    ) ; or
  ) ; while
  (prompt "\nSelect blocks to update...")
  (if (setq ss (ssget "_:L" '((0 . "INSERT") (2 . "ET_SYMB_BLOCK"))))
    (progn
      (setq k 0) 
      (while (< k (sslength ss))
        (setq cbl (tblsearch "BLOCK" (cdr (assoc 2 (entget (setq blk (ssname ss k))))))) 
        (setq cbl2 (cdr (assoc -2 cbl)))
        (while (boundp 'cbl2) 
          (setq ee (entget cbl2))
          ; update layer value
          (setq ncl (cons 62 c))
          (setq acl (assoc 62 ee))
          (if acl
            (setq newe (subst ncl acl ee))
            (setq newe (append ee (list ncl)))
          ) ; if
          ;|
          (or
            (wcmatch (cdr (assoc 8 ee))
              (strcat
                "ET_SYMB_GREY"
                ","
                "ET_ATTR_ABMESS"
                ","
                "ET_ATTR_BEZ"
                ","
                "ET_ATTR_LEIST"
                ","
                "ET_ATTR_LV"
                ","
                "ET_ATTR_SCHALT"
                ","
                "ET_ATTR_SCHUTZ"
                ","
                "ET_ATTR_STROM"
                ","
                "ET_ATTR_TUER"
                ","
                "ET_ATTR_TYP"
                ","
                "ET_ATTR_VERT"
              )
            )
            (entmod newe)
          )
          |; ;;; ^^^ Above is exactly what you want ^^^, but I prefer this what I wrote below : vvv (study "wcmatch" function - it can serve to very beneficial appliance) vvv ;;;
          (or (wcmatch (cdr (assoc 8 ee)) "ET_SYMB_*,ET_ATTR_*") (entmod newe))
          (setq cbl2 (entnext cbl2))
        ) ; end while
        (entupd blk)
        (setq k (1+ k))
      ) ; end while
    ) ; end progn
    (prompt "\nEmpty sel. set... Nothing selected...")
  ) ; end if (ss)
  (princ)
) ; end bbl

 

Edited February 25, 2022 by marko_ribar

[Philipp]

17 hours ago, marko_ribar said:

(defun c:bbl ( / *error* ss k blk cbl cbl2 ee c acl aly nly ncl )

  (defun *error* ( s ) ; localized *error* for if an error (such as ctrl-c) occurs
    ; while this command is active...
    (if (/= s "function cancelled")
      (princ (strcat "\nError: " s))
    )
    (princ)
  ) ; *error*

  (while
    (or
      (textscr)
      (princ "\n                                                     ")
      (princ "\n                 color number   |   standard meaning ")
      (princ "\n                ________________|____________________")
      (princ "\n                                |                    ")
      (princ "\n                       0        |      <byblock>     ")
      (princ "\n                       1        |      red           ")
      (princ "\n                       2        |      yellow        ")
      (princ "\n                       3        |      green         ")
      (princ "\n                       4        |      cyan          ")
      (princ "\n                       5        |      blue          ")
      (princ "\n                       6        |      magenta       ")
      (princ "\n                       7        |      white         ")
      (princ "\n                    8...255     |      -varies-      ")
      (princ "\n                      256       |      <bylayer>     ")
      (princ "\n                                               \n\n\n")
      (progn (initget "?") (setq c (getint "\nEnter new color number <?> : ")) nil)
      (or (not c) (= c "?"))
      (and c (not (<= 0 c 256)))
    ) ; or
  ) ; while
  (prompt "\nSelect blocks to update...")
  (if (setq ss (ssget "_:L" '((0 . "INSERT") (2 . "ET_SYMB_BLOCK"))))
    (progn
      (setq k 0) 
      (while (< k (sslength ss))
        (setq cbl (tblsearch "BLOCK" (cdr (assoc 2 (entget (setq blk (ssname ss k))))))) 
        (setq cbl2 (cdr (assoc -2 cbl)))
        (while (boundp 'cbl2) 
          (setq ee (entget cbl2))
          ; update layer value
          (setq ncl (cons 62 c))
          (setq acl (assoc 62 ee))
          (if acl
            (setq newe (subst ncl acl ee))
            (setq newe (append ee (list ncl)))
          ) ; if
          ;|
          (or
            (wcmatch (cdr (assoc 8 ee))
              (strcat
                "ET_SYMB_GREY"
                ","
                "ET_ATTR_ABMESS"
                ","
                "ET_ATTR_BEZ"
                ","
                "ET_ATTR_LEIST"
                ","
                "ET_ATTR_LV"
                ","
                "ET_ATTR_SCHALT"
                ","
                "ET_ATTR_SCHUTZ"
                ","
                "ET_ATTR_STROM"
                ","
                "ET_ATTR_TUER"
                ","
                "ET_ATTR_TYP"
                ","
                "ET_ATTR_VERT"
              )
            )
            (entmod newe)
          )
          |; ;;; ^^^ Above is exactly what you want ^^^, but I prefer this what I wrote below : vvv (study "wcmatch" function - it can serve to very beneficial appliance) vvv ;;;
          (or (wcmatch (cdr (assoc 8 ee)) "ET_SYMB_*,ET_ATTR_*") (entmod newe))
          (setq cbl2 (entnext cbl2))
        ) ; end while
        (entupd blk)
        (setq k (1+ k))
      ) ; end while
    ) ; end progn
    (prompt "\nEmpty sel. set... Nothing selected...")
  ) ; end if (ss)
  (princ)
) ; end bbl

 

Thanks, but it does not select the block again, like in every code with the line:

(if (setq ss (ssget "_:L" '((0 . "INSERT") (2 . "ET_SYMB_BLOCK"))))

 

maybe  another way around that would be easier to archieve would be a program that does this:

 

select block(s)

search for colour

*select colour 0-256 (in my example: green)

change to colour

*select colour 0-256 (in my example: byblock)