Add selected text to other selected ones as prefix

[veteranus]

Hi,

 

I  need a lisp routine explained with this image, I would be grateful for your help.

 

Regards.

 

[dlanorh]

Try this. I was unsure whether you wanted to select the text to get the prefix individually or as a selection set. It does the former, but is easily alterable to do the latter.

 

(defun c:PText ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst)

  (defun *error* ( msg )
	(mapcar 'setvar sv_lst sv_vals)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
	(princ)
  );end_*error*_defun
    
  (setq sv_lst (list 'cmdecho 'osmode)
		sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        p_obj (vlax-ename->vla-object (car (entsel "\nSelect Prefix text : ")))
        p_str (vlax-get-property p_obj 'textstring)
  );end_setq
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (while (setq t_ent (entsel "\nSelect Text to Prefix : "))  
    (setq t_obj (vlax-ename->vla-object (car t_ent)))
    (vlax-put-property t_obj 'textstring (strcat p_str (vlax-get-property t_obj 'textstring)))
  );end_while
  
  (mapcar 'setvar sv_lst sv_vals)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun

 

[veteranus]

5 minutes ago, dlanorh said:

Try this. I was unsure whether you wanted to select the text to get the prefix individually or as a selection set. It does the former, but is easily alterable to do the latter.

 

(defun c:PText ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst)

  (defun *error* ( msg )
	(mapcar 'setvar sv_lst sv_vals)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
	(princ)
  );end_*error*_defun
    
  (setq sv_lst (list 'cmdecho 'osmode)
		sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        p_obj (vlax-ename->vla-object (car (entsel "\nSelect Prefix text : ")))
        p_str (vlax-get-property p_obj 'textstring)
  );end_setq
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (while (setq t_ent (entsel "\nSelect Text to Prefix : "))  
    (setq t_obj (vlax-ename->vla-object (car t_ent)))
    (vlax-put-property t_obj 'textstring (strcat p_str (vlax-get-property t_obj 'textstring)))
  );end_while
  
  (mapcar 'setvar sv_lst sv_vals)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun

 

 

Tx for you effort. I want to use with selection set. Can you revise the code please?

[Tharwat]

Hi,

Just this a shot.

(defun c:test (/ s x i e)
  (and (princ "\nPick a prefix text :")
       (or (setq s (ssget "_+.:S:E" '((0 . "*TEXT"))))
           (alert "Invalid object or nothing selected. Try again")
       )
       (princ
         (strcat "\nSelect texts to add prefix ["
                 (setq x (cdr (assoc 1 (entget (ssname s 0)))))
                 "]. to them :"
         )
       )
       (setq i -1
             s (ssget "_:L" '((0 . "*TEXT")))
       )
       (while (setq e (ssname s (setq i (1+ i))))
         (entmod
           (subst (cons 1 (strcat x (cdr (assoc 1 (setq e (entget e))))))
                  (assoc 1 e)
                  e
           )
         )
       )
  )
  (princ)
)

 

[veteranus]

5 minutes ago, Tharwat said:

Hi,

Just this a shot.

(defun c:test (/ s x i e)
  (and (princ "\nPick a prefix text :")
       (or (setq s (ssget "_+.:S:E" '((0 . "*TEXT"))))
           (alert "Invalid object or nothing selected. Try again")
       )
       (princ
         (strcat "\nSelect texts to add prefix ["
                 (setq x (cdr (assoc 1 (entget (ssname s 0)))))
                 "]. to them :"
         )
       )
       (setq i -1
             s (ssget "_:L" '((0 . "*TEXT")))
       )
       (while (setq e (ssname s (setq i (1+ i))))
         (entmod
           (subst (cons 1 (strcat x (cdr (assoc 1 (setq e (entget e))))))
                  (assoc 1 e)
                  e
           )
         )
       )
  )
  (princ)
)

Hi, Can you upgrade the lisp for working with mtext s?

 

[dlanorh]

Try this version

 

(defun c:PText ( / *error* sv_lst sv_vals c_doc ss colour_lst t_str lyr l_lst)

  (defun *error* ( msg )
	(mapcar 'setvar sv_lst sv_vals)
	(if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
	(if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nAn Error : " msg " occurred.")))
	(princ)
  );end_*error*_defun
    
  (setq sv_lst (list 'cmdecho 'osmode)
		sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        p_obj (vlax-ename->vla-object (car (entsel "\nSelect Prefix text : ")))
        p_str (vlax-get-property p_obj 'textstring)
  );end_setq
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)
  
  (mapcar 'setvar sv_lst '(0 0))
  
  (prompt "\nSelect Text to Prefix : ")
  (setq ss (ssget '((0 . "TEXT"))))
  
  (cond (ss
          (vlax-for t_obj (vla-get-activeselectionset c_doc)  
            (vlax-put-property t_obj 'textstring (strcat p_str (vlax-get-property t_obj 'textstring)))
          );end_forwhile
        )  
  );end_cond

  (mapcar 'setvar sv_lst sv_vals)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun

 

[Tharwat]

Are you sure that the program does not work with Mtext objects ?

[veteranus]

I just upgraded this line,

 

  (prompt "\nSelect Text to Prefix : ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))

 

Now it worket like charm. Thanks dlanorh and Tharwat. Regards for you helps.

[dlanorh]

1 minute ago, veteranus said:

I just upgraded this line,

 

  (prompt "\nSelect Text to Prefix : ")
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))

 

Now it worket like charm. Thanks dlanorh and Tharwat. Regards for you helps.

 

You could have followed @Tharwat  example and

 

 (setq ss (ssget '((0 . "*TEXT"))))

 

[Tharwat]

32 minutes ago, dlanorh said:

 

You could have followed @Tharwat  example and

 

 (setq ss (ssget '((0 . "*TEXT"))))

 

You can guide a horse to a river but you can not force him to drink. 

[veteranus]

50 minutes ago, dlanorh said:

 

You could have followed @Tharwat  example and

 

 (setq ss (ssget '((0 . "*TEXT"))))

 

I followed hım and it worked very well. Thanks again mr. Tharwat and you sir.

[ronjonp]

You could have also searched for this .. I'd guess there are already 20+ solutions to this question.

[Lee Mac]

Here's another existing & generic solution:

http://www.cadtutor.net/forum/showthread.php?64606&p=441001&viewfull=1#post441001