Aller au contenu

Imprimer liste de Folio (Lisp de Bred)


bbteddy

Messages recommandés

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

 

; 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:

Lien vers le commentaire
Partager sur d’autres sites

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...

Lien vers le commentaire
Partager sur d’autres sites

Bonjour à toutes et tous,

 

J'ai testé =>

 

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,..

Civil 3D 2024 - COVADIS_18.2

https://www.linkedin...3%ABt-95313341/

Lien vers le commentaire
Partager sur d’autres sites

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...

Lien vers le commentaire
Partager sur d’autres sites

  • 8 ans après...

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

Lien vers le commentaire
Partager sur d’autres sites

  • 1 an après...

Bonjour,

je suis désolé mais je n'ai vraiment pas beaucoup de temps à t'accorder.

 

As-tu un message d'erreur dans la ligne de commande ?

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

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

je suis désolé mais je n'ai vraiment pas beaucoup de temps à t'accorder.

 

As-tu un message d'erreur dans la ligne de commande ?

 

Bonjour,

Ha mince... :unsure:

Non je n'ai pas d'erreur dans la ligne de commande.

Ci-dessous un lien avec un exemple qui marche et un qui ne marche pas. Certaines personnes ont essayé de m'aider mais en vain...

 

http://cadxp.com/topic/44875-bug-lisp-impt/page__view__findpost__p__259850

 

Regarde quand tu as un moment.

 

Merci

Lien vers le commentaire
Partager sur d’autres sites

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é