looking for a Lisp that add attributes to blocks and copy some specific values

[Hans_Knol]

Hi all,

Hope someone is able to help me with creating a Lisp file described below. 

On attached drawing we have a block with attributes, on top of this block is placed an other block with attributes, (same insertionpoint) which has the same value from in the attribute TAG1 or TAG1F. the value of the attribute “SIGCODE” must also be equal in both blocks, normaly one block is vissable and the other or others are on frozen or off layers.

The original linetype of the lines from the "frozen" blocks are “HIDDEN”

Then the value of the "frozen" blocks attribute "MFG" must be placed in a new attribute called “MFG01” which must be hidden and the insertion point can be the insertion point of the block what’s original visible on the Drawing. When there are more blocks behind a block (symbol) then it must be placed in the attribute “MFG02” etc. which must be hidden and the insertion point can be the insertion point of the block what’s original visible on the Drawing. And so on.

The same must be done with the attribute CAT, this must be placed in a new attribute called “CAT01” which must be hidden and the insertion point can be the insertion point of the block what’s original visible on the Drawing. When there are more block behind a block (symbol) then it must be placed in the attribute “CAT02” etc. which must be hidden and the insertion point can be the insertion point of the block what’s original visible on the Drawing. And so on.

The Lisp routine must be run automatically with for example the name MFGCAT

Hope someone is able to create this Lisp routine.

[Hans_Knol]

I got this but it doesn't work, maybe someone can have a look to this.... or it helps to get a good routine.

(defun c:MFGCAT ()
(defun get-insertion-point (block)
(cdr (assoc 10 (entget block)))
)

(defun get-attributes-data (block)
(mapcar '(lambda (att)
(list (cdr (assoc 2 att)) (cdr (assoc 1 att)))
)
(vl-remove-if-not
'(lambda (att)
(eq (cdr (assoc 0 att)) 'ATTDEF)
)
(entget block)
)
)
)

(defun set-attribute-value (block attribute-name new-value)
(setq atts (get-attributes-data block))
(foreach att atts
(if (string-equal (car att) attribute-name)
(progn
(setq att (entmod (subst (cons 1 new-value) (assoc 1 att) att)))
(setq new-atts (append new-atts (list att)))
)
(setq new-atts (append new-atts (list att)))
)
)
(entmod new-atts)
)

(defun process-block (block)
(setq insertion-point (get-insertion-point block))
(setq mfg-value (cdr (assoc "MFG" (get-attributes-data block))))
(setq cat-value (cdr (assoc "CAT" (get-attributes-data block))))
(setq count 1)

(while (setq next-block (assoc -1 (entget (tblnext "BLOCK" (cdr block)))))
(setq count (+ count 1))
(setq next-block-name (cdr (assoc 2 next-block)))
(setq next-block-insertion-point (get-insertion-point next-block))
(setq next-block-mfg-att (strcat "MFG" (itoa count)))
(setq next-block-cat-att (strcat "CAT" (itoa count)))

(command "_-insert" next-block "" insertion-point 1 1 0 next-block-insertion-point)
(setq mfg-value (strcat mfg-value "," (cdr (assoc "MFG" (get-attributes-data next-block)))))
(setq cat-value (strcat cat-value "," (cdr (assoc "CAT" (get-attributes-data next-block)))))

(set-attribute-value next-block "MFG" next-block-mfg-att)
(set-attribute-value next-block "CAT" next-block-cat-att)
)

(set-attribute-value block "MFG" mfg-value)
(set-attribute-value block "CAT" cat-value)
)

(setq blocklist (tblnext "BLOCK"))
(while blocklist
(setq blockname (cdr (assoc 2 blocklist)))
(setq block (entget (tblobjname "BLOCK" blockname)))
(process-block block)
(setq blocklist (tblnext "BLOCK"))
)
(princ)
)

[paullimapa]

You may find this post helpful