Topic: remake blocks with attributes

[curmudgeon]

Working in Autocad 2000. Large floor plans with RMUSAGE blocks - two attributes of text description, one for a room number, one for an area, and one piece of text. Over time, the attributes have been moved without moving the block - there is no nontext entity.

The attached file, reblk.lsp, I massaged from some example code. It runs. It works.
But the file gets larger, exponentially.

Why does the file keep getting larger? There is no new data.
The files recover without finding any errors, but the objects in the handle table increase faster than the number of blocks remade.

[ribarm]

Here is my observation, but without example DWG its hard to tell and test...

Code - Auto/Visual Lisp: [Select]

1. (defun c:resetattribpositioninblock ( / mxv thisblock blockname block b_ename enxt ss taglist namelist attribs elst insPt attDefs layer xScale yScale zScale ent tag xform rotation )
2.  
3. (defun mxv ( m v ) (mapcar (function (lambda ( r ) (apply '+ (mapcar '* r v)))) m))
4.  
5. (setq thisblock (entget (car (entsel "\nPick Block")))
6.       blockname (cdr (assoc 2 thisblock))
7.       block     (tblsearch "block" blockname)
8.       b_ename   (cdr (assoc -2 block))
9.       enxt      (entnext (cdr (assoc -1 thisblock)))
10.       ss        (ssadd)
11.       insPt     (cdr (assoc 10 thisblock)) ;; I think this was wrong (setq insPt (cdr (assoc 10 (entget enxt)))) IMHO
12.       )
13.  
14. (while (= "ATTRIB" (cdr (assoc 0 (entget enxt))))
15.   (ssadd enxt ss)
16.   (setq enxt (entnext enxt))
17. );; ss selection set of attribute enames thisblock
18.  
19. (while (ssname ss 0)
20.   (setq namelist (append namelist (list (cdr (assoc 1 (entget (ssname ss 0)))))))
21.   (setq taglist (append taglist (list (cdr (assoc 2 (entget (ssname ss 0)))))))
22.   (ssdel (ssname ss 0) ss)
23. );; list of attribute values to save
24.  
25. (setq attribs (mapcar 'cons taglist namelist)
26.       xScale (cdr (assoc 41 thisblock)) yScale (cdr (assoc 42 thisblock)) zScale (cdr (assoc 43 thisblock)) rotation (cdr (assoc 50 thisblock)) layer (cdr (assoc 8 thisblock))
27.       ent   (cdr (assoc -2 block))
28.       xform (list
29.               (list (* xScale (cos rotation)) (* xScale (- (sin rotation))) 0.0)
30.               (list (* yScale (sin rotation)) (* yScale (cos rotation)) 0.0)
31.               (list 0.0 0.0 zScale)
32.             )
33.       )
34.  
35. (while ent
36.   (if (= "ATTDEF" (cdr (assoc 0 (setq elst (entget ent)))))
37.             (setq attDefs (cons (cons (cdr (assoc 2 elst)) elst) attDefs)))
38.             (setq ent (entnext ent))
39.           )
40.  
41. ;; before you make new reference, I think you should remove old one
42. (entdel (cdr (assoc -1 thisblock))) ;; my mod...
43.  
44. (entmakex
45.   (list (cons 0 "INSERT") (cons 8 layer) (cons 66 1) (cons 2 blockname)
46.         (cons 10 insPt) (cons 41 xScale) (cons 42 yScale) (cons 43 zScale) (cons 50 rotation))
47.   )
48.  
49. (foreach att (reverse attDefs)
50.   (setq tag  (car att) elst (cdr att)
51.         )
52. (entmakex (list (cons 0 "ATTRIB") (cons 100 "AcDbEntity") (assoc 8 elst)
53.                 (cons 100 "AcDbText") (cons 10 (mapcar '+ insPt (mxv xform (cdr (assoc 10 elst)))))
54.                 (cons 40 (* yScale (cdr (assoc 40 elst))))
55.                 (cons 1 (cond ((cdr (assoc tag attribs)))
56.                             (T (cdr (assoc 1 elst)))))
57.                 (cons 50 (+ (cdr (assoc 50 elst)) rotation)) (cons 41 1) (assoc 51 elst) (assoc 7 elst) (assoc 72 elst)
58.                 (cons 11 (mapcar '+ insPt (mxv xform (cdr (assoc 11 elst)))))
59.                 (cons 100 "AcDbAttribute") (cons 2 tag) (assoc 70 elst) (assoc 74 elst)
60.                 )
61.             )
62.   )
63. (entmakex '((0 . "SEQEND")))
64. ;|
65. (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity")'(8 .  "TEXT") '(62 . 1) '(100 . "AcDbCircle")
66.         (cons 10 insPt) '(40 . 8)))
67. |;
68. (princ)
69. )
70.  
71. (defun c:resetattribpositioninblockmultiple ( / resetattribpositioninblock ss i )
72.  
73. (defun resetattribpositioninblock ( e / mxv thisblock blockname block b_ename enxt ss taglist namelist attribs elst insPt attDefs layer xScale yScale zScale ent tag xform rotation )
74.  
75. (defun mxv ( m v ) (mapcar (function (lambda ( r ) (apply '+ (mapcar '* r v)))) m))
76.  
77. (setq thisblock (entget e)
78.       blockname (cdr (assoc 2 thisblock))
79.       block     (tblsearch "block" blockname)
80.       b_ename   (cdr (assoc -2 block))
81.       enxt      (entnext (cdr (assoc -1 thisblock)))
82.       ss        (ssadd)
83.       insPt     (cdr (assoc 10 thisblock)) ;; I think this was wrong (setq insPt (cdr (assoc 10 (entget enxt)))) IMHO
84.       )
85.  
86. (while (= "ATTRIB" (cdr (assoc 0 (entget enxt))))
87.   (ssadd enxt ss)
88.   (setq enxt (entnext enxt))
89. );; ss selection set of attribute enames thisblock
90.  
91. (while (ssname ss 0)
92.   (setq namelist (append namelist (list (cdr (assoc 1 (entget (ssname ss 0)))))))
93.   (setq taglist (append taglist (list (cdr (assoc 2 (entget (ssname ss 0)))))))
94.   (ssdel (ssname ss 0) ss)
95. );; list of attribute values to save
96.  
97. (setq attribs (mapcar 'cons taglist namelist)
98.       xScale (cdr (assoc 41 thisblock)) yScale (cdr (assoc 42 thisblock)) zScale (cdr (assoc 43 thisblock)) rotation (cdr (assoc 50 thisblock)) layer (cdr (assoc 8 thisblock))
99.       ent   (cdr (assoc -2 block))
100.       xform (list
101.               (list (* xScale (cos rotation)) (* xScale (- (sin rotation))) 0.0)
102.               (list (* yScale (sin rotation)) (* yScale (cos rotation)) 0.0)
103.               (list 0.0 0.0 zScale)
104.             )
105.       )
106.  
107. (while ent
108.   (if (= "ATTDEF" (cdr (assoc 0 (setq elst (entget ent)))))
109.             (setq attDefs (cons (cons (cdr (assoc 2 elst)) elst) attDefs)))
110.             (setq ent (entnext ent))
111.           )
112.  
113. ;; before you make new reference, I think you should remove old one
114. (entdel (cdr (assoc -1 thisblock))) ;; my mod...
115.  
116. (entmakex
117.   (list (cons 0 "INSERT") (cons 8 layer) (cons 66 1) (cons 2 blockname)
118.         (cons 10 insPt) (cons 41 xScale) (cons 42 yScale) (cons 43 zScale) (cons 50 rotation))
119.   )
120.  
121. (foreach att (reverse attDefs)
122.   (setq tag  (car att) elst (cdr att)
123.         )
124. (entmakex (list (cons 0 "ATTRIB") (cons 100 "AcDbEntity") (assoc 8 elst)
125.                 (cons 100 "AcDbText") (cons 10 (mapcar '+ insPt (mxv xform (cdr (assoc 10 elst)))))
126.                 (cons 40 (* yScale (cdr (assoc 40 elst))))
127.                 (cons 1 (cond ((cdr (assoc tag attribs)))
128.                             (T (cdr (assoc 1 elst)))))
129.                 (cons 50 (+ (cdr (assoc 50 elst)) rotation)) (cons 41 1) (assoc 51 elst) (assoc 7 elst) (assoc 72 elst)
130.                 (cons 11 (mapcar '+ insPt (mxv xform (cdr (assoc 11 elst)))))
131.                 (cons 100 "AcDbAttribute") (cons 2 tag) (assoc 70 elst) (assoc 74 elst)
132.                 )
133.             )
134.   )
135. (entmakex '((0 . "SEQEND")))
136. )
137.  
138. (setq ss (ssget "_:L" (list '(0 . "INSERT") '(66 . 1) (cons 410 (getvar 'ctab)))))
139. (repeat (setq i (sslength ss))
140.   (resetattribpositioninblock (ssname ss (setq i (1- i))))
141. )
142. (princ)
143. )
144.  

[EDIT : I am not sure above will work fine with dynamic/anonymous blocks... Multiple version has filter for sel.set with '(66 . 1) which is reserved for only blocks with attributes, so xrefs are automatically filtered out - IMO...]

[curmudgeon]

Perfect !
Well, I want to get them all as a selection set. There will be around 1,000 of these in a normal drawing.

I cannot thank you enough.

[ribarm]

...
Well, I want to get them all as a selection set. There will be around 1,000 of these in a normal drawing.
...

I've added additional code in my post for multiple selection, but I am not quite sure you also have dynamic/anonumous blocks for processing and if you do have, I am not sure it will work as desired - if someone with more experience could look, perhaps another revision is needed (probably there should be checking of effectivename property - but I am not sure for anonumous blocks)...

Regards, M.R.