Replace text with block and transfer value into attribute

[Anonymous]

Replace text with block and transfer value into attribute

Dear all,

I need a lisp routine which basicly performs the action below:

I have only room number as mtext objects. What I want to achieve is:

I defined a block with attribute inside named ROOM_NO,

I want to replace each mtext object with this block while getting the value into the attribute.

The issue comes from migrating the drawing from Revit to AutoCad. Revit exports the room tags as mtext objects and I need to covert them to proper blocks with attibute. I have over 3000 rooms which is why a lisp routing comes in handy.

Regards,

MA

[pbejse]

---

@Anonymous wrote:

Replace text with block and transfer value into attribute....

MA

---

Basically that is the requirement. Not too difficult. Post a drawing sample mhmtlgr.

[Anonymous]

I am Doing a project simillar to mhmtlgrr 's Request. While I've managed to find a Routine that replaces the text with a Dynamic Block (and another Routine to Rename an attribute in a block), I couldn't Figure out a way to transfer the text string into the Tag "CFM"  

(defun c:t2b( / ss) ; Replaces Text with "10 X 8 Supply Register Set.dwg"
  (vl-load-com)
  (setq blk "P:\\HVAC Design\\0-AutoCAD MEP Shared\\LS MEP Catalogs\\Supply\\10 X 8 Supply Register Sets") ; Put block name here, with directory if block is not already in drawing
  (setq se (ssget "X" '((0 . "TEXT")(1 . "*cfm")))) 
  (setq ss (ssget "X" '((0 . "TEXT")(1 . "*cfm"))))
  
  
  
;;-----------------------------------------------

        (if ss
    (progn
 
      (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (mapcar '(lambda (x) (vl-cmdf "-insert" blk (cdr (assoc 10 (entget x))) 1 1 (* (/ 180 pi) (cdr (assoc 50 (entget x)))))
      ) ss)
      
            
      
            
      
      )
	  
    (princ "\nNo text entities found.")
      
    )
  (princ)
 
  )

;;------------------------------------------------------------------------------------------------
 ; REPTAG - Re-names tag with a new value within an insert selection
; TAG - Tag Name in an Attribure
; NEWVALUE - New Tag name 
(defun reptag (tag newvalue ent / alist )
(if (and (= (type ent) (read "VLA-OBJECT")) newvalue)
(progn
(setq alist ( vlax-invoke ent 'GetAttributes))
 (foreach a alist
  (if (=  (vla-get-tagstring a) tag)
  (vlax-put-property a 'TextString newvalue)
  );i
 );fe
);p
(if (= 'ename (type ent)) (reptag tag newvalue (vlax-ename->vla-object ent)));i
);i
(princ));d

;;------------------------------------------------------------------------------------------------

[DannyNL]

That should indeed be pretty easy to code.

Can you post an example drawing and your block for testing purposes (in 2013 format as I do not have 2018 installed yet)?

[DannyNL]

Never mind.

Try this example code and change the block and tag name to match the ones you are using.

There are some assumptions in this code but these can be changed later on if needed:

1) the block needs to be existing (but not necessarily inserted) in the drawing.

2) MTEXT should not have any formatting.

3) Block will be inserted at the same insertion point of the text.

(defun c:Txt2Blk (/ T2B_Selection T2B_Baseblock T2B_AttributeTag T2B_ActiveLayout T2B_ActiveDoc T2B_Text T2B_Block)
   (setq T2B_Baseblock    "TEST")
   (setq T2B_AttributeTag "ROOM")   
   (if
      (and
         (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-Blocks (setq T2B_ActiveDoc (vla-get-ActiveDocument (vlax-get-acad-object)))) T2B_Baseblock))))
         (setq T2B_Selection (ssget '((0 . "*TEXT"))))
      )
      (progn
         (setq T2B_ActiveLayout (vla-get-Block (vla-get-ActiveLayout T2B_ActiveDoc)))
         (vla-StartUndoMark T2B_ActiveDoc)
         (foreach T2B_Text (mapcar 'cadr (ssnamex T2B_Selection))
            (if
               (= (type T2B_Text) 'ENAME)
               (progn
                  (setq T2B_Text (vlax-ename->vla-object T2B_Text))
                  (setq T2B_Block (vla-InsertBlock T2B_ActiveLayout (vla-get-InsertionPoint T2B_Text) T2B_Baseblock 1 1 1 0))
                  (PushAttValue T2B_Block (list (list T2B_AttributeTag (vla-get-TextString T2B_Text))))
                  (vla-Delete T2B_Text)
               )
            )
         )
         (vla-EndUndoMark T2B_ActiveDoc)
         (vlax-release-object T2B_ActiveLayout)
      )
   )
   (vlax-release-object T2B_ActiveDoc)
   (princ)
)

(defun PushAttValue (PAV_BlkObject PAV_TagValList / PAV_AttList)
   (if
      (and
         (= (type PAV_BlkObject)     'VLA-OBJECT)
         (= (vla-get-ObjectName    PAV_BlkObject) "AcDbBlockReference")
         (= (vla-get-HasAttributes PAV_BlkObject) :vlax-true)
      )     
      (progn
         (setq PAV_AttList (vlax-safearray->list (vlax-variant-value (vla-GetAttributes PAV_BlkObject))))
         (foreach PAV_Item PAV_AttList
            (vl-catch-all-apply 'vla-put-TextString (list PAV_Item (cadr (assoc (strcase (vla-get-TagString PAV_Item)) PAV_TagValList))))
         )
     )           
   )
)    

[Anonymous]

Dear ppesquera,

My case is solved on CadTutor with the help of user called Tharwat. Please check out the following link for further details:

Thread: Replace text with block and transfer value into attribute

You may find the sample file and final code.

Hope this helps.

Regards.

[DannyNL]

Dear @Anonymous,

That's not really nice to ask a solution for your problem on two different forum's at once, before waiting if someone is trying to help you on the first of them. Now on one of them someone (me in this case) has put in some unnecessary time in it trying to help you.

There are a lot people active on these forums and are willing to help you, but it's polite to see and wait a bit before you are going shopping on another forum to prevent someone is wasting his time on you.

[Anonymous]

Dear @DannyNL,

I appriciate your concern but unfortunately your thought is somehow selfish.

1. That's not really nice to ask a solution for your problem on two different forum's at once,before waiting if someone is trying to help you on the first of them.
   1. Helping is not a race to win.
2. Now on one of them someone (me in this case) has put in some unnecessary time in it trying to help you.
   1. I don't see any waste of time on learning from different methods of programming. When I compare yours with the other one, I got chance to learn different ways of doing same thing which is precious to me and again, thanks for your effort.
3. There are a lot people active on these forums and are willing to help you, but it's polite to see and wait a bit before you are going shopping on another forum
   1. As I mentioned before, I am digging different methods to learn. So I wouldn't define this path as shopping, my point is learning different perspectives.
4. to prevent someone is wasting his time on you.
   1. Your time teach me. So please consider your time as valuable as much since it helped me.

And sometimes, I believe that you did it either, you need urgent help for your project which is on deadline. If this would be my case, your answer come out 3 months after my question.

Hope my intention will relax your nerves.

Thanks for your effort and help again.

[DannyNL]

Hhmmm.....when I get a bit annoyed when I find out that I wasted my time in solving something that didn't need any solving anymore, then I'm selfish in trying to help you?! I don't think so and you turn the world upside down.

And no it's not a race or a contest. But I do not like working on problems if someone else is also working on the same issue or the problem has already been solved. During that time I might be able to help someone else that actually still needs help 

But to be honest and fair is fair; I didn't see that your original question was from 3 months ago. Sorry, that's my bad. I only saw the reply from ppesquera and thought it was still something to be solved and went to work on it.

And if I didn't get a response in three months, I can see why you did ask for a solution on another forum. However, it would have been nice to post in this thread as well that the question was solved (on another forum) and no longer open, so it would be clear to anyone reading this thread it was no longer a issue.

[Anonymous]

Regardless, You have my kudos. And Thank you so much! I have been Trying to come Up with this code for weeks! I'm definitely going to try this out!

Lee mac has nothing on you (but you didn't hear that from me  >_>)

[DannyNL]

Haha...thanks for the nice words and glad the code can help you 

But to be honest, Lee Mac is in a league of his own.

He comes up with some real smart optimized coding solutions I never would have thought of and some of his code I can only understand after reading over and over again  

[Anonymous]

Oh I am with you there, he is a Legend. Lee Mac Is the reason I got into Coding for AutoCAD. Every code he puts out is an absolute Gem!

[pbejse]

In fairness to the mhmtlgrr, my reply to the OP was after two weeks. I came across the same request for help on another forum [ CTT ] and after seeing that it was replied on the same day as the OP, then I didn't bother to pursue this discussion. 

I wasn't sure about ppesquera post if it's a request for assistance or a suggestion to mhmtlgrr's  problem.  To this day it's still not clear 

FWIW, it is an easy program to code.

[Anonymous]

It was a bit of both LOL xD

[Anonymous]

You saved my life, this is what DannyNL was looking for.

1) I noticed that, the block insertion point is being at the coordinate (Geometry --> Position X of variable T2B_Text). Is it possible to insert the block at the coordinate ( Text --> Text alignment X of variable T2B_Text)?  (See image 1)

2) Is there any way to make sure that the total value of the variable "T2B_AttributeTag" is not all transferred to the block attribute?  (See image 2)

Example: T2B_AttributeTag = TO 1301-UZY-1826A

                  Value of Block attribute (T2B_Block) = 1301-UZY-1826A                                          (Accurate this way) 

I'm new to the Forum, sorry if I wasn't very specific!