CADxp: Imprimer liste de Folio (Lisp de Bred) - CADxp

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

Imprimer liste de Folio (Lisp de Bred)

#1 L'utilisateur est hors-ligne   bbteddy 

  • ceinture verte
  • Groupe : Membres
  • Messages : 55
  • Inscrit(e) : 16-avril 04

Posté 10 avril 2009 - 07:15

Bonjour à vous tous !!!
Et étant donner que je le dit pas assez merci pour toutes les réponse que j'ai pu trouver à vos cotés.

Petit message pour Bred en particulier car le code lisp que j'ai trouvé vient de lui.

En fait je souhaite rai une petite amélioration par rapport à mon utilisation, je m'explique :
- Ce lisp imprime les blocs identiques d'une sélection.
- Je souhaiterai si possible que les blocs soient imprimés dans un ordre bien définit par un numéros qui correspond à la variable attribut "FOLIO" qui est tout simplement mon numéros de page.

Voici une copie du code de BRED (c'est du chinois pour moi :cool: )

Je vous remercie par avance
@bientôt

Citation

; imprime tous les cadre/bloc identique d'un page - par BRED -

(defun c:impt (/ ACDOC B BACKGROUNDPLOT C I P1 P2 SEL XMIN YMAX PLT)

(vl-load-com)

(while (not sel)

(setq sel (car (entsel "\n Choix du cadre (Bloc) :")))

(if sel

(if (not (equal (vla-get-ObjectName (setq b (vlax-ename->vla-object sel))) "AcDbBlockReference"))

(setq sel nil)))

)

(setq sel (ssget '((0 . "INSERT")))

AcDoc (vla-get-activedocument (vlax-get-acad-object))

BACKGROUNDPLOT (getvar "BACKGROUNDPLOT"))

(setvar "BACKGROUNDPLOT" 0)

(repeat (setq i (sslength sel))

(if (equal (vla-get-effectivename (setq c (vlax-ename->vla-object (ssname sel (setq i (1- i))))))

(vla-get-effectivename b))

(progn

(vla-GetBoundingBox c 'xmin 'ymax)

(setq p1 (vlax-make-safearray vlax-vbdouble (cons 0 1))

p2 (vlax-make-safearray vlax-vbdouble (cons 0 1)))

(vlax-make-variant

(vlax-safearray-fill p1 (list (car (vlax-safearray->list xmin)) (cadr (vlax-safearray->list xmin)))))

(vlax-make-variant

(vlax-safearray-fill p2 (list (car (vlax-safearray->list ymax)) (cadr (vlax-safearray->list ymax)))))

(if (> (- (car (vlax-safearray->list ymax)) (car (vlax-safearray->list xmin)))

(- (cadr (vlax-safearray->list ymax)) (cadr (vlax-safearray->list xmin))))

(vla-put-PlotRotation (vla-get-activelayout AcDoc) ac90degrees)

(vla-put-PlotRotation (vla-get-activelayout AcDoc) ac0degrees))

(setq plt (vla-get-plot AcDoc))

(vla-put-PlotType (vla-get-activelayout AcDoc) acWindow)

(vla-setwindowtoplot (vla-get-activelayout AcDoc) p1 p2)

(vla-plottodevice plt (vla-get-configname (vla-get-activelayout AcDoc)))

)

)

)

(setvar "BACKGROUNDPLOT" BACKGROUNDPLOT)

(princ)

)


:cool:
0

#2 L'utilisateur est hors-ligne   Bred 

  • ceinture noire 5em dan
  • Groupe : Membres
  • Messages : 2720
  • Inscrit(e) : 07-mars 06
  • LocationAntibes

Posté 10 avril 2009 - 19:15

Salut,
test ça
c'est encore du bricolage.... mais ça devrais fonctionner...

Enlèves l'espace dans la partie en gras

; imprime tous les cadre/bloc identique d'un page - par BRED -

; bloc ayant un attribut "folio" = numéro de page

(defun c:imptfolio (/ ACDOC B BACKGROUNDPLOT C I P1 P2 SEL XMIN YMAX PLT lst-att

		    LST LST-F LST-NB Y)

  (vl-load-com)


  (while (not sel)

    (setq sel (car (entsel "\n Choix du cadre (Bloc) :")))


    (if sel

      (if (not (equal (vla-get-ObjectName (setq b (vlax-ename->vla-object sel))) "AcDbBlockReference"))

	(setq sel nil)))

    )

  (setq sel (ssget '((0 . "INSERT")))

	AcDoc (vla-get-activedocument (vlax-get-acad-object))

	BACKGROUNDPLOT (getvar "BACKGROUNDPLOT"))


  (setvar "BACKGROUNDPLOT" 0)


  ; Récupère Attrib "FOLIO"

  (repeat (setq i (sslength sel))

    (if (equal (vla-get-effectivename (setq c (vlax-ename->vla-object (ssname sel (setq i (1- i))))))

	       (vla-get-effectivename b))


      (if (setq lst-att (vlax-safearray->list (vlax-variant-value (vla-GetAttributes c))))

	(repeat (setq y (length lst-att))

	  (if (equal (strcase (vla-get-TagString (nth (setq y (1- y)) lst-att))) "FOLIO")

	    (setq lst-F (append (list (cons (atoi (vla-get-TextString (nth y lst-att))) c))  lst-F)

		  lst-nb (append (list (atoi (vla-get-TextString (nth y lst-att)))) lst-nb))

	    )	  )	)      )

    )


  ; Tri

  (setq lst-nb (vl-sort lst-nb [surligneur] [b]'< )[/b][/surligneur] 

	i 0)

  (repeat (length lst-nb)

    (setq lst (append lst (list (cdr (assoc (nth i lst-nb) lst-F))))

	  i (1+ i))

    )


  ; trite liste bloc

  (setq i 0)

  (repeat (length lst)

    (setq c (nth i lst)

	  i (1+ i))


    (vla-GetBoundingBox c 'xmin 'ymax)

    (setq p1 (vlax-make-safearray vlax-vbdouble (cons 0 1))

	  p2 (vlax-make-safearray vlax-vbdouble (cons 0 1)))


    (vlax-make-variant

      (vlax-safearray-fill p1 (list (car (vlax-safearray->list xmin)) (cadr (vlax-safearray->list xmin)))))

    (vlax-make-variant

      (vlax-safearray-fill p2 (list (car (vlax-safearray->list ymax)) (cadr (vlax-safearray->list ymax)))))


    (if (> (- (car (vlax-safearray->list ymax)) (car (vlax-safearray->list xmin)))

	   (- (cadr (vlax-safearray->list ymax)) (cadr (vlax-safearray->list xmin))))

      (vla-put-PlotRotation (vla-get-activelayout AcDoc) ac90degrees)

      (vla-put-PlotRotation (vla-get-activelayout AcDoc) ac0degrees))


    (setq plt (vla-get-plot AcDoc))

    (vla-put-PlotType (vla-get-activelayout AcDoc) acWindow)

    (vla-setwindowtoplot (vla-get-activelayout AcDoc) p1 p2)

    (vla-plottodevice plt (vla-get-configname (vla-get-activelayout AcDoc)))

    )

  (setvar "BACKGROUNDPLOT" BACKGROUNDPLOT)

  (princ)

)


[Edité le 10/4/2009 par Bred]
Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...
0

#3 L'utilisateur est hors-ligne   bbteddy 

  • ceinture verte
  • Groupe : Membres
  • Messages : 55
  • Inscrit(e) : 16-avril 04

Posté 11 avril 2009 - 07:11

Bonjour
Merci pour la réponse je test ca mardi à la première heure !!!

Bon weekend Pascal.
0

#4 L'utilisateur est hors-ligne   lili2006 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11508
  • Inscrit(e) : 21-décembre 05

Posté 11 avril 2009 - 09:19

Bonjour à toutes et tous,

J'ai testé =>

Citation

Commande: imptfolio
Choix du cadre (Bloc) :
Choix des objets: 1 trouvé(s)
Choix des objets: 1 trouvé(s), 2 au total
Choix des objets: Spécifiez le coin opposé: 6 trouvé(s) (1 dupliqué(s)), 7 au
total
Choix des objets:
; erreur: Erreur Automation. Aucune description n'a été entrée.
Commande:


J'ai remplacé dans le lisp "folio" par "N°PAGE", car mes blocs comportent cet attribut pour la numérotation du carnet,..
0

#5 L'utilisateur est hors-ligne   lili2006 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11508
  • Inscrit(e) : 21-décembre 05

Posté 11 avril 2009 - 09:30

Re

Oups, je n'avais pas vu que ma présentation en EO sur le cadre "bloc", n'était pas configuré alors forcément,...

Marche parfaitement chez moi !!!!

Merci à toi Bred

:P
0

#6 L'utilisateur est hors-ligne   Bred 

  • ceinture noire 5em dan
  • Groupe : Membres
  • Messages : 2720
  • Inscrit(e) : 07-mars 06
  • LocationAntibes

Posté 11 avril 2009 - 21:49

Citation

J'ai remplacé dans le lisp "folio" par "N°PAGE", car mes blocs comportent cet attribut pour la numérotation du carnet,..

Ben bientôt lili va nous pondre ses lisp....

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

#7 L'utilisateur est hors-ligne   lili2006 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 11508
  • Inscrit(e) : 21-décembre 05

Posté 11 avril 2009 - 22:26

Re,

Citation

Ben bientôt lili va nous pondre ses lisp....


Ouh là,...

Entre remplacer trois textes et écrire un lisp, y'à du chemin,...

Que je franchirai volontiers dés que je pourrais y consacrer le temps nécessaire,...
0

#8 L'utilisateur est hors-ligne   bbteddy 

  • ceinture verte
  • Groupe : Membres
  • Messages : 55
  • Inscrit(e) : 16-avril 04

Posté 14 avril 2009 - 07:51

Bonjour,

Merci beaucoup car ce lisp marche à merveille.

Bonne semaine et @ bientôt

Stéphane
0

#9 L'utilisateur est hors-ligne   fiesta13310 

  • ceinture marron
  • Groupe : Membres
  • Messages : 262
  • Inscrit(e) : 09-février 12

Posté 14 septembre 2017 - 08:21

Voir le messageBred, le 10 avril 2009 - 19:15 , dit :

Salut,

test ça

c'est encore du bricolage.... mais ça devrais fonctionner...


Enlèves l'espace dans la partie en gras


; imprime tous les cadre/bloc identique d'un page - par BRED -

; bloc ayant un attribut "folio" = numéro de page

(defun c:imptfolio (/ ACDOC B BACKGROUNDPLOT C I P1 P2 SEL XMIN YMAX PLT lst-att

		    LST LST-F LST-NB Y)

  (vl-load-com)


  (while (not sel)

    (setq sel (car (entsel "\n Choix du cadre (Bloc) :")))


    (if sel

      (if (not (equal (vla-get-ObjectName (setq b (vlax-ename->vla-object sel))) "AcDbBlockReference"))

	(setq sel nil)))

    )

  (setq sel (ssget '((0 . "INSERT")))

	AcDoc (vla-get-activedocument (vlax-get-acad-object))

	BACKGROUNDPLOT (getvar "BACKGROUNDPLOT"))


  (setvar "BACKGROUNDPLOT" 0)


  ; Récupère Attrib "FOLIO"

  (repeat (setq i (sslength sel))

    (if (equal (vla-get-effectivename (setq c (vlax-ename->vla-object (ssname sel (setq i (1- i))))))

	       (vla-get-effectivename B))


      (if (setq lst-att (vlax-safearray->list (vlax-variant-value (vla-GetAttributes c))))

	(repeat (setq y (length lst-att))

	  (if (equal (strcase (vla-get-TagString (nth (setq y (1- y)) lst-att))) "FOLIO")

	    (setq lst-F (append (list (cons (atoi (vla-get-TextString (nth y lst-att))) c))  lst-F)

		  lst-nb (append (list (atoi (vla-get-TextString (nth y lst-att)))) lst-nb))

	    )	  )	)      )

    )


  ; Tri

  (setq lst-nb (vl-sort lst-nb [surligneur] [b]'< )[/b][/surligneur] 

	i 0)

  (repeat (length lst-nb)

    (setq lst (append lst (list (cdr (assoc (nth i lst-nb) lst-F))))

	  i (1+ i))

    )


  ; trite liste bloc

  (setq i 0)

  (repeat (length lst)

    (setq c (nth i lst)

	  i (1+ i))


    (vla-GetBoundingBox c 'xmin 'ymax)

    (setq p1 (vlax-make-safearray vlax-vbdouble (cons 0 1))

	  p2 (vlax-make-safearray vlax-vbdouble (cons 0 1)))


    (vlax-make-variant

      (vlax-safearray-fill p1 (list (car (vlax-safearray->list xmin)) (cadr (vlax-safearray->list xmin)))))

    (vlax-make-variant

      (vlax-safearray-fill p2 (list (car (vlax-safearray->list ymax)) (cadr (vlax-safearray->list ymax)))))


    (if (> (- (car (vlax-safearray->list ymax)) (car (vlax-safearray->list xmin)))

	   (- (cadr (vlax-safearray->list ymax)) (cadr (vlax-safearray->list xmin))))

      (vla-put-PlotRotation (vla-get-activelayout AcDoc) ac90degrees)

      (vla-put-PlotRotation (vla-get-activelayout AcDoc) ac0degrees))


    (setq plt (vla-get-plot AcDoc))

    (vla-put-PlotType (vla-get-activelayout AcDoc) acWindow)

    (vla-setwindowtoplot (vla-get-activelayout AcDoc) p1 p2)

    (vla-plottodevice plt (vla-get-configname (vla-get-activelayout AcDoc)))

    )

  (setvar "BACKGROUNDPLOT" BACKGROUNDPLOT)

  (princ)

)


<font class=edite>[Edité le 10/4/2009 par Bred]</font>


Bonjour Bred,

Voilà 3 ans maintenant que j'utilise ton LISP qui marchait très bien jusqu'à présent.
Maintenant j'ai un bug, je ne sais pas si c'est autocad qui fait ce beug mais c'est énervant.
Quand j'utilise impt, pendant un temps il fonctionne très bien, puis un beau matin, je veux l'utiliser sur le même fichier que la veil et la ça beug. En fait il me créer que des pages blanche. Alors quand je fait imprimer puis fenêtre pour voir l'aperçu de la dernière page qu'il a appliqué à la présentation, au lieu que ce soit le dernier bloc à imprimer, il me montre un rectangle blanc pommé dans l'espace objet qui a les même dimensions que mon bloc, sauf qu'il y en a pas. Alors si j'utilise impt et que je sélectionne 5 blocs par exemple, il va me créer 5 pages blanche...

J'ai trouvé une parade à ça, mais c'est chiant. Je sélectionne tout (ctrl+A), je copie et colle dans un nouveau dessin autocad, je relance impt et là tout fonctionne.

As-tu une idée de ce qu'il se passe?
PS : je travail avec autocad 2017.

Merci d'avance et bonne journée
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)