Author Topic: Changing attributes of a block and all other blocks with the same name.  (Read 2255 times)

0 Members and 1 Guest are viewing this topic.

cwortmeyer

  • Guest
Hello people.
Does anyone know how to make a lisp that, when changing the attributes of a block, identifies all other blocks with the same name and also automatically changes the attributes of these blocks, leaving them the  the same as the block that was modified?
Example:
I change the attributes of a block named PF-77 , then run a lisp that updates all other blocks of the same name.

Thanks

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Changing attributes of a block and all other blocks with the same name.
« Reply #1 on: December 21, 2019, 11:17:04 AM »
Untested...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:attsyncit ( / rbl a al s i bl )
  2.   (if (setq rbl (car (entsel "\nPick reference block to sync with...")))
  3.     (progn
  4.       (setq a rbl)
  5.       (while (= (cdr (assoc 0 (entget (setq a (entnext a))))) "ATTRIB")
  6.         (setq al (cons (list (cdr (assoc 2 (entget a))) (cdr (assoc 1 (entget a)))) al))
  7.       )
  8.       (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (assoc 2 (entget rbl)))))
  9.       (ssdel rbl s)
  10.       (repeat (setq i (sslength s))
  11.         (setq bl (ssname s (setq i (1- i))))
  12.         (setq a bl)
  13.         (while (= (cdr (assoc 0 (entget (setq a (entnext a))))) "ATTRIB")
  14.           (entupd (cdr (assoc -1 (entmod (subst (cons 1 (cadr (assoc (cdr (assoc 2 (entget a))) al))) (assoc 1 (entget a)) (entget a))))))
  15.         )
  16.       )
  17.     )
  18.   )
  19.   (princ)
  20. )
  21.  
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

cwortmeyer

  • Guest
Re: Changing attributes of a block and all other blocks with the same name.
« Reply #2 on: December 27, 2019, 09:13:30 PM »
Marko,
Your untested lisp works perfectly!
But what if I want to change all attributes except one?

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Changing attributes of a block and all other blocks with the same name.
« Reply #3 on: December 28, 2019, 01:57:24 AM »
Marko,
Your untested lisp works perfectly!
But what if I want to change all attributes except one?

Untested...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:attsyncit-except-one ( / rbl a al s i bl att )
  2.   (if (and (setq rbl (car (entsel "\nPick reference block to sync with..."))) (setq att (car (nentsel "\nPick attribute you don't want to sync on previously selected block reference..."))))
  3.     (progn
  4.       (setq a rbl)
  5.       (while (= (cdr (assoc 0 (entget (setq a (entnext a))))) "ATTRIB")
  6.         (if (not (eq a att))
  7.           (setq al (cons (list (cdr (assoc 2 (entget a))) (cdr (assoc 1 (entget a)))) al))
  8.         )
  9.       )
  10.       (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) (assoc 2 (entget rbl)))))
  11.       (ssdel rbl s)
  12.       (repeat (setq i (sslength s))
  13.         (setq bl (ssname s (setq i (1- i))))
  14.         (setq a bl)
  15.         (while (= (cdr (assoc 0 (entget (setq a (entnext a))))) "ATTRIB")
  16.           (if (vl-position (cdr (assoc 2 (entget a))) (mapcar 'car al))
  17.             (entupd (cdr (assoc -1 (entmod (subst (cons 1 (cadr (assoc (cdr (assoc 2 (entget a))) al))) (assoc 1 (entget a)) (entget a))))))
  18.           )
  19.         )
  20.       )
  21.     )
  22.   )
  23.   (princ)
  24. )
  25.  
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

cwortmeyer

  • Guest
Re: Changing attributes of a block and all other blocks with the same name.
« Reply #4 on: December 28, 2019, 08:36:34 PM »
Marko, you really do not test these lisps? They work perfectly... Impressive. Thank you.

I would like to know if we could inform the TAG that should not be updated by parameters such as:

