Aller au contenu

Exporter 1 présentation en 1 DWG


Messages recommandés

Posté(e)

Salut à tous,

 

Je ne sais pas si la question a déjà été posée, après recherches, j'ai rien trouvé. (j'ai également posé ma question dans la rubrique AutoCAD 2009)

 

Voilà, mon soucis :

 

- J'ai des plans avec xref (Plan de chauffage et ventilation / xref de bâtiment)

 

- Mon plan comporte en espace objet : mon xref et mes différents réseaux.

 

- J'ai 2 présentations en espace papier (donc 1 plan par onglet) respectivement 1 pour les réseaux de chauffage et 1 pour les réseaux de ventilation avec dans chaque fenêtres de présentation, les calques de l'autre présentation gelés dans la fenêtre Chaque plan peu comporter plusieurs fenêtres.

 

Ce que souhaiterai faire, c'est créer 1 fichier DWG par présentation (par onglets) en conservant l'espace objet et l'espace papier mais surtout (et c'est là que cela se complique...) en supprimant les entités de l'espace objet qui ne sont pas visible dans la présentation.

 

Un peu comme la fonction _exportlayout sauf que cette fonction transfert tout le dessin (présentation et objets) dans l'espace objet en mettant le plan à l'échelle de l'espace papier, ce qui ne m'arrange pas vraiment.

 

Voilà, j'espère que quelqu'un aura la solution ;)

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

Salut

 

Un 1er jet

 

(defun c:exl(/ act bdl bou cal cod dbx doc lay lst nom old sel)

 (defun Ouvrir_dessin_dbx(dwg / dbx doc lan rel)
   (and (setq dwg (findfile dwg))
     (progn
(vlax-for doc (vla-get-documents (vlax-get-acad-object))
  (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
    (setq dbx doc lan T)
  )
)
(and (not dbx)
  (setq dbx (vlax-create-object (if (< (setq rel (atoi (getvar "ACADVER"))) 16)
				  "ObjectDBX.AxDbDocument"
				  (strcat "ObjectDBX.AxDbDocument." (itoa rel))
				)
	    )
  )
  (vla-open dbx dwg)
)
     )
   )
   (list dbx lan)
 )

 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (vlax-for cal (vla-get-layers doc)
   (setq bdl (cons (cons cal (vla-get-freeze cal)) bdl))
   (or (= (vla-get-name cal) (getvar "clayer")) (vla-put-freeze cal :vlax-false))
 )
 (vlax-for lay (vla-get-layouts doc)
   (and (/= (setq act (vla-get-name lay)) "Model")
 (ssget "x" (list (cons 0 "viewport") (cons 410 act)))
     (progn
(setq lst nil old nil)
(vla-put-activelayout doc lay)
(vlax-for fen (setq sel (vla-get-activeselectionset doc))
  (vla-getxdata fen "" 'cod 'cal)
  (setq cod (vlax-safearray->list cod)
	cal (vlax-safearray->list cal)
	bou 0
  )
  (while (setq nom (nth bou cal))
    (and (eq (nth bou cod) 1003)
	 (not (member nom lst))
      (setq lst (cons (vlax-variant-value nom) lst))
    )
    (setq bou (1+ bou))
  )
)
(vla-delete sel)
(princ (strcat "\nTraitement pour l'onglet : " act))
(princ)
(ssget "x" (list (cons -4 "")))
(vlax-for ent (setq sel (vla-get-activeselectionset doc))
  (if (member (vla-get-layer ent) lst)
    (setq old (cons ent old))
  )
)
(vla-removeitems sel
		 (vlax-make-variant
		   (vlax-safearray-fill
		     (vlax-make-safearray vlax-vbobject (cons 0 (1- (length old))))
		     old
		   )
		 )
)
(vla-wblock doc (setq nom (strcat (vla-get-path doc) "/" (vl-filename-base (vla-get-name doc)) " - " act ".dwg")) sel)
(vla-delete sel)
(setq dbx (ouvrir_dessin_dbx nom)
      cal (vlax-safearray-fill 
	    (vlax-make-safearray vlax-vbObject '(0 . 0))
	    (list (vla-item (vla-get-layouts doc) act))
	  )
      cod (vla-get-layouts (car dbx))
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-copyobjects (list doc cal cod)))
  (vla-copyobjects doc cal cod)
)
(or (cadr dbx)
  (progn
    (princ " ...Sauvegarde")(princ)
    (vla-saveas (car dbx) nom)
    (vlax-release-object (car dbx))
    (princ "...Ok")(princ)
  )
)
     )
   )
 )
 (foreach cal bdl
   (or (= (vla-get-name (car cal)) (getvar "clayer")) (vla-put-freeze (car cal) (cdr cal)))
 )
 (vla-endundomark doc)
 (princ)
)

 

Il faut utiliser parfois la commande _recover. J'essaye de comprendre pourquoi

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Posté(e)

Je test ça tout de suite et je te dis ce que ça donne.

 

Merci à toi Patrick et à lecarbe pour m'avoir répondu ;)

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

Alors, j'ai essayé et voilà le résultat :

 

C'est presque parfait !!! j'adore.

 

Liste des problèmes rencontrés :

 

1- Parfois, je dois effectivement faire une récupération des dessins créés (pas trop gênant quand on le sais)

 

2- Je retrouve mon cadre et mon cartouche dans l'espace papier (ça c'est impeccable) mais aussi dans l'espace objet (ça c'est moins bon, mais pas trop grave)

 

3- certains calques gelés sont réactivés lors de la création du nouveau fichier. (cela peut devenir gênant car cela modifie mon plan)

---> Peut-être qu'en sauvegardant la configuration des calques on peut résoudre le problème ? je sais pas si c'est faisable en lisp ...

 

4- Les éléments qui n'appartiennent pas au dessin (xrefs, objets) de la présentation exportée sont toujours présents dans l'espace objet du nouveau fichier. (c'est ennuyeux mais pas trop gênant)

 

5- Sur certains fichiers, j'ai un message "Limite supérieure de SAFEARRAYBOUND est plus petite que la limite inférieure." est-ce le nombre de fenêtre fmult qui peut générer ça ? (+ de 2 fenêtres)

 

 

Conclusion :

 

Ton lisp est super, il me dépannera facilement. Par contre, si on pouvait résoudre les différents problèmes rencontrés ce serait une perfection. ;)

 

Par contre, le point 3 est relativement important à mes yeux et demanderait à être résolu car il modifie certains plans créés et c'est pas vraiment le but de la manip.

 

EN TOUT CAS ... MERCI ENORMEMENT !

 

 

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

En aveugle ;)

 

(defun c:exl(/ act bou cal cod dbx doc lay lst nom old sel)

 (defun Ouvrir_dessin_dbx(dwg / dbx doc lan rel)
   (and (setq dwg (findfile dwg))
     (progn
(vlax-for doc (vla-get-documents (vlax-get-acad-object))
  (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
    (setq dbx doc lan T)
  )
)
(and (not dbx)
  (setq dbx (vlax-create-object (if (< (setq rel (atoi (getvar "ACADVER"))) 16)
				  "ObjectDBX.AxDbDocument"
				  (strcat "ObjectDBX.AxDbDocument." (itoa rel))
				)
	    )
  )
  (vla-open dbx dwg)
)
     )
   )
   (list dbx lan)
 )

 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (vlax-for lay (vla-get-layouts doc)
   (and (/= (setq act (vla-get-name lay)) "Model")
 (ssget "x" (list (cons 0 "viewport") (cons 410 act)))
     (progn
(setq lst nil old nil)
(vla-put-activelayout doc lay)
(vlax-for fen (setq sel (vla-get-activeselectionset doc))
  (vla-getxdata fen "" 'cod 'cal)
  (setq cod (vlax-safearray->list cod)
	cal (vlax-safearray->list cal)
	bou 0
  )
  (while (setq nom (nth bou cal))
    (and (eq (nth bou cod) 1003)
	 (not (member nom lst))
      (setq lst (cons (vlax-variant-value nom) lst))
    )
    (setq bou (1+ bou))
  )
)
(vla-delete sel)
(princ (strcat "\nTraitement pour l'onglet : " act))(princ)
(ssget "x" (list (cons 67 0)))
(vlax-for ent (setq sel (vla-get-activeselectionset doc))
  (if (member (vla-get-layer ent) lst)
    (setq old (cons ent old))
  )
)
(vla-removeitems sel
		 (vlax-make-variant
		   (vlax-safearray-fill
		     (vlax-make-safearray vlax-vbobject (cons 0 (1- (length old))))
		     old
		   )
		 )
)
(vla-wblock doc (setq nom (strcat (vla-get-path doc) "/" (vl-filename-base (vla-get-name doc)) " - " act ".dwg")) sel)
(vla-delete sel)
(setq dbx (ouvrir_dessin_dbx nom)
      cal (vlax-safearray-fill 
	    (vlax-make-safearray vlax-vbObject '(0 . 0))
	    (list (vla-item (vla-get-layouts doc) act))
	  )
      cod (vla-get-layouts (car dbx))
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-layouts (car dbx)) act)))
  (vla-add (vla-get-layouts (car dbx)) act)
) 
(vla-copyobjects doc cal cod)
(or (cadr dbx)
  (progn
    (princ " ...Sauvegarde")(princ)
    (vla-saveas (car dbx) nom)
    (vlax-release-object (car dbx))
    (princ "...Ok")(princ)
  )
)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

1) Je pense que c'est résolu

2) ???, si tu as un exemple

3) Normalement, c'est bon

4) ???

5) ???, à voir suivant l'exemle

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Posté(e)

Merci

 

je testerais ça cet après-midi et je te dirais ...

 

Passe moi ton adresse mail en MP pour que je puisse t'envoyer un ou les plans qui "beug"

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

alors, maintenant ça plante.

 

Commande: exl
Régénération de la présentation.
Régénération du modèle.

Traitement pour l'onglet : Chauf
: Erreur Automation Objet effacé
Commande:

 

cela me génère 1 premier fichier avec le dessin en espace objet mais pas la présentation en espace papier.

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

Comme je le disais, en aveugle

 

CA ne va plus planter. Je pensais avoir réglé le problème

 

(defun c:exl(/ act bou cal cod dbx doc lay lst nom old sel)

 (defun Ouvrir_dessin_dbx(dwg / dbx doc lan rel)
   (and (setq dwg (findfile dwg))
     (progn
(vlax-for doc (vla-get-documents (vlax-get-acad-object))
  (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
    (setq dbx doc lan T)
  )
)
(and (not dbx)
  (setq dbx (vlax-create-object (if (< (setq rel (atoi (getvar "ACADVER"))) 16)
				  "ObjectDBX.AxDbDocument"
				  (strcat "ObjectDBX.AxDbDocument." (itoa rel))
				)
	    )
  )
  (vla-open dbx dwg)
)
     )
   )
   (list dbx lan)
 )

 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (vlax-for lay (vla-get-layouts doc)
   (and (/= (setq act (vla-get-name lay)) "Model")
 (ssget "x" (list (cons 0 "viewport") (cons 410 act)))
     (progn
(setq lst nil old nil)
(vla-put-activelayout doc lay)
(vlax-for fen (setq sel (vla-get-activeselectionset doc))
  (vla-getxdata fen "" 'cod 'cal)
  (setq cod (vlax-safearray->list cod)
	cal (vlax-safearray->list cal)
	bou 0
  )
  (while (setq nom (nth bou cal))
    (and (eq (nth bou cod) 1003)
	 (not (member nom lst))
      (setq lst (cons (vlax-variant-value nom) lst))
    )
    (setq bou (1+ bou))
  )
)
(vla-delete sel)
(princ (strcat "\nTraitement pour l'onglet : " act))(princ)
(ssget "x" (list (cons 67 0)))
(vlax-for ent (setq sel (vla-get-activeselectionset doc))
  (if (member (vla-get-layer ent) lst)
    (setq old (cons ent old))
  )
)
(vla-removeitems sel
		 (vlax-make-variant
		   (vlax-safearray-fill
		     (vlax-make-safearray vlax-vbobject (cons 0 (1- (length old))))
		     old
		   )
		 )
)
(vla-wblock doc (setq nom (strcat (vla-get-path doc) "/" (vl-filename-base (vla-get-name doc)) " - " act ".dwg")) sel)
(vla-delete sel)
(setq dbx (ouvrir_dessin_dbx nom)
      cal (vlax-safearray-fill 
	    (vlax-make-safearray vlax-vbObject '(0 . 0))
	    (list (vla-item (vla-get-layouts doc) act))
	  )
      cod (vla-get-layouts (car dbx))
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-layouts (car dbx)) act)))
  (vla-add (vla-get-layouts (car dbx)) act)
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-copyobjects (list doc cal cod)))
  (vla-copyobjects doc cal cod)
)
(or (cadr dbx)
  (progn
    (princ " ...Sauvegarde")(princ)
    (vla-saveas (car dbx) nom)
    (vlax-release-object (car dbx))
    (princ "...Ok")(princ)
  )
)
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Posté(e)

Alors test effectué.

 

Sur les plans pour lesquels j'avais réellement besoin de cette fonction :

 

- IMPECCABLE !! Grand Merci à toi

 

--> Juste 4 détails (qui ne gêne en rien le bon fonctionnement de ce super lisp) pour atteindre la perfection :)

 

- L'onglet "présentation 1" dans les nouveaux DWG créés qui serait à supprimer (c'est clairement un détail ...)

- Certains calques gelés (sur les xrefs) sont réactivé et inversement (surement dû aux xrefs imbriquées) mais le résultat est nickel.

- La récupération nécessaire pour ouvrir certains fichiers. (quand on le sais ...c'est pas gênant, simplement un peu plus long)

- certains éléments inutiles (objets en dehors de la zone de la fenêtre fmult) restent présents dans l'espace objet (mais comme le dessin principal est nickel, c'est pas un soucis)

 

 

Par contre, sur un plan avec 5 ou 6 fenêtres, j'ai toujours le message "Limite supérieure de SAFEARRAYBOUND ...." (c'est pas très grave d'autant que le problème n'est peut-être pas dû à ça ..)

 

En tout cas, je suis super content que tu ais pris de ton temps pour me pondre ce lisp qui va m'ôter une grande épine du pieds.

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)
  Citation
- IMPECCABLE !! Grand Merci à toi

De rien

 

  Citation
--> Juste 4 détails (qui ne gêne en rien le bon fonctionnement de ce super lisp) pour atteindre la perfection :)

Il faut, il faut

 

  Citation
- L'onglet "présentation 1" dans les nouveaux DWG créés qui serait à supprimer (c'est clairement un détail ...)

J'ai essayé, mais quand j'ouvre le dessin avec ObjectDbx, l'onglet "Présentation 1" n'existe pas.

C'est peut-être dû à la récupération.

Tu as une version qui tente de le supprimer s'il existe.

 

  Citation
- Certains calques gelés (sur les xrefs) sont réactivé et inversement (surement dû aux xrefs imbriquées) mais le résultat est nickel.

Le lisp ne touche plus à l'état des calques (gelés ou pas, activé ou pas, etc...)

 

  Citation
- La récupération nécessaire pour ouvrir certains fichiers. (quand on le sais ...c'est pas gênant, simplement un peu plus long)

Je ne comprends pas d'ou cela provient

Je lance un 1er (vla-copyobjects doc cal cod) --> Erreur

Je refais (vla-copyobjects doc cal cod) et cela fonctionne mais avec une récupération pour le dessin.

J'ai tenté une pause, le temps que wbloc soit terminé, une ouverture, puis fermeture du dessin, puis une ouverture et recopie de l'onglet. Le résultat est le même :o

Une chose m'échappe.

 

  Citation
- certains éléments inutiles (objets en dehors de la zone de la fenêtre fmult) restent présents dans l'espace objet (mais comme le dessin principal est nickel, c'est pas un soucis)

Ben oui, je fais la sélection dans l'espace objet, regarde les calques gelés dans l'onglet et élimine de la sélection les objets qui doivent être gelés.

 

  Citation
Par contre, sur un plan avec 5 ou 6 fenêtres, j'ai toujours le message "Limite supérieure de SAFEARRAYBOUND ...." (c'est pas très grave d'autant que le problème n'est peut-être pas dû à ça ..)

Je n'ai jamais eu ce message. Je t'ai indiqué mes adresses mail par MP.

 

  Citation
En tout cas, je suis super content que tu ais pris de ton temps pour me pondre ce lisp qui va m'ôter une grande épine du pieds.

Il reste plus qu'à envoyer la bouteille :D

Avec des bulles :cool: (évite le Perrier ^^)

 

(defun c:exl(/ act bou cal cod dbx def doc lay lst nom old sel)

 (defun Ouvrir_dessin_dbx(dwg / dbx doc lan rel)
   (and (setq dwg (findfile dwg))
     (progn
(vlax-for doc (vla-get-documents (vlax-get-acad-object))
  (and (eq (strcase (vla-get-fullname doc)) (strcase dwg))
    (setq dbx doc lan T)
  )
)
(and (not dbx)
  (setq dbx (vlax-create-object (if (< (setq rel (atoi (getvar "ACADVER"))) 16)
				  "ObjectDBX.AxDbDocument"
				  (strcat "ObjectDBX.AxDbDocument." (itoa rel))
				)
	    )
  )
  (vla-open dbx dwg)
)
     )
   )
   (list dbx lan)
 )

 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object))
def (vla-get-activelayout doc)
 )
 (vla-startundomark doc)
 (acad-push-dbmod)
 (vlax-for lay (vla-get-layouts doc)
   (and (/= (setq act (vla-get-name lay)) "Model")
 (ssget "x" (list (cons 0 "viewport") (cons 410 act)))
     (progn
(setq lst nil old nil)
(vla-put-activelayout doc lay)
(vlax-for fen (setq sel (vla-get-activeselectionset doc))
  (vla-getxdata fen "" 'cod 'cal)
  (setq cod (vlax-safearray->list cod)
	cal (vlax-safearray->list cal)
	bou 0
  )
  (while (setq nom (nth bou cal))
    (and (eq (nth bou cod) 1003)
	 (not (member nom lst))
      (setq lst (cons (vlax-variant-value nom) lst))
    )
    (setq bou (1+ bou))
  )
)
(vla-delete sel)
(princ (strcat "\nTraitement pour l'onglet : " act))(princ)
(ssget "x" (list (cons 67 0)))
(vlax-for ent (setq sel (vla-get-activeselectionset doc))
  (if (member (vla-get-layer ent) lst)
    (setq old (cons ent old))
  )
)
(vla-removeitems sel
		 (vlax-make-variant
		   (vlax-safearray-fill
		     (vlax-make-safearray vlax-vbobject (cons 0 (1- (length old))))
		     old
		   )
		 )
)
(vla-wblock doc (setq nom (strcat (vla-get-path doc) "/" (vl-filename-base (vla-get-name doc)) " - " act ".dwg")) sel)
(vla-delete sel)
(setq dbx (ouvrir_dessin_dbx nom)
      cal (vlax-safearray-fill 
	    (vlax-make-safearray vlax-vbObject '(0 . 0))
	    (list (vla-item (vla-get-layouts doc) act))
	  )
      cod (vla-get-layouts (car dbx))
)
(vlax-for sel (vla-get-layouts (car dbx))
  (or (member (vla-get-name sel) (list "Model" act))
    (vla-delete sel)
  )
)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-copyobjects (list doc cal cod)))
  (vla-copyobjects doc cal cod)
  (vlax-for sel (vla-get-layouts (car dbx))
    (or (member (vla-get-name sel) (list "Model" act))
      (vla-delete sel)
    )
  )
)
(or (cadr dbx)
  (progn
    (princ " ...Sauvegarde")(princ)
    (vla-saveas (car dbx) nom)
    (vlax-release-object (car dbx))
    (princ "...Ok")(princ)
  )
)
     )
   )
 )
 (vla-put-activelayout doc def)
 (acad-pop-dbmod)
 (vla-endundomark doc)
 (princ)
)

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Posté(e)

- Le code ci-dessus est une nouvelle mouture ? si oui t'as modifié quoi ?

 

