copier la présentation courante

[GEGEMATIC]

salut,

j'ai besoin sans arrêt de copier de nombreuse fois une présentation.

comme je m'y colle, je vois que LE MEME JOUR, Falvignard et matthieu se penchent sur la question en VBA

http:// news://discussion.autodesk.com:119/5751328@discussion.autodesk.com

ou

http://discussion.autodesk.com/thread.jspa?messageID=5751818&tstart=0

 

Plutôt que de péniblement adapter leur code vba à mon problème ,j'essaye de le traduire en lisp

ça marche presque, car ça plant à la dernière ligne:

Erreur Automation. Aucune description n'a été entrée.

j'ai du oublier qq chose, mais quoi ?

 

merci de votre aide

 

 

 

 

 
;;**************************************************************************
;§/traces/copie l'onglet courant n fois/none
(defun c:copie_onglet_courant ( / acadObject acadDocument layout_col nb i name taborder lres)
  (vl-Load-Com)

 (setq aclay (get_aclayout))
 ;(pw_getintmem "\nNombre de copies ?" "layout-number")
 (setq layout-number (getint "\nNombre de copies ?"))
 ;(setq pc (car (pw_vlax_list_items (vla-get-plotconfigurations pw-acaddocument))))
 (repeat layout-number
    (pw_copie_onglet aclay layout-number)
 )

)
;;**************************************************************************
;§/traces/copie l'onglet  nb fois/layout nb
(defun pw_copie_onglet (objLayoutSource nb / acadObject acadDocument layout_col nb i name taborder lres)

;;;Function CopierPresentation(objLayoutSource As AcadLayout, strNomNouveauLayout As String) As AcadLayout
;;;Dim objLayout As AcadLayout
;;;Dim objArray() As Object
;;;Dim i As Integer
;;;Dim intBlockCount As Integer
;;;
;;;     On Error Resume Next
;;;
;;;     'Additionner la nouvelle présentation
 (setq nom (vla-get-name objLayoutSource))
 (setq layouts (vla-get-Layouts pw-acaddocument))
 (repeat nb
  ;;(setq strNomNouveauLayout (pw_inc_ch nom 1))
  
   (setq strNomNouveauLayout (strcat nom (getstring "\nSuffixe ?")))
;;;     Set objLayout = ThisDrawing.Layouts.Add(strNomNouveauLayout)
   (setq objLayout (vla-add layouts strNomNouveauLayout))
   
;;;
;;;     objLayout.CopyFrom objLayoutSource
   (vla-Copyfrom objLayout objLayoutSource)
;;;
;;;     intBlockCount = objLayoutSource.Block.Count
   (setq intBlockCount (vla-get-count (vla-get-block objLayoutSource)))
   (setq objArray (vlax-make-safearray  vlax-vbObject (cons 0 (- intBlockCount 1))))
;;;     If intBlockCount Then
;;;         ReDim objArray(intBlockCount - 1)
   (setq i 0)
   (repeat (- intBlockCount 1)
;;;
;;;         'Reprendre les éléments associé à la présentation
;;;         For i = 0 To intBlockCount - 1
;;;             Set objArray(i) = objLayoutSource.Block.Item(i)
;;;         Next i
     (vlax-safearray-put-element objArray i (vla-item (vla-get-block objLayoutSource) i))
     
		       (setq i (+ 1 i))
;;;   
;;;         'Copier les éléments de la présentation sur la nouvelle présentation
;;;         ThisDrawing.CopyObjects objArray, objLayout.Block

;;; c'est la que ça plante :
     (vla-CopyObjects pw-acaddocument objArray (vla-get-block objLayout))
		             
     )
   )
 )

;;**************************************************************************
;§/traces/retourne l'onglet courant / none
;;
(defun get_aclayout ( / acadObject  ) 
 (setq acadObject (vlax-get-acad-object)) 
 (setq pw-acaddocument (vla-get-ActiveDocument acadObject)) 
 (vlax-Get-property pw-acaddocument 'ActiveLayout)
)

[(gile)]

Salut,

 

J'ai remis de l'ordre dans les variables, remplacé toute la partie make-safearray/vla-copyobjects par des vlax-invoke et une liste, j'ai supprimé (mis en commentaire) aussi un repeat de trop, et ça semble fonctionner.

 

;;************************************************************************* *
;;;§/traces/copie l'onglet courant n fois/none
(defun c:copie_onglet_courant (/ acLay	layout-number  acadObject pw-acaddocument)
 (vl-Load-Com)

 (setq aclay (get_aclayout))
 ;;(pw_getintmem "\nNombre de copies ?" "layout-number")
 (setq layout-number (getint "\nNombre de copies ?"))
 ;;(setq pc (car (pw_vlax_list_items (vla-get-plotconfigurations pw-acaddocument))))
 ;(repeat layout-number ; repeat inutile
   (pw_copie_onglet aclay layout-number)
 ;)

)
;;************************************************************************* *
;;;§/traces/copie l'onglet nb fois/layout nb
(defun pw_copie_onglet (objLayoutSource
		 nb	       /	     nom
		 layouts       strNomNouveauLayout
		 objLayout     objlst
		)

;;;Function CopierPresentation(objLayoutSource As AcadLayout, strNomNouveauLayout As String) As AcadLayout
;;;Dim objLayout As AcadLayout
;;;Dim objArray() As Object
;;;Dim i As Integer
;;;Dim intBlockCount As Integer
;;;
;;; On Error Resume Next
;;;
;;; 'Additionner la nouvelle présentation
 (setq nom (vla-get-name objLayoutSource))
 (setq layouts (vla-get-Layouts pw-acaddocument))
 (repeat nb
   ;;(setq strNomNouveauLayout (pw_inc_ch nom 1))

   (setq strNomNouveauLayout (strcat nom (getstring "\nSuffixe ?")))
;;; Set objLayout = ThisDrawing.Layouts.Add(strNomNouveauLayout)
   (setq objLayout (vla-add layouts strNomNouveauLayout))

;;;
;;; objLayout.CopyFrom objLayoutSource
   (vla-Copyfrom objLayout objLayoutSource)

   ;;; MODIFICATION en remplacement de ce qui est ci dessous.

   (vlax-for o (vla-get-block objLayoutSource) (setq objlst (cons o objlst)))

   (vlax-invoke 
pw-acaddocument
'CopyObjects
(reverse objlst)
(vla-get-block objLayout)
     )
   
;| Partie remplacée

;;; intBlockCount = objLayoutSource.Block.Count
   (setq intBlockCount (vla-get-count (vla-get-block objLayoutSource)))
   (setq objArray (vlax-make-safearray
	     vlax-vbObject
	     (cons 0 (- intBlockCount 1))
	   )
   )
;;; If intBlockCount Then
;;; ReDim objArray(intBlockCount - 1)
   (setq i 0)
   (repeat (- intBlockCount 1)
;;;
;;; 'Reprendre les éléments associé à la présentation
;;; For i = 0 To intBlockCount - 1
;;; Set objArray(i) = objLayoutSource.Block.Item(i)
;;; Next i
     (vlax-safearray-put-element
objArray
i
(vla-item (vla-get-block objLayoutSource) i)
     )

     (setq i (+ 1 i))
     )
;;;
;;; 'Copier les éléments de la présentation sur la nouvelle présentation
;;; ThisDrawing.CopyObjects objArray, objLayout.Block

;;; c'est la que ça plante :
     (vla-CopyObjects
pw-acaddocument
objArray
(vla-get-block objLayout)
     )
|;
 )
)

;;************************************************************************* *
;;;§/traces/retourne l'onglet courant / none
;;
(defun get_aclayout (/ acadObject)
 (setq acadObject (vlax-get-acad-object))
 (setq pw-acaddocument (vla-get-ActiveDocument acadObject))
 (vlax-Get-property pw-acaddocument 'ActiveLayout)
) 

 

Ou, "à ma façon" (j'ai ajouté un test qui contrôle qu'on est bien en espace présentation et un autre au cas où le nom soit déjà utilisé) :

 

(defun c:copy_layout (/ acdoc acLay nb newlay objlst)
 (vl-load-com)
 (if (= (getvar "TILEMODE") 0)
   (and
     (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))
     (setq aclay (vla-get-ActiveLayout acdoc))
     (setq nb (getint "\nNombre de copies: "))
     (repeat nb
(while
  (vl-catch-all-error-p
    (vl-catch-all-apply
      '(lambda ()
	 (setq newlay
		(vla-add (vla-get-Layouts acdoc)
			 (strcat
			   (vla-get-Name acLay)
			   (getstring T "\nSuffixe: ")
			 )
		)
	 )
       )
    )
  )
   (princ "\nCe nom existe déjà.")
)
(vla-Copyfrom newlay aclay)
(vlax-for ob (vla-get-Block aclay)
  (setq objlst (cons ob objlst))
)
(vlax-invoke
  acdoc
  'CopyObjects
  (reverse objlst)
  (vla-get-Block newlay)
)
     )
   )
   (princ
     "\nCette commande n'est accessible que dans une présentation."
   )
 )
 (princ)
) 

