Author Topic: Add attribute to defined block  (Read 7960 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Add attribute to defined block
« on: May 16, 2019, 09:47:08 AM »
Hi...
I just wanted to ask if this is possible...
Block is already defined and placed in DWG as references... Now there are no attributes attached to it... I added one single ATTDEF near one reference and the question is - Is it possible to add this ATTDEF as ATTRIB inside that reference through LISP as with REFEDIT that definition vanishes and only when BEDIT, I can see it inside but as ATTDEF... I wonder if DXF 66 is the problem, but I'll attach DWG for you to experiment just for any case...

Thanks, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Add attribute to defined block
« Reply #1 on: May 16, 2019, 09:54:46 AM »
It’s very do-able. In fact, each block instance of a given block definition can sport different attributes - as a block instance (with attribs) is akin to a linked list. I wrote about this many many years ago. I’ll post the link and / or code later (currently in transit, posting from my phone).
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #2 on: May 16, 2019, 10:03:09 AM »
It’s very do-able. In fact, each block instance of a given block definition can sport different attributes - as a block instance (with attribs) is akin to a linked list. I wrote about this many many years ago. I’ll post the link and / or code later (currently in transit, posting from my phone).

I'll be very grateful to see this comes true...
Thanks MP.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #3 on: May 17, 2019, 10:52:14 AM »
Not the happiest solution, but for quick fix, it did the task...

Here are my written materials :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:addatt-statblk ( / *adoc* hyperdatalst hyperdata ucsf att blk ss blst blstdata n s attr f lay xdata ldata hyper )
  2.  
  3.  
  4.   (defun hyperdatalst ( hypers-vla / rtn )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (vlax-for hyper-vla hypers-vla
  9.       (setq rtn (cons (hyperdata hyper-vla) rtn))
  10.     )
  11.     rtn
  12.   )
  13.  
  14.   (defun hyperdata ( hyper-vla / rtn )
  15.  
  16.     (vl-load-com)
  17.  
  18.     (setq rtn (list (vla-get-url hyper-vla) (vla-get-urldescription hyper-vla) (vla-get-urlnamedlocation hyper-vla)))
  19.   )
  20.  
  21.   (if (= 8 (logand 8 (getvar 'undoctl)))
  22.     (vla-endundomark *adoc*)
  23.   )
  24.   (vla-startundomark *adoc*)
  25.   (if (= 0 (getvar 'worlducs))
  26.     (progn
  27.       (vl-cmdf "_.UCS" "_W")
  28.       (setq ucsf t)
  29.     )
  30.   )
  31.   (alert "Avoid to set ATTDEF you want to add to block that way, that it lies in layer \"0\" - it will then inherit layer of block... This is just warning, but you decide in what layer you want your attribute(s)...")
  32.   (while
  33.     (or
  34.       (not (setq att (car (entsel "\nPick attribute definition on unlocked layer..."))))
  35.       (if att
  36.         (or
  37.           (/= (cdr (assoc 0 (entget att))) "ATTDEF")
  38.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget att))))))))
  39.         )
  40.       )
  41.     )
  42.     (prompt "\nMissed or picked wrong entitiy type or picked ATTDEF on locked layer...")
  43.   )
  44.   (while
  45.     (or
  46.       (not (setq blk (car (entsel "\nPick static block reference on unlocked layer you want to add attribute that was previously picked..."))))
  47.       (if blk
  48.         (or
  49.           (/= (cdr (assoc 0 (entget blk))) "INSERT")
  50.           (= :vlax-true (vla-get-isdynamicblock (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  51.           (= :vlax-true (vla-get-isxref (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  52.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (entget blk)))))))))
  53.         )
  54.       )
  55.     )
  56.     (prompt "\nMissed or picked wrong entity type, or picked entity not static block, or picked entity on locked layer...")
  57.   )
  58.   (if (not (vl-every '(lambda ( x ) (= x 1.0)) (list (cdr (assoc 41 (entget blk))) (cdr (assoc 42 (entget blk))) (cdr (assoc 43 (entget blk))))))
  59.     (progn
  60.       (prompt "\nMaster block isn't uniformly scaled... Retry routine with uniformly scaled block reference - scaled xscf=1.0 yscf=1.0 zscf=1.0 as reference entity for processing...")
  61.       (exit)
  62.     )
  63.   )
  64.   (setq xdata (assoc -3 (entget blk '("*"))))
  65.   (setq ldata (vlax-ldata-list blk))
  66.   (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object blk))))
  67.   (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 (entget blk)))) (cons 410 (getvar 'ctab)))))
  68.   (foreach b (setq blst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  69.     (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget blk))))))))
  70.       (setq blst (vl-remove b blst))
  71.     )
  72.   )
  73.   (setq blst (vl-remove blk blst))
  74.   (if (vl-some '(lambda ( x ) (not (equal '(210 0.0 0.0 1.0) (assoc 210 (entget x))))) blst)
  75.     (setq f t)
  76.   )
  77.   (if f
  78.     (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst))
  79.     (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 10 (entget x))) (cdr (assoc 50 (entget x))) (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst))
  80.   )
  81.   (setq n (cdr (assoc 2 (entget blk))))
  82.   (vl-cmdf "_.UCS" "_e" blk)
  83.   (vl-cmdf "_.EXPLODE" blk)
  84.   (while (< 0 (getvar 'cmdactive))
  85.     (vl-cmdf "")
  86.   )
  87.   (setq s (ssget "_P"))
  88.   (ssadd att s)
  89.   (vl-cmdf "_.-BLOCK" "{_TEMP_}" "_non" '(0.0 0.0 0.0) s "")
  90.   (setq attr (getvar 'attreq))
  91.   (setvar 'attreq 0)
  92.   (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) 1.0 1.0 0.0)
  93.   (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast)))))))
  94.   (if xdata
  95.     (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata))))))
  96.   )
  97.   (setq xdata nil)
  98.   (if ldata
  99.     (foreach ld ldata
  100.       (vlax-ldata-put (entlast) (car ld) (cdr ld))
  101.     )
  102.   )
  103.   (setq ldata nil)
  104.   (if hyper
  105.     (foreach h hyper
  106.       (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h))
  107.     )
  108.   )
  109.   (setq hyper nil)
  110.   (vl-cmdf "_.UCS" "_P")
  111.   (foreach b blstdata
  112.     (if f
  113.       (progn
  114.         (setq lay (cdr (assoc 8 (entget (car b)))))
  115.         (setq xdata (assoc -3 (entget (car b) '("*"))))
  116.         (setq ldata (vlax-ldata-list (car b)))
  117.         (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b)))))
  118.         (vl-cmdf "_.UCS" "_e" (car b))
  119.         (entdel (car b))
  120.         (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) (cadr b) (caddr b) 0.0)
  121.         (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast)))))))
  122.         (if xdata
  123.           (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata))))))
  124.         )
  125.         (setq xdata nil)
  126.         (if ldata
  127.           (foreach ld ldata
  128.             (vlax-ldata-put (entlast) (car ld) (cdr ld))
  129.           )
  130.         )
  131.         (setq ldata nil)
  132.         (if hyper
  133.           (foreach h hyper
  134.             (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h))
  135.           )
  136.         )
  137.         (setq hyper nil)
  138.         (vl-cmdf "_.UCS" "_P")
  139.       )
  140.       (progn
  141.         (setq lay (cdr (assoc 8 (entget (car b)))))
  142.         (setq xdata (assoc -3 (entget (car b) '("*"))))
  143.         (setq ldata (vlax-ldata-list (car b)))
  144.         (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b)))))
  145.         (entdel (car b))
  146.         (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" (cadr b) (cadddr b) (nth 4 b) (cvunit (caddr b) "radian" "degree"))
  147.         (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast)))))))
  148.         (if xdata
  149.           (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata))))))
  150.         )
  151.         (setq xdata nil)
  152.         (if ldata
  153.           (foreach ld ldata
  154.             (vlax-ldata-put (entlast) (car ld) (cdr ld))
  155.           )
  156.         )
  157.         (setq ldata nil)
  158.         (if hyper
  159.           (foreach h hyper
  160.             (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h))
  161.           )
  162.         )
  163.         (setq hyper nil)
  164.       )
  165.     )
  166.   )
  167.   (setvar 'attreq attr)
  168.   (vl-cmdf "_.PURGE" "_B" n "_N")
  169.   (vl-cmdf "_.RENAME" "_B" "{_TEMP_}" n)
  170.   (if ucsf
  171.     (vl-cmdf "_.UCS" "_P")
  172.   )
  173.   (vla-endundomark *adoc*)
  174.   (princ)
  175. )
  176.  

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rematt-statblk ( / *adoc* hyperdatalst hyperdata ucsf att blk ss blst blstdata n s attr f lay xdata ldata hyper )
  2.  
  3.  
  4.   (defun hyperdatalst ( hypers-vla / rtn )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (vlax-for hyper-vla hypers-vla
  9.       (setq rtn (cons (hyperdata hyper-vla) rtn))
  10.     )
  11.     rtn
  12.   )
  13.  
  14.   (defun hyperdata ( hyper-vla / rtn )
  15.  
  16.     (vl-load-com)
  17.  
  18.     (setq rtn (list (vla-get-url hyper-vla) (vla-get-urldescription hyper-vla) (vla-get-urlnamedlocation hyper-vla)))
  19.   )
  20.  
  21.   (if (= 8 (logand 8 (getvar 'undoctl)))
  22.     (vla-endundomark *adoc*)
  23.   )
  24.   (vla-startundomark *adoc*)
  25.   (if (= 0 (getvar 'worlducs))
  26.     (progn
  27.       (vl-cmdf "_.UCS" "_W")
  28.       (setq ucsf t)
  29.     )
  30.   )
  31.   (while
  32.     (or
  33.       (not (setq att (car (nentsel "\nPick attribute on desired static block on unlocked layer..."))))
  34.       (if att
  35.         (or
  36.           (/= (cdr (assoc 0 (entget att))) "ATTRIB")
  37.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget att))))))))
  38.         )
  39.       )
  40.     )
  41.     (prompt "\nMissed or picked wrong entitiy type or picked ATTRIB on locked layer...")
  42.   )
  43.   (if
  44.     (or
  45.       (not (setq blk (cdr (assoc 330 (entget att)))))
  46.       (if blk
  47.         (or
  48.           (/= (cdr (assoc 0 (entget blk))) "INSERT")
  49.           (= :vlax-true (vla-get-isdynamicblock (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  50.           (= :vlax-true (vla-get-isxref (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  51.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (setq lay (cdr (assoc 8 (entget blk)))))))))
  52.         )
  53.       )
  54.     )
  55.     (progn
  56.       (prompt "\nMissed or picked wrong entity type, or picked entity not static block, or picked entity on locked layer... Quitting...")
  57.       (exit)
  58.     )
  59.   )
  60.   (if (not (vl-every '(lambda ( x ) (= x 1.0)) (list (cdr (assoc 41 (entget blk))) (cdr (assoc 42 (entget blk))) (cdr (assoc 43 (entget blk))))))
  61.     (progn
  62.       (prompt "\nMaster block isn't uniformly scaled... Retry routine with uniformly scaled block reference - scaled xscf=1.0 yscf=1.0 zscf=1.0 as reference entity for processing...")
  63.       (exit)
  64.     )
  65.   )
  66.   (setq xdata (assoc -3 (entget blk '("*"))))
  67.   (setq ldata (vlax-ldata-list blk))
  68.   (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object blk))))
  69.   (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 (entget blk)))) (cons 410 (getvar 'ctab)))))
  70.   (foreach b (setq blst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  71.     (if (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget blk))))))))
  72.       (setq blst (vl-remove b blst))
  73.     )
  74.   )
  75.   (setq blst (vl-remove blk blst))
  76.   (if (vl-some '(lambda ( x ) (not (equal '(210 0.0 0.0 1.0) (assoc 210 (entget x))))) blst)
  77.     (setq f t)
  78.   )
  79.   (if f
  80.     (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst))
  81.     (setq blstdata (mapcar '(lambda ( x ) (list x (cdr (assoc 10 (entget x))) (cdr (assoc 50 (entget x))) (cdr (assoc 41 (entget x))) (cdr (assoc 42 (entget x))) (cdr (assoc 43 (entget x))))) blst))
  82.   )
  83.   (setq n (cdr (assoc 2 (entget blk))))
  84.   (vl-cmdf "_.UCS" "_e" blk)
  85.   (vl-cmdf "_.EXPLODE" blk)
  86.   (while (< 0 (getvar 'cmdactive))
  87.     (vl-cmdf "")
  88.   )
  89.   (setq s (ssget "_P"))
  90.   (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
  91.     (if (and (= (cdr (assoc 0 (entget e))) "ATTDEF") (= (cdr (assoc 2 (entget e))) (cdr (assoc 2 (entget att)))))
  92.       (progn
  93.         (ssdel e s)
  94.         (entdel e)
  95.       )
  96.     )
  97.   )
  98.   (vl-cmdf "_.-BLOCK" "{_TEMP_}" "_non" '(0.0 0.0 0.0) s "")
  99.   (setq attr (getvar 'attreq))
  100.   (setvar 'attreq 0)
  101.   (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) 1.0 1.0 0.0)
  102.   (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast)))))))
  103.   (if xdata
  104.     (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata))))))
  105.   )
  106.   (setq xdata nil)
  107.   (if ldata
  108.     (foreach ld ldata
  109.       (vlax-ldata-put (entlast) (car ld) (cdr ld))
  110.     )
  111.   )
  112.   (setq ldata nil)
  113.   (if hyper
  114.     (foreach h hyper
  115.       (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h))
  116.     )
  117.   )
  118.   (setq hyper nil)
  119.   (vl-cmdf "_.UCS" "_P")
  120.   (foreach b blstdata
  121.     (if f
  122.       (progn
  123.         (setq lay (cdr (assoc 8 (entget (car b)))))
  124.         (setq xdata (assoc -3 (entget (car b) '("*"))))
  125.         (setq ldata (vlax-ldata-list (car b)))
  126.         (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b)))))
  127.         (vl-cmdf "_.UCS" "_e" (car b))
  128.         (entdel (car b))
  129.         (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" '(0.0 0.0 0.0) (cadr b) (caddr b) 0.0)
  130.         (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast)))))))
  131.         (if xdata
  132.           (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata))))))
  133.         )
  134.         (setq xdata nil)
  135.         (if ldata
  136.           (foreach ld ldata
  137.             (vlax-ldata-put (entlast) (car ld) (cdr ld))
  138.           )
  139.         )
  140.         (setq ldata nil)
  141.         (if hyper
  142.           (foreach h hyper
  143.             (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h))
  144.           )
  145.         )
  146.         (setq hyper nil)
  147.         (vl-cmdf "_.UCS" "_P")
  148.       )
  149.       (progn
  150.         (setq lay (cdr (assoc 8 (entget (car b)))))
  151.         (setq xdata (assoc -3 (entget (car b) '("*"))))
  152.         (setq ldata (vlax-ldata-list (car b)))
  153.         (setq hyper (hyperdatalst (vla-get-hyperlinks (vlax-ename->vla-object (car b)))))
  154.         (entdel (car b))
  155.         (vl-cmdf "_.-INSERT" "{_TEMP_}" "_non" (cadr b) (cadddr b) (nth 4 b) (cvunit (caddr b) "radian" "degree"))
  156.         (entupd (cdr (assoc -1 (entmod (subst (cons 8 lay) (assoc 8 (entget (entlast))) (entget (entlast)))))))
  157.         (if xdata
  158.           (entupd (cdr (assoc -1 (entmod (append (entget (entlast)) (list xdata))))))
  159.         )
  160.         (setq xdata nil)
  161.         (if ldata
  162.           (foreach ld ldata
  163.             (vlax-ldata-put (entlast) (car ld) (cdr ld))
  164.           )
  165.         )
  166.         (setq ldata nil)
  167.         (if hyper
  168.           (foreach h hyper
  169.             (vl-cmdf "_.-HYPERLINK" "_I" "_O" (entlast) "" (car h) (caddr h) (cadr h))
  170.           )
  171.         )
  172.         (setq hyper nil)
  173.       )
  174.     )
  175.   )
  176.   (setvar 'attreq attr)
  177.   (vl-cmdf "_.PURGE" "_B" n "_N")
  178.   (vl-cmdf "_.RENAME" "_B" "{_TEMP_}" n)
  179.   (if ucsf
  180.     (vl-cmdf "_.UCS" "_P")
  181.   )
  182.   (vla-endundomark *adoc*)
  183.   (princ)
  184. )
  185.  

I wonder again, is there a better solution that would be good and that is not this way cumbersome to use EXPLODE and other command functions like BLOCK, INSERT and that don't involve creating temporary block named "{_TEMP_}" which could already be used in DWG so that routine wouldn't disturb anything existing in DWG...

Regards, M.R.

[EDIT : I've updated codes to preserve HYPERLINKS, XDATA, LDATA and LAYER property of block...]
« Last Edit: June 02, 2019, 01:43:41 PM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Add attribute to defined block
« Reply #4 on: May 17, 2019, 03:03:50 PM »
Curiously I could not find the post (posted 2014-ish) so I wrote something from scratch.

Code: [Select]
(defun _genericize-dxf-data ( dxf-data )
    (vl-remove-if
        (function
            (lambda (p)
                (or
                    (minusp (car p))
                    (member (car p) '(0 330 360 5 100 66))
                )
            )
        )
        dxf-data
    )
)

Code: [Select]
(defun _entmake-from-entity-and-map ( entity map )
    (   (lambda ( entity-data )
            (entmake
                (mapcar
                    (function
                        (lambda ( p / p! )
                            (if (setq p! (assoc (car p) entity-data))
                                p!
                                p
                            )
                        )
                    )
                    map
                )
            )
        )
        (_genericize-dxf-data (entget entity))
    )
)

Code: [Select]
(defun _entmake-insert-from-insert ( insert )
    (_entmake-from-entity-and-map
        insert
       '(
            (0 . "INSERT")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbBlockReference")
            (66 . 1)
            (2 . "UNNAMED")
            (10 -12.611 33.6579 0.0)
            (41 . 1.0)
            (42 . 1.0)
            (43 . 1.0)
            (50 . 0.0)
            (70 . 0)
            (71 . 0)
            (44 . 0.0)
            (45 . 0.0)
            (210 0.0 0.0 1.0)
        )       
    )
)

Code: [Select]
(defun _entmake-attrib-from-attdef ( attdef )
    (_entmake-from-entity-and-map
        attdef
       '(   (0 . "ATTRIB")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
            (100 . "AcDbText")
            (10 -12.0677 32.7299 0.0)
            (40 . 0.381851)
            (1 . "VAL-1")
            (50 . 0.0)
            (41 . 1.0)
            (51 . 0.0)
            (7 . "Standard")
            (71 . 0)
            (72 . 0)
            (11  0.0 0.0 0.0)
            (210 0.0 0.0 1.0)
            (100 . "AcDbAttribute")
            (280 . 0)
            (2 . "ATT-1")
            (70 . 0)
            (73 . 0)
            (74 . 0)
            (280 . 0)
        )
    )
)

Code: [Select]
(defun _entmake-seqend-from-insert ( insert )
    (_entmake-from-entity-and-map
        insert
       '(   (0 . "SEQEND")
            (100 . "AcDbEntity")
            (67 . 0)
            (410 . "Model")
            (8 . "0")
        )
    )
)

Bring it all together in a wrapper function ...

Code: [Select]
(defun _add-attribs-to-insert ( insert ss-attdefs / i e lst object attribs )
    (and
        (progn (vl-load-com) t)
        (eq 'pickset (type ss-attdefs))
        (< 0 (setq i (sslength ss-attdefs)))
        (setq object (vlax-ename->vla-object insert))
        (_entmake-insert-from-insert insert)
        (cond
            ((eq :vlax-false (vla-get-hasattributes object)))
            ((vl-every
                (function (lambda (a) (_entmake-attrib-from-attdef a)))
                (mapcar 'vlax-vla-object->ename (vlax-invoke object 'getattributes))
            ))
        )
        (progn
            (repeat i (setq lst (cons (ssname ss-attdefs (setq i (1- i))) lst)))
            (vl-every '_entmake-attrib-from-attdef lst)
        )
        (_entmake-seqend-from-insert insert)
        (progn
            (vla-put-lock
                (vla-item
                    (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
                    (cdr (assoc 8 (entget insert)))
                )
                :vlax-false
            )
            (entdel insert)
            (repeat (setq i (sslength ss-attdefs))
                (vl-catch-all-apply 'entdel (list (ssname ss-attdefs (setq i (1- i)))))
            )     
            T
        )
    )
)

Bring it all together in a command ...

Code: [Select]
(defun c:add-attribs-to-insert ( / insert ss ss-attdefs )
    (princ
        (if
            (and
                (setq insert (car (entsel "\nSelect existing insert: ")))
                (eq "INSERT" (cdr (assoc 0 (entget insert))))
                (setq ss-attdefs (ssget '((0 . "attdef"))))
                (_add-attribs-to-insert insert ss-attdefs)
            )
            "\nDone."
            "\nFailed."
        )
    )
    (princ)             
)

As mentioned previously, this technique allows each instance of a block to sport it's own number of attributes, c/w unique tags if desired. Also, one can make any of the attributes constant after the fact, making them effectively read-only to users. The latter is different than constant attributes which are common to each instance of the block.

Please note that the supplied code creates a new instance of a selected block insert (deleting the original instance - this will impact other programs that rely on the existing insert's handle), populating the new instance with any previous attributes as well as adding the new ones.

See the image below which demonstrates 4 instance of the block "x" (which is defined attribute-less), each having it's own attributes. Attached dwg illuminates same.

Finally, code was written quickly and is not bomb proof, I'll leave that up to you.

Edit: Revised the _add-attribs-to-insert function as it was creating the new attributes in the reverse order desired.

Cheers.
« Last Edit: May 17, 2019, 03:22:00 PM by MP »
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #5 on: May 18, 2019, 08:57:41 AM »
I've changed my codes a little...
Thanks for input MP...

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2122
  • class keyThumper<T>:ILazy<T>
Re: Add attribute to defined block
« Reply #6 on: May 18, 2019, 06:10:45 PM »
I've changed my codes a little...
Thanks for input MP...

Regards, M.R.

It's preferable not to change the posted code associated with a question after the question is resolved.
The changes make it virtually impossible for someone following later to understand the issues.

Regards,

Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #7 on: May 19, 2019, 01:41:25 AM »
I've changed my codes a little...
Thanks for input MP...

Regards, M.R.

It's preferable not to change the posted code associated with a question after the question is resolved.
The changes make it virtually impossible for someone following later to understand the issues.

Regards,

Only later I noticed that there were mistakes in my codes...
This is why I slightly modified them...

Thanks for consideration, but I don't want to leave bad material...
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #8 on: May 28, 2019, 04:33:28 AM »
Hi, I've implemented XDATA and LAYER info in my routines... Now new question arises : What if blocks previously had attached LDATA...
I mean, I tested this on block reference :

Code: [Select]
Command: (vlax-ldata-put (vlax-ename->vla-object (car (entsel))) "key" (list 1 2 3))
Select object: (1 2 3)
Command: (vlax-ldata-get (vlax-ename->vla-object (car (entsel))) "key")
Select object: (1 2 3)

So my question : how can I get "key" string if there is LDATA attached... I guess I destroyed handles, so I want to put back as much as possible to newly created blocks... Any help, MP, Lee, CAB, ROY, RON or anyone (I surely missed someone)???
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #9 on: May 28, 2019, 05:21:43 AM »
I've found it... I didn't know for (vlax-ldata-list) - had to revise my knowledge of AutoLISP...

Code: [Select]
Command: (vlax-ldata-put (vlax-ename->vla-object (car (entsel))) "key1" "bla1")
Select object: "bla1"
Command: (vlax-ldata-put (car (entsel)) "key2" "bla2")
Select object: "bla2"
Command: (vlax-ldata-list (car (entsel)))
Select object: (("key2" . "bla2") ("key1" . "bla1"))

Now, just to change my codes... It may take some extra time...
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

roy_043

  • Water Moccasin
  • Posts: 1895
  • BricsCAD 18
Re: Add attribute to defined block
« Reply #10 on: May 28, 2019, 07:00:01 AM »
Apart from Ldata there can be other data stored in the extension dictionary.

But what you are trying to do, replacing the inserts without breaking anything, is quite difficult. Applications may have stored references to the inserts in data connected to other entities or in the main dictionary.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #11 on: May 28, 2019, 09:21:39 AM »
Apart from Ldata there can be other data stored in the extension dictionary.

But what you are trying to do, replacing the inserts without breaking anything, is quite difficult. Applications may have stored references to the inserts in data connected to other entities or in the main dictionary.

With that said, everything written is complete waste, but for completness of my foolish attempts I added hyperlinks data preservation which I forgot... So, if it works, fine - SUPER, but if not then Roy wins and I can't do anything to correct this to be working as should... Anyway I tried, at least for practice...

Regards, M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #12 on: May 28, 2019, 12:08:24 PM »
Sorry, but I think I hit the wall : It is imposible to revert entity handle to previous one... At least I don't know how to do that...

Quote
Command: (setq h (cdr (assoc 5 (entget (car (entsel))))))
Select object: "20D"
Command: ATT
ATTDEF
Specify start point:
Command: ADDATT-STATBLK
Pick attribute definition on unlocked layer...
Pick static block reference on unlocked layer you want to add attribute that was previously picked...Deleting block "x".
1 block deleted.
Command: (setq enx (entget (car (entsel))))
Select object: ((-1 . <Entity name: 1a6208675d0>) (0 . "INSERT") (330 . <Entity name: 1a62085d1f0>) (5 . "215") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "x") (10 23.55 15.8904 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
Command: (setq enx (vl-remove-if '(lambda ( x ) (vl-position (car x) '(-1 330))) enx))
((0 . "INSERT") (5 . "215") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "x") (10 23.55 15.8904 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
Command: (setq enx (subst (cons 5 h) (assoc 5 enx) enx))
((0 . "INSERT") (5 . "20D") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "x") (10 23.55 15.8904 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
Command: (entmod enx)
nil
Command: (entget (car (entsel)))
Select object: ((-1 . <Entity name: 1a6208675d0>) (0 . "INSERT") (330 . <Entity name: 1a62085d1f0>) (5 . "215") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbBlockReference") (66 . 1) (2 . "x") (10 23.55 15.8904 0.0) (41 . 1.0) (42 . 1.0) (43 . 1.0) (50 . 0.0) (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (210 0.0 0.0 1.0))
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

MP

  • Seagull
  • Posts: 17750
  • Have thousands of dwgs to process? Contact me.
Re: Add attribute to defined block
« Reply #13 on: May 28, 2019, 12:30:58 PM »
So my question : how can I get "key" string if there is LDATA attached... I guess I destroyed handles, so I want to put back as much as possible to newly created blocks... Any help, MP, Lee, CAB, ROY, RON or anyone (I surely missed someone)???

Existing data -- aside from handles -- can generally be harvested and "reconstituted". That was not stated as a requirement or else I would have coded accordingly. No time to play at present. PS: Stay away from ldata. Use xdata or dictionaries and xrecords.
Engineering Technologist • CAD Automation Practitioner
Automation ▸ Design ▸ Drafting ▸ Document Control ▸ Client
cadanalyst@gmail.comhttp://cadanalyst.slack.comhttp://linkedin.com/in/cadanalyst

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Add attribute to defined block
« Reply #14 on: June 02, 2019, 03:38:21 AM »
So after I hit the wall and realized I can't change entity handle, I thought about this topic once again after I found in VLisp documentation (vla-addattribute) method... So now codes are much simpler and what is more important no new block entity - everything from linking structure should be preserved, IMO... So Roy, this is my last revision that I use now, but I still have old versions just for any case...

First one : addatt-statblk :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:addatt-statblk ( / LM:InverseMatrix *adoc* att es blk pt a data aa matrix r al st bck con ent fil inv lay lit lts liw lck mat mta mtac mtbw mtdd nor oba psn prs scf tgf thi trc usd vfy vis )
  2.  
  3.  
  4.   ;;--------------------=={ Inverse Matrix }==------------------;;
  5.   ;;                                                            ;;
  6.   ;;  Implements the Gauss-Jordan Elimination algorithm to      ;;
  7.   ;;  inverse a non-singular nxn matrix.                        ;;
  8.   ;;------------------------------------------------------------;;
  9.   ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  10.   ;;------------------------------------------------------------;;
  11.   ;;  Arguments: m - nxn Matrix                                 ;;
  12.   ;;------------------------------------------------------------;;
  13.   ;;  Returns:  Matrix inverse, or nil if matrix is singular    ;;
  14.   ;;------------------------------------------------------------;;
  15.  
  16.   (defun LM:InverseMatrix ( m / _identity _eliminate p r x )
  17.  
  18.     (defun _identity ( n / i j l m ) (setq i 1)
  19.       (repeat n (setq j 0)
  20.         (repeat n
  21.           (setq l (cons (if (= i (setq j (1+ j))) 1. 0.) l))
  22.         )
  23.         (setq m (cons (reverse l) m) l nil i (1+ i))
  24.       ) (reverse m)
  25.     )
  26.  
  27.     (defun _eliminate ( m p )
  28.       (mapcar
  29.         (function
  30.           (lambda ( x / d )
  31.             (setq d (car x)) (mapcar (function (lambda ( a b ) (- a (* d b)))) (cdr x) p)
  32.           )
  33.         )
  34.         m
  35.       )
  36.     )
  37.  
  38.     (setq m (mapcar 'append m (_identity (length m))))
  39.     (while m
  40.       (setq p (apply 'max (mapcar 'abs (mapcar 'car m))))
  41.       (while (not (equal p (abs (caar m)) 1e-14))
  42.         (setq m (append (cdr m) (list (car m))))
  43.       )
  44.       (if (equal 0.0 (caar m) 1e-14)
  45.         (setq m nil)
  46.         (setq p (/ 1. (caar m))
  47.               p (mapcar (function (lambda ( x ) (* p x))) (cdar m))
  48.               m (_eliminate (cdr m) p)
  49.               r (cons p (_eliminate r p))
  50.         )
  51.       )
  52.     )
  53.     (reverse r)
  54.   )
  55.  
  56.   (if (= 8 (logand 8 (getvar 'undoctl)))
  57.     (vla-endundomark *adoc*)
  58.   )
  59.   (vla-startundomark *adoc*)
  60.   (while
  61.     (or
  62.       (not (setq att (car (entsel "\nPick attribute definition on unlocked layer..."))))
  63.       (if att
  64.         (or
  65.           (/= (cdr (assoc 0 (entget att))) "ATTDEF")
  66.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget att))))))))
  67.         )
  68.       )
  69.     )
  70.     (prompt "\nMissed or picked wrong entitiy type or picked ATTDEF on locked layer...")
  71.   )
  72.   (while
  73.     (or
  74.       (not (setq es (entsel "\nPick static block reference on unlocked layer you want to add attribute that was previously picked...")))
  75.       (not (setq blk (car es)))
  76.       (not (setq pt (cadr es)))
  77.       (if blk
  78.         (or
  79.           (/= (cdr (assoc 0 (entget blk))) "INSERT")
  80.           (= :vlax-true (vla-get-isdynamicblock (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  81.           (= :vlax-true (vla-get-isxref (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  82.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget blk))))))))
  83.         )
  84.       )
  85.     )
  86.     (prompt "\nMissed or picked wrong entity type, or picked entity not static block, or picked entity on locked layer...")
  87.   )
  88.   (setq a (vlax-ename->vla-object att))
  89.   (vla-transformby (vlax-ename->vla-object blk) (vlax-tmatrix (LM:InverseMatrix (setq matrix (caddr (nentselp pt))))))
  90.   (vla-transformby a (vlax-tmatrix (LM:InverseMatrix matrix)))
  91.   (if (/= r (vla-get-rotation aa))
  92.     (vla-put-rotation aa r)
  93.   )
  94.   (if (/= al (vla-get-alignment aa))
  95.     (progn
  96.       (vla-put-alignment aa al)
  97.     )
  98.   )
  99.   (if (/= st (vla-get-stylename aa))
  100.     (vla-put-stylename aa st)
  101.   )
  102.   (setq bck (vla-get-backward a))
  103.   (if (/= bck (vla-get-backward aa))
  104.     (vla-put-backward aa bck)
  105.   )
  106.   (setq con (vla-get-constant a))
  107.   (if (/= con (vla-get-constant aa))
  108.     (vla-put-constant aa con)
  109.   )
  110.   (setq ent (vla-get-entitytransparency a))
  111.   (if (/= ent (vla-get-entitytransparency aa))
  112.     (vla-put-entitytransparency aa ent)
  113.   )
  114.   (if (/= fil (vla-get-fieldlength aa))
  115.     (vla-put-fieldlength aa fil)
  116.   )
  117.   (setq inv (vla-get-invisible a))
  118.   (if (/= inv (vla-get-invisible aa))
  119.     (vla-put-invisible aa inv)
  120.   )
  121.   (setq lay (vla-get-layer a))
  122.   (if (/= lay (vla-get-layer aa))
  123.     (vla-put-layer aa lay)
  124.   )
  125.   (setq lit (vla-get-linetype a))
  126.   (if (/= lit (vla-get-linetype aa))
  127.     (vla-put-linetype aa lit)
  128.   )
  129.   (if (/= lts (vla-get-linetypescale aa))
  130.     (vla-put-linetypescale aa lts)
  131.   )
  132.   (if (/= liw (vla-get-lineweight aa))
  133.     (vla-put-lineweight aa liw)
  134.   )
  135.   (setq lck (vla-get-lockposition a))
  136.   (if (/= lck (vla-get-lockposition aa))
  137.     (vla-put-lockposition aa lck)
  138.   )
  139.   (setq mat (vla-get-material a))
  140.   (if (/= mat (vla-get-material aa))
  141.     (vla-put-material aa mat)
  142.   )
  143.   (setq mta (vla-get-mtextattribute a))
  144.   (if (/= mta (vla-get-mtextattribute aa))
  145.     (vla-put-mtextattribute aa mta)
  146.   )
  147.   (setq mtac (vla-get-mtextattributecontent a))
  148.   (if (/= mtac (vla-get-mtextattributecontent aa))
  149.     (vla-put-mtextattributecontent aa mtac)
  150.   )
  151.   (setq mtbw (vla-get-mtextboundarywidth a))
  152.   (if (/= mtbw (vla-get-mtextboundarywidth aa))
  153.     (vla-put-mtextboundarywidth aa mtbw)
  154.   )
  155.   (setq mtdd (vla-get-mtextdrawingdirection a))
  156.   (if (/= mtdd (vla-get-mtextdrawingdirection aa))
  157.     (vla-put-mtextdrawingdirection aa mtdd)
  158.   )
  159.   (setq nor (vla-get-normal a))
  160.   (if (/= nor (vla-get-normal aa))
  161.     (vla-put-normal aa nor)
  162.   )
  163.   (if (/= oba (vla-get-obliqueangle aa))
  164.     (vla-put-obliqueangle aa oba)
  165.   )
  166.   (if (/= psn (vla-get-plotstylename aa))
  167.     (vla-put-plotstylename aa psn)
  168.   )
  169.   (setq prs (vla-get-preset a))
  170.   (if (/= prs (vla-get-preset aa))
  171.     (vla-put-preset aa prs)
  172.   )
  173.   (if (/= scf (vla-get-scalefactor aa))
  174.     (vla-put-scalefactor aa scf)
  175.   )
  176.   (if (/= tgf (vla-get-textgenerationflag aa))
  177.   )
  178.   (setq thi (vla-get-thickness a))
  179.   (if (/= thi (vla-get-thickness aa))
  180.     (vla-put-thickness aa thi)
  181.   )
  182.   (setq trc (vla-get-truecolor a))
  183.   (if (/= trc (vla-get-truecolor aa))
  184.     (vla-put-truecolor aa trc)
  185.   )
  186.   (if (/= usd (vla-get-upsidedown aa))
  187.     (vla-put-upsidedown aa usd)
  188.   )
  189.   (setq vfy (vla-get-verify a))
  190.   (if (/= vfy (vla-get-verify aa))
  191.     (vla-put-verify aa vfy)
  192.   )
  193.   (setq vis (vla-get-visible a))
  194.   (if (/= vis (vla-get-visible aa))
  195.     (vla-put-visible aa vis)
  196.   )
  197.   (vla-transformby (vlax-ename->vla-object blk) (vlax-tmatrix matrix))
  198.   (vla-delete a)
  199.   (vl-cmdf "_.ATTSYNC" "_N" (cdr (assoc 2 (entget blk))))
  200.   (vla-endundomark *adoc*)
  201.   (princ)
  202. )
  203.  

Now I figured after deep research that after process of block becoming attributed block - it was added fixed DXF Group Code (66 . 1), you can never return back to block with no attributes (even if you remove last attribute definition and attribute from references, block reference stays so called "corrupted" that is has (66 . 1) which can't be removed and it has SEQEND entity bind to reference which also can't be erased or deleted or removed in any way I know... So if you leave this "corrupted" block and now try to add new attributes via ATTDEF command and previously posted addatt-statblk.lsp, Definitions are moved into block definition, but attributes are never added to references - simply they can't be inserted between INSERT and SEQEND entity - so as I have coded - after adding (vla-addattribute) method I erased-deleted ATTDEF from current active space you are working on as there should be no purpose to be left over added in normal situation attribute entities to block references... Result is that attributes defined and that should be added actually vanish... So I deeply thought about this problem and I decided to code my rematt-statblk.lsp in a way that it's allowed to remove attributes and attribute definitions all until one last remains... If you apply routine and on last one, nothing will happen - it's not allowed - DXF GC (66 . 1) can't be changed...

Second rematt-statblk :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:rematt-statblk ( / *adoc* att blk ss b k bb tagstring textstring inspt d bp a )
  2.  
  3.  
  4.   (if (= 8 (logand 8 (getvar 'undoctl)))
  5.     (vla-endundomark *adoc*)
  6.   )
  7.   (vla-startundomark *adoc*)
  8.   (while
  9.     (or
  10.       (not (setq att (car (nentsel "\nPick attribute on desired static block on unlocked layer..."))))
  11.       (if att
  12.         (or
  13.           (not (wcmatch (cdr (assoc 0 (entget att))) "ATTRIB,ATTDEF"))
  14.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget att))))))))
  15.         )
  16.       )
  17.     )
  18.     (prompt "\nMissed or picked wrong entitiy type or picked ATTRIB on locked layer...")
  19.   )
  20.   (if
  21.     (or
  22.       (not (setq blk (cdr (assoc 330 (entget att)))))
  23.       (if blk
  24.         (or
  25.           (not (wcmatch (cdr (assoc 0 (entget blk))) "INSERT,BLOCK_RECORD"))
  26.           (= :vlax-true (vla-get-isdynamicblock (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  27.           (= :vlax-true (vla-get-isxref (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  28.           (if (= (cdr (assoc 0 (entget blk))) "INSERT")
  29.             (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget blk))))))))
  30.             (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget (setq blk (car (vl-sort (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 331)) (entget blk))) '(lambda ( a b ) (< (distance inspt (safearray-value (variant-value (vla-get-insertionpoint (vlax-ename->vla-object a))))) (distance inspt (safearray-value (variant-value (vla-get-insertionpoint (vlax-ename->vla-object b))))))))))))))))))
  31.           )
  32.         )
  33.       )
  34.     )
  35.     (progn
  36.       (prompt "\nMissed or picked wrong entity type, or picked entity not static block, or picked entity on locked layer... Quitting...")
  37.       (exit)
  38.     )
  39.   )
  40.   (setq k 0)
  41.   (setq bb blk)
  42.   (while (and (setq bb (entnext bb)) (/= (cdr (assoc 0 (entget bb))) "SEQEND"))
  43.     (if (= (cdr (assoc 0 (entget bb))) "ATTRIB")
  44.       (setq k (1+ k))
  45.     )
  46.   )
  47.   (setq tagstring (vla-get-tagstring (vlax-ename->vla-object att)))
  48.   (setq textstring (vla-get-textstring (vlax-ename->vla-object att)))
  49.   (setq a (rem (+ pi pi (- (angle (trans bp 0 blk) (trans inspt 0 blk)) (cdr (assoc 50 (entget blk))))) (+ pi pi)))
  50.   (if (> k 1)
  51.     (progn
  52.       (vlax-for o b
  53.         (if (and (= (vla-get-objectname o) "AcDbAttributeDefinition") (= (vla-get-tagstring o) tagstring) (= (vla-get-textstring o) textstring) (equal d (distance (safearray-value (variant-value (vla-get-insertionpoint o))) '(0.0 0.0 0.0)) 1e-6) (equal a (angle '(0.0 0.0) (safearray-value (variant-value (vla-get-insertionpoint o)))) 1e-6))
  54.           (vla-delete o)
  55.         )
  56.       )
  57.       (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 (cdr (assoc 2 (entget blk)))))))
  58.         (foreach o (vl-remove-if-not '(lambda ( x ) (equal d (distance (safearray-value (variant-value (vla-get-insertionpoint x))) (safearray-value (variant-value (vla-get-insertionpoint r)))) 1e-6)) (append (vlax-invoke r 'getconstantattributes) (vlax-invoke r 'getattributes)))
  59.           (if (and (= (vla-get-objectname o) "AcDbAttribute") (= (vla-get-tagstring o) tagstring) (= (vla-get-textstring o) textstring) (equal a (rem (+ pi pi (- (angle (trans (safearray-value (variant-value (vla-get-insertionpoint r))) 0 (vlax-vla-object->ename r)) (trans (safearray-value (variant-value (vla-get-insertionpoint o))) 0 (vlax-vla-object->ename r))) (vla-get-rotation r))) (+ pi pi)) 1e-6))
  60.             (vla-delete o)
  61.           )
  62.         )
  63.         (vla-update r)
  64.       )
  65.     )
  66.   )
  67.   (vla-endundomark *adoc*)
  68.   (princ)
  69. )
  70.  