(defun c:attsyncit-except-one ( att / rbl a al s i bl)

(attsyncit-except-one quantity)

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Changing attributes of a block and all other blocks with the same name.
« Reply #5 on: December 29, 2019, 06:22:53 AM »
You want to specify TAG of attribute as an argument to the function what attribute shouldn't be synced? Am I right?
Look I have created (with help of alanjt's sub) modification of this routine that takes care of what should be synced and what not through dialog box... You just apply routine to block reference and from dialog box you choose only those tags with values you want to be synced, others you leave unselected and finally you click OK... This is much simpler and takes care of all possibilities that may occur with multiple attributed block references... Still I don't know if it would work well with invisible attributes, but then there is always way to test it and for those situations... Here is my final version and I hope you will be satisfied with it... So use it on your own risk, but if you find something unusual please report and try to fix and show us what you did to resolve problem(s)...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:attsyncit ( / AT:ListSelect rbl a al n altmp s i bl rbln bln )
  2.  
  3.  
  4.   (defun AT:ListSelect ( title label height width multi lst / fn fo d item f )
  5.     ;; List Select Dialog (Temp DCL list box selection, based on provided list)
  6.     ;; title - list box title
  7.     ;; label - label for list box
  8.     ;; height - height of box
  9.     ;; width - width of box
  10.     ;; multi - selection method ["true": multiple, "false": single]
  11.     ;; lst - list of strings to place in list box
  12.     ;; Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite)
  13.     (setq fo (open (setq fn (vl-filename-mktemp "" "" ".dcl")) "w"))
  14.     (foreach x (list (strcat "list_select : dialog { label = \"" title "\"; spacer;")
  15.                      (strcat ": list_box { label = \"" label "\";" "key = \"lst\";")
  16.                      (strcat "allow_accept = true; height = " (vl-princ-to-string height) ";")
  17.                      (strcat "width = " (vl-princ-to-string width) ";")
  18.                      (strcat "multiple_select = " multi "; } spacer; ok_cancel; }")
  19.                )
  20.       (write-line x fo)
  21.     )
  22.     (close fo)
  23.     (new_dialog "list_select" (setq d (load_dialog fn)))
  24.     (start_list "lst")
  25.     (mapcar (function add_list) lst)
  26.     (end_list)
  27.     ;;;(setq item (set_tile "lst" "0"))
  28.     (action_tile "lst" "(setq item $value)")
  29.     (setq f (start_dialog))
  30.     (unload_dialog d)
  31.     (vl-file-delete fn)
  32.     (if (= f 1)
  33.       (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" item ")")))
  34.     )
  35.   )
  36.  
  37.   (if (setq rbl (car (entsel "\nPick reference block to sync with...")))
  38.     (progn
  39.       (setq a rbl)
  40.       (while (and (setq a (entnext a)) (= (cdr (assoc 0 (entget a))) "ATTRIB"))
  41.         (setq al (cons (list (cdr (assoc 2 (entget a))) (cdr (assoc 1 (entget a)))) al))
  42.       )
  43.       (if al
  44.         (progn
  45.           (setq n (apply 'max (mapcar 'strlen (mapcar 'car al))))
  46.           (setq altmp (mapcar '(lambda ( x / st ) (setq st "") (repeat (+ (- n (strlen (car x))) 10) (setq st (strcat st " "))) (strcat (car x) st (cadr x))) al))
  47.           (setq altmp (AT:ListSelect "CHOOSE ATTRIBUTES YOU WANT TO SYNC" "ATTRIBUTES TAGS AND VALUES" 40 30 "true" altmp))
  48.           (setq altmp (mapcar '(lambda ( x ) (substr x 1 (vl-string-search " " x))) altmp))
  49.           (setq al (vl-remove-if-not '(lambda ( x ) (vl-position (car x) altmp)) al))
  50.           (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1))))
  51.           (setq rbln (if (vlax-property-available-p (vlax-ename->vla-object rbl) 'effectivename) (vla-get-effectivename (vlax-ename->vla-object rbl)) (vla-get-name (vlax-ename->vla-object rbl))))
  52.           (ssdel rbl s)
  53.           (repeat (setq i (sslength s))
  54.             (setq bl (ssname s (setq i (1- i))))
  55.             (setq bln (if (vlax-property-available-p (vlax-ename->vla-object rbl) 'effectivename) (vla-get-effectivename (vlax-ename->vla-object bl)) (vla-get-name (vlax-ename->vla-object bl))))
  56.             (if (= rbln bln)
  57.               (progn
  58.                 (setq a bl)
  59.                 (while (= (cdr (assoc 0 (entget (setq a (entnext a))))) "ATTRIB")
  60.                   (if (vl-position (cdr (assoc 2 (entget a))) (mapcar 'car al))
  61.                     (entupd (cdr (assoc -1 (entmod (subst (cons 1 (cadr (assoc (cdr (assoc 2 (entget a))) al))) (assoc 1 (entget a)) (entget a))))))
  62.                   )
  63.                 )
  64.               )
  65.             )
  66.           )
  67.         )
  68.       )
  69.     )
  70.   )
  71.   (princ)
  72. )
  73.  

Regards, M.R.
« Last Edit: January 02, 2020, 03:15:06 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

cwortmeyer

  • Guest
Re: Changing attributes of a block and all other blocks with the same name.
« Reply #6 on: December 29, 2019, 08:02:49 PM »
Many thanks again, Marko.
As always, your program worked perfectly (even with invisible attributes).
I adapted the program to my needs. This definitely solved my problem.

Code: [Select]
(attsyncit (list '"UND" '"COD" '"CAD" '"TIP" '"PUN" '"LAR" '"COMP" '"OBS" '"QTDJ" '"NMCNJ" '"POS" '"FLRMT" '"DESC" '"PRF"))

(defun attsyncit( altmp / rbl a al n altmp s i bl )
  (if (/=(setq rbl LastBlockOfMaterials)nil)
    (progn
      (setq a rbl)
      (while (and (setq a (entnext a)) (= (cdr (assoc 0 (entget a))) "ATTRIB"))
        (setq al (cons (list (cdr (assoc 2 (entget a))) (cdr (assoc 1 (entget a)))) al))
      )
      (if al
        (progn
          (setq n (apply 'max (mapcar 'strlen (mapcar 'car al))))
          (setq al (vl-remove-if-not '(lambda ( x ) (vl-position (car x) altmp)) al))
          (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) '(8 . "EM_IndPos") (assoc 2 (entget rbl)))))
          (ssdel rbl s)
          (repeat (setq i (sslength s))
            (setq bl (ssname s (setq i (1- i))))
            (setq a bl)
            (while (= (cdr (assoc 0 (entget (setq a (entnext a))))) "ATTRIB")
              (if (vl-position (cdr (assoc 2 (entget a))) (mapcar 'car al))
                (entupd (cdr (assoc -1 (entmod (subst (cons 1 (cadr (assoc (cdr (assoc 2 (entget a))) al))) (assoc 1 (entget a)) (entget a))))))
              )
            )
          )
        )
      )
    )
  )
  (princ)
)

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Changing attributes of a block and all other blocks with the same name.
« Reply #7 on: December 30, 2019, 01:08:49 AM »
You don't need this line :

(setq n (apply 'max (mapcar 'strlen (mapcar 'car al))))

And you should remove this marked red :

(defun attsyncit ( altmp / rbl a al n altmp s i bl )
  (if (/=(setq rbl LastBlockOfMaterials)nil)
  (if (and (setq s (ssget "_X" (list '(0 . "INSERT") '(66 . 1) '(8 . "EM_IndPos") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))))) (if (and LastBlockOfMaterials (= (type LastBlockOfMaterials) 'ename)) (setq rbl LastBlockOfMaterials) (setq rbl (ssname s 0))))
    (progn
      ...

Also you can call it like this :
(attsyncit (list "UND" "COD" "CAD" "TIP" "PUN" "LAR" "COMP" "OBS" "QTDJ" "NMCNJ" "POS" "FLRMT" "DESC" "PRF"))
« Last Edit: December 30, 2019, 01:36:58 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube