Match text strings by selecting

[spaynter]

Does anyone know where I can find the lisp routine that when I pick a text string (example: Install blah blah) then I pick another text string and it will make the second text string match the first string word for word ?

[kennet.sjoberg]

You can try this code :

(defun c:InfectText (/ Ent TextSource SelSet Items Index EntDxf )
  (command "_.UNDO" "BEgin" )
  (if (setq Ent (entsel "Select the text infection source : " ) )
    (progn
      (if (= (cdr (assoc 0 (entget (car Ent ))) ) "TEXT" )
        (progn
          (setq TextSource (cdr (assoc 1 (entget (car Ent )))) )
          (prompt "\nSelect text to infect : " )
          (if (setq SelSet (ssget '((0 . "TEXT" ))) )
            (progn
              (setq Items (sslength SelSet ) )
              (setq Index -1 )
              (repeat Items
                (setq Index (1+ Index ) )
                (setq EntDxf (entget (ssname SelSet Index ) ) )
                (setq EntDxf (subst (cons 1 TextSource ) (assoc 1 EntDxf ) EntDxf ) )
                (entmod EntDxf )
              )
              (princ (strcat (itoa Items ) " text objects changed to " TextSource " ! " ) )
            )
            (princ "No text selected ! " )
          )
        )
        (princ ".... you must select TEXT ! ")
      )
    )
    (princ "Miss, aim better ! ")
  )
  (command "_.UNDO" "End" )
  (princ )
)

: ) Happy Computing !

kennet

[LanceMcHatton]

Kennet,

Did you write that code? I think I'll be replacing mine with yours and I'd like to give credit where it's due.

[LanceMcHatton]

Here's one that we use. It also only works on DTEXT entities but it's only good for a single use, whereas Kennet's lisp will pick a source and apply it to all selected entities.

;  Description: Function to replace the value of a text entity with the
;  value of another text entity.
;
;  Originally written By: Robert P. Ehrman - 1/19/91
;  Modified by Lance McHatton for GCWallace, Inc. - March 24, 2004
;
;  Operation: The routine will ask you to pick two lines of text, then it
;			 will change the values of the second entity, but will not modify
;			 it in any other way, for instance, see below:
;
;			 Before the routine:
;			   text entity 1 is "L500" at 1,1 on "TH" with a value of "BACK OF CURB"
;			   text entity 2 is "L100" at 9,9 on "TS" with a value of "2900.25"
;			 After the routine:
;			   text entity 1 is "L500" at 1,1 on "TH" with a value of "BACK OF CURB"
;			   text entity 2 is "L100" at 9,9 on "TS" with a value of "BACK OF CURB"
;
;  Note: This lisp will only work on DTEXT entities.
;			 
;			 
;----------------------------------------------------------------------------
(defun C:GCWCOPYTEXT (/ End Cmde Olderr Ename1 Ename2 Elist1 Elist2 Text1 Text2)
  (defun End (s)
	(setvar "CMDECHO" Cmde)
	(princ s)
	(setq *error* olderr)
	(princ)
  )
  (setq Cmde	 (getvar "CMDECHO")
		Olderr   *error*
		*error*  End)
  (while 1
	(setq Elist1 '((0 . "BOGUS")))
	(while (not (= (cdr (assoc 0 Elist1)) "TEXT"))
	  (setq Ename1 (car (entsel "\nSelect FIRST text string. : ")))
	  (setq Elist1 (entget Ename1)))
	(setq Elist2 '((0 . "BOGUS")))
	(while (not (= (cdr (assoc 0 Elist2)) "TEXT"))
	  (setq Ename2 (car (entsel "\nSelect SECOND text string. : ")))
	  (setq Elist2 (entget Ename2)))
	(setq Text1 (cdr (assoc 1 Elist1)))
	(setq Text2 (cdr (assoc 1 Elist2)))
	(setq Elist1 (subst (cons 1 Text2) (assoc 1 Elist1) Elist1))
	(setq Elist2 (subst (cons 1 Text1) (assoc 1 Elist2) Elist2))
	(entmod Elist2)
	)
  (End "\nFunction completed.")
  (princ)
)

[CAB2k]

Here is another one to consider.

;**********************************************************************
; Original Program Name: C:CA
; Description:  Match text values in attributes or text strings. Pick
;               Source entity (Attribute or Text) then pick destination
;               entity, it will copy the text value from the source to
;               the destination.
; Date:         4-23-99
; Version:      1.00
; Author:       Micah Nerren (714) 556-4454
;**********************************************************************
; New Program Name: C:CopyText
; Overhauled 06-19-02 by John Uhden, Cadlantic
;       based on request by jducharme@reid-crowther.com
;       in the AutoCAD Customization Newsgroup.
; Note: Since there's almost nothing left of the original code,
;       this is donated as public domain, aka "Freeware"
;       R15+ only
;**********************************************************************
(defun C:CopyText ( / *error* source text pick target ent layer)
  (vl-load-com)
  (if (not *acad*)(setq *acad* (vlax-get-acad-object)))
  (defun *error* (errmsg)
    (vla-EndUndoMark (vla-get-activedocument *acad*))
    (and
      errmsg
      (not (wcmatch (strcase errmsg) "*QUIT*,*CANCEL*"))
      (princ (strcat "\nERROR: " errmsg))
    )
    (princ)
  )
  (vla-StartUndoMark (vla-get-activedocument *acad*))
  (AND
    (setq source (car (nentsel"\nSelect Source Text/Attribute: ")))
    (setvar "errno" 0)
    (or
      (member (cdr (assoc 0 (setq source (entget source))))'("TEXT" "ATTRIB"))
      (prompt "\n  Must be either an Attribute or Text!")
    )
    (setq text (cdr (assoc 1 source)))
    (princ (strcat "\n  Source Value = " text))
    (while (/= (getvar "errno") 52)
      (and
        (setq pick (nentsel "\nSelect target Text/Attribute to change: "))
        (setq target (car pick))
        (setq ent    (entget target)
              layer  (cdr (assoc 8 ent))
              target (vlax-ename->vla-object target)
        )
        (or
          (= (length pick) 2)
          (prompt "\n  Target is nested in a Block or Xref")
        )
        (or
          (member (cdr (assoc 0 ent)) '("TEXT" "ATTRIB"))
          (prompt "\n  Must be either an Attribute or Text!")
        )
        (or
          (/= (logand 4 (cdr (assoc 70 (tblsearch "layer" layer)))) 4)
          (prompt (strcat "\n  Layer " layer " is locked"))
        )
        (or
          (/= (vla-get-textstring target) text)
          (prompt "\n  Text is the same.")
        )
        (and
          (not (vla-put-textstring target text))
          (/= (vla-get-textstring target) text)
          (princ "\n  Failed to modify target.")
        )
      )
    )
  )
  (*error* nil)
)

[kennet.sjoberg]

Kennet, Did you write that code?

Yes ! Do whatever you like.

: ) Happy Computing !

kennet

[LanceMcHatton]

Here is another one to consider.

Ok, now THAT one rocks! It does DTEXT and ATTRIBUTES! Back and forth!

I wish all my favorite lisps would work out this way...getting better and better with every new post.

[spaynter]

Hey Thanks everyone. This is just what I was looking for.

[CADdancer]

Hello To Everyone:

Kennet, could your routine be modified to work with both "Text" and "Mtext" strings....???

It would be very helpful if it could be accomplished....!!!

Thank you for any assistance.

[kennet.sjoberg]

Hello To Everyone:

Kennet, could your routine be modified to work with both "Text" and "Mtext" strings....???

It would be very helpful if it could be accomplished....!!!

Thank you for any assistance.

Change the line
(if (setq SelSet (ssget '((0 . "TEXT" ))) )
to
(if (setq SelSet (ssget '((0 . "TEXT,MTEXT" ))) )

But it will NOT work at all MTEXT

: ) Happy Computing !

kennet