copie d\'entites d\'une presentations a d\'autres presentations a la volée

PHILPHIL · le 14 octobre 2009

hello

est ce qu'il y a moyen de faire des copies d'objets/entites d'une presentations a d'autres presentations

en selectionnant les entites dans la prensetation

le point de base

la liste des presentations d'arrivées

le point d'arrivée commun a chaque presentaion

sans que l'on est a ouvrir les presentations

mouai

j'espere que seven et AA2011 seront plus réactif

bonne soirée

a+

phil

zebulon_ · le 15 octobre 2009

Bonjour,

le fichier DupObjPres.dcl

DupObj : dialog {
        label = "Dupliquer Objets Présentations";
          : button {
            label = "Sélectionner objets <";
            key = DupObjSS;
            is_default = true;
          }
          : list_box {
            label = "Présentations";
            key = DupObjPre;
            multiple_select = true;
          }
          ok_cancel;
        }

le fichier DupObjPres.lsp

(defun do_accpet_dupobj ()
 (if (= ss nil)
   (alert "Aucun objet sélectionné")
   (if (= LPRE "")
     (alert "Aucune présentation sélectionnée")
     (done_dialog 2)
   )
 )
)

(defun c:DupObjPres (/ LLAY LPRE dcl_id what_next ss CURTAB PRE NOM_PRE)
 (vl-load-com)
 (if (zerop (getvar "TILEMODE"))
   (progn
     (setq LLAY (layoutlist))  
     (setq LPRE "")
     ;; supprimer le layout courant de la liste
     (setq LLAY (vl-remove-if '(lambda(x) (= x (getvar "CTAB"))) LLAY))

     ;ouverture de la boîte de dialogue
     (setq dcl_id (load_dialog "DupObjPres.dcl"))
     (setq what_next 5)
     (while (< 2 what_next)
       (if (not (new_dialog "DupObj" dcl_id)) (exit))

       (start_list "DupObjPre")
         (mapcar 'add_list LLAY)
       (end_list)

       (set_tile "DupObjPre" LPRE)

       (action_tile "DupObjPre" "(setq LPRE $value)")
       (action_tile "DupObjSS" "(done_dialog 5)")
       (action_tile "accept" "(do_accpet_dupobj)")
       (action_tile "cancel" "(done_dialog 0)")

       (setq What_next (start_dialog))
       (cond
         ((= what_next 5) (setq ss (ssget)))
       )
     ) ; while
     (if (= What_next 2)
       (progn
          (command "_CopyBase" "_non" '(0 0) ss "")
          (setq CURTAB (getvar "CTAB"))
          (setq LPRE (read (strcat "(" LPRE ")")))
          (foreach PRE LPRE
            (setq NOM_PRE (nth PRE LLAY))
            (setvar "CTAB" NOM_PRE)
            (command "_PSPACE")
            (command "_PasteClip" "_non" '(0 0))
          )
          (setvar "CTAB" CURTAB)
       )
     )
   )
   (alert "Uniquement en espace papier")
 )
 (princ)
)

en passant par des copier/coller

Amicalement

Vincent

PHILPHIL · le 15 octobre 2009

hello

zebulon merci beaucoup pour ton LISP

je viens de tester et pas de souci

j'ai pas eu le temps de voir s'il faisait une regeneration de(s) fenetre(s) par contre

je verrai si je trouve le moyen de les geler pour qu'il n'est pas faire la regeneration histoire que ca aille plus vite

merci bcp

a+

bonne journée

phil

Patrick_35 · le 15 octobre 2009

Salut Zeb

J'ai regardé ton lisp et j'aurai trois suggestions

La 1er est que l'on peut copier des objets en EO alors que l'on est en EP (cvport <> 1)

La seconde est que tu peux faire une copie des objets sur eux-même et changer la sélection de présentation en modifiant le code dxf 410

Et la troisième est que tu peux éviter une boucle

(vl-remove-if '(lambda(x) (= x (getvar "CTAB"))) LLAY)

par

(vl-remove (getvar "CTAB") LLAY)

@+

zebulon_ · le 15 octobre 2009

vl-remove, bien sûr...

J'avais essayé en faisant un entmake après avoir modifié le code dxf 410 et ça marchait super bien, sauf pour les entités complexes.

Tu proposes une copie d'abord puis un changement du code dxf. C'est vrai que c'est pas pareil et je m'en vais essayer.

Amicalement

Vincent

zebulon_ · le 15 octobre 2009

J'ai essayé de faire un entmod sur le code dxf 410, mais cela ne fonctionne pas

Commande: (setq a (entget e))
((-1 . ) (0 . "LINE") (330 . )
(5 . "143") (100 . "AcDbEntity") (67 . 1) (410 . "Présentation1") (8 . "1")
(100 . "AcDbLine") (10 46.0 38.3771 0.0) (11 160.538 117.677 0.0) (210 0.0 0.0
1.0))

(setq a (subst (cons 410 "Présentation2") (assoc 410 a) a))

me donne

((-1 . ) (0 . "LINE") (330 . )
(5 . "143") (100 . "AcDbEntity") (67 . 1) (410 . "Présentation2") (8 . "1")
(100 . "AcDbLine") (10 46.0 38.3771 0.0) (11 160.538 117.677 0.0) (210 0.0 0.0
1.0))

Le code 410 est bien changé avec un nom de présentation qui existe, mais quand je fais un (entmod a), rien ne se passe.

Qu'est ce que je fais de travers ?

Amicalement

Vincent

PHILPHIL · le 15 octobre 2009

hello

et en visual lisp comment on recupere l'information du nom de la presentation pour une entité ??

le code dxf 410 c'est tres clair mais en visual lips ca devient usine a gazz

a+

phil

bonuscad · le 15 octobre 2009

Le code 410 est bien changé avec un nom de présentation qui existe, mais quand je fais un (entmod a), rien ne se passe.

Pourquoi faire un (entmod) ?? Tu veux faire une copie pas un déplacement d'objet d'une présentation à une autre.

En plus je suis pas sur que (entmod) soit la méthode approprié pour faire ce genre de changement.

Fait plutôt un (entmake) qui sera une copie de ton objet.

Tu peux faire par exemple un:

(foreach n '(-1 330 5) (setq dxf_cod (vl-remove (assoc n dxf_cod) dxf_cod))), après avoir fait ton (subst) sur 410, pour éliminer les noms d'entités et leur handle et soumettre cette dernière à (entmake)

zebulon_ · le 16 octobre 2009

Bonjour,

j'avais essayé de soumettre à entmake (voir message plus haut) et cela marche très bien pour des entités simples, mais pour des objets plus complexes comme des blocs avec des attributs cela se plante.

C'est pour ça que je suis passé par le presse papier, faute d'avoir trouvé un autre moyen. D'ailleurs, quand je fait cette opération de duplication entre différentes présentation "à la main", j'utilise aussi le copier/coller.

Comme le suppose PHILPHIL, il doit y avoir un moyen plus rapide que cela avec vlisp avec une méthode de copie ou quelque chose du genre.

A voir si quelqu'un peut éclairer notre lanterne

Amicalement

Vincent

bonuscad · le 16 octobre 2009

pour des objets plus complexes comme des blocs avec des attributs cela se plante.

Utilises (entnext) !

Un exemple vite fait, donc un peu brouillon (à adapter à ton code)

((lambda ( / )
(setq js (ssget (list '(-4 . "") '(-4 . "AND>"))) n -1)
(cond
	(js
		(while (setq en (ssname js (setq n (1+ n))))
			(setq dxf_cod (entget en))
			(foreach n '(-1 330 5) (setq dxf_cod (vl-remove (assoc n dxf_cod) dxf_cod)))
			(setq dxf_cod (subst (cons 410 [color=red]"Présentation2"[/color]) (assoc 410 dxf_cod) dxf_cod))
			(entmake dxf_cod)
			(if (member (cdr (assoc 0 dxf_cod)) '("POLYLINE" "INSERT"))
				(progn
					(while (/= (cdr (assoc 0 (setq dxf_cod (entget (setq en (entnext en)))))) "SEQEND")
						(foreach n '(-1 -2 330 347 5) (setq dxf_cod (vl-remove (assoc n dxf_cod) dxf_cod)))
						(setq dxf_cod (subst (cons 410 [color=red]"Présentation2"[/color]) (assoc 410 dxf_cod) dxf_cod))
						(entmake dxf_cod)
					)
					(foreach n '(-1 -2 330 347 5) (setq dxf_cod (vl-remove (assoc n dxf_cod) dxf_cod)))
					(setq dxf_cod (subst (cons 410 [color=red]"Présentation2"[/color]) (assoc 410 dxf_cod) dxf_cod))
					(entmake dxf_cod)
				)
			)
		)
	)
)
))

[Edité le 16/10/2009 par bonuscad]

Patrick_35 · le 16 octobre 2009

Salut

Bonus a raison.

Après plusieurs test, je n'ai pas trouvé comment changer un objet de layout, aussi bien en autolisp qu'en visual.

C'était trop simple avec le 410 :(

Bonus

Un peu plus simple pour supprimer des codes dxf ;)

(vl-remove-if '(lambda(x) (member (car x) '(-1 -2 330 347 5))) dxf_cod)

@+

sergio · le 15 février 2017

Bonjour à tous,

Je sais que je fais remonter un vieux dossier mais j'ai besoin de votre aide...

Lorsque que je lance ce lisp avec DupObjPres j'ai un message d'erreur qui apparaît:

; erreur: quitter / sortir abandon

J'ai essayé de résoudre le problème mais mon niveau est... nul :)

J'ai fait une recherche pour comprendre l’erreur et j'obtiens ceci:

Commande: DUPOBJPRES
Analyse rétrospective:
[0.46] (VL-BT)
[1.42] (*ERROR* "quitter / sortir abandon")
[2.37] (_call-err-hook #<SUBR @0000000049b33610 *ERROR*> "quitter / sortir abandon")
[3.31] (sys-error "quitter / sortir abandon")
:ERROR-BREAK.26 "quitter / sortir abandon"
[4.23] (EXIT)
[5.19] (C:DUPOBJPRES)
[6.15] (#<SUBR @0000000049df6a98 -rts_top->)
[7.12] (#<SUBR @00000000352a0700 veval-str-body> "(C:DUPOBJPRES)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)

Je ne sais pas si ça pourra vous aider à m'en sortir.

Voila je n'est pas les capacités pour résoudre mon problème mais ce lisp pourrai me faire gagner beaucoup de temps.

Je suis projeteur méthodes et je vous laisse imaginer le nombre de présentations que je peux avoir dans mes carnets...

Pour info je suis sous autocad 2016.

Merci à tous.

(gile) · le 15 février 2017

Salut,

l'erreur est due au fait que le LISP ne trouve pas le fichier "DupObjPres.dcl" parce qu'il n'est pas dans répertoire des chemins de recherche (ou que ce fichier ne définit pas de boite de dialog nommés "DupObj", mais ce n'est pas le cas ici).

Dans les expressions suivantes,

- la première charge le fichier "DupObjPres.dcl", s'il n'est pas trouvé dcl_id aura une valeur négative ;

- la seconde initialise la boite de dialogue "DupObj" et retourne nil si dcl_id est négatif ou si "DopObj" n'est pas trouvé dans le fichier (DupObj : dialog ...).

Les fonctions (exit) ou (quit) permettent d'arrêter l'exécution du LISP, ce qui génère une erreur LISP dont le message est "quitter / sortir abandon".

(setq dcl_id (load_dialog "DupObjPres.dcl"))
...
(if (not (new_dialog "DupObj" dcl_id)) (exit))

sergio · le 15 février 2017

Je suis à 99.9% sûr que c'est moi le boulet...

Je n'est pas saisi la totalité de votre réponse mais j'ai compris que le lisp ne trouvait pas son fichier.dcl.

J'ai pris l'habitude (mauvaise peut être) de renommé les fichiers lisp pour ne pas oublier à quoi ils servent quand je les utilise occasionnellement. Les lisp fonctionnent, sauf ceux qui on un fichier.dcl en commun je présume. Du coup j'ai renommé les fichiers correctement et maintenant il fonctionne très bien.

Un grand merci, le sujet est résolu.

Dorénavant j'écrirai un commentaire dans le lisp pour ne pas oublier leur utilité.

Encore merci pour votre réactivité.

Et en général merci à tout ceux qui contribuent au développement des lisp qui nous arrangent bien la vie...

(Je déplacerai si nécessaire)

Une question hors sujet, certaine LISP exécutent des taches en "arrière plan", type "VERR" "UNVERR" "MPL" et d'autres activent toutes les présentations les unes après les autres, comme celle-ci ou un autre que j'ai "ZALL" (qui exécute un zoom étendu sur toutes les présentations).

Est-il possible que DupObjPres.lsp fasse son travail sans défiler toutes les présentations?

Cordialement,

Sergio

PHILPHIL · le 15 février 2017

hello Sergio

un Lisp de Gile ou / et de Bryce

qui travail en arriere plan

a+

Phil

(defun c:cpp (/ acdoc layouts
;;;              selectedlayouts
             *error* lay ss sa) ; Bryce, janvier 2012
; Copie les objets sélectionnés dans les présentations choisies.
 (vl-load-com)
 (setq layouts (vla-get-layouts
                 (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
               )
 )
 (defun *error* (msg)
   (and msg
        (or (member (strcase msg)
                    '("FUNCTION CANCELLED"
                      "QUIT / EXIT ABORT"
                      "FONCTION ANNULEE"
                      "QUITTER / SORTIR ABANDON"
                     )
            )
            (princ (strcat "\nErreur : " msg))
        )
   )
   (if ss
     (setq ss nil)
   )
   (vla-endundomark acdoc)
   (princ)
 )
 (vla-startundomark acdoc)
 (or (and (/= (getvar 'ctab) "Model") (= (getvar 'cvport) 1))
     (progn (princ "\n** Commande non autorisée dans l'espace Objet**")
            (quit)
     )
 )
 (if (and (or (setq ss (cadr (ssgetfirst))) (setq ss (ssget)))
          (setq sa (bs:ss2safearray ss))
     )
   (progn (setq selectedlayouts (bs:getotherlayouts nil t))
;;;(setq test42 selectedlayouts)
     (foreach lay selectedlayouts
            (vla-copyobjects acdoc
                             sa
                             (vla-get-block (vla-item layouts lay))
            )
          ) ; foreach
          (princ "\nCopie effectuée !")
   )
 ) ;if ssget
 (*error* nil)
) ;cpp

(princ "\nCommande à utiliser: CPP")
(princ)


;; BS:GETOTHERLAYOUTS Bryce 19/01/2012
;; basé sur GETLAYOUTS (gile) 03/12/07
;;
;; Retourne la liste des présentations choisies dans la boite de dialogue
;; La présentation active n'est pas proposée.
;;
;; 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 bs:GetOtherLayouts (titre mult / lay tmp file ret)
 (setq	lay  (vl-sort (vl-remove (getvar 'CTAB) (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 présentations\""
  "\"Choisir une présentation\""
)
     )
     ";:list_box{height = 80;key=\"lst\";multiple_select="
     (if mult
"true;width = 80;}: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)
)

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

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

(defun bs:ss2safearray (sset / i entlst) ; Bryce
 (setq i 0)
 (repeat (sslength sset)
   (setq entlst (cons (vlax-ename->vla-object (ssname sset i)) entlst))
   (setq i (1+ i))
 )
 (vlax-safearray-fill (vlax-make-safearray vlax-vbobject
                                           (cons 0 (1- (length entlst)))
                      )
                      entlst
 )
)

sergio · le 16 février 2017

Salut PHILPHIL,

Je viens de tester et ça marche nikel! :D

Merci

A+

Connexion

copie d\'entites d\'une presentations a d\'autres presentations a la volée

Messages recommandés

PHILPHIL

zebulon_

PHILPHIL

Patrick_35

zebulon_

zebulon_

PHILPHIL

bonuscad

zebulon_

bonuscad

Patrick_35

sergio

(gile)

sergio

PHILPHIL

sergio

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante