Changement de système de coordonnées - Présentation à mettre à jour

[lovecraft]

Bonjour à tous,

 

J'expose le problème:

 

J'ai un dessin dans lequel j'ai des présentations. Suite à un changement de système de coordonnées, il se trouve que les présentations sont à refaire (car les entités graphique ne sont plus au même emplacement)

 

Est il possible de mettre à jour les fenêtres de présentations automatiquement ? Sinon, y aurait il des lisps qui traînent ?

 

Merci de vos réponses,

 

Cordialement,

 

Laurent

[lecrabe]

Hello

 

Je vois tres bien ton souci ...

 

Il faudrait faire des recherches sur Cadxp car je crois bien avoir demande (il y a qq annees)

un Lisp/VLisp qui justement (pour ce probleme) fasse en automatique un PAN

dans toutes les Fenetres de toutes les Presentations

a partir d'un Vecteur (Distance + Rotation) ce qui est largement suffisant ...

 

Je crois que Gilles (gile) ou Bonuscad ou Patrick_35

avait "pondu" un joli programme (comme d'habitude) !

 

Sorry je suis a la bourre complet, et donc je n'ai pas le temps de farfouiller !?

 

Si jamais tu retrouves, SVP tu nous redonnes le progr ou lien

et surtout tu le retestes avec un AutoCAD/MAP 2012/2013

 

Merci d'avance, lecrabe

[lecrabe]

Hello

 

Sorry je n'ai pas pu m'empecher de farfouiller !

 

Par contre je n'ai pas reteste avec un AutoCAD/MAP 2012/2013 ...

 

Donc SVP tu nous tiens au courant, lecrabe

 

PS: Encore Merci a notre irremplacable Gilles !!

 

 


;;;
;;; AUTOPAN par GC - 06/2009
;;; Effectue le panoramique spécfie par deux points ou un deplacement
;;; dans toutes les fenetres des presentations selectionnees
;;;
;;; Version 1.01 avec Integration de la fonction STR2LST + TABORDER 
;;;

(defun c:autopan (/ *error* p1 p2 acdoc layouts ctab vplst vp lock)
 (vl-load-com)

 (defun *error* (msg)
   (or	(= msg "Fonction annulee")
(princ (strcat "\nErreur: " msg))
   )
   (and ctab (vla-put-ActiveLayout acdoc ctab))
   (princ)
 )

 (setq	acdoc	(vla-get-ActiveDocument (vlax-get-acad-object)))
 (while (null
   (setq
     p1	(getpoint
	  "\nSpecifiez le Point de base ou Deplacement: "
	)
   )
 )
   (princ
     "\nNecessite deux Points ou un Deplacement suivi de ENTREE. "
   )
 )
 (if (null (setq
      p2 (getpoint
	   "\nSpecifiez le deuxieme Point: "
	 )
    )
     )
   (setq p2 p1)
   (setq p2 (mapcar '- p2 p1))
 )
 (setq	layouts	(vla-get-Layouts acdoc)
ctab (vla-get-ActiveLayout acdoc)
)
 (foreach l (getlayouts "Presentations a traiter" T)
   (setq vplst nil)
   (vlax-for obj (vla-get-Block (vla-item layouts l))
     (if (= (vla-get-ObjectName obj) "AcDbViewport")
(setq vplst (cons obj vplst))
     )
   )
   (while (cdr vplst)
     (setq vp	  (car vplst)
    vplst (cdr vplst)
    lock  nil
     )
     (if (= (vla-get-DisplayLocked vp) :vlax-true)
(progn
  (vla-put-DisplayLocked vp :vlax-false)
  (setq lock T)
)
     )
     (vla-put-ActiveLayout acdoc (vla-item layouts l))
     (vla-put-MSpace acdoc :vlax-true)
     (vla-put-ActivePViewport acdoc vp)
     (vla-put-Target
vp
(vlax-3d-point
  (mapcar '-
	  (vlax-safearray->list
	    (vlax-variant-value (vla-get-Target vp))
	  )
	  p2
  )
)
     )
     (vla-put-MSpace acdoc :vlax-false)
     (if lock
(vla-put-DisplayLocked vp :vlax-true)
     )
   )
 )
 (vla-put-ActiveLayout acdoc ctab)
 (princ)
)

;; GETLAYOUTS par GC 03/12/07
;; Retourne la liste des présentations choisies dans la boite de dialogue
;;
;; arguments
;; titre : titre de la boite de dialogue ou nil, défauts = Choisir la (ou les) présentation(s)
;; mult : T ou nil (pour choix multiple ou unique)

(defun GetLayouts (titre mult / lay tmp file ret)
 (setq	lay  (vl-sort (layoutlist)
	      (function
		(lambda	(x1 x2)
		  (< (TabOrder x1)
		     (TabOrder x2)
		  )
		)
	      )
     )
tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat
     "GetLayouts:dialog{label="
     (if titre
(vl-prin1-to-string titre)
(if mult
  "\"Choisir les Presentations\""
  "\"Choisir une Presentation\""
)
     )
     ";:list_box{key=\"lst\";multiple_select="
     (if mult
"true;}:row{:retirement_button{label=\"Toutes\";key=\"all\";}
       ok_button;cancel_button;}}"
"false;}ok_cancel;}"
     )
   )
   file
 )
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "GetLayouts" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list lay)
 (end_list)
 (action_tile "all" "(setq ret (reverse lay)) (done_dialog)")
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
    (foreach n (str2lst (get_tile \"lst\") \" \")
    (setq ret (cons (nth (atoi n) lay) ret))))
    (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 (reverse ret)
)

;; STR2LST par GC
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine a transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
       (cons (substr str 1 pos)
         (str2lst (substr str (+ (strlen sep) pos 1)) sep)
       )
       (list str)
 )
)


;; TabOrder par GC
;; Retourne le numéro d'ordre de la présentation 
;; 
;; Argument : le nom de la présentation (chaîne) 
;; 
;; Retour : le numéro d'ordre de la présentation (entier) 

(defun TabOrder (name / dict lay) 
 (setq dict (dictsearch (namedobjdict) "ACAD_LAYOUT")) 
 (if (setq lay (cdr (assoc 350 (member (cons 3 name) dict)))) 
       (cdr (assoc 71 (entget lay))) 
 ) 
) 

[lovecraft]

Hello,

 

Merci pour la recherche (que je n'ai pas faite;( )

 

Je te confirme que cela fonctionne bien sous les versions 2013. Cependant je n'ai pas trouvé le moyen de donner un déplacement uniquement la méthode par deux points.

 

Voili voulou

 

Encore merci pour cette merveille ;)

 

Cordialement,

 

Laurent