Combine multiple block attribute tags to a single tag

[blue3three]

Hello, 

 

I am looking for some guidance on modifying the following script, as it is written, it will find "BLOCK X" in a drawing and change the Old Tags "DESCRIPTION1" though 'DESCRIPTION6" to New Tag "DESCRIPTION". I can then run a separate LISP file that will copy the values between the old BLOCK X and a new BLOCK Y tags. What I would like is for each value for "DESCRIPTION1" through "DESCRIPTION6" to be combined into one continuous value so that I can then transfer it to BLOCK Y that has one 'DESCRIPTION" value that is MTEXT with multiple lines. As of now it only copies the first line ('DESCRIPTION1") and I have to re-type all the other lines. 

 

Any help would be appreciated!!

;;  FUNCTION SYNTAX:  CBT                                          ;;
;;                                                                       ;;
(defun changeTags (/ BLK DOC I TAGLST SS)
 (vl-load-com)
;;-------------------------------------------------------------------------------;;
(setq blk "BLOCK X"
   tagLst '(
        ;"Old Tag"    "New Tag"
    ("DESCRIPTION1"    "DESCRIPTION")
    ("DESCRIPTION2"    "DESCRIPTION")
    ("DESCRIPTION3"    "DESCRIPTION")
    ("DESCRIPTION4"    "DESCRIPTION")
    ("DESCRIPTION5"    "DESCRIPTION")
    ("DESCRIPTION6"    "DESCRIPTION")
        )
   i -1
   doc (vla-get-activedocument (vlax-get-acad-object))
   )
 (if (ssget "_X" (list (cons 0 "INSERT")(cons 2 blk)))
   (vlax-for bl (setq ss (vla-get-activeselectionset doc))
     (foreach att (vlax-invoke bl 'getAttributes)
   (If (assoc (vla-get-tagstring att) tagLst)
     (vla-put-tagstring att (cadr (assoc (vla-get-tagstring att) tagLst)))
     )))
   (princ "\nNo Selection Set Found."))
 (princ)
;; Run program manually with this:
(defun c:CBT () (changeTags))

 

 

[Steven P]

Here is a little hint, you'll just need to create the text string from that

 

(defun c:changeTags (/ BLK DOC I TAGLST SS)
  (vl-load-com)
;;-------------------------------------------------------------------------------;;
  (setq blk "BLOCK X"
      tagLst '(;"Old Tag"    "New Tag"
                ("DESCRIPTION1"    "DESCRIPTION")
                ("DESCRIPTION2"    "DESCRIPTION")
                ("DESCRIPTION3"    "DESCRIPTION")
                ("DESCRIPTION4"    "DESCRIPTION")
                ("DESCRIPTION5"    "DESCRIPTION")
                ("DESCRIPTION6"    "DESCRIPTION")
              )
      i -1
      doc (vla-get-activedocument (vlax-get-acad-object))
  ) ; end setq
  (if (ssget "_X" (list (cons 0 "INSERT")(cons 2 blk)))
    (progn
      (vlax-for bl (setq ss (vla-get-activeselectionset doc))
        (foreach att (vlax-invoke bl 'getAttributes)
          (If (assoc (vla-get-tagstring att) tagLst)

(princ (vla-get-textstring att))

            (vla-put-tagstring att (cadr (assoc (vla-get-tagstring att) tagLst)))
          ) ; end if
        ) ; end foreach
      ) ; end vlax-for
    ) ; end progn
    (princ "\nNo Selection Set Found.")
  ) ; end if
)

 

[BIGAL]

You need to change the way your looking up the block if you want block1X atts then put in Block1Y need some thing like this.

 

(setq blk "BLOCK X"
   tagLst '(
        ;"Old Tag"    "New Tag"
    ("DESCRIPTION1"    "DESCRIPTION")
    ("DESCRIPTION2"    "DESCRIPTION")
    ("DESCRIPTION3"    "DESCRIPTION")
    ("DESCRIPTION4"    "DESCRIPTION")
    ("DESCRIPTION5"    "DESCRIPTION")
    ("DESCRIPTION6"    "DESCRIPTION")
        )
)
(if (setq ent (car (entsel "\nPick block ")))
 (progn
 (setq bl (vlax-ename->vla-object ent))
   (setq atts (vlax-invoke bl 'getAttributes))
   (setq str (vlax-get (nth 0 atts) 'textstring))
   (setq x 1)
   (repeat (- (length atts) 1)
   (setq str (strcat str "\\P" (vlax-get (nth x atts) 'textstring)))
   (setq x (1+ x))
   )
  )
     (princ "\nNo Selection Set Found.")
)  

Next step is select BlockY and do vlax-put textstring into correct att.