Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Outils pour gérer les présentations

Didier-AD

Par Didier-AD
dans Routines LISP

 Partager

Messages recommandés

Didier-AD Newbie

Didier-AD

Posté(e)
Posté(e)

Il y en a à moi, d'autres que j'ai glanées ici et là, en particulier dans ce forum

voici donc ma bibliothèque de gestion des présentations

; 
(vl-load-com)
;;---Début---------------------------------------------------Pres_FindLayouts-
;; << recherche le VLA-OBJECT correspondant à la collection de layouts         >>
;; <<                                                                          >>
;;
;;  créée le :  vendredi 17 novembre 2000  à 00:39
;;
;; Admet : 
;; =======
;;
;; Retourne : VLA-OBJECT = collection des layout
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_FindLayouts ( / acadobj acaddoc )
 (setq acadobj (vlax-get-acad-object)
acaddoc (vlax-get-property acadobj 'ActiveDocument)
 )	
 (vlax-get-property acaddoc 'Layouts)
);...........
;;---fin-----------------------------------------------------Pres_FindLayouts-


;;---Début---------------------------------------------------Pres_Find_a_Layout
;; << trouve le VLA-OBJECT correspondant à une présentation                    >>
;; <<                                                                          >>
;;
;;  créée le :  vendredi 17 novembre 2000  à 00:45
;;
;; Admet : 
;; =======
;;   lenom      : Chaine   = nom du Layout
;;
;; Retourne : VLA-OBJECT = trouvé
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_Find_a_Layout ( lenom / Layo count n nom ly found)
   (setq layo  (Pres_FindLayouts)
  count (vlax-get-property layo 'Count)
  n 0
   )
   (repeat count
     (setq nom (vlax-get-property (setq ly (vlax-invoke-method layo 'item n)) 'Name))
     (if (=  lenom nom) (setq found ly))
     (setq n (1+ n))
   )
   found
);...........
;;---fin-----------------------------------------------------Pres_Find_a_Layout


;;---Début---------------------------------------------------Pres_Ajoutepres--
;; << ajoute une présentation mais verifie si une présenation porte ce nom     >>
;; <<  si oui retourne le vla-object de cette présentation,                    >>
;; <<  si non crée une nouvelle présentation                                   >>
;;
;;  créée le :  vendredi 17 novembre 2000  à 00:23
;;
;; Admet : 
;; =======
;;   lenom      : Chaine   = nom de la présentation
;;
;; Retourne : vla-object = nom activeX de la présentation
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_Ajoutepres ( lenom / layo existe)   ;;; MOD1
 (if (setq existe (Pres_Find_a_Layout (strcase lenom)))
     existe
     (vlax-invoke-method (Pres_FindLayouts) 'Add lenom)
 )
);...........
;;---fin-----------------------------------------------------Pres_Ajoutepres--


;;---Début---------------------------------------------------Pres_RenamePres--
;; << renomme une présentation                                                 >>
;; <<                                                                          >>
;;
;;  créée le :  vendredi 17 novembre 2000  à 00:27
;;
;; Admet : 
;; =======
;;   oldname    : Chaine   = ancien nom
;;   Newname    : Chaine   = nouveau nom
;;
;; Retourne : ObjectName de la présentation 
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_RenamePres ( OldName NewName / ly)
  (setq ly (Pres_Find_a_layout oldName))
  (if ly (vlax-put-property ly 'Name NewName))
  ly    ;;; MOdification Alain    
);...........
;;---fin-----------------------------------------------------Pres_RenamePres--
   	  

;;---Début---------------------------------------------------Pres_DeletePres--
;; << efface une présentation                                                  >>
;; <<                                                                          >>
;;
;;  créée le :  vendredi 17 novembre 2000  à 00:34
;;
;; Admet : 
;; =======
;;   lenom        : Chaine ou VLA-OBJECT   = nom de la présentation ou son VLA-OBJECT
;;
;; Retourne : Sans intérêt = 
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_DeletePres ( lenom / ly)
 (if (= (type lenom) 'VLA-OBJECT)
   (setq Ly lenom)
   (setq ly (Pres_Find_a_Layout lenom))
 )
 (if ly (vlax-invoke-method ly 'delete))
  
);...........
;;---fin-----------------------------------------------------Pres_DeletePres--
  

;;---Début---------------------------------------------------Pres_Listepres---
;; << liste tous les Layouts d'un dessin                                       >>
;; << Y compris "model"                                                        >>
;;
;;  créée le :  vendredi 17 novembre 2000  à 00:53
;;  modifié par Alain 
;; Admet : 
;; =======
;;
;; Retourne : Liste = des noms de layouts dans l'ordre d'affichage des onglets
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_Listepres ( / layo count n nom lnom lay)
   (setq layo (Pres_FindLayouts)
  count (vlax-get-property layo 'Count)
  n 0
   )
   (repeat count
     (setq nom  (vlax-invoke-method layo 'item n)  ;; récupère l'ObjectName
    lnom (cons (cons (itoa (vla-get-TabOrder nom)) ;; récupère l'ordre d'affichage transformé en STRING pour faciliter le trie
		     (vla-get-Name nom)     ;; récupère le nom d'affichage
	       )
	       lnom
	 )
    n    (1+ n)
     )	    
   )
;;; je pense que tu avoir des routines de trie mais je propose celle-ci  
   (mapcar (function (lambda(x) (cdr (assoc x lnom))))  
           (acad_strlsort (mapcar 'car lnom))  ;; efectue le trie
   )
);...........
;;---fin-----------------------------------------------------Pres_Listepres---



;;---Début--------------------------------------------------Pres_SetCLayouts--
;; << fixe le layout courant                                                   >>
;; <<                                                                          >>
;;
;;  créée le :  lundi 20 novembre 2000  à 22:00
;;
;; Admet : 
;; =======
;;   name       : Chaine   = nom du layout si nil, espace objet
;;
;; Retourne : VLA-OBJECT = ObjectName du layout
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_SetCLayouts ( name / layout acaddoc )
 (setq layout  (cond
	   ((and (= (type name)  'VLA-OBJECT)
		 (= (vla-get-objectname name) "AcDbLayout")
	    )
	    name
	   )
	   ((= (type name) 'STR)
	       (Pres_Find_a_Layout name)
	   )
        )
layout  (if layout layout
	           (Pres_Find_a_Layout "Model")
	)
 )
 (if layout (vla-put-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)) layout))
 layout

);...........
;;---fin----------------------------------------------------Pres_SetCLayouts--

;;---Début-----------------------------------------------------Pres_CLayouts--
;; << retourne le layout courant                                               >>
;; <<                                                                          >>
;;
;;  créée le :  lundi 20 novembre 2000  à 22:00
;;
;; Admet : 
;; =======
;;   name       : Chaine   = nom du layout si nil, espace objet
;;
;; Retourne : VLA-OBJECT = ObjectName du layout courant
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_CLayout (  / layout acaddoc )
 (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))
);...........
;;---fin----------------------------------------------------Pres_SetCLayouts--



;;---Début---------------------------------------------------Pres_LayoutsOrder
;; << Reéfini l'ordre des onglets des layouts                                  >>
;; <<                                                                          >>
;;
;;  créée le :  mardi 21 novembre 2000  à 21:22
;;
;; Admet : 
;; =======
;;   lislayout  : Liste    = liste des layouts
;;
;; Retourne : Sans intéret = 
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_LayoutsOrder ( lislayout / layout ii)
     (setq ii 0)
     (mapcar (function (lambda(layout)
		    (vla-put-Taborder layout (setq ii (1+ ii)))
		)
      )
      (mapcar (function Pres_Find_a_Layout) lislayout)
     )
);...........
;;---fin-----------------------------------------------------Pres_LayoutsOrder



;;---Début---------------------------------------------------Pres_SupViewCreLayouts
;; <<  Nom pas trés evocateur peut être mais qui signifie que l'on supprime    >>
;; << la création d'une Fenêtre sur le Layout à la création                    >>
;;
;;  créée le :  samedi 25 novembre 2000  à 17:35
;;
;; Admet : 
;; =======
;;
;; Retourne : Sans intéret = 
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_SupViewCreLayouts ( / )
 (vla-put-LayoutCreateViewport (vla-get-Display            ;;; accés à l'ojet Display (en gros onglet affichage d'Option)
			     (vla-get-Preferences   ;;; accés à l'ojet Préférences géré par la commande Option
			          (vlax-get-acad-object)
			     )
			)
                               0  ;;; une valeur de 1 le rétabli
 )
);...........
;;---fin-----------------------------------------------------Pres_SupViewCreLayouts



;;---Début---------------------------------------------------PresName---------
;; << Retourne le nom d'une présentation                                       >>
;; <<                                                                          >>
;;
;;  créée le :  samedi 25 novembre 2000  à 18:49
;;
;; Admet : 
;; =======
;;   Ent       : Maitien, Ename ou OjectName = Maintien ou Ename ou ObjectName de la présentation
;;
;; Retourne : Chaine = Nom de la présentation
;; ==========
;-------------------------------------------------------------------------------
(Defun PresName(Ent / Obj)
     (if (setq Obj (if (= (type ent) 'VLA-OBJECT)
                    Ent
                    (progn
                        (if (= (type ent) 'STR) (setq ent (handent ent)))
                        (if (= (type ent) 'ENAME)
                     (vlax-ename->vla-object ent)
                 )
                    )
                )
         )
         (vla-get-name Obj)
     )
);...........
;;---fin-----------------------------------------------------PresName---------

;;---Début---------------------------------------------------PresObjName---------
;; << Retourne l'ObjectName  d'une présentation                                >>
;; << en vérifiant si l'objet est bien une présen                              >>
;;
;;  créée le :  samedi 25 novembre 2000  à 19:28
;;
;; Admet : 
;; =======
;;   Layout       : Nom ,Maitien, Ename ou ObjectName = Maintien ou Ename ou ObjectName de la présentation
;;
;; Retourne : Objectname = ObjectName de la présentation
;; ==========
;-------------------------------------------------------------------------------
(Defun PresObjName(layout / Obj)
    (setq obj
    (cond 
  	((= (type Layout) 'STR)
      	    (if (setq tmp (handent Layout))
	        (vlax-ename->vla-object tmp)
	        (Pres_Find_a_Layout layout)     
            )
        )
	((= (type Layout) 'ENAME)
	       (vlax-ename->vla-object layout)
	)
	((= (type Layout) 'VLA-OBJECT)
	       layout
	)
          )
    )
    (if (and obj (= (vla-get-objectname obj) "AcDbLayout")) Obj)
);...........
;;---fin-----------------------------------------------------PresObjName---------


;;---Début---------------------------------------------------PresDimPaper-----
;; << retourne les dimensions du papier d'un layout                            >>
;; <<                                                                          >>
;;
;;  créée le :  lundi 4 décembre 2000  à 20:54
;;
;; Admet : 
;; =======
;;   Layout     : Nom ou Obj ou Ename ou Hand = la présentation
;;
;; Retourne : Liste = (largeur hauteur)
;; ==========
;-------------------------------------------------------------------------------
(Defun PresDimPaper ( Layout / tmp dimx dimy)
  (if (setq layout (PresObjName Layout))
    (progn
      (vla-GetPaperSize Layout 'dimx 'dimy)
      (if (= (rem (vla-get-PlotRotation Layout) 2) 0) ; si c'est 0 ou 2 Portrait 1 ou 3 Paysage
   (list dimx dimy)
   (list dimy dimx)
      )
    )
  )      
);...........
;;---fin-----------------------------------------------------PresDimPaper-----


;;---Début---------------------------------------------------Pres_IsPaper--------
;; << Fonction qui retourne T si on est en espace papier complet               >>
;; <<                                                                          >>
;;
;;  créée le :  dimanche 3 octobre 2004  à 19:22
;;
;; Admet : 
;; =======
;;
;; Retourne : Booléen = T si en EP complet
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_IsPaper ( / )
 (and (/= "Model" (PresName (Pres_CLayout)))
      (= 1 (getvar "CVPORT"))
 )     
)
;;---fin-----------------------------------------------------Pres_IsPaper--------


;;---Début---------------------------------------------------Pres_IsObjet-----
;; << permet de savoir si on est en objet                                      >>
;; <<                                                                          >>
;;
;;  créée le :  dimanche 3 octobre 2004  à 19:28
;;
;; Admet : 
;; =======
;;
;; Retourne : Entier = 0 : en "Model" ; 1 en objet dans une présentation ; Nil en Papier
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_IsObjet ( / )
 (cond
   ((= 1 (getvar "Tilemode")) 0 )
   ((and (/= "Model" (PresName (Pres_CLayout))) (> (getvar "CVPORT") 1)) 1)
   (T Nil 	  )
 )     

)
;;---fin-----------------------------------------------------Pres_IsObjet-----


;;---Début---------------------------------------------------Pres_ListPlot----
;; << donnela liste des traceurs valables                                      >>
;; <<                                                                          >>
;;
;;  créée le :  vendredi 26 janvier 2007  à 00:44
;;
;; Admet : 
;; =======
;;
;; Retourne : Liste = de nom de traceurs
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_ListPlot ( / Ltra)
       (setq Ltra (vlax-safearray->list
	    (vlax-variant-value
	      (vla-getplotdevicenames
		(vla-get-layout
		  (vla-get-modelspace
		    (vla-get-activedocument
		      (vlax-get-acad-object)
		    )
		  )
		)
	       )
	     )
	   )
)
       (if (vl-position "Aucun" Ltra)
         (setq Ltra (vl-remove "Aucun" Ltra))
       )
 Ltra
)
;;---fin-----------------------------------------------------Pres_ListPlot----


;;---Début---------------------------------------------------Pres_PutPlotter--
;; << impose un traceur à une présentation                                     >>
;; <<                                                                          >>
;;
;;  créée le :  vendredi 26 janvier 2007  à 00:49
;;
;; Admet : 
;; =======
;;   Lay        : Chaine   = ou objet présentation
;;   plotter    : Chaine   = nom du traceur
;;
;; Retourne : Booléen = T si çà s'est normalement bien passé
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_PutPlotter ( Lay plotter / )
 (if (= 'STR (type Lay))
   (setq Lay (Pres_Find_a_Layout Lay))
 )
 (if (member plotter (Pres_ListPlot))
  (progn
   (vla-put-configname Lay plotter)
   T
  )
 )  
   
)
;;---fin-----------------------------------------------------Pres_PutPlotter--

;;---Début---------------------------------------------------Pres_GetPlotter--
;; << retourne le traceur associé à une présentation                           >>
;; <<                                                                          >>
;;
;;  créée le :  vendredi 26 janvier 2007  à 00:49
;;
;; Admet : 
;; =======
;;   Lay        : Chaine   = ou objet présentation
;
;; Retourne : chaine : nom du plotter actuel
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_GetPlotter ( Lay  )
 (if (= 'STR (type Lay))
   (setq Lay (Pres_Find_a_Layout Lay))
 )
 
 (vla-get-configname Lay )
   
)
;;---fin-----------------------------------------------------Pres_GetPlotter--



;;---Début---------------------------------------------------Pres_PutPaper--
;; << impose un format du traceur à une présentation                                     >>
;; << ATTENTION, NE FONCTIONNE QU'AVEC LES FORMATS Ai (A1, A2,A3,A4....)                 >>
;;
;;  créée le :  vendredi 26 janvier 2007  à 00:49
;;
;; Admet : 
;; =======
;;   Lay        : Chaine   = ou objet présentation
;;   paper      : Chaine   = nom du format
;;   Portrait   : booléen  = si 1 se débrouille pour placer le format en portrait
;;                           si 0 se débrouille pour placer le format en paysage
;;                           si nil laisse comme çà 
;;
;; Retourne : Booléen = T si çà s'est normalement bien passé
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_PutPaper ( Lay paper portrait / dimx dimy)
 (if (= 'STR (type Lay))
   (setq Lay (Pres_Find_a_Layout Lay))
 )
 (vla-put-canonicalmediaName Lay paper)
 (cond
     ((= portrait 1) (vla-put-plotrotation lay 0)) 
     ((= portrait 0) (vla-put-plotrotation lay 1)) 
 )
   
)
;;---fin-----------------------------------------------------Pres_PutPaper--


;;---Début---------------------------------------------------Pres_ListFormatsOfPres
;; << retourne la liste des formats disponibles pour une présentation          >>
;; << sa configuration traceur actuelle    et le format actuel                 >>
;;
;;  créée le :  mardi 30 janvier 2007  à 00:39
;;
;; Admet : 
;; =======
;;   Lay        : Chaine   = ou objet : layout
;;
;; Retourne : Liste = (traceur format-actuel (liste des formats Brut) (liste des formats francisés))
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_ListFormatsOfPres ( Lay / paps lst)
 (if (= 'STR (type Lay))
   (setq Lay (Pres_Find_a_Layout Lay))
 )
 (setq paps (vlax-invoke lay 'GetCanonicalMediaNames))
 (setq lst (mapcar '(lambda (pap) (vla-GetLocaleMediaName Lay pap)) paps))
 (list (Pres_GetPlotter Lay) (vla-get-CanonicalMediaName Lay) paps lst)
)
;;---fin-----------------------------------------------------Pres_ListFormatsOfPres

;;---Début---------------------------------------------------Pres_ListFormatsOfPlotter
;; << donne la liste des formats liés à un traceur                              >>
;; <<                                                                          >>
;;
;;  créée le :  mardi 30 janvier 2007  à 00:58
;;
;; Admet : 
;; =======
;;   Plotter    : Chaine   = traceur
;;
;; Retourne : Liste = ((formats bruts) (formats francisés))
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_ListFormatsOfPlotter ( Plotter / esp lay paps lst lst2)
;;; ATTENTION, FONCTION LENTE !!!!  
(if (zerop (getvar "tilemode"))
	(setq esp (vla-get-paperspace (vla-get-ActiveDocument (vlax-get-acad-object))))
	(setq esp (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))))
)
(setq Lay (vla-get-layout esp)
      def (vla-get-configname lay)
)
       (if (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-configname (list Lay Plotter))))
	(progn
		(vla-RefreshPlotDeviceInfo Lay)
		(setq paps (vlax-invoke lay 'GetCanonicalMediaNames))
		(setq lst (mapcar '(lambda (pap) (vla-GetLocaleMediaName Lay pap)) paps))
	        (setq lst2 (list paps lst))
		(vl-catch-all-apply 'vla-put-configname (list lay def))
	)
	(setq lst2 '(""))
)
       lst2
)
;;---fin-----------------------------------------------------Pres_ListFormatsOfPlotter



;;---Début---------------------------------------------------Pres_Plot--------
;; << lance l'impression d'un layout                             >>
;; <<                                                                          >>
;;
;;  créée le :  mardi 13 février 2007  à 00:07
;;
;; Admet : 
;; =======
;;   l_layout   : Liste    = chaines = nom des layouts
;;
;; Retourne : Sans intéret = 
;; ==========
;-------------------------------------------------------------------------------
(Defun Pres_Plot ( l_layout / lnom plot)
 (setq lnom (vlax-make-safearray vlax-vbString (cons 0 (- (length l_layout) 1))))
 (vlax-safearray-fill lnom l_layout)
 (setq plot (vla-get-plot (vla-get-ActiveDocument (vlax-get-acad-object))))
 (vlax-invoke-method plot 'SetLayoutsToPlot lnom)
 (vlax-invoke-method plot 'PlotToDevice) 
)
;;---fin-----------------------------------------------------Pres_Plot--------
;;---Début---------------------------------------------------C:ImprimeTout--------
;; << lance l'impression de tous les layouts>>
;; <<                                                                          >>
;;
;;  créée le :  mardi 26 Juin 2007  à 00:36
;;
;; Admet : 
;; =======
;;
;; Retourne : Sans intéret = 
;; ==========
;-------------------------------------------------------------------------------
(defun C:ImprimeTout ()
 (Pres_Plot (cdr (Pres_ListePres)))
)
;;---fin----------------------------------------------------C:ImprimeTout--------

 

[Edité le 27/6/2007 par Didier-AD]

Didier-AD Newbie

Didier-AD

Posté(e)
  • Auteur
Posté(e)

En fonction d'un besoin concernant les présentations

as tu un besoin particulier concernant les présentations afin que je puiss te donner un exemple d'utilisation ?

Bred Newbie

Bred

Posté(e)
Posté(e)
lister mes présentations

(layoutlist)

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité