Lisp to set all properties inside a block to ByBlock

[Kurpulio]

Hi

 

I receive lot of architect drawings with many blocks which contain total random settings and additional blocks inside..

 

To handle them easier I need a lisp that can change the: Color, Linetype, Lineweight, Transparency to ByBlock for all existing objects inside a selected block (meaning hatches, nested blocks, symbols, texts etc. too)

 

Anyone has something like that? I googled for hours but all the lisps I found left many objects unchanged inside the block

Its no problem if it can only be done with separate lisps

 

Here is an example drawing with a block that i usually have problems with.

blocktest.dwg

[rlx]

untested

(defun c:t1 () (vl-load-com) (vlax-for b (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
  (vlax-for o b (vla-put-color o 0)(vla-put-linetype o "ByBlock")(vla-put-Lineweight o -1)
    (vla-put-EntityTransparency o "ByBlock")))(vl-cmdf "_ATTSYNC" "N" "*"))

Edited October 16, 2020 by rlx
added attsync for update attributes

[Kurpulio]

Hello,

It is working perfectly!

nice that it can be done with just a short code

 

Can you make it that it is not affecting the whole drawing, instead i can select separate blocks before?

 

[rlx]

That kinda depends wether the same block is both part of your drawing as well as part of your big bada boom block. Routine works by updating the block definition itself so you can't have 'block-A' with entity props byblock in your b.b.b.block and color bylayer in the rest of your drawing.

[Kurpulio]

well i don't have multiple instances of the same block

i mean now the lisp affects everything in the drawing from single lines to all blocks

There are different blocks in the drawing independent of each other

So i want that it only changes the properties to ByBlock to the block i select

[Steven P]

For example Make DoorBlock as all by layer if you select DoorBlock, Leave WidowBlock alone if you don't select it.

 

This is what I use. I copied this before I started putting references to where it came from, so sorry I can't refer you to the original. It was either here or on Lee Macs website I think

 

Command Attnorm.

 

The first part sets up what you want the block properties to be - I also have AttnormRed where the colour is set to Red so I can easily spot instances of the same block through a drawing for example (Change myblockcolour). There is a highlighted part further in the code to  where you can change what is being modified

 

(defun c:attnorm (/ myblocklayer myblockcolour myblocklineweight myblocklinetype)
  (setq myblocklayer "0")
  (setq myblockcolour 0)
  (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)
          (vla-put-color ent myblockcolour)
          (vla-put-lineweight ent myblocklineweight)
;;          (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                        ;;
;;------------------------------------------------------------;;

 

[rlx]

If you want to be able to select which blocks you want to update things get a little bit more complex but you asked , so don't blame the dragon.

;;; https://www.cadtutor.net/forum/topic/71349-lisp-to-set-all-properties-inside-a-block-to-byblock/
;;; Rlx 17 oct 2020

(defun c:t1 ( / max-num-of-rows start-column result-list blk AllBlockObjects AllNestedBlocks n i lst done)
  (cond
    ((not (setq blk (car (entsel "\nSelect block to process : "))))
     (princ "\nDrink less or get glasses because you missed."))
    ((not (vl-consp (setq AllBlockObjects (GetAllBlockObjects blk))))
     (princ "\nHope you didn't pay for this block because its empty."))
    ((not (vl-consp (setq AllNestedBlocks (GetAllNestedBlocks AllBlockObjects))))
     (princ "\nNo nested blocks in this block"))
    (t
     (list->toggle:create_dialog
       (acad_strlsort (rdup (mapcar 'car AllNestedBlocks))) nil  "Select nested blocks to pimp")
     (foreach x result-list (if (= (cdr x) "1")(setq lst (cons (car x) lst))))
     (setq i 0)(pimp (vlax-ename->vla-object blk))(setq i (1+ i))
     (vlax-for b (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
       (vlax-for o b (cond ((setq n (block-n o)) (if (and (member n lst) (not (member n done)))
         (progn (pimp o) (setq i (1+ i) done (cons n done))))) (t (pimp o)))))
     (vl-cmdf "_ATTSYNC" "N" "*")
    )
  )
  (princ (strcat "\nUpdated " (if i (itoa i) "nada") " blocks"))
  (princ)
)

(defun pimp (o) (vla-put-color o 0)(vla-put-linetype o "ByBlock")
  (vla-put-Lineweight o -1)(vla-put-EntityTransparency o "ByBlock"))


; (setq lst (GetAllBlockObjects (car (entsel))))
(defun GetAllBlockObjects ( b / e l)
  (vlax-for o (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))(cdr (assoc 2 (entget b))))
    (setq l (cons o l))))

(defun block-n (o) (if (and (= 'vla-object (type o))(eq (vla-get-objectname o) "AcDbBlockReference"))
  (if (vlax-property-available-p o 'EffectiveName) (vla-Get-EffectiveName o) (vla-Get-Name o)) nil))

; (setq lst (GetAllNestedBlocks (GetAllBlockObjects (car (entsel)))))
(defun GetAllNestedBlocks ( l / n r ) (foreach o l (if (setq n (block-n o)) (setq r (cons (cons n o) r)))) r)

;remove duplicates
(defun rdup ( i / o ) (vl-remove-if '(lambda (x) (cond ((vl-position x o) t) ((setq o (cons x o)) nil))) i))

;--- List->Toggle --------------------------------------- Begin of List->Toggle ------------------------------------------ List->Toggle ---

; max-num-of-rows / start-column / result-list -> global vars needed because dialog will be recreated if resized
(defun list->toggle:create_dialog
  ( %lst %dflt $msg / max-dialog-width dialog-fn dialog-fp dialog-id action-list split_list-list l collie
                      max-column-length max-str-len number-of-columns max-num-of-colums-per-dialog )
  ; limit of the maximum size of dialog and maximum rows per column
  (setq max-dialog-width 120)
  (or max-num-of-rows (setq max-num-of-rows 10))
  ; start column will be reset when number or rows is changed
  (or start-column (setq start-column 0))
  (or result-list (setq result-list (mapcar '(lambda (x)(cons x "0")) %lst)))
  ; split_list up list in columns where each column has max-num-of-rows
  (setq split_list-list (split_list %lst max-num-of-rows) max-str-len (apply 'max (mapcar 'strlen %lst))
        number-of-columns (length split_list-list) max-column-length (apply 'max (mapcar 'length split_list-list))
        max-num-of-colums-per-dialog (fix (/ max-dialog-width (+ max-str-len 5)))) ; 5 = togglewidth (guess)
  ; open dialog for writing
  (setq dialog-fp (open (setq dialog-fn (vl-filename-mktemp ".dcl")) "w"))
  ; write header
  (write-line (strcat "split_list:dialog {label=\"" $msg "\";") dialog-fp)
  ; write body start
  (write-line ":boxed_row {" dialog-fp)
  (setq column-index start-column)
  (if (> (setq n (+ start-column number-of-columns)) max-num-of-colums-per-dialog)
    (setq n max-num-of-colums-per-dialog))
  (repeat n
    (setq collie (nth column-index split_list-list) l (length collie) )
    (write-line ":column {alignment=top;" dialog-fp)
    (foreach item collie
      (write-line (strcat ":toggle {label=\"" item "\";key=\"tg_" item "\";}") dialog-fp)
      (setq action-list (cons item action-list)); used later by action_tile's
    )
    (repeat (- max-num-of-rows l)(write-line ":row {height=1.5;}" dialog-fp))
    (write-line "}" dialog-fp)
    (setq column-index (1+ column-index))
  )

  ; write body end
  (write-line "}" dialog-fp)

  ; write footer
  (write-line
    (strcat "spacer;:concatenation {alignment=centered;children_fixed_width=true;"
            ":button{label=\"&Less Rows\";key=\"bt_less_rows\";mnemonic=\"L\";}"
            ":button{label=\"&More Rows\";key=\"bt_more_rows\";mnemonic=\"M\";}"
            ":button{label=\"&Prev.Page\";key=\"bt_prev_page\";mnemonic=\"P\";}"
            ":button{label=\"&Next Page\";key=\"bt_next_page\";mnemonic=\"N\";}}") dialog-fp)
  (write-line
    (strcat "spacer;:concatenation {alignment=centered;:button{label=\"Select All\";key=\"bt_select_all\";}"
            ":button{label=\"Clear All\";key=\"bt_clear_all\";}:button{label=\"Default\";key=\"bt_default\";}"
            "spacer;spacer;ok_cancel;}}") dialog-fp)

  (and (not (setq dialog-fp (close dialog-fp)))
       (< 0 (setq dialog-id (load_dialog dialog-fn)))
       (new_dialog "split_list" dialog-id)
       (progn
         (mapcar '(lambda (x)(set_tile (strcat "tg_" (car x)) (cdr x))) result-list)
         (mapcar '(lambda (x)(action_tile (strcat "tg_" (car x)) "(list->toggle:update_tile $key $value)")) result-list)
         (action_tile "accept" "(done_dialog 1)")
         (action_tile "cancel" "(done_dialog 0)")
         (action_tile "bt_clear_all" "(list->toggle:set_all_toggles 0)")
         (action_tile "bt_select_all" "(list->toggle:set_all_toggles 1)")
         (action_tile "bt_less_rows" "(if (list->toggle:change_rows -1)(done_dialog 2))")
         (action_tile "bt_more_rows" "(if (list->toggle:change_rows +1)(done_dialog 2))")
         (action_tile "bt_prev_page" "(if (list->toggle:change_page -1)(done_dialog 3))")
         (action_tile "bt_next_page" "(if (list->toggle:change_page +1)(done_dialog 3))")
         (action_tile "bt_default" "(list->toggle:apply_defaults)")
         (setq drv (start_dialog))(unload_dialog dialog-id)(vl-file-delete dialog-fn)
       )
  )
  (cond ((or (= drv 2)(= drv 3))(list->toggle:create_dialog %lst %dflt $msg)))
  (princ)
)

(defun list->toggle:set_all_toggles (i) (foreach tg action-list (set_tile (strcat "tg_" tg) (itoa i)))
  (setq result-list (mapcar '(lambda (x)(cons x (itoa i))) %lst)))

(defun list->toggle:change_rows (i) (if (< 4 (+ max-num-of-rows i) 25)
  (progn (setq max-num-of-rows (+ max-num-of-rows i))(setq start-column 0)) nil))

(defun list->toggle:change_page (i)
  (if (and (<= 0 (+ start-column i))(<= (+ start-column i) (- number-of-columns max-num-of-colums-per-dialog )))
    (setq start-column (+ start-column i)) nil))

(defun list->toggle:update_tile ($k $v)
  (setq result-list (subst (cons (substr $k 4) $v) (assoc (substr $k 4) result-list) result-list)))

(defun list->toggle:apply_defaults ()
  (if (and (vl-consp result-list) (vl-consp %dflt))
    (foreach item %dflt
      (if (assoc item result-list)
        (progn (setq result-list (subst (cons item "1") (assoc item result-list) result-list))
          (set_tile (strcat "tg_" item) "1")))))
)

; (lst-strcat '("A" "B" "C") "+") -> "A+B+C"
(defun lst-strcat (%l $s) (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list $s x))) %l)))))

; (split_list '(1 2 3 4 5 6 7 8 9) 4) (split_list '(1 2 ) 4)
(defun split_list (l n / _sub) (defun _sub (a b c / r) (if (not (<= 1 c (- (length a) b)))(setq c (- (length a) (1- b))))
 (repeat c (setq r (cons (nth (1- b) a) r) b (1+ b)))(reverse r))(if l (cons (_sub l 1 n) (split_list (_sub l (1+ n) nil) n))))

(defun list->toggle:show_result (%l / tmp s)
  (cond
    ((or (not (vl-consp %l)) (vl-every ''((x)(= (cdr x) "0")) %l)) "None")
    ((vl-every ''((x)(= (cdr x) "1")) %l) "All")
    (t (foreach x %l (if (= (cdr x) "1")(setq tmp (cons (car x) tmp))))
     (if (vl-consp tmp)(setq s (lst-strcat (reverse tmp) "+")))
     (cond ((not (string-p s)) "Nothing selected") ((> (strlen s) 100) "List too long to show")(t s)))
  )
)

; example for subfolder selection
(defun getfolder ( msg / fl sh )
  (if (and (setq sh (vlax-create-object "Shell.Application")) (setq fl (vlax-invoke sh 'browseforfolder 0 msg 0 "")))
    (setq fl (vlax-get-property (vlax-get-property fl 'self) 'path))(setq fl nil))(release_me (list sh)) fl)

(defun c:LT-test ( / fol lst dflt max-num-of-rows start-column result-list)
  (setq dflt '("E" "FGA" "G" "GE" "GX" "HV" "S" "TC" "U"))
  (if (and (setq fol (getfolder "Targetfolder"))
           (vl-consp (setq lst (vl-remove-if '(lambda (x)(member x '("." ".."))) (vl-directory-files fol nil -1)))))
    (progn (list->toggle:create_dialog lst dflt "Select subfolders") (alert (list->toggle:show_result result-list))))
  (princ)
)

;--- List->Toggle ---------------------------------------- End of List->Toggle ------------------------------------------- List->Toggle ---

 

Kurpulio2.lsp

Edited October 17, 2020 by rlx

[Kurpulio]

On 10/17/2020 at 12:45 PM, rlx said:

If you want to be able to select which blocks you want to update things get a little bit more complex but you asked , so don't blame the dragon.

 

Kurpulio2.lsp 9.01 kB · 1 download

 

Wow! you are awesome

you even created an UI for it where i can exclude nested stuff if i want. really neat work, feels good to use

 

It just needs a little adjustments:)

If i run it on the example drawing, it leaves out some nested blocks somewhy (red are the ones it changed)

 

Also there's this other problem:

The block drawing i attached above is from a full drawing, which i'll attach now

The problem is that the script doesn't work in this drawing, it gives an error.

 

When i select a block, and select all nested blocks as well, and run it, it doesn't change anything, and gives these messages:

Select block to process : ; error: Automation Error. Null object ID
Command:
Associatve hatch entity on locked or frozen layer. No update performed.

I turned all layers to thawed and unlocked and visible and tried to run the command, but in this case it just gave this error

Command: T1
Select block to process : ; error: Automation Error. Null object ID
Command:

I could only upload the full drawing here:

https://file.io/yQJSAYFdFpiD

https://filebin.net/xsjjfnl7f3mxoqpv

https://easyupload.io/9kehu5

 

Could you test it on this please?

 

On 10/16/2020 at 7:01 PM, Steven P said:

Command Attnorm.

 

Hey!

This script is also nice, but it also misses to change the properties in some nested blocks

 

 

[Steven P]

rlx.. I am suspecting you have stopped taking life too seriously "Drink less or get glasses"....

I might also save this code away, thanks

[rlx]

yeah , cause of (still) not having enough hours in a day mostly concentrated on the interface and not so much on the testing. Think it has to do with anonymous blocks & stuff. Can't really do something about it right now but will look into it if and when I have some more time. Can't download your files from the (company) computer I'm at right now too …

 

Created this interface for my batch appie , when a single listbox just isn't enough any more. But like 50 thousand entities in a block and 300-400 nested blocks , that are a lot of entities. Wouldn't it be easier to wblock this thing , then byblock everything in wblock and paste it back or something? Or explode the crab out of everthing in your wblock. I mean , you're only going to look at it or what?

[Kurpulio]

2 hours ago, rlx said:

Wouldn't it be easier to wblock this thing , then byblock everything in wblock and paste it back or something? Or explode the crab out of everthing in your wblock. I mean , you're only going to look at it or what?

yeah copying out and exploding than recopying is a possible way, i kind of did it so far, but its annoying to do, especially on my lagy computer with many big blocks

and as i'll have to deal with 1000x of drawings like these, your code would be awesome if it worked:)

Take all the time

im sure it'll be a nice tool for other ppl who find this post too

[rlx]

had a little more 'fun' with this (darn anymous blocks & true colors) and this one might come a little closer but still think best results are achieved by wblock your block first and then pimp the crab out every block. Had only one test run with this one and gonna seek psychiatric help now with doc 'Merlot' and then hit the sack...

 

 

BlockByBlock-2.lsp

[Kurpulio]

Hey i could only check it now.

Hope you're still alive

Thank you for working on it

Not sure if it worked for you (i see u use autocad 2016), but it doesn't for me

If i use it on blocktest1.dwg , no matter if i select nested blocks or not it affects the whole drawing, even changes the properties to ByBlock on non-block objects in the drawing like single lines

Do you plan to fix it? maybe it just needs little adjustments

 

[rlx]

My mail box thinks you're spam , well punk are you? (with the voice of Clint Eastwood )

 

Oh I thought you wanted all ents inside block updated... silly me... good news is nos problemos, the bad news is , dragons never know when to stop and just have to go over the top so its gonna take more time before I'm satisfied (not the youngest dragon on the block anymore ya know)

 

 

 

 

[Kurpulio]

ui looking very good!:)

"Oh I thought you wanted all ents inside block updated"

well ofc i want it. Problem was that it updated everything outside the block also.

Btw is it possible to select multiple blocks with it? I mean select a couple blocks on the drawing and run the command on them? Or it'll handle 1 at a time?

Take all the time, i'll be honored to have this dragonborn lisp

[TADCutor]

Interested in what's being discussed here. I have also been looking for a LISP that sets the content of every block to "ByBlock".

[geeloop]

hello! I am searching same LISP. Because there is always transparency problems with my dynamic blocks. And it take a lot of time to struggle with them.

On 10/26/2020 at 1:14 AM, rlx said:

My mail box thinks you're spam , well punk are you? (with the voice of Clint Eastwood )

 

Oh I thought you wanted all ents inside block updated... silly me... good news is nos problemos, the bad news is , dragons never know when to stop and just have to go over the top so its gonna take more time before I'm satisfied (not the youngest dragon on the block anymore ya know)

 

 

 

 

 

[Thomas Schlüssi]

On 10/21/2020 at 12:54 AM, rlx said:

had a little more 'fun' with this (darn anymous blocks & true colors) and this one might come a little closer but still think best results are achieved by wblock your block first and then pimp the crab out every block. Had only one test run with this one and gonna seek psychiatric help now with doc 'Merlot' and then hit the sack...

 

 

BlockByBlock-2.lspUnavailable

Hi!

 

Sadly the Download is not available anymore. 

Could you please reupload the code.

 

Thanks in advance.

[Cad64]

2 hours ago, Thomas Schlüssi said:

Sadly the Download is not available anymore. 

Could you please reupload the code.

 

The file is available. I just downloaded it.

[Thomas Schlüssi]

Hi!

 

Thanks for the reply. Worked for me now too. Had an error yesterday with "File no longer available".

 

But unfortunately the LISP doesn't do what I need. I would have thought that the LISP would open a window as quoted below where I could choose which properties I would like to have. My goal is to set the entire drawing to ByLayer.

 

 

On 10/25/2020 at 11:14 PM, rlx said:

My mail box thinks you're spam , well punk are you? (with the voice of Clint Eastwood )

 

Oh I thought you wanted all ents inside block updated... silly me... good news is nos problemos, the bad news is , dragons never know when to stop and just have to go over the top so its gonna take more time before I'm satisfied (not the youngest dragon on the block anymore ya know)