- pour le mp j'ai rien reçu :casstet:

 

Pour la bouteille, un coca ça va ? :thumbup: :thumbup: :thumbup:

 

 

 

[Edité le 21/12/2009 par neptune38]

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)
  Citation
- Le code ci-dessus est une nouvelle mouture ? si oui t'as modifié quoi ?

1) Si le dessin est juste ouvert, le fait de lancer le lisp permet maintenant de quitter le dessin sans que la question de la sauvegarde soit posé

2) Si le 1er (vla-copyobjects doc cal cod) est bien passé, tentative de supprimer l'onglet "Présentation 1"

3) Suppression de la tentative de création de l'onglet en cours (je pensais que c'était cela qui faisait planter mon 1er (vla-copyobjects doc cal cod))

 

  Citation
- pour le mp j'ai rien reçu :casstet:

C'est repartit

 

  Citation
Pour la bouteille, un coca ça va ? :thumbup: :thumbup: :thumbup:

Tu la boiras avec tes enfants à ma santé :D

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Posté(e)

merci patrick

 

je testerais cet après-midi ;)

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

Je viens de tester la dernière mouture :

 

1) quitter le dessin d'origine sans sauvegarder : ça marche

2) suppression de l'onglet présentation 1 : rien de changé (c'est pas important de toute façon)

 

pour le MP apparemment ça marche pas, je t'en envoie un pour voir.

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

Salut,

 

Je n'ai pas suivi ce fil en détail, mais concernant la suppression de "Présentation1" il me semble que ce n'est pas possible.

Si on supprime toutes les présentations d'un dessin, AutoCAD recrée automatiquement une présentation (il lui faut un espace objet et un espace papier).

Gilles Chanteau - gileCAD - GitHub
Développements sur mesure pour AutoCAD

Posté(e)

La classe !

 

J'ai maintenant 2 stars du lisp en action, vous me gâtez les gars :D

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

Posté(e)

Salut

 

La dernière version

 

;;;=================================================================
;;;
;;; EXL.LSP V1.02
;;;
;;; Exporter des Présentations
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun c:exl(/	act bou cal cod dbx def doc fen lay liste_lay lst lst_base nom obj res sel val
	bda)

 (defun bda (titre lst / dcl fic fil res txt val)
   (setq fic (vl-filename-mktemp "exl" nil ".dcl")
  fil (open fic "w")
   )
   (foreach txt '(	"exl : dialog {"
		"  key = \"titre\";"
		"  alignment = centered;"
		"  is_cancel = true;"
		"  allow_accept = true;"
		"  width = 50;"
		"  : list_box {label= \"Sélection\"; key=\"sel\"; height = 20; multiple_select=true;}"
		"  spacer;"
		"  ok_cancel;"
		"}"
	 )
     (write-line txt fil)
   )
   (close fil)
   (setq dcl (load_dialog fic))
   (new_dialog "exl" dcl "")
   (set_tile "titre" titre)
   (start_list "sel")
   (mapcar 'add_list lst)
   (end_list)
   (action_tile "sel"    "(setq val $value)")
   (action_tile "accept" "(done_dialog 1)")
   (action_tile "cancel" "(done_dialog 0)")
   (setq res (start_dialog))
   (unload_dialog dcl)
   (vl-file-delete  fic)
   (list res val)
 )

 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object))
