Topic: Copy specific block to all layouts automatically

[ELOQUINTET]

Hey guys,

I use this lisp routine written bt Will alot but I'm interested in making a variation of it that would have the block I want to copy hard coded into it. I would also like it to not open a dialogue box but instead just copy to all layout tabs. I want to use this in a script so don't require the user input. Is this a hard thing to modify or does anyone have something already modified that I might take a look at?

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

[ELOQUINTET]

Aha after some fishing I found something I think will work. It inserts and copies in one shot sweet. Thank you Jeff for putting this together 

Code: [Select]

Re: Paste Block to Every Tab with Lisp
;;;Insert a block into all PaperSpace Layout Tabs,
;;;all at 0,0,0 & 0 deg. rotation
;;;by Jeff Mishler, January 2004

(defun c:ins2tabs ( / lays bname blk newblk)
(setq lays (vla-get-layouts
(vla-get-activedocument
(vlax-get-acad-object)))
bname (getstring "\nBlock to insert in all Layouts?: ")
)
(if (not (tblsearch "block" bname))
(progn
(princ "\nBlock not found, please select block: ")
(setq bname
(getfiled "Block Selection for Tab Insert" bname "dwg" 0))
)
)
(vlax-for x lays
(if (not (= "Model" (vla-get-name x)))
(progn
(setq blk (vla-get-block x)
newblk (vlax-invoke-method
blk
'insertblock
(vlax-3d-point
'(35.5 0.5 0.0))
bname 1.0 1.0 1.0 0.0))
)
)
)
(princ)
)


[ronjonp]

Here is another variant (mostly Will's code):

Code: [Select]

(defun cbal (blockname / ss doc lst)
  (if
    (and (setq
   ss (ssget "_x"
     (list (cons 2 blockname) (cons 410 (getvar 'ctab)))
      )
)
(= (getvar 'tilemode) 0)
    )
     (progn
       (setq doc (vla-get-activedocument (vlax-get-acad-object))
     ss (mapcar 'vlax-ename->vla-object (mapcar 'cadr (ssnamex ss)))
       )
       (vlax-map-collection
(vla-get-layouts doc)
'(lambda (x) (setq lst (cons x lst)))
       )
       (setq
lst (vl-remove (vla-get-activelayout doc)
(cdr lst)
     )
       )
       (mapcar '(lambda (x)
  (vla-copyobjects
    doc
    (vlax-safearray-fill
      (vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length ss)))
      )
      ss
    )
    (vla-get-block x)
  )
)
       lst
       )
     )
  )
)

(cbal "blockname")
You have to be on the current tab that the block resides on or it won't do anything.

[ELOQUINTET]

spoke too soon. I have another problem. I need to change one of the attribute values on all layouts. I was trying to use GATTE but cannot figure out how to do it completely from the command line.

Command: gatte

Select block or attribute [Block name]: b

Enter block name: revtitle

Known tag names for block: REV__DATE NAME PROMPT SEP BW FOR SEND
REV__DATE_ABBRV REV_NUM
Select attribute or type attribute name: NAME


*Invalid selection*
Expects a point or RE

what am i doing wrong here?

[ELOQUINTET]

i had a though that i could modify a routine i have for changing revision date but I have a feeling that the red part is wrong. It's not supposed to itoa but I can't find what or maybe I'm way off?

Code: [Select]

(defun c:Rev1NAME (/ Ctab$ Layout$)
  (setq Ctab$ (getvar "CTAB"))
  (foreach Layout$ (layoutlist)
    (command "LAYOUT" "S" Layout$)
    ;Replace the following with your blocknames and attribute tags
    (PutBlkAttrib "Revtitle" "NAME" [color=red](itoa D.K.))[/color]
    );foreach
  (setvar "CTAB" Ctab$)
  (princ)
);defun c:Rev1NAME

[T.Willey]

If I remember correctly, it wants a string.  So use "D.K." (with the double quotes) in stead of (itoa D.K.).

[ELOQUINTET]

aha yes thanks tim i knew i was close it works now. I am trying to develop some things i can run through script so I'm trying to eliminate human interraction thanks

[kpblc]

To copy blocks to all layouts (exclude Model) you can try this one:

Code: [Select]

(vl-load-com)
(or *kpblc-activedoc*
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of or

(defun c:pasteblock (/ blk pt ins_pt res_pt blk_name layouts selset)
  (vla-startundomark *kpblc-activedoc*)
  (if (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    '(lambda ()
                       (setq blk
                              (car (entsel "\n Select a block to ba placed <Cancel> : "))
                             ) ;_ end of setq
                       ) ;_ end of lambda
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           blk
           (= (cdr (assoc 0 (entget blk))) "INSERT")
           ) ;_ end of and
    (progn
      (setq ins_pt   (cdr (assoc 10 (entget blk)))
            pt       (cond
                       ((not (vl-catch-all-error-p
                               (vl-catch-all-apply
                                 '(lambda ()
                                    (setq pt (getpoint "\nSelect a point <InsPoint> : "))
                                    ) ;_ end of lambda
                                 ) ;_ end of vl-catch-all-apply
                               ) ;_ end of vl-catch-all-error-p
                             ) ;_ end of not
                        pt
                        )
                       (t ins_pt)
                       ) ;_ end of cond
            blk_name (cdr (assoc 2 (entget blk)))
            layouts  (vla-get-layouts *kpblc-activedoc*)
            res_pt   (mapcar '- ins_pt pt)
            ) ;_ end of setq
      (foreach layout (vl-remove-if
                        '(lambda (x) (= (strcase (getvar "ctab")) (strcase x)))
                        (layoutlist)
                        ) ;_ end of vl-remove-if
        (if (not (setq selset (ssget "_X"
                                     (list (cons 0 "INSERT")
                                           (cons 2 blk_name)
                                           (cons 410 layout)
                                           (cons 10 res_pt)
                                           ) ;_ end of list
                                     ) ;_ end of ssget
                       ) ;_ end of setq
                 ) ;_ end of not
          (vla-insertblock
            (vla-get-block (vla-item layouts layout))
            (vlax-3d-point res_pt)
            blk_name
            1.
            1.
            1.
            0.
            ) ;_ end of vla-insertblock
          (princ (strcat "\nThis block insertion on layout \""
                         layout
                         "\" exist already."
                         ) ;_ end of strcat
                 ) ;_ end of princ
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defunP.S. If block contains some attributes, new insertion will get "default" values.

[CAB]

Here is a modified version of Wills Fine Routine.

;;  CAB variation 06.05.07
;;  Modified to copy anything or delete blocks in layouts
;;  Added option to call without the dialog box, does all tabs


Note that there is a DCL file needed, see the end of the lisp.

[ELOQUINTET]

cool cab will check it out thanks