Jump to content

Set objects of a specific layer to the colour from block

Philipp

By Philipp
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Philipp Contributor

Philipp

Posted
  • Author
Posted

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

 

Link to comment
Share on other sites
  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • Philipp

    12

  • tombu

    3

  • mhupp

    3

  • Steven P

    2

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

SLW210
SLW210

You can Start with AFRALISP for learning LISP, VLISP, VBA, etc. as well as the AutoCAD Developers Guide and Tutorials that come with AutoCAD.   If I read the question correctly... The O

Steven P
Steven P

I am not sure if I am following this correctly, Like MHUPP says, maybe a sample drawing could help - even a small portion of one, perhaps with a 'before' and 'after' block from what you have now and w

tombu
tombu

Lots of similar code out there but most like Steven P's set a list of properties to ByBlock and Layer 0 which is how most blocks are created. They exist and have the properties of whatever layer you p

Philipp Contributor

Philipp

Posted
  • Author
Posted

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.

Link to comment
Share on other sites
marko_ribar Veteran

marko_ribar

Posted
Posted (edited) 
(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 by marko_ribar
Link to comment
Share on other sites
Philipp Contributor

Philipp

Posted
  • Author
Posted
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)

Link to comment
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
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  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.

×
 Share
Go to topic listing
×
×
  • Create New...