Exporting Identical Tag Attributes to New Block with Fixed Tags

[More8927]

So the company I work for is trying to update a block so the attributes are properly tagged for exporting purposes.  We have 1000's of drawings and on a given day I can shift through 25-100 that need the new block.  After a few days of scowering the web in my spare time I have written some semi functional code, but it has a few bugs I can't work out because I don't properly understand how lisp handles data types.  

Currently it is not adding the old attributes, when debugging the list prints right, I just can't get it to insert into the new block right.

Any ideas?

Code:

(defun c:BU (/ )

(DEFUN AddSupportPath (dir / tmp Cpath);function for adding support path
 (VL-LOAD-COM)
 (SETQ Cpath (GETENV "ACAD") tmp (STRCAT ";" dir ";"))
 (IF (NOT (VL-STRING-SEARCH dir cpath)) (SETENV "ACAD" (STRCAT Cpath ";" dir)))
 (PRINC)
)
(AddSupportPath "X:\\Precast\\z-Misc\\00_PUBLISH");add new block support path
 
(setq osnapold (getvar "osmode")) 
(setq ss (ssget "_X" '((0 . "INSERT") (2 . "BOM 2013"))));select old block
(setq origin (cdr (assoc 10 (entget (ssname ss 0)))));identify old block origin
(setq scale (cdr (assoc 41 (entget (ssname ss 0)))));identify old block scale 
 
(setq sel (entsel "\nSelect a Block: "));select old block for attribute list
(setq attlst
 (mapcar '(lambda (x) (vla-get-TextString x))
 (vlax-invoke (vlax-ename->vla-object (car sel)) 'GetAttributes);make list of old attributes
 )
)
 
;(princ attlst);debugg line to print items to verify correct
 
(command "ucs" "w");switch to world coord
(command "_-insert" "BOM2016" origin scale "" "" items);insert new block with old attributes
(setvar "osmode" osnapold) 
(command "ucs" "p");switch coord back
(command)
)

I would also like to delete this line and just have it use the "ss" variable when extracting old attributes, but it throws a data type error.

(setq sel (entsel "\nSelect a Block: "));select old block for attribute list

Thanks everyone

[hmsilva]

Untested...

(defun c:BU (/ AddSupportPath)

   (defun AddSupportPath (dir / tmp Cpath) ;function for adding support path
      (vl-load-com)
      (setq Cpath (getenv "ACAD")
            tmp   (strcat ";" dir ";")
      )
      (if (not (vl-string-search dir cpath))
         (setenv "ACAD" (strcat Cpath ";" dir))
      )
      (princ)
   )

   (AddSupportPath "X:\\Precast\\z-Misc\\00_PUBLISH") ;add new block support path

   (if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "BOM 2013") (cons 410 (getvar 'ctab))))) ;select old block in current layout tab...
      (progn
         (setq osnapold (getvar "osmode"))
         (setq req (getvar "attreq"))
         (setvar "osmode" 0)
         (setvar "attreq" 0) ; assumes the defaults for the values of all attributes
         (setq blk (ssname ss 0)) ; get ename
         (setq ent (entget blk)) ; get ent list
         (setq origin (cdr (assoc 10 ent))) ;identify old block origin
         (setq scale (cdr (assoc 41 ent))) ;identify old block scale
 ;(setq sel (entsel "\nSelect a Block: "));select old block for attribute list
         (setq attlst
               ;|(mapcar '(lambda (x) (vla-get-TextString x))
 (vlax-invoke (vlax-ename->vla-object hnd) 'GetAttributes);make list of old attributes
 )|;
                 (mapcar '(lambda (att) (cons (vla-get-TagString att) (vla-get-TextString att)))
                         (vlax-invoke (vlax-ename->vla-object hnd) "GetAttributes")
                 )
         ) ; make a dotted pair list of old attributes
 ;(princ attlst);debugg line to print items to verify correct
         (command "ucs" "w") ;switch to world coord
         (command "_-insert" "BOM2016" origin scale "" "") ; insert new block...
         (mapcar
            '(lambda (att)
                (if (setq pair
                            (assoc (vla-get-TagString att) attlst)
                    )
                   (vla-put-TextString att (cdr pair))
                )
             )
            (vlax-invoke
               (vlax-ename->vla-object (entlast))
               "GetAttributes"
            )
         ) ; put attribute strings from the old block
         (setvar "attreq" req)
         (setvar "osmode" osnapold)
         (command "ucs" "p") ;switch coord back
      )
   )
   (princ)
)

Hope this helps,
Henrique

[More8927]

Okay, I tested the code and it supplied "errorr: bad argument type: lentityp nil" I thought it was because the comment out on the old mapcar wasn't working right. I deleted the old mapcar and still got the same thing.  I understand the switching append to cons because of the execution speed, but visual lisp still puzzles me a bit.  I'll keep going through it though to see if I can figure something out. 

[hmsilva]

---

@mmorenoNUPQJ wrote:

Okay, I tested the code and it supplied "errorr: bad argument type: lentityp nil" I thought it was because the comment out on the old mapcar wasn't working right. I deleted the old mapcar and still got the same thing.  I understand the switching append to cons because of the execution speed, but visual lisp still puzzles me a bit.  I'll keep going through it though to see if I can figure something out. 

---

Sorry, my bad....

change the first line to

(defun c:BU (/ AddSupportPath att attlst blk ent origin osnapold pair req scale ss)

and change

(vlax-invoke (vlax-ename->vla-object hnd) "GetAttributes")

to

(vlax-invoke (vlax-ename->vla-object blk) "GetAttributes")

Hope this helps,
Henrique

[More8927]

That got rid of the error message and now the new block inserts in the proper location and at the proper sccale, but it still isn't being populated with the old attributes.   I ran it again to print attlst and that does have everything in it. It just isn't pasting in for some reason.  

Also what does "cons 410"?  I know cons adds strings to a list, but what is the 410 for?

[hmsilva]

---

@mmorenoNUPQJ wrote:

That got rid of the error message and now the new block inserts in the proper location and at the proper sccale, but it still isn't being populated with the old attributes.   I ran it again to print attlst and that does have everything in it. It just isn't pasting in for some reason.  

...

---

Are the TAG's from the new block, the same as the old one?

If possible, post asample dwg with both blocks...

---

@mmorenoNUPQJ wrote:

... 

Also what does "cons 410"?  I know cons adds strings to a list, but what is the 410 for?

---

To add to 'ssget' filter list the current layout tab...

_$ (cons 410 (getvar 'ctab))
(410 . "Model")
_$

Hope this helps,
Henrique

[More8927]

Attached is a file with the old block in it that I am running the lisp on.  Also attached is the new block.  The tags are different.  When somebody fist made the original version of this block 20 years ago they had all the tags the same.  Over the past 20 years it has been updated a few times, but the tags have always been screwed up so they can just redefine the old one and have it still work.  The problem has come up that we would like to export out the attributes using LeeMac's extractor, because it runs so smooth, but all the tags having the same name creates overflow errors. 

[hmsilva]

It's not easy...

It's already getting late in this part of the world, tomorrow I'll see what I can do...

Henrique

[More8927]

No problem, Thanks a ton for your help.  I need to find dinner for the family anyways.  I'll be out for the weekend because I forgot my flashdrive at work. 

Thanks, a lot for your help so far though.

[hmsilva · Accepted solution]

Quick and dirty...

(vl-load-com)
(defun c:demo (/ AddSupportPath att attlst blk ent i origin osnapold req scale ss)
   (defun AddSupportPath (dir / tmp Cpath) ;function for adding support path
      (setq Cpath (getenv "ACAD")
            tmp   (strcat ";" dir ";")
      )
      (if (not (vl-string-search dir cpath))
         (setenv "ACAD" (strcat Cpath ";" dir))
      )
      (princ)
   )
   (AddSupportPath "X:\\Precast\\z-Misc\\00_PUBLISH") ; add new block support path
   (if (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "BOM 2013") (cons 410 (getvar 'ctab))))); select old block in current layout tab...
      (progn
         (command "ucs" "w"); switch to world coord
         (setq osnapold (getvar 'osmode); get current OSMODE value
               req      (getvar 'attreq); get current ATTREQ value
               blk      (ssname ss 0); get BOM 2013 ename
               ent      (entget blk); get BOM 2013 definition list
               origin   (cdr (assoc 10 ent)); identify old block origin
               scale    (cdr (assoc 41 ent)); identify old block scale
               i        -1; set index to -1
         )
         (setq attlst (mapcar '(lambda (att) (vla-get-TextString att))
                              (vlax-invoke (vlax-ename->vla-object blk) 'GetAttributes)
                      )
         );make a list of old attributes text strings
         (setvar 'osmode 0)
         (setvar 'attreq 0)
         (command "_-insert" "BOM2016" origin scale "" ""); insert new block...
         ; foreach attribute from BOM2016, put text string from attlist using the same index...
         (foreach att (vlax-invoke (vlax-ename->vla-object (entlast)) "GetAttributes")
            (vla-put-TextString att (nth (setq i (1+ i)) attlst))
         )
         (command "ucs" "p"); switch coord back
         (setvar 'attreq req); restores original value
         (setvar 'osmode osnapold); restores original value
      )
   )
   (princ)
)

Hope this helps,
Henrique

[More8927]

That worked perfectly, Thank you very much.

[hmsilva]

---

@More8927 wrote:

That worked perfectly, Thank you very much.

---

You're welcome, More8927!
Glad I could help

Henrique