[Edité le 17/10/2007 par (gile)]

 

[Edité le 18/10/2007 par (gile)]

[GEGEMATIC]

Merci beaucoup du décrottage,

et de l'exemple d'obtention d'une liste directement assimilable par lisp,

au lieu de ces ignobles safferarray ...

Mais ... (il y a un mais)

dans mon cas, l'onglet contient un cartouche et une fenêtre délimitée.

avec les 2 versions du programme,

j'obtiens

- un onglet

- le cartouche

- une fenêtre delimitée ayant une rapport d'échelle bidon

- une fenêtre non délimitée ayant un rapport d'echelle correct, mais une position de zoom incorrect,

dépassant le cadre

 

les 2 fenetres sont actives

si j'efface la fenetre non délimitée, je ne peut plus cliquer à l'exterieur du cadre.

je ne peux faire espaco, autocad me dit qu'aucune fenêtre est active ...

 

bizarre bizarre ...

encore merci

Gégé

 

 

 

[(gile)]

Je pense avoir trouvé la raison du pourquoi du comment.

 

En faisant la liste des objets avec cons l'ordre des objets sont inversés, or le premier objet (PViewport) correspond à la présentation donc dans la copie la présentation prend les propriétés de la fenêtre et vice versa.

 

Il suffit de faire un reverse de la liste d'objets.

 

Je corrige les codes ci-dessus.

[Matt666]

J'ai l'impression qu'on ne peut pas toucher aux paramètres de présentation ni aux paramètres d'impression en autolisp...

 

Est-ce le cas ???

 

C'est à dire sans commande...

 

Merci !

A bientot.

 

Matt.

[GEGEMATIC]

Génial, ça marche.

je vais me coucher avec ce problème, et je me lève le voilà résolu !

à 22h55 !

Envoi moi ton adresse en message privé, un coup de main pareil, ça mérite une petite bouteille ...

 

Par contre, par curiosité, j'aurai bien aimé savoir ce qui n'allait pas, à part le repeat en trop, dans ma gestion littérale des saffearray.

sachant qu'avec ta methode, que j'ignorais, c'est nettement p^lus simple et plus clair.

Merci merci !

[(gile)]

Par contre, par curiosité, j'aurai bien aimé savoir ce qui n'allait pas, à part le repeat en trop, dans ma gestion littérale des saffearray.

 

J'ai trouvé 2 choses :

- une parenthèse mal placée : le (vla-copy ...) était à l'intérieur de la boucle (repeat ...) qui remplit le safearray ;

- il manquait un objet dans le safearray : il fallait faire (repeat intBlockCount ...) au lieu de (repeat (1- intBlockCount) ...)

[GEGEMATIC]

merci,

j'aime bien me baser sur des exemples qui marchent, lorsque je n'ai plus de cervelle, mais qu'il faut que je trouve, que j'adapte ...

pour la bouteille je déconne pas, envoi moi ton adresse.