;;;=================================================================
;;;
;;; MPL.LSP V1.03
;;;
;;; Copy the Plot Configuration to selected Layouts
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:mpl(/ s *errmpl* MsgBox multiplie_plt)

;;;---------------------------------------------------------------
;;;
;;; Error Handling
;;;
;;;---------------------------------------------------------------

(defun *errmpl* (msg)
(if (/= msg "Function cancelled")
(if (= msg "quit / exit abort")
(princ)
(princ (strcat "\nErreur : " msg))
)
(princ)
)
(setq *error* s)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(princ)
)

;;;---------------------------------------------------------------
;;;
;;; Message
;;;
;;;---------------------------------------------------------------

(defun MsgBox (Titre Bouttons Message / Reponse WshShell)
(vl-load-com)
(setq WshShell (vlax-create-object "WScript.Shell"))
(setq Reponse (vlax-invoke WshShell 'Popup Message 0 Titre (itoa Bouttons)))
(vlax-release-object WshShell)
Reponse
)

;;;---------------------------------------------------------------
;;;
;;; Main Programm
;;;
;;;---------------------------------------------------------------

(defun multiplie_plt(/ config doc i init_mpl j lay liste_lay lst n position positiondests resultat)

(defun liste_destination()
(start_list "dest")
(mapcar 'add_list (vl-remove (nth (atoi position) liste_lay) liste_lay))
(end_list)
(set_tile "dest" positiondest)
)

(if (setq init_mpl (findfile "mpl.dcl"))
(progn
(setq init_mpl (load_dialog init_mpl)
liste_lay nil
n 1
position "0"
positiondest "0"
)
(vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object)))
(setq lst (cons (cons (vla-get-taborder lay) lay) lst))
)
(while (assoc n lst)
(setq liste_lay (cons (vla-get-name (cdr (assoc n lst))) liste_lay))
(if (and (eq (vla-get-name (cdr (assoc n lst))) (getvar "ctab")) (zerop (getvar "tilemode")))
(setq position (itoa (1- n)))
)
(setq n (1+ n))
)
(setq liste_lay (reverse liste_lay))
(if (cdr liste_lay)
(progn
(new_dialog "mpl" init_mpl "")
(start_list "mpl")
(mapcar 'add_list liste_lay)
(end_list)
(liste_destination)
(set_tile "titre" "Layout Page Setup Copy V1.03")
(set_tile "mpl" position)
(mode_tile "mpl" 2)
(while (and (/= resultat 1)(/= resultat 0))
(action_tile "mpl" "(setq position $value)(liste_destination)")
(action_tile "dest" "(setq positiondest $value)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq resultat (start_dialog))
)
(unload_dialog init_mpl)
(if (eq resultat 1)
(progn
(setq doc (vla-get-activedocument (vlax-get-acad-object))
config (vla-item (vla-get-layouts doc) (nth (atoi position) liste_lay))
)
(setq liste_lay (vl-remove (nth (atoi position) liste_lay) liste_lay))
(while (not (eq positiondest ""))
(setq position (read positiondest))
(setq lay (vla-item (vla-get-layouts doc) (nth position liste_lay)))
(vla-copyfrom lay config)
(princ (strcat "\nCopping layout page setup to " (vla-get-name lay) " from " (vla-get-name config)))
(setq positiondest (substr positiondest (+ 2 (strlen (itoa position))) (strlen positiondest)))
)
)
)
)
(msgbox "MPL" 48 "\nUsing unnecessary Lisp")
)
)
(msgbox "MPL" 16 "File MPL.DCL not found")
)
)

;;;---------------------------------------------------------------
;;;
;;; Routine launch
;;;
;;;---------------------------------------------------------------

(vl-load-com)
(setq s *error*)
(setq *error* *errmpl*)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(multiplie_plt)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq *error* s)
(princ)
)

(setq nom_lisp "MPL")
(if (/= app nil)
(if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
(princ (strcat "..." nom_lisp " Loaded."))
(princ (strcat "\n" nom_lisp ".LSP Loaded.....type " nom_lisp " to execute.")))
(princ (strcat "\n" nom_lisp ".LSP Loaded......type " nom_lisp " to execute.")))
(setq nom_lisp nil)
(princ)
(c:mpl)

**********************DCL Code (mpl.dcl)*************************************************
// =================================================================
//
// MPL.DCL V1.03
//
// Copyright (C) Patrick DEWEVRE
//
// =================================================================

mpl : dialog {
key = "titre";
fixed_width = true;
alignment = centered;
is_cancel = true;
width = 60;
: popup_list {label= "Source"; key = "mpl";}
spacer;
: list_box {label= "Destination" ; key="dest"; height = 10; multiple_select=true;}
spacer;
ok_cancel;
}

Advertisements