Topic: Design Center ...

[Hangman]

Has anyone gotten annoyed at the insert of a design center object and found that it was designed 'byblock' and you have to explode it to get it to show the layer it was placed on  (ADT 2k4)
Maybe it's just me, I use a lot of the stuff from my 2000i Design Center to place into a dwg.  Unfortunately, I have to explode them to get them to show on the layer I placed them, otherwise they are always white.  But when I explode them, I no longer have a portrait for an elevation or section cut.
It's really annoying and time consuming to go into each object and change the properties to bylayer just so I have a portrait for my section.
I've tried just one or two lisps that are suppose to change properties of a block to 'color by layer' and editing attributes of a block but they don't work.
Would anyone have an idea on how to shorten the wasted time involved in changing the properties of these objects without exploding them  
Would anyone have a lisp that would allow changes to these particular objects
Thanks,

[Mark]

Not sure that this one will do it but give it a try.

Code: [Select]


;;; FUNCTION
;;; changes every block in a dwg to 'bylayer'
;;;
;;; ARGUMENTS
;;;
;;; USAGE
;;;
;;;
;;;
;;; PLATFORMS
;;; 2000+
;;;
;;; AUTHOR
;;; Copyright© 2002 Mark S. Thomas
;;; mark.thomas@theswamp.org
;;;
;;; VERSION
;;; 1.0 Fri Sep 27, 2002
;;;
(defun c:vl_BlockByLayer (/ *blks* blk-list)

  (setq *doc*
        (vlax-get-property (vlax-get-acad-object) 'ActiveDocument)
        *blks*
        (vlax-get-property *doc* 'Blocks)
        )

  ; create a list of simple block names
  (vlax-for X *blks*
            (if
              (and
                (/= (vlax-get-property X 'IsLayout) :vlax-true); MS. PS.
                (/= (vlax-get-property X 'IsXRef) :vlax-true); Xref
                )
              (setq
                blk-list
                (append
                  (list
                    (vlax-get-property X 'Name); block name string
                    )
                  blk-list
                  )
                ); setq
              ) ; if
            ); vlax-for

  ; iterate through the list of blocks
  (mapcar
    '(lambda (b)
       (vlax-for x (vla-item *blks* b)
                 (vlax-put-property x 'Color 256)
                 )
       ) ; lambda
    blk-list
    ) ; mapcar

  (if (not (vlax-object-released-p *blks*))
    (vlax-release-object *blks*))

  (vla-regen *doc* 1)

  (if (not (vlax-object-released-p *doc*))
    (vlax-release-object *doc*))

  (princ)

  ); defun


[Hangman]

Thanks Mark, ...  No, unfortunately, that didn't do it.
This is what I got in return;

Code: [Select]


Command: VL_BLOCKBYLAYER
*Cancel*
lisp value has no coercion to VARIANT with this type:  256

I've found the objects deep within the soil, but I can't change them to by layer without screwing them up so they won't display correctly when inserted.
hmmmmm...  

[Mark]

Upload a copy of the dwg to the lilly.pond and i'll work on it tonight or in the morning

[ronjonp]

Are yo trying to redefine the block on layer 0 so that it will absorb the color of the layer it is on?

If so......try this:

Code: [Select]

(defun To-0 (BLCK / BNAME BLIST E EDATA SPIN TMP)

;;; Prints a pinwheel on the command line
  (defun Spin ()
    (setq SYM
  (cond
    ((= SYM nil) "-")
    ((= SYM "-") "\\")
    ((= SYM "\\") "|")
    ((= SYM "|") "/")
    ((= SYM "/") "-")
  )
    )
    (princ (strcat "\rScanning... "
  SYM
  "                                    "
  )
    )
  ) ;end spin

  (if (= (type BLCK) (read "LIST"))
    (setq TMP (car BLCK)
 BLIST (cdr BLCK)
 BLCK TMP
 TMP nil
    )
  )
  (setq BLCK (tblsearch "BLOCK" BLCK))
  (if
    (and
      (/= (logand (cdr (assoc 70 BLCK)) 4) 4) ;skips xrefs
    ) ;and
     (progn
       (setq E (cdr (assoc -2 BLCK)))
       (while E
(if (= (cdr (assoc 0 (entget E))) "INSERT")
;If the object is a block
  (progn
    (setq BNAME (cdr (assoc 2 (entget E))))
;save the name to a list
    (if (not (member BNAME BLIST))
      (if (not BLIST)
(setq BLIST (list BNAME))
;create the list if it doesn't exist
(setq BLIST (append BLIST (list BNAME)))
      ) ;if
    ) ;if
  ) ;progn      
) ;if
(setq EDATA (entget E))
(if (assoc 62 EDATA) ;Resets object color to BYLAYER if it isn't.
  (setq EDATA (subst (cons 62 256) (assoc 62 EDATA) EDATA))
) ;if
(if (assoc 6 EDATA) ;Resets object linetype to BYLAYER if it isn't.
  (setq EDATA (subst (cons 6 "BYLAYER") (assoc 6 EDATA) EDATA))
) ;if
(setq EDATA (subst (cons 8 "0") (assoc 8 EDATA) EDATA))
;changes layer to 0
(entmod EDATA) ;updates entity
(setq E (entnext E)) ;get next enitiy, nil if end of block
(Spin)
       ) ;end while E
     ) ;progn
  ) ;if
  BLIST ; returns names of any nested blocks
) ;defun


(defun C:NUKE (/ BLK_NM)
  (command "._undo" "m")
;global nuke
  (while (setq BLK_NM (tblnext "BLOCK" (null BLK_NM)))
    (TO-0 (cdr (assoc 2 BLK_NM)))
  ) ;while
  (command "._regen")
  (princ "\rFinished                  ")
  (princ)
) ;defun
(prompt "\nNUKE loaded.")
(princ)
(c:nuke)

[Hangman]

Mark, It's just a simple object from the design center, a cabinet, a sink, a refrigertor.   These are blocks, but they are objects.   When inserted into a drawing, they take on the effect of an object.  If you want to do a section or elevation of a room, these objects are there, there is no need to draw them, they are already inserted into the dwg.
When I was working on ADT 2ki, I could drop these into a drawing on any particular layer and they would take on the color and linetype of that layer.
With ADT 2k4, they are inserted in block form even though they are objects.  Unfortunately, they are BY BLOCK so no matter what layer they are placed on, they are layer 0, white because they are BY BLOCK.   2ki wasn't as picky with these things as 2k4 is, with 2ki, you mearly had to designate the layer and they took on the attributes of that layer.
So I need to either find or write a lisp that will allow me to edit these objects without messing up the display of them, to change them to bylayer, or I need to ...  do something else.  
I'll try to upload a small dwg so you can see what I'm do'in.
Ron,
Yes, that does the trick.   Can I edit this to be able to pick which blocks I want this to happen to rather than have it scan and go through everything

[ronjonp]

try this one:

Code: [Select]

(defun To-0 (BLCK / BNAME BLIST E EDATA SPIN TMP)

;;; Prints a pinwheel on the command line
  (defun Spin ()
    (setq SYM
  (cond
    ((= SYM nil) "-")
    ((= SYM "-") "\\")
    ((= SYM "\\") "|")
    ((= SYM "|") "/")
    ((= SYM "/") "-")
  )
    )
    (princ (strcat "\rScanning... " SYM " "))
  ) ;end spin

  (if (= (type BLCK) (read "LIST"))
    (setq TMP (car BLCK)
 BLIST (cdr BLCK)
 BLCK TMP
 TMP nil
    )
  )
  (setq BLCK (tblsearch "BLOCK" BLCK))
  (if
    (and
      (/= (logand (cdr (assoc 70 BLCK)) 1) 1) ;skips annomyous blocks
      (/= (logand (cdr (assoc 70 BLCK)) 4) 4) ;skips xrefs
    ) ;and
     (progn
       (setq E (cdr (assoc -2 BLCK)))
       (while E
(if (= (cdr (assoc 0 (entget E))) "INSERT")
;If the object is a block
  (progn
    (setq BNAME (cdr (assoc 2 (entget E))))
;save the name to a list
    (if (not (member BNAME BLIST))
      (if (not BLIST)
(setq BLIST (list BNAME))
;create the list if it doesn't exist
(setq BLIST (append BLIST (list BNAME)))
      ) ;if
    ) ;if
  ) ;progn
) ;if
(setq EDATA (entget E))
(if (assoc 62 EDATA) ;Resets object color to BYLAYER if it isn't.
  (setq EDATA (subst (cons 62 256) (assoc 62 EDATA) EDATA))
) ;if
(if (assoc 6 EDATA) ;Resets object linetype to BYLAYER if it isn't.
  (setq EDATA (subst (cons 6 "BYLAYER") (assoc 6 EDATA) EDATA))
) ;if
(setq EDATA (subst (cons 8 "0") (assoc 8 EDATA) EDATA))
;changes layer to 0
(entmod EDATA) ;updates entity
(setq E (entnext E)) ;get next enitiy, nil if end of block
(Spin)
       ) ;end while E
     ) ;progn
  ) ;if
  BLIST ; returns names of any nested blocks
) ;defun


(defun C:NUKE (/ BLK_NM CHOICE E EDATA IDX PK_BLK SS)
  (command "._undo" "m")
  (setq CHOICE "S")
  (initget "G S")
  (setq
    CHOICE (getkword
    (strcat "\n<G>lobal or <S>elect block: <" CHOICE "> ")
  )
  )
  (if (not CHOICE)
    (setq CHOICE "S")
  )
  (if (= (strcase CHOICE) "G")
;global nuke
    (while (setq BLK_NM (tblnext "BLOCK" (null BLK_NM)))
      (TO-0 (cdr (assoc 2 BLK_NM)))
    ) ;while
;nuke selected block
    (progn
      (prompt "\nSelect Block(s) to Nuke: ")
      (setq SS (ssget '((0 . "INSERT"))))
      (setq IDX 0)
      (repeat (sslength SS)
(setq BLK (cdr (assoc 2 (entget (ssname SS IDX)))))
(cond
 (PK_BLK (setq PK_BLK (append PK_BLK (list BLK))))
 (T (setq PK_BLK (list BLK)))
) ;cond
(setq IDX (1+ IDX))
      ) ;repeat
      (while PK_BLK
(setq PK_BLK (To-0 PK_BLK))
      ) ;while
    ) ;progn
  ) ;if
  (command "._regen")
  (princ "\rFinished ")
  (princ)
) ;defun
(prompt "\nNUKE loaded.")
(princ)
(c:nuke)

[Hangman]

Ron,
Close, someth'n happened.  It dies somewhere's in the middle, the block doesn't get changed but, ...

It does give me the option to pick n choose.  

[ronjonp]

Not sure what's going on.......give this one a try:

Code: [Select]

; TIP1127.LSP: BCOLOR.LSP    Change Block Color    (c)1995, Dean Langmaid

;**********Routine to change the color of a block**********
(defun C:BCOLOR (/ CLR CNT CMD EN1 EN2 EG1 EG2 NAM SS1 YN)
   (setq CMD (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   ;---Get the block to modify---
   (while (null EN1)
      (setq EN1 (entsel "\nSelect block to modify: "))
      (if EN1
         (progn
            (setq EN1 (car EN1)
               EG1 (entget EN1)
            )
            (if (= (cdr (assoc 0 EG1)) "INSERT")
               (redraw EN1 3)
               (progn
                  (redraw EN1 3)
                  (setq EN1 nil)
                  (princ "\nItem selected is not a block.")
               )
            )
         )

         (princ "\nNothing selected.  Try again.")
      )
   )
   ;---Check for layer change---
   (initget "Yes No")
   (setq YN (getkword "\nChange entities to layer 0 <No>: "))
   ;---Check for color---
   (while (null CLR)
      (initget "? RED YELLOW GREEN CYAN BLUE MAGENTA WHITE BYLAYER BYBLOCK")
      (setq CLR (getint "\nColor for entities/? for list/<BYLAYER>: ")
         CLR (cond ((null CLR) 256)
            ((and (= (type CLR) 'INT) (< -1 CLR 257)) CLR)
            ((= CLR "?") (LSTCDS))
            ((= CLR "RED") 1)
            ((= CLR "YELLOW") 2)
            ((= CLR "GREEN") 3)
            ((= CLR "CYAN") 4)
            ((= CLR "BLUE") 5)
            ((= CLR "MAGENTA") 6)
            ((= CLR "WHITE") 7)
            ((= CLR "BYBLOCK") 0)
            ((= CLR "BYLAYER") 256)
            (t  (and (princ "\nBad value, try again.") nil))
      ))
   )
   ;---Loop through entities in the block---
   (setq NAM (cdr (assoc 2 EG1))
      EN2 (cdr (assoc -2 (tblsearch "BLOCK" NAM)))
   )
   (PRBLK EN2 NAM)

   (setvar "CMDECHO" CMD)
   (princ)
)
;*******Subroutine to change color and layer********
(defun PRBLK (EN2 NAM)
   (setq CNT 0)
   (while EN2
      (setq CNT (1+ CNT)
         EG2 (entget EN2)
         EN2 (entnext (cdr (assoc -1 EG2)))
      )
      (grtext -2 (strcat NAM " block entity # " (itoa CNT)))

      ;---Check for nested blocks---
      (if (= (cdr (assoc 0 EG2)) "INSERT")
         (progn
            (setq NM2 (cdr (assoc 2 EG2))
               EN3 (cdr (assoc -2 (tblsearch "BLOCK" NM2)))
            )
            (PRBLK EN3 NM2)
         )

         (progn
            ;---Check color---
            (if (assoc 62 EG2)
               (setq EG2 (subst (cons 62 CLR) (assoc 62 EG2) EG2))
               (setq EG2 (append EG2 (list (cons 62 CLR))))
            )
            (entmod EG2)

            ;---Check layer---
            (if (and (= YN "Yes") (/= (cdr (assoc 8 EG2)) "0"))
               (progn
                  (setq EG2 (subst (cons 8 "0") (assoc 8 EG2) EG2))
                  (entmod EG2)
               )
            )
         )
      )
   )
   ;---Update all blocks in the drawing---
   (setq SS1 (ssget "X" (list (cons 2 NAM)))
      CNT 0
   )
   (while (setq EN1 (ssname SS1 CNT))
      (setq CNT (1+ CNT))
      (entupd EN1)
   )
)

;********Subroutine to list the options*************
(defun LSTCDS ()
   (if textpage (textpage) (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")
   (getint "\nColor number: ")
)
(C:BCOLOR)
(princ); end bcolor.lsp

[Hangman]

Ron,
Nope, that didn't do the trick either.   The first one works, the following do not.  I'm wondering if there is something with the choice that is causing to be faulty.
The first one, although working, is also selecting every window, wall and door that is in the dwg as well.  But then again, they are objects.   For the most part, the first one is great but now I run into the task of prioritizing what is put in the dwg first and last.  I can see some headaches coming without the choice selection.  hmmm.

[Hangman]

Aaaah nuts.
Can somebody help me, Ronjon sent me the above listed code to try with design center objects, the first set of code works great, but I've run across a problem.  I have partition doors in my dwg and the program just changed all the centerlines in the door to CONTINUOUS and the color to the color of the doors.  (Which is what the lsp is suppose to do BUT, I don't want the doors touched, just the kitchen sink   ).
Does anyone else know of a lsp that'll allow me select a Design Center object to change color without running every block or object in the dwg
Or, can someone help me with the first set of code above   Ronjon tried, (see the second set of code) but something happened.?.

Thanks.

[ronjonp]

Hangman,

Try using the nuke.lsp here:  http://www.cadopolis.com/shareware_listing.asp?TheCategory=CatAll&TheSubcategory=SubLayerManagement&TheKeywords= maybe this one will work.....


Ron

[Hangman]

Sorry Ron,  No good.  
Are you running ADT 2k4   Do you have some blocks from the 2000i Design Center
I am wondering, If I send some to you, if you could duplicate what I'm trying to do and see the results.   Or better yet, I'll create a dwg with several things involved and let you see what I'm getting.?.
This problem is becoming a nightmare.  Why can't Autodesk leave things alone    :horror: