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.")

[deegeecees]

Man, if ComEd hadn't crippled themselves by not using Paperspace, THAT would be a keeper for me. Nice work CAB, you always amaze me.

[whdjr]

Looks like Will removed the routine..

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

CAB,
I don't know what happened to that link I didn't remove it.

Here is the code:

Code: [Select]

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;copyb.lsp by Will DeLoach    Copyright 2004                      ;;;
;;;                                                                 ;;;
;;;Description:                                                     ;;;
;;;The user selects an object on screen (not a viewport) and then it;;;
;;;is copied on all other layout tabs in the same location as the   ;;;
;;;object that was selected.                                        ;;;
;;;                                                                 ;;;
;;;This was tested on AutoCad 2000                                  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;This is a rewrite of the ssget function to handle missed picks   ;;;
;;;and right clicks.  It also filters out viewports because they    ;;;
;;;wreck havoc in this routine.                                     ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ss_get (msg filter / ent)
  (while (not ent)
    (princ msg)
    (cond ((setq ent (ssget filter)))
  ((= (getvar "ErrNo") 52)
   (exit)
  )
  ((null ent)
   (princ "\nSelection missed.  Please try again.")
  )
    )
  )
  ent
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;This is a subr to collect all the layout tab objects into a list.;;;
;;;This subr removes the "Model" tab and the current tab as well.   ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun layout_list_no_activelayout (doc / lst)
  (vlax-map-collection
    *layouts*
    '(lambda (x) (setq lst (cons x lst)))
  )
  (vl-remove (vla-get-activelayout doc)
     (cdr
       (*sort* lst 'vla-get-taborder)
     )
  )
)
;;;
;;;
;;;
(defun *sort* (lst func)
  (vl-sort lst
   '(lambda (e1 e2)
      (< ((eval func) e1) ((eval func) e2))
    )
  )
)
;;;
;;;
;;;
(defun getSelectedItems (tilename AllItemsList / indexes)
  (if (setq indexes (get_tile tilename))
    (setq indexes (read (strcat "(" indexes ")"))
  indexes (mapcar '(lambda (n) (nth n AllItemsList))
  indexes
  )
    )
  )
  indexes
)
;;;
;;;
;;;
(defun get_selected_layouts (lst / id)
 ;
  (defun on_list_pick ()
    (if (= (get_tile "layout_list") "")
      (mode_tile "select" 1)
      (mode_tile "select" 0)
    )
  )
 ;
  (and (setq id (load_dcl))
       (start_list "layout_list")
       (mapcar 'add_list (mapcar 'vla-get-name lst))
       (not (end_list))
       (action_tile "cancel" "(done_dialog 0)")
       (action_tile
"select"
(strcat
   "(setq selection (getSelectedItems \"layout_list\" lst))"
   "(done_dialog 1)"
)
       )
       (action_tile "layout_list" "(on_list_pick)")
       (not (mode_tile "select" 1))
       (start_dialog)
       (not (unload_dialog id))
  )
  (if selection
    selection
    *error*
  )
)
;;;
;;;
;;;
(defun load_dcl (/ dcl dcl_id)
  (setq dcl "copyb_layouts.dcl")
  (while
    (if (minusp (setq dcl_id (load_dialog dcl)))
      (setq dcl (getfiled "Select correct DCL file location: "
  dcl
  "dcl"
  (+ 8 128)
)
      )
      (not (new_dialog "copyb_layouts" dcl_id))
    )
  )
  dcl_id
)
;;;
;;;
;;;
(defun *ssnames* (selection_set / num lst)
  (repeat (setq num (sslength selection_set))
    (setq num (1- num)
  lst (cons (ssname selection_set num) lst)
    )
  )
  lst
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;This is the main routine.  It copys an object to all selected    ;;;
;;;layout tabs at the exact location of the selected object.        ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:copyb (/ ss objs *acad* *adoc* *layouts*)
  (setq *acad*   (vlax-get-acad-object)
*adoc*   (vla-get-activedocument *acad*)
*layouts* (vla-get-layouts *adoc*)
  )
  (cond ((= (getvar "TILEMODE") 1)
(princ "\nThis command does not work in Modelspace.  ")
)
((> (getvar "CVPORT") 1)
(princ "\nThis command does not work in a Viewport.  ")
)
((not
   (setq ss (ss_get
      "\nSelect an Object to copy to selected Layout tabs:  "
      '((-4 . "<NOT") (0 . "VIEWPORT") (-4 . "NOT>"))
    )
   )
)
(princ "\nError:  Function Cancelled ")
)
(T
(setq objs (mapcar 'vlax-ename->vla-object (*ssnames* ss)))
(mapcar '(lambda (x)
    (vla-copyobjects
      *adoc*
      (vlax-safearray-fill
(vlax-make-safearray
  vlax-vbobject
  (cons 0 (1- (length objs)))
)
objs
      )
      (vla-get-block x)
    )
  )
(get_selected_layouts
   (layout_list_no_activelayout *adoc*)
)
)
)
  )
  (princ)
)
DCL file:

Code: [Select]

copyb_layouts : dialog {
  label = "Available Layouts";
  :boxed_column {
    label = "Select Layouts to copy objects to:";
    : list_box {
      key = "layout_list";
      height = 12;
      multiple_select = true;
      }
    }
  : row {
    : button {
      label = "&Select...";
      key = "select";
      }
    : button {
      label = "&Cancel";
      is_cancel = true;
      key = "cancel";
      }
  }
}

I hope this helps everyone.

****Edit:  Replaced the copyb routine with a newer version. 9.9.05 8:56:am

[ELOQUINTET]

alright cab i'll give it a shot when i get a chance thanks alot. does this work for dtext because i believe each line is an indvidual? i still have to figure out a way to paste the see sheet #1 to all remaining sheets. i really need that paste block to all layouts routine for another situation, will where are ya buddy heeeeellllp.

[deegeecees]

Eloquintet,
If I may make a suggestion:

I'm going to make some assumptions here, but if you are using titleblocks in your layouts, then how about an attribute that is updated with its corresponding layout name? Just a thought.

Deeg

[CAB]

Man, if ComEd hadn't crippled themselves by not using Paperspace, THAT would be a keeper for me. Nice work CAB, you always amaze me.

Thank you Sir...

[deegeecees]

Absolutely no problem whatsoever.

[ELOQUINTET]

assum nothing deegeecees. we enter our info into access. we have an empty titleblock which is not a block of which these general notes are a part of. then we use a button to insert an attributed block based on the drawing number we search for in the database. some screwy ways of doing things around here. anyway i'll give all of this a try when i get a chance thanks guys

[whdjr]

alright cab i'll give it a shot when i get a chance thanks alot. does this work for dtext because i believe each line is an indvidual? i still have to figure out a way to paste the see sheet #1 to all remaining sheets. i really need that paste block to all layouts routine for another situation, will where are ya buddy heeeeellllp.

I posted the routine.  Holler louder (read PM) if you need more help.

[ELOQUINTET]

i got it will just don't have alot of time lately to fiddle 

[ELOQUINTET]

both routines work great on this end. i do have a couple requests if it's not asking too much. first will is it possible to not have to specify the dcl location upon using the routine? second is for cab. would it be possible to modify one of these routines to change the text i pick on all other layouts to     SEE NOTES ON SHEET #1 ? i can work with what i have but it would work like a dream with these 2 additions. pllllllease

[CAB]

Code: [Select]

;; special version for Dan
;;  changes all matching text to SEE NOTES ON SHEET #1
;;  but does not change the selected text.
(defun c:pstext-edit-dan (/ str pt ent oldstr cnt 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 revise to SEE NOTES ON SHEET #1")
      (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
                ctab   (getvar "CTab")
          )
         
              (vlax-for x (vla-get-layouts
                            (vla-get-activedocument
                              (vlax-get-acad-object)
                            )
                          )
                ;;  skip model space
            ;;  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
                        (vla-put-textstring y "SEE NOTES ON SHEET #1")  ; str)
                        (setq cnt (1+ cnt))
                      )
                    ) ; endif
                  ) ; vlax-for
                ) ; endif
              ) ; vlax-for
              (vlax-release-object ent)
              (prompt (strcat "\n" (itoa cnt) " Layouts Updated."))

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

[ELOQUINTET]

thanks a million gazillion cab you truly deserve the cypress

[ELOQUINTET]

will how would i avoid having to load the dcl everytime i run the routine?

[whdjr]

will how would i avoid having to load the dcl everytime i run the routine?

Dan,

That is an evil trick I put in the tool to piss people off.


Just kiddin'.

The 'copyb' routine only asks you for the location of the DCL file because it can't find it.  If you move it to a location in your support path then it will find it and not ask you for it.

[ELOQUINTET]

aha now i traced my problem. i changed the file from copyb_layouts to just copyb but didn't update everything within. i got it working now thanks for the hint ha these icons suck the big one cept for mr green of course 

[whdjr]

Glad you got it to work Dan.