Explode and Change Colour of All Objects

[caltho]

Hi, I am trying to create a LISP file to process base plans for our models. To prepare the base plan I need to explode all blocks, delete all hatches and then change all objects to grey. I'm a bit of a noob at LISP but have managed to hack together the following code. While each part works individually, I can't seem to get it to run together. Any help would be greatly appreciated. TIV.

 

(defun C:prepbase (/ AllBlocks AllHatches SolOnly sset AllObjects ggrey)
;explode all blocks
  (setvar "qaflags" 1)
(setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
 (while (/= AllBlocks nil)
  (progn
   (command "_.explode"  AllBlocks "")
   (setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
  );progn
 );while
(if (= AllBlocks nil)(alert "All blocks were exploded"))
(setq SolOnly (ssget "X" '((0 . "3DSOLID"))))
(command  "_.erase" "all" "R" SolOnly "")
(alert "All non-Solid entities deleted. Purge file before exporting to ACIS.")
(setvar "qaflags" 0)

;delete all hatches
(setq AllHatches (ssget "X" (list (cons 0 "HATCH"))))
(setq sset (ssget "P"))
(sssetfirst sset sset)
(command "_.erase" AllHatches)
(alert "All HATCHES DELETED")

  ;make everything grey
(ssget "X")
(setq ggrey (ssget "P"))
(sssetfirst ggrey ggrey)
(command "._ChProp" "COLOR" "" "_C" 253 "")
(alert "All COLOURS WERE CHANGED")

 (princ) 
);end prepbase

 

[BIGAL]

Why explode blocks can make their color grey by resetting block properties. Can use bylayer or byblock. Did this often and changed linetypes etc also.

Edited July 2, 2022 by BIGAL

[tombu]

Maybe if you could explain your workflow better to explain why anyone would explode all blocks in a drawing which for many of us would be a cardinal sin. Providing a link to before and after drawings and the CTB or STB plot style you're using would let us see what you're trying to do. If the hatches are on a seperate layer in those blocks freezing or setting the layer to not plot would be easy enough. Modifying or replacing the blocks would be another option.

[Steven P]

Should 

(command "_.erase" AllHatches)

 

be

(command "_.erase" AllHatches "")

 

 

and maybe

(command "._ChProp" "COLOR" "" "_C" 253 "")

 

would work better if you specify which objects in the line? (in the case of pickfirst being set to 0, this will fail)

 

(command "._ChProp" ggrey "" "COLOR" "" "_C" 253 "")

 

 

.. then it works for me

 

 

 

Now as for the why you would want to..... In some cases I can understand exploding blocks, for example I see some rectangles and simple shapes as a block, an item used only once in the drawing and so on when there is no real benefit for drawing them as blocks. More complex shapes.... go blocks. However I guess that this is a small part of your work and there will be  reason for it all

[Steven P]

and I reckon you can shorten the code a bit like this

 

(defun C:prepbase (/ AllBlocks AllHatches SolOnly sset AllObjects ggrey)
;explode all blocks
 (setvar "qaflags" 1)     ;;;;;;;;;;Do you need this?
 (setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
 (while (/= AllBlocks nil)
  (progn
   (command "_.explode"  AllBlocks "")
   (setq AllBlocks (ssget "X" (list (cons 0 "INSERT"))))
  );progn
 );while
;; (if (= AllBlocks nil)(alert "All blocks were exploded"))     ;;;;;;;;;;Do you need this like this?
(alert "All blocks were exploded")

 (command  "_.erase" "all" "R" (ssget "X" '((0 . "3DSOLID"))) "")
 (alert "All non-Solid entities deleted. Purge file before exporting to ACIS.")
 (setvar "qaflags" 0)     ;;;;;;;;;;Do you need this?

;delete all hatches
 (command "_.erase" (ssget "X" (list (cons 0 "HATCH"))) "")
 (alert "All HATCHES DELETED")

;make everything grey
 (command "._ChProp" (ssget "X") "" "COLOR" "" "_C" 253 "")
 (alert "All COLOURS WERE CHANGED")
 (princ) 
)

 

Edited July 2, 2022 by Steven P

[mhupp]

10 hours ago, BIGAL said:

Why explode blocks can make their color grey by resetting block properties. Can use bylayer or byblock. Did this often and changed linetypes etc also.

 

Also if your blocks have any attributes inside they will lose all data with explode an should probably use burst instead.

 

To simplify the while loop

(while (setq AllBlocks (ssget "X" '((0 . "INSERT")(66 . 1))) ;blocks with attributes
  (command "_.Burst"  AllBlocks "")
);while
(while (setq AllBlocks (ssget "X" '((0 . "INSERT"))))
  (command "_.Explode"  AllBlocks "")
);while

 

Edited July 2, 2022 by mhupp

[Emmanuel Delay]

Notice: QAFLAGS

If you ran this code and aborted it, you may have QAFLAGS stuck on 1.

You probably want it back on 0.

 

If it's 1 you can't select stuff before executing the command... quite annoying. 

[caltho]

Thanks for all of the replies. The reason I wanted to explode all the blocks was to easily set their colour to grey. I found even when I change the block to by-layer/ the colour of the block, sometimes the colour of a line is already set within the block and it doesn't get changed.

 

Someone else has asked for the purpose of this: it is to take someone else's plans and use them as a sort of underlay. Pretty much in all cases this will requiring hiding a lot of layers, particularly hatches. I don't ever need to manipulate the underlays, so deleting those hatches is fine. The underlay comes from an external source, so I can't just update it on my system, and then I receive it it is full of different colours, hatches, etc. Oftentimes the underlay will be updated 3 or 4 times while I'm working on the project so it would be helpful to have this script do these things for me. 

 

Thanks for the input, I will attempt to get it working again now with all your help! Will post back

[Steven P]

That's what I thought you were doing,

 

I have this AttNorm, mostly every object in a block will be set to be ByBlock and layer 0, saves having to explode blocks. If a line in the block is set to a colour it will change that.

 

If the block contains other blocks though, it won't change them, any lines in them will stay the same.

As it is it will also change the layers of every object in the block to layer 0, but you can ;; that out in the code

Final note is that I didn't make this up, copied it when I was first looking at LISPs and haven't referenced where I got it from, if it anyones then thanks, I use it a lot and more than happy to make a note to reference the original author

Last final note... perhaps this is a long way to do this but it mostly works for me, not needed to do anything else yet

 

 

Look near the end what to do just to change the colour

 

 

 

(defun c:attnorm (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) ;;Sets block to layer 0, by layer and so on
  (setq myblocklayer "0")
  (setq myblockcolour 0)
  (setq myblocklineweight aclnwtbyblock)
  (setq myblocklinetype "byblock")
  (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (princ)
)
(defun c:attnormgrey (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) ;; As Attnorm but sets the colour to grey (253)
  (setq myblocklayer "0")
  (setq myblockcolour 253)
  (setq myblocklineweight aclnwtbyblock)
  (setq myblocklinetype "byblock")
  (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (princ)
)
(defun c:attnormcolour (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) ;;as above but asks for the olour to use
  (setq myblocklayer "0")
  (setq myblockcolour (getint "Enter Colour Code Value (0 - 249)(253: Grey) "))
  (setq myblocklineweight aclnwtbyblock)
  (setq myblocklinetype "byblock")
  (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun mynorm (myblocklayer myblockcolour myblocklineweight myblocklinetype / *error* adoc lst_layer func_restore-layers)
  (defun *error* (msg)
    (func_restore-layers)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
  ) ;_ end of defun

  (defun func_restore-layers ()
    (foreach item lst_layer
      (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
      (vl-catch-all-apply
        '(lambda ()
           (vla-put-freeze
             (car item)
             (cdr (assoc "freeze" (cdr item)))
           ) ;_ end of vla-put-freeze
         ) ;_ end of lambda
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of foreach
  ) ;_ end of defun

  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  ) ;_ end of vla-startundomark

  (if (and (not (vl-catch-all-error-p
          (setq selset
            (vl-catch-all-apply
              (function
                (lambda ()
                  (ssget '((0 . "INSERT")))
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of setq
       ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    selset
    ) ;_ end of and
    (progn
      (vlax-for item (vla-get-layers adoc)
        (setq
          lst_layer (cons (list item
                (cons "lock" (vla-get-lock item))
                (cons "freeze" (vla-get-freeze item))
              ) ;_ end of list
              lst_layer
          ) ;_ end of cons
        ) ;_ end of setq
        (vla-put-lock item :vlax-false)
        (vl-catch-all-apply
          '(lambda () (vla-put-freeze item :vlax-false))
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vlax-for
      (foreach blk_def
        (mapcar
          (function
            (lambda (x)
              (vla-item (vla-get-blocks adoc) x)
            ) ;_ end of lambda
          ) ;_ end of function
          ((lambda (/ res)
              (foreach item (mapcar
                (function
                  (lambda (x)
                    (vla-get-name
                      (vlax-ename->vla-object x)
                    ) ;_ end of vla-get-name
                  ) ;_ end of lambda
                ) ;_ end of function
                ((lambda (/ tab item)
                    (repeat (setq tab  nil
                        item (sslength selset)
                      ) ;_ end setq
                      (setq
                        tab
                        (cons
                          (ssname selset
                            (setq item (1- item))
                          ) ;_ end of ssname
                          tab
                        ) ;_ end of cons
                      ) ;_ end of setq
                    ) ;_ end of repeat
                    tab
                  ) ;_ end of lambda
                )
              ) ;_ end of mapcar
              (if (not (member item res))
                (setq res (cons item res))
              ) ;_ end of if
              ) ;_ end of foreach
              (reverse res)
            ) ;_ end of lambda
          )
        ) ;_ end of mapcar
        (vlax-for ent blk_def

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Sets the block attributes
;;add in here other attributes to change
          (vla-put-layer ent myblocklayer)           ;;;;;;;Hide this one away if you want to retain layers
          (vla-put-color ent myblockcolour)          ;;;;;;;Colours
          (vla-put-lineweight ent myblocklineweight) ;;;;;;;Sets lineweight, hide if not needed
;;          (vla-put-linetype ent myblocklinetype)
;;end of setting up block attributes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

        ) ;_ end of vlax-for
      ) ;_ end of foreach
      (func_restore-layers)
      (vla-regen adoc acallviewports)
    ) ;_ end of progn
  ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
) ;_ end of defun
;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;