Community
What I have done before for the same work is to insert a new block to replace the old one then ATTSYNC, with a simple lisp which runs automatically whenever open an existing drawing. But you have to make sure the attribute tags match each other. You can rename the tag later after inserting the new block.
@elfert wrote:
I have drawing head that is a block named 'what ever1' with attributes inside that has values/data now i need to insert another drawing head block with another name 'what ever2' and it also have some attributes but they don't have the same tag name. After i have insert 'what ever2' i need to take attribute values from drawing head block named 'what ever1' and put them into the attributes in drawing head block named 'what ever2' and after all the values has been transfer i need delete drawing head block named 'what ever1'. Is there a lisp or something similar that could do the job or can some help to start writing one any help please! thx in advance
Something like this perhaps.
As a starpoint...
(defun c:demo (/ ATTLST ATTLST1 ATTS OBJ OBJ1 OLD_LST OLD_REC POS S1 S2)
(vl-load-com)
(if (setq s1 (ssget "_+.:E:S:L" '((0 . "INSERT") (2 . "what ever1") (66 . 1))))
(progn
(setq atts '(("Old_Tag1" "New_Tag1") ("Old_Tag2" "New_Tag2") ("Old_Tag3" "New_Tag3"))
old_rec (getvar 'ATTREQ)
obj (vlax-ename->vla-object (ssname s1 0))
attlst (vlax-invoke obj 'GetAttributes)
);; setq
(foreach att attlst
(setq old_lst (cons (list (vla-get-TagString att) (vla-get-TextString att)) old_lst))
);; foreach
(setvar 'ATTREQ 0)
(vl-cmdf "_.-insert" "BLK2" (vlax-get obj 'InsertionPoint) "" "" "")
(if (setq s2 (ssget "_L" '((0 . "INSERT") (2 . "what ever1") (66 . 1))))
(progn
(setq obj1 (vlax-ename->vla-object (ssname s2 0))
attlst1 (vlax-invoke obj1 'GetAttributes)
);; setq
(foreach att attlst1
(if (setq pos (vl-position (vla-get-TagString att) (mapcar 'cadr atts)))
(vla-put-TextString
att
(nth (vl-position
(nth pos (mapcar 'car atts))
(mapcar 'car old_lst)
)
(mapcar 'cadr old_lst)
)
)
);; if
);; foreach
);; progn
);; if
(setvar 'ATTREQ old_rec)
;(vla-delete obj)
);; progn
);; if
(princ)
);; demo
EDIT: I did commented the vla-delete...
HTH
Henrique
@elfert wrote:
Many thanks for the work you have done so far and very nice lisp you made there but there is something that need to be changed and not working. What need to be changed is: 1. The user don't have to select the block. The Lisp should be able to get the drawing head name 'whatever1' just by given the block name 'whatever1' in the lisp routine itself. What is not working: 2. The values from attributes in drawing head block named 'whatevert1' seems no to transfer to the drawing head block named 'whatever2' that is inserted. I have tried to build the scenario with the to Drawing head blocks and put in attributes in both of them. If you need i can send you the drawing files. But thx in advance.
You're welcome, elfert.
Post a sample dwg with both blocks and indicates the attributes to copy...
Henrique
@elfert wrote:
Here is the test drawing 'test.dwg' with the drawing head name 'DHB1'. I also add the file with the drawing head block name 'DHB2'. And the modifyed Lisp.
Change
(if (setq s2 (ssget "_L" '((0 . "INSERT") (2 . "DHB1") (66 . 1))))
to
(if (setq s2 (ssget "_L" '((0 . "INSERT") (2 . "DHB2") (66 . 1))))
HTH
Henrique
You're welcome, elfert.
Again, just as a demo
(defun c:demo ( / ACTLYT ATTLST ATTLST1 ATTS ENT HND I LYT OBJ OBJ1 OLD_LST OLD_REC POS RT S1 S2 SC)
(vl-load-com)
(setq atts '(("OLDTAG1" "NEWTAG1") ("OLDTAG2" "NEWTAG2"))
old_rec (getvar 'ATTREQ)
atclyt (getvar 'CTAB))
(setvar 'ATTREQ 0)
(if (setq s1 (ssget "_X" '((0 . "INSERT") (2 . "DHB1") (66 . 1))))
(repeat (setq i (sslength s1))
(setq hnd (ssname s1 (setq i (1- i)))
ent (entget hnd)
lyt (cdr (assoc 410 ent))
sc (cdr (assoc 41 ent))
rt (* (/ (cdr (assoc 50 ent)) pi) 180.0)
attlst nil
attlst1 nil
obj (vlax-ename->vla-object hnd)
attlst (vlax-invoke obj 'GetAttributes)
);; setq
(foreach att attlst
(setq old_lst (cons (list (vla-get-TagString att) (vla-get-TextString att)) old_lst))
);; foreach
(setvar 'CTAB lyt)
(vl-cmdf "_.-insert" "DHB2" "_NONE" (vlax-get obj 'InsertionPoint) sc sc rt)
(if (setq s2 (ssget "_L" '((0 . "INSERT") (2 . "DHB2") (66 . 1))))
(progn
(setq obj1 (vlax-ename->vla-object (ssname s2 0))
attlst1 (vlax-invoke obj1 'GetAttributes)
);; setq
(foreach att attlst1
(if (setq pos (vl-position (vla-get-TagString att) (mapcar 'cadr atts)))
(vla-put-TextString
att
(nth (vl-position
(nth pos (mapcar 'car atts))
(mapcar 'car old_lst)
)
(mapcar 'cadr old_lst)
)
)
);; if
);; foreach
);; progn
);; if
;(vla-delete obj)
);; repeat
);; if
(setvar 'CTAB atclyt)
(setvar 'ATTREQ old_rec)
(princ)
);; demo
I did commented the (val-delete obj) to allow you to verify if the attributes were well populated...
To erase the original object, just remove the ";" from the ;(vla-delete obj)...
Hope that helps
Henrique
Forums Links
Can't find what you're looking for? Ask the community or share your knowledge.
Post to forums