def (vla-get-activelayout doc)
bou 1
 )
 (vla-startundomark doc)
 (acad-push-dbmod)
 (vlax-for lay (vla-get-layouts doc)
   (setq lst_base (cons (cons (vla-get-taborder lay) lay) lst_base ))
 )
 (while (assoc bou lst_base)
   (setq liste_lay (cons (vla-get-name (cdr (assoc bou lst_base))) liste_lay )
  bou (1+ bou)
   )
 )
 (and (= (car (setq res (bda "Exl 1.02" (reverse liste_lay)))) 1)
      (setq res (cadr res))
   (while (not (eq res ""))
     (setq lst nil
    obj nil
    val (read res)
    lay (cdr (assoc (1+ val) lst_base))
    act (vla-get-name lay)
     )
     (and (ssget "x" (list (cons 0 "viewport") (cons 410 act)))
(progn
  (princ (strcat "\nTraitement pour l'onglet : " act))(princ)
  (vlax-for fen (setq sel (vla-get-activeselectionset doc))
    (vla-getxdata fen "" 'cod 'cal)
    (setq cod (vlax-safearray->list cod)
	  cal (vlax-safearray->list cal)
	  bou 0
    )
    (while (setq nom (nth bou cal))
      (and (eq (nth bou cod) 1003)
	   (not (member nom lst))
	(setq lst (cons (vlax-variant-value nom) lst))
      )
      (setq bou (1+ bou))
    )
  )
  (vla-delete sel)
  (setq dbx (vlax-create-object (if (< (setq rel (atoi (getvar "ACADVER"))) 16)
				  "ObjectDBX.AxDbDocument"
				  (strcat "ObjectDBX.AxDbDocument." (itoa rel))
				)
	    )
  )
  (ssget "x" (list (cons 67 0)))
  (vlax-for ent (setq sel (vla-get-activeselectionset doc))
    (or (member (vla-get-layer ent) lst)
      (setq obj (cons ent obj))
    )
  )
  (vla-delete sel)
  (vla-copyobjects doc
		   (vlax-make-variant
		     (vlax-safearray-fill
		       (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj))))
		       obj
		     )
		   )
		   (vla-get-modelspace dbx)
  )
  (vla-copyobjects doc
		   (vlax-make-variant
		     (vlax-safearray-fill
		       (vlax-make-safearray vlax-vbobject (cons 0 0))
		       (list lay)
		     )
		   )
		   (vla-get-layouts dbx)
  )
  (vla-saveas dbx (setq nom (strcat (vla-get-path doc) "/" (vl-filename-base (vla-get-name doc)) " - " act ".dwg")))
  (vlax-release-object dbx)
  (setq dbx (vla-open (vla-get-documents (vlax-get-acad-object)) nom))
  (vlax-for ent (vla-get-layouts dbx)
    (cond
      ((eq (vla-get-name ent) act)
	(vla-put-activelayout dbx ent)
      )
      ((/= (vla-get-name ent) "Model")
	(vla-delete ent)
      )
    )
  )
  (vla-close dbx :vlax-true)
)
     )
     (setq res (substr res (+ 2 (strlen (itoa val))) (strlen res)))
   )
   (alert "Traitement des onglets terminés.")
 )
 (acad-pop-dbmod)
 (vla-endundomark doc)
 (princ)
)

(setq nom_lisp "EXL")
(if (/= app nil)
 (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
   (princ (strcat "..." nom_lisp " chargé."))
   (princ (strcat "\n" nom_lisp ".LSP Chargé.....Tapez " nom_lisp " pour l'éxecuter.")))
 (princ (strcat "\n" nom_lisp ".LSP Chargé......Tapez " nom_lisp " pour l'éxecuter.")))
(setq nom_lisp nil)
(princ)

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Posté(e)

Cette version est géniale !!!

 

Merci Patrick pour le développement de cette appli ;)

 

Elle a été testé et modifié plusieurs fois dans la journée d'hier et tous les changements sont nickels, pas de problèmes rencontrés.

 

Super réactif patrick ;)

 

 

Pour résumer :

 

 

EXL

 

Fonction : exporte les présentations (onglets) de vos dessins et crée 1 fichier dwg par onglet.

 

Caractéristiques:

 

- Sélection possible des onglets que l'on souhaite exporter.

- 1 Seul onglet ar dessin créé

- Les fichiers créés, sont nommés comme suit --> Nom du DWG d'origine + Nom de l'onglet.dwg

- Le dessin original n'est pas modifié

 

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

  • 2 semaines après...
Posté(e)

salut,

 

patrick, je suppose qu'il veux inserer l'xref dans les dwg exportés afin que les nouveaux dessins créés par ton lisp n'aient plus d'xref.

 

[Edité le 5/1/2010 par neptune38]

Raph.

Celui qui pose une question est bête 5 minutes, celui qui n'en pose pas l'est toute sa vie !

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
×
×
  • 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é