And finally, after I saw that one last attribute can't be removed without "corruption", I coded one more simple routine for changing attribute tagstring, promptstring and textstring, so that you can fix that one the way you like without creating new ATTDEF, applying addatt-statblk and removing the one you don't like... So this one can be useful in any situation you wish to alter picked already bind attribute to block with attributes...

Last redatt-statblk :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:redatt-statblk ( / *adoc* att blk tagstring promptstring textstring inspt b )
  2.  
  3.  
  4.   (if (= 8 (logand 8 (getvar 'undoctl)))
  5.     (vla-endundomark *adoc*)
  6.   )
  7.   (vla-startundomark *adoc*)
  8.   (while
  9.     (or
  10.       (not (setq att (car (nentsel "\nPick attribute on desired static block on unlocked layer..."))))
  11.       (if att
  12.         (or
  13.           (not (wcmatch (cdr (assoc 0 (entget att))) "ATTRIB,ATTDEF"))
  14.           (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget att))))))))
  15.         )
  16.       )
  17.     )
  18.     (prompt "\nMissed or picked wrong entitiy type or picked ATTRIB on locked layer...")
  19.   )
  20.   (if
  21.     (or
  22.       (not (setq blk (cdr (assoc 330 (entget att)))))
  23.       (if blk
  24.         (or
  25.           (not (wcmatch (cdr (assoc 0 (entget blk))) "INSERT,BLOCK_RECORD"))
  26.           (= :vlax-true (vla-get-isdynamicblock (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  27.           (= :vlax-true (vla-get-isxref (vla-item (vla-get-blocks *adoc*) (cdr (assoc 2 (entget blk))))))
  28.           (if (= (cdr (assoc 0 (entget blk))) "INSERT")
  29.             (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget blk))))))))
  30.             (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget (setq blk (car (vl-sort (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= (car x) 331)) (entget blk))) '(lambda ( a b ) (< (distance inspt (safearray-value (variant-value (vla-get-insertionpoint (vlax-ename->vla-object a))))) (distance inspt (safearray-value (variant-value (vla-get-insertionpoint (vlax-ename->vla-object b))))))))))))))))))
  31.           )
  32.         )
  33.       )
  34.     )
  35.     (progn
  36.       (prompt "\nMissed or picked wrong entity type, or picked entity not static block, or picked entity on locked layer... Quitting...")
  37.       (exit)
  38.     )
  39.   )
  40.   (initget 1)
  41.   (setq tagstring (getstring t "\nSpecify new Tagstring : "))
  42.   (while (not (snvalid tagstring))
  43.     (initget 1)
  44.     (setq tagstring (getstring t "\nSpecify new Tagstring : "))
  45.   )
  46.   (initget 1)
  47.   (setq promptstring (getstring t "\nSpecify new Promptstring : "))
  48.   (while (not (snvalid promptstring))
  49.     (initget 1)
  50.     (setq promptstring (getstring t "\nSpecify new Promptstring : "))
  51.   )
  52.   (initget 1)
  53.   (setq textstring (getstring t "\nSpecify new Textstring : "))
  54.   (while (not (snvalid textstring))
  55.     (initget 1)
  56.     (setq textstring (getstring t "\nSpecify new Textstring : "))
  57.   )
  58.   (vlax-for o b
  59.     (if (and (not (vlax-erased-p att)) (= (vla-get-objectname o) "AcDbAttributeDefinition") (= (vla-get-tagstring o) (vla-get-tagstring (vlax-ename->vla-object att))) (= (vla-get-textstring o) (vla-get-textstring (vlax-ename->vla-object att))))
  60.       (progn
  61.         (vla-put-tagstring o tagstring)
  62.         (if (vlax-property-available-p o 'promptstring)
  63.           (vla-put-promptstring o promptstring)
  64.         )
  65.         (vla-put-textstring o textstring)
  66.       )
  67.     )
  68.   )
  69.   (vl-cmdf "_.ATTSYNC" "_N" (cdr (assoc 2 (entget blk))))
  70.   (vla-endundomark *adoc*)
  71.   (princ)
  72. )
  73.  

So, I believe this is my last - final revision and I hope that now working with attributes should be as desired and much easier... So if you want you can still use my old rematt-statblk.lsp to remove last attribute - it should remove it, but linked chains that may have existed prior this operation will be broken, so be careful... I described what I thought it is possible - very possible and the way it should be approached when dealing with adding and removing attributes to already defined block... So I hope those my last materials will prove useful in your future work and I hope it all now has deeper sense...

If you notice something that I missed or you find routines could be better and improved, your reply is appreciated very much...
Regards, and all the best...
M.R.
« Last Edit: September 24, 2021, 10:25:38 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube