Jump to content
Kurpulio

Lisp to set all properties inside a block to ByBlock

Recommended Posts

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

Share this post


Link to post
Share on other sites
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 by rlx
added attsync for update attributes
  • Like 1

Share this post


Link to post
Share on other sites
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?

 

Share this post


Link to post
Share on other sites
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.

  • Like 1

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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                        ;;
;;------------------------------------------------------------;;

 

Share this post


Link to post
Share on other sites
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 by rlx
  • Like 1

Share this post


Link to post
Share on other sites
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)

image.png.c6efba042a4140648a433a7dd791a313.png

 

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

 

 

Share this post


Link to post
Share on other sites
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

  • Funny 1

Share this post


Link to post
Share on other sites
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?

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites
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... :sleeping:

 

🐉

 

BlockByBlock-2.lsp

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites
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)

 

🐉

 

 

 

BlockByBlock_Dialog.jpg

Share this post


Link to post
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
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  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.


×
×
  • Create New...