;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./
;; 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
(defun c:deleteb () (cod "del" t) (princ)) ; old program call
(defun c:deleteba () (cod "del" nil) (princ)) ; all tabs, no dcl
(defun c:copyb () (cod "copy" t) (princ)) ; old program call
(defun c:copyba () (cod "copy" nil) (princ)) ; all tabs, no dcl
;;
(defun c:delntab () (cod "del" t) (princ))
(defun c:delntaba () (cod "del" nil) (princ)) ; all tabs, no dcl
(defun c:copy2tab () (cod "copy" t) (princ))
(defun c:copy2taba () (cod "copy" nil) (princ)) ; all tabs, no dcl

;;*** See the DCL needed at the end of this file ***

;;/'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./'\./

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;cod.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 and 2006 ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;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 wd:layout_list (doc func / lst)
(vlax-map-collection
(vla-get-layouts *adoc*)
'(lambda (x) (setq lst (cons x lst)))
)
(setq lst (cdr (*sort* lst 'vla-get-taborder)))
(if (eq func "copy")
(vl-remove (vla-get-activelayout doc) lst)
lst
)
)
;;;
;;;
;;;
(defun *sort* (lst func)
(vl-sort lst
'(lambda (e1 e2)( (getvar "CVPORT") 1)
(princ "\nThis command does not work in a Viewport. ")
)
((not (setq ss (ss_get msg filter))) ; CAB 01/18/2011
(princ "\nError: Function Cancelled ")
)
(t
(setq objs (mapcar 'vlax-ename->vla-object (*ssnames* ss)))
(if dcl
(setq lays (get_selected_layouts
dcl_str
(wd:layout_list *adoc* func)
)
)
(setq lays (wd:layout_list *adoc* func ))
)
(if (eq func "copy")
;| (mapcar '(lambda (x)
(vla-copyobjects
*adoc*
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length objs))))
objs
)
(vla-get-block x)
)
)
lays
)|;
;; Courtesy of ronjonp 01/18/2011
(mapcar '(lambda (x) (vlax-invoke *adoc* 'copyobjects objs (vla-get-block x) nil)) lays)

(if (setq
ss (ssget
"X"
(list
(cons 2 (str_cat (mapcar 'vla-get-name objs) ","))
(cons 410 (str_cat (mapcar 'vla-get-name lays) ","))
)
)
)
(mapcar 'vla-delete
(mapcar 'vlax-ename->vla-object (*ssnames* ss))
)
)
)
)
)
(princ)
)

;|
// Save this to "cod_layouts.dcl" in ACAD search path
copyb : 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 = "&Proceed...";
key = "select";
}
: button {
label = "&Cancel";
is_cancel = true;
key = "cancel";
}
}
}
deleteb : dialog {
label = "Available Layouts";
:boxed_column {
label = "Select Layouts to delete blocks from:";
: list_box {
key = "layout_list";
height = 12;
multiple_select = true;
}
}
: row {
: button {
label = "&Proceed...";
key = "select";
}
: button {
label = "&Cancel";
is_cancel = true;
key = "cancel";
}
}
}
|;

******* cod_layouts.dcl **********

copyb : 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";
}
}
}
deleteb : dialog {
label = "Available Layouts";
:boxed_column {
label = "Select Layouts to delete objects from:";
: list_box {
key = "layout_list";
height = 12;
multiple_select = true;
}
}
: row {
: button {
label = "&Select...";
key = "select";
}
: button {
label = "&Cancel";
is_cancel = true;
key = "cancel";
}
}
}

Advertisements