Extrusion d\'objets clos avec une hauteur en texte

[lecrabe]

 

Hello

 

On peut quand même imaginer que le texte (= Hauteur du Batiment pour l'extrusion) est dans la 1ere zone de la région (juste à l'intérieur du contour extérieur) c'est à dire qu'il n'est pas à l'intérieur d'un ilot !

 

Le Decapode

 

[(gile)]

Salut lecrabe,

 

Les routines (celle de Zebulon ou la mienne) partent de ce postulat, et ne retiennent le texte que s'il est dans la région, pas s'il est dans un ilot.

On peut imaginer qu'il y ait, à l'intérieur de cet ilot, une autre région (ou polyligne, cercle ...) à extruder à une altitude différente.

[zebulon_]

Bonjour,

 

PS : un risque persiste quand même, même si la probabilité esr faible : que la demi droite soit tangeante (ou ne rencontre qu'un sommet) à une "excroissance" de l'entité (1 intersection au lieu de 2).

 

C'est vrai. Il faudrait vérifier que le _ray ne passe pas par un sommet ou un point tangent. Pour les polylignes, les cercles et les ellipses, on arrive à gérer. Pour les régions, c'est un peu plus coton.

 

Amicalement

 

Zebulon_

 

 

[Edité le 18/10/2006 par zebulon_]

[(gile)]

Après des tests un peu plus poussés, le LISP Textrude semble fonctionner correctement tant que la hauteur de texte n'est pas trop petite par rapport à la taille du dessin.

 

En poussant la variable système MaxHatch à 10000000, ça fonctionne encore quand la hauteur de texte fait 1/20000 de la hauteur de la vue en zoom étendu.

 

Je modifie le LISP, pour forcer la valeur de MaxHatch et la restaurer à la fin (version 2.4).

[zebulon_]

Bonjour,

On ne joue pas au loto On essaye de faire en sorte que ça marche dans toutes les situations.

Mais on peut quand même faire appel au hasard, j'ai changé l'angle fixe pi/4 pour un angle pseudo-aléatoire compris entre 0 et 2*pi. (C'est curieux de ne pas avoir de fonction random dans lisp :casstet: )

Ensuite, plutôt que de faire un seul test, j'en fais 10. Et si, dans ces conditions, je tombe 5 fois sur 10 sur un angle ou un point de tangence, c'est que j'ai vraiment pas de chance.

Mais il parraît qu'on a une chance sur un million de se faire mordre par une chauve-souris enragée.. Bon, admettons... :)

 

ça donne ça

 

 
(defun randnum (/ modulus multiplier increment random)
 ;;--------------------------------------------------;;
 ;;Source http://www.afralisp.net/Tips/code104.htm   ;;
 ;;--------------------------------------------------;;
 ;;retourne un nombre pseudo-aléatoire entre 0 et 1  ;;
 ;;--------------------------------------------------;;
 (if (not randnum_seed)
   (setq randnum_seed (getvar "DATE"))
 )
 (setq modulus 65536
   multiplier 25173
   increment 13849
   randnum_seed (rem (+ (* multiplier randnum_seed) increment) modulus)
   random (/ randnum_seed modulus)
 )
)


(defun nb_intersect (e1 e2)
 (setq e1 (vlax-ename->vla-object e1))
 (setq e2 (vlax-ename->vla-object e2))
 (/ (length (vlax-invoke e1 'IntersectWith e2 acExtendNone)) 3)
)


(defun main_txextrude ()
 (setvar "cmdecho" 0)
 (setq oldDELOBJ (getvar "DELOBJ"))
 (setvar "DELOBJ" 0)
 ;;sélectionner  tous les contours
 (setq sscont 
   (ssget "_X"
     (list 
       (cons 8 CONTLAY)
       '(-4 . "< OR")
         '(-4 . "< AND")
           '(0 . "LWPOLYLINE")
           '(70 . 1)
         '(-4 . "AND>")
         '(0 . "CIRCLE")
         '(0 . "ELLIPSE")
         '(0 . "REGION")
       '(-4 . "OR>")
     )
   )
 )
 (if sscont
   (progn
     (setq sstx (ssget "_X" (list (cons 8 TXLAY) '(0 . "TEXT"))))
     (setq I 0)
     (while (< I (sslength sscont))
       (setq etcont (ssname sscont I))
       (setq J 0)
       (setq TROUVE nil)
       (while (and (not TROUVE) (< J (sslength sstx)))
         (setq etx (ssname sstx J))
         (setq PTINS (cdr (assoc 10 (entget etx))))
         (setq NBPAIR 0)
         (setq NBIMPAIR 0)
         (repeat 10
           ;; faire la demi-droite, angle aléatoire
           (setq RANDOM_ANGLE (* 2 pi (randnum)))  ;; compris entre 0 et 2*pi
           (command "_ray" "_non" (trans PTINS 0 1) "_non" (polar (trans PTINS 0 1) RANDOM_ANGLE 1) "")
           (setq eray (entlast))
           (setq nbpts (nb_intersect eray etcont))
           ;; j'efface la demi_droite
           (command "_erase" eray "")
           (if (zerop (rem nbpts 2))  ;; nbpts est pair
             (setq NBPAIR (+ NBPAIR 1))
             (setq NBIMPAIR (+ NBIMPAIR 1))
           )
         ) ;; fin repeat
         (setq J (+ J 1))
         (if (setq TROUVE (> NBIMPAIR NBPAIR)) ;; il y a plus d'impairs que de pairs. J'ai vraiment pas de bol si ça marche pas.
           (progn
             ;; j'enlève etx du jeu de sélection sstx, puisque etx à trouvé son contour
             (setq sstx (ssdel etx sstx))
             ;; puis j'extrude
             (if (< 16 (atoi (substr (getvar "acadver") 1 2)))
               (command "_.extrude" etcont "" (cdr (assoc 1 (entget etx))))
               (command "_.extrude" etcont "" (cdr (assoc 1 (entget etx))) 0.0)
             )
           )
         )
       )
       (setq I (+ I 1))
     )
   )
   (alert "pas de contour")
 )
 (setvar "DELOBJ" oldDELOBJ)
)


(defun c:txextrude ()
 (setq etx (car (entsel "\nSélectionner le texte dont vous voulez récupérer le calque ...")))
 (if etx
   (progn
     (setq etx (entget etx))
     (if (= (cdr (assoc 0 etx)) "TEXT")
       (progn
         (setq TXLAY (cdr (assoc 8 etx)))
         (alert TXLAY)
         (setq etcont (car (entsel "\nSélectionner le contour dont vous voulez récupérer le calque ...")))
         (if etcont
           (progn
             (setq etcont (entget etcont))
             (setq CONTLAY (cdr (assoc 8 etcont)))
             (alert CONTLAY)
             (main_txextrude)
           )
         )
       )
       (alert "pas un texte")
     )
   )
 )
 (princ)
)

 

Amicalement

 

Zebulon_

[(gile)]

C'est une bonne idée, la probabilité évoquée est considérablement diminuée ;)

 

Pour une exécution plus rapide, et eviter le "feu d'artifice" de demi-droites, je me suis permis une traduction en VisualLISP de main_txextrude :

 

(defun randnum (/ modulus multiplier increment random)
 ;;--------------------------------------------------;;
 ;;Source http://www.afralisp.net/Tips/code104.htm ;;
 ;;--------------------------------------------------;;
 ;;retourne un nombre pseudo-aléatoire entre 0 et 1 ;;
 ;;--------------------------------------------------;;
 (if (not randnum_seed)
   (setq randnum_seed (getvar "DATE"))
 )
 (setq	modulus	     65536
multiplier   25173
increment    13849
randnum_seed (rem (+ (* multiplier randnum_seed) increment) modulus)
random	     (/ randnum_seed modulus)
 )
)


(defun nb_intersect (e1 e2)
 (/ (length (vlax-invoke e1 'IntersectWith e2 acExtendNone))
    3
 )
)


(defun main_txextrude (CONTLAY TXLAY / AcDoc Space sscont sstx I etcont J TROUVE etx PTINS NBPAIR NBIMPAIR nbpts eray reg)
 (vl-load-com)
 (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace AcDoc)
	(vla-get-ModelSpace AcDoc)
	)
)
 (vla-StartUndoMark AcDoc)
 ;;sélectionner tous les contours
 (setq	sscont
 (ssget	"_X"
	(list
	  (cons 8 CONTLAY)
	  '(-4 . "		  '(-4 . "		  '(0 . "LWPOLYLINE")
	  '(70 . 1)
	  '(-4 . "AND>")
	  '(0 . "CIRCLE")
	  '(0 . "ELLIPSE")
	  '(0 . "REGION")
	  '(-4 . "OR>")
	)
 )
 )
 (if sscont
   (progn
     (setq sstx (ssget "_X" (list (cons 8 TXLAY) '(0 . "TEXT"))))
     (setq I 0)
     (while (	(setq etcont (ssname sscont I))
(setq J 0)
(setq TROUVE nil)
(while (and (not TROUVE) (	  (setq etx (ssname sstx J))
  (setq PTINS (cdr (assoc 10 (entget etx))))
  (setq NBPAIR 0)
  (setq NBIMPAIR 0)
  (repeat 10
    ;; faire la demi-droite, angle aléatoire
    (setq RANDOM_ANGLE (* 2 pi (randnum)))
    ;; compris entre 0 et 2*pi
    (setq eray (vla-addRay
		 Space
		 (vlax-3d-point PTINS)
		 (vlax-3d-point (polar PTINS RANDOM_ANGLE 1))
		 )
	  )
    (setq nbpts (nb_intersect eray (vlax-ename->vla-object etcont)))
    ;; j'efface la demi_droite
    (vla-delete eray)
    (if	(zerop (rem nbpts 2))
      ;; nbpts est pair
      (setq NBPAIR (+ NBPAIR 1))
      (setq NBIMPAIR (+ NBIMPAIR 1))
    )
  )
  ;; fin repeat
  (setq J (+ J 1))
  (if (setq TROUVE (> NBIMPAIR NBPAIR))
    ;; il y a plus d'impairs que de pairs. J'ai vraiment pas de bol si ça marche pas.
    (progn
      ;; j'enlève etx du jeu de sélection sstx, puisque etx à trouvé son contour
      (setq sstx (ssdel etx sstx))
      ;; puis j'extrude
      (if (= "REGION" (cdr (assoc 0 (entget etcont))))
	(setq reg (vla-copy (vlax-ename->vla-object etcont)))
	(setq reg (car (vlax-invoke
		    Space
		    'addRegion
		    (list (vlax-ename->vla-object etcont))
		  )
		       )
	)
      )
      (vla-addExtrudedSolid Space reg (cdr (assoc 1 (entget etx))) 0.0)
      (vla-delete reg)
    )
  )
)
(setq I (+ I 1))
     )
   )
   (alert "pas de contour")
 )
 (vla-EndUndoMark AcDoc)
)


(defun c:txextrude (/ etx TXLAY etcont CONTLAY)
 (setq	etx
 (car
   (entsel
     "\nSélectionner le texte dont vous voulez récupérer le calque ..."
   )
 )
 )
 (if etx
   (progn
     (setq etx (entget etx))
     (if (= (cdr (assoc 0 etx)) "TEXT")
(progn
  (setq TXLAY (cdr (assoc 8 etx)))
  (alert TXLAY)
  (setq	etcont
	 (car
	   (entsel
	     "\nSélectionner le contour dont vous voulez récupérer le calque ..."
	   )
	 )
  )
  (if etcont
    (progn
      (setq etcont (entget etcont))
      (setq CONTLAY (cdr (assoc 8 etcont)))
      (alert CONTLAY)
      (main_txextrude CONTLAY TXLAY)
    )
  )
)
(alert "pas un texte")
     )
   )
 )
 (princ)
) 

[zebulon_]

Bonjour,

 

et eviter le "feu d'artifice" de demi-droites

 

c'est vrai que ça faisait un peu "14 juillet", mais ça donne une idée de la nouvelle discipline olympique du lancer de rayon (dans laquelle je suis un champion... :D )

 

Blague à part, Vlisp est effectivement dans ce cas d'une efficacité et d'une discrétion redoutables.

 

Bon, je crois qu'avec ça le Décapode va nous trouver un qualificatif de son cru :

 

Le Décapode "Rayonnant"

Le Décapode "MaxHatchurant" ...

 

selon qu'il préfère une solution ou l'autre

 

Amicalement

 

Zebulon_

[zebulon_]

Bonjour didier

 

2 petites choses :

(command "_-layer" "_M" (strcat calque "H") "")

La variable calque n'est pas initialisée ?

 

D'autre part, ce que tu proposes revient un peu à ce que j'avais fais au début en utilisant la commande _bpoly et a le même défaut : quand le texte est dans un ilôt d'une région, la routine crée quand même un solide parce que la commande "contour" crée quelque chose avec le contour de l'ilôt.

 

D'ailleurs, pourquoi y a-t-il dans autocad 2 commandes FPOLY(_bpoly) et CONTOUR(_boundary) qui font la même chose ?

 

Amicalement

 

Zebulon_

 

[RhymOne]

NON!!!

Impossible à refaire tourner textrude mais pourquoi sa m'arrive quans j'en ai besoin..

ce que j'ai :

http://dl.free.fr/esft7Q0xb

 

Merci d'avance.

 

[speedy]

Bonjour à toutes et à tous

J'avais vue le sujet hier soir et je l'ai essayé ce matin, c'est génial il fonctionne à merveille...

je le garde de coté pour la prochaine fois.....merci à Gile et zebulon_.

 

Bonne journée....

 

Michel a

[RhymOne]

Speedy peut tu réiterer ce que tu à pris pour faire tourner le lisp stp car moi sa me balance :

Erreur: nombre d'arguments insuffisants*Annuler*

Commande: _.zoom

Spécifiez le coin d'une fenêtre, entrez un facteur d'échelle (nX ou nXP) ou

[Tout/Centre/DYnamique/ETendu/Précédent/Echelle/Fenêtre/Objet] :

_previous

Pas de vue précédente enregistrée.

; erreur: une erreur est survenue dans la fonction *erreur*Fonction annulée

Commande: *Annuler*

 

Merci d'avance

[zebulon_]

Bonjour Rhymone,

 

tu peux peut-être nous partager ton fichier dwg afin de pouvoir le tester, sinon cela va être difficile de te dire ce qui cloche.

 

Amicalement

Vincent

 

[RhymOne]

Bonjour,

En fait j'essaye toujours les lisp avec un dessin vierge.

J'ai copier coller le lisp vers un editeur de texte mais impossible a le faire tourné je comprend pas pourtant sa me serait bien utilie....