Topic: Paste text in ALL Layouts simultaneously

[CAB]

I have been messing with a creative routine created by Jeff Mishler.
It places text in all layouts at the same location based on the original text
location. There is another routine to edit all the text. As with most of my
routines they satisfy the requirements of the author. But in my case the original
text has some attributes that are not transferred to the copies that are created in
the remaining layouts. I addressed some of the attributes already but yesterday
the text rotation got me. Although I added that I felt there should be a way copy
the text exactly and place it in the layouts. Well you say, use the COPY command.
The copy command as I understand it requires that you activate each layout before
you PASTE and this is painfully slow especially with say 8 layouts. The routine
as it works now ADDs the test to the layout object directly which is very fast.

Finally to the question.
How can I add the new text entity to each layout object and include ALL of the text
attributes of the original?  I know I could just PUT each attribute like I did with
the rotation. But I was looking for a more elegant solution like entmake where I
could PUT the entity in each layout object. I am still floundering in this visual
lisp stuff. So any suggestions?

CAB

PS Thanks again Jeff for the routine.

Code: [Select]

Code Removed, see a later post

[Jeff_M]

CAB,
You're welcome for the first go at this. Now here's some small sample code to make exact copies in all layouts using basic lisp. To use vlisp & activex you DO have to "vla-get/put" all the properties.

Code: [Select]


(defun c:test (/ ent tab newent)
  (setq ent (car (entsel "\nSelect text to copy: ")))
  (if (= "TEXT" (cdr (assoc 0 (setq ent (entget ent)))))
    (foreach tab (layoutlist)
      (if (not (= (strcase tab) "MODEL"))
(progn
 (setq newent (subst (cons 410 tab) (assoc 410 ent) ent))
 (entmake newent)
 )
)
      )
    )
  )


Jeff

[Jeff_M]

After thinking about it a bit, I think that you could also use the "CopyObjects" Method in ActiveX. But I think that the entmake method I demonstrated works best for this.......unless you are trying to steer away from the ename based objects and go towards all activex. According to Tony Tanzillo, this is the proper course......FWIW.

Jeff

[ELOQUINTET]

hmmm interesting idea but could the text be incremented so i could use it for numbering of sheets. now that would be a dream. ah how long have i been having this same dream  

[CAB]

Thanks Jeff, worked well.
I am creating a regular lisp version.
dan are you still trying to get that lisp?
how long has it been? a year now as I remember:)

[ELOQUINTET]

:sigh: yeah about right  

[CAB]

OK here is the revised routine.
Read revision notes.
Updated the "ADD" routine to add line text if the user enters text via the routine.
If the user picks the text to copy you may use line text mtext or rtext but the edit
routine will not edit rtext. The routine makes a copy of the original text with all
attributes when a text object is picked. User entered text uses current layer and style
but does allow text angle to be entered. Updated the edit routine to detect text with
other than left justified on line text. This is because the insert point changes when
edited and center justification is used. The routine uses the alignment point as a test
for line text.

CAB

Code: [Select]

Code Removed, see a later post.

[CAB]

Revised for bug fix.

Code: [Select]

;;  Multi Tab Text Insert/Edit
;;  By Jeff Mishler
;;  
;;  Places text into all PS layouts - PSText.lsp
;;  To revise, use the PSText-edit.lsp command.
;;  When adding text:
;;    Uses current text style, and current layer
;;    Uses current text style text size, if 0 uses sys var TextSize
;;  Copying existing Text,Mtext,or Rtext uses existing attributes
;;  Edit routine does not handle Rtext
;;
;;
;;  Modified by Charles Alan Butler 05/23/04 - 06/18/04
;;  added paperspace check & user input error check
;;  added close active viewport
;;  added allow spaces in user text string
;;  added ability to pick existing text in ps to insert in layouts
;;  added Line Text Edit to pstext-edit
;;  Modified by CAB 06/17/04
;;  added use of text rotation
;;  Modified by CAB 06/18/04
;;  revised the text copy process to copy all attributes of the selected text
;;  revised both routines to handle MTEXT & add routine to handle RTEXT
;;  11/04/2004 CAB bug fix, 2 copies in original tab, fixed

(defun c:pstext (/ str pt txt_ht elst ent cnt tab newent rot yesno loop ctab)
  (if (= (getvar "tilemode") 1)
    (alert "\nYou must be in Paper Space to run this routine.\t")
    (progn ; else you are in paper space, ok to proceed
      (if (/= (getvar "cvport") 1); a view port is active
        (command "_pspace") ; close the view port
      )
      (prompt "\nSelect nothing or ENTER to type the text: ")
      (setq loop t)
      (while loop
       (setq ent (entsel "\nSelect text to place on all PS layouts: "))
       (cond
          ((null ent) (setq loop nil));  exit on nothing selected
          ((= (cdr (assoc 0 (setq elst (cdr(entget (car ent)))))) "RTEXT")
           (INITGET "Yes No")
           (setq yesno
                  (getKword
                    (strcat "\nRTEXT selected, you can copy but not edit this type."
                            " Continue <Yes>/No: ")))
           (if (/= yesno "No")
             (setq loop nil); got text, so exit loop
             (setq elst nil)
           )
          )
          ((member (cdr (assoc 0 elst))'("MTEXT" "TEXT"))
           (setq loop nil); got text, so exit loop
           )
          ((prompt "\nNot a TEXT object, Try Again."))
        ); end cond
      ) ; end while
      (if (and
            (null ent) ; no text selected, so get user input
            (/= (setq str
                  (getstring t "\nEnter the Text to place on all PS layouts: ")) "")
            (setq pt (getpoint "\nSelect or Enter common insertion Point: "))
          )
        (progn
          (if (null (setq ang (getangle "\nSelect or Enter text angle: <0>")))
            (setq ang 0)
          )
          ;; If text height is undefined (signified by 0 in the table)
          (if (= (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))) 0)
            (command "text" pt "" ang str)
            (command "text" pt ang str)
          ) ; endif
          (setq elst (entget (entlast)))
        ) ; progn
      ) ; endif (null ent)
      (if elst
        (progn
          (setq cnt 0
                ctab (getvar "CTab"))
          (foreach tab (layoutlist)
            (if (and (/= (strcase tab) "MODEL")
                     (/= tab ctab))
              (progn
                (setq newent (subst (cons 410 tab) (assoc 410 elst) elst))
                (entmake newent)
                (setq cnt (1+ cnt))
              )
            )
          )
          (prompt (strcat "\n" (itoa cnt) " Layouts Updated."))
        ) ; progn
        (prompt "\nUser Quit.")
      ) ; endif
    ) ; progn
  ) ;endif
  (princ)
); end defun
(prompt "\nEnter psText to add text.")

(defun c:pstext-edit (/ str pt ent oldstr cnt)
  (vl-load-com)
  (defun get_point (e)
     ;;  get a referance point to compare, if dtext use alignment point
     ;;  because center justification can change the insertion point
     (if (= (vla-get-objectname e) "AcDbText")
       (vlax-get e "textalignmentpoint")
       (vlax-get e "insertionpoint")
     )
  )
  (if (= (getvar "tilemode") 1)
    (alert "\nYou must be in Paper Space to run this routine.\t")
    (progn ; else you are in paper space, ok to proceed
      (if (/= (getvar "cvport") 1); a view port is active
        (command "_pspace") ; close the view port
      )
      (princ "\nSelect text to revise in all PS layouts: ")
      (if (setq ss (ssget ":S" '((0 . "TEXT,MTEXT"))))
        (progn
          (setq ent    (vlax-ename->vla-object (ssname ss 0))
                oldstr (vlax-get ent "textstring")
                pt     (get_point ent)
                cnt    1
          )
          (command "_.ddedit" (ssname ss 0) "")
          (if (= (setq str (vlax-get ent "textstring")) oldstr)
            (prompt "\nNo change in text, nothing to do.")
            (progn ;  step through all layouts
              (vlax-for x (vla-get-layouts
                            (vla-get-activedocument
                              (vlax-get-acad-object)
                            )
                          )
                ;;  skip model space
                (if (not (wcmatch (strcase (vla-get-name x)) "MODEL"))
                  (vlax-for y (vla-get-block x)
                    (if
                      (and
                        (member (vla-get-objectname y) '("AcDbMText" "AcDbText"))
                        (= (vla-get-textstring y) oldstr)
                        (= (car pt)(car (get_point y)))
                        (= (cadr pt)(cadr (get_point y)))
                      )
                      (progn
                        (vla-put-textstring y str)
                        (setq cnt (1+ cnt))
                      )
                    ) ; endif
                  ) ; vlax-for
                ) ; endif
              ) ; vlax-for
              (vlax-release-object ent)
              (prompt (strcat "\n" (itoa cnt) " Layouts Updated."))
            ); progn
          ); endif
        ) ; progn
        (prompt "\nObject is not plain text or Mtext.")
      ) ; endif
    ) ; progn
  ) ;endif
  (princ)
) ; defun
(prompt "\nEnter psText-edit to edit text.")


[whdjr]

Amazing.  I didn't even know this thread existed.  I just posted some code in "Show your Stuff" that is similar to what your doing.

[ELOQUINTET]

i was wondering if this routine could be modified to paste a block to all layout tabs?

[CAB]

Dan look here
http://www.theswamp.org/forum/index.php?topic=3932.msg47208#msg47208

[CAB]

Will it's hard to keep up...
It's like a full time job

[ELOQUINTET]

cab i was able to copy jeff's routine from that post (which i already had actually gawd these smilies blow) but was not able to access wills. is it in the pond and unavailable at the moment? i was wondering also if it is possible to erase text that is within given coordinates on all layouts. what happens is we have general notes which go on the first sheet. the remaining sheets just say see sheet #1 but people (myself included) copy the layouts without changing it to see sheet #1 until the end. so i'm looking for a quicker way to change it when this happens. any thoughts?

[CAB]

Looks like Will removed the routine..

How about a delete in all tabs except the one you are in?

[CAB]

Dan
This routine will allow you to pick text in paper space and delete any
matching text with the same insert point in all the remaining layouts.
It is the opposite of pstext.lsp

Code: [Select]

(defun c:pstext-del (/ str pt ent oldstr err cnt cnterr ctab)
  (vl-load-com)
  (defun get_point (e)
    ;;  get a referance point to compare, if dtext use alignment point
    ;;  because center justification can change the insertion point
    (if (= (vla-get-objectname e) "AcDbText")
      (vlax-get e "textalignmentpoint")
      (vlax-get e "insertionpoint")
    )
  )
  (if (= (getvar "tilemode") 1)
    (alert "\nYou must be in Paper Space to run this routine.\t")
    (progn ; else you are in paper space, ok to proceed
      (if (/= (getvar "cvport") 1) ; a view port is active
        (command "_pspace") ; close the view port
      )
      (princ "\nSelect text to delete in all PS layouts: ")
      (if (setq ss (ssget ":S" '((0 . "TEXT,MTEXT"))))
        (progn
          (setq ent    (vlax-ename->vla-object (ssname ss 0))
                oldstr (vlax-get ent "textstring")
                pt     (get_point ent)
                cnt    0
                cnterr 0
                ctab   (getvar "CTab")
          )

          ;;  step through all layouts
          (vlax-for x (vla-get-layouts
                        (vla-get-activedocument
                          (vlax-get-acad-object)
                        )
                      )
            ;;  skip model space or current tab
            (if (not (or (= (strcase (vla-get-name x)) "MODEL")
                         (= (vla-get-name x) ctab)
                     )
                )
              (vlax-for y (vla-get-block x)
                (if
                  (and
                    (member (vla-get-objectname y) '("AcDbMText" "AcDbText"))
                    (= (vla-get-textstring y) oldstr)
                    (= (car pt) (car (get_point y)))
                    (= (cadr pt) (cadr (get_point y)))
                  )
                   (progn
                     (setq err (vl-catch-all-apply 'vla-delete (list y)))
                     (setq cnt (1+ cnt))
                     (and
                       (vl-catch-all-error-p err)
                       (print (vl-catch-all-error-message err))
                       (setq cnterr (1+ cnterr))
                     )
                   ) ; progn
                ) ; endif
              ) ; vlax-for
            ) ; endif
          ) ; vlax-for
          (vlax-release-object ent)
          (prompt (strcat "\nItems found = " (itoa cnt) " and items deleted = "
                          (itoa (- cnt cnterr))))

        ) ; progn
        (prompt "\nObject is not plain text or Mtext.")
      ) ; endif
    ) ; progn
  ) ;endif
  (princ)
) ; defun
(prompt "\nEnter psText-del to delete matching text.")