Extrusion d\'objets clos avec une hauteur en texte

[lecrabe]

 

Bonsoir les Pros du DEV !

 

Voici à nouveau une "petite" demande qui devrait intéresser pas mal de monde ...

 

Soit un DWG avec sur un calque (ou dans une selection) des objets clos, du genre :

polyligne, cercle, ellipse, rectangle, polygone regulier, voire même peut etre aussi des régions.

 

Sur un autre calque (ou dans une selection) un simple TEXT / MTEXT, A L'INTERIEUR de l'objet clos qui indique en fait la hauteur de l'objet (Valeur numerique simple).

 

La routine devra récupérer le texte à l'intérieur de chaque objet clos pour exécuter une commande d'extrusion ("_EXTRUDE") et ainsi on aura de jolis batiments en 3D volumique avec leur hauteur réelle !

 

Car bien sur mon DWG est un plan de cadastre avec des polylignes closes partout indiquant l'emprise brute (contour des batiments), et il suffit de venir mettre à la main le texte de la hauteur ...

 

La routine devra tourner sur "toutes" les versions d'AutoCAD et en fait la syntaxe de la cmd "_EXTRUDE" est différente depuis la 2007:

 

*** AutoCAD 2000-2006 ***

_EXTRUDE

Sélection des objets ...

1ère question sur la hauteur:

2ème question sur l'angle d'extrusion: ZERO bien sur

 

*** AutoCAD 2007 ***

_EXTRUDE

Sélection des objets ...

Une seule question sur la hauteur par défaut:

(Car il y a des lettres pour passer les autres options: direction, chemin, angle)

 

Voilu, Voili, Voila

Le Decapode (qui va encore remercier les fous de Lisp / V-Lisp)

 

 

 

 

[Tramber]

Je l'ai déjà fait. Mais dans une version manuelle.

 

 

 

Là, il faudra, récupérer le texte, et aussi passer en Vlisp pour éviter les problèmes d'incompatibilité. La difficulté (non insurmontable), c'est la récupération du texte.

 

Dommage que je n'ai pas le temps tout de suite.

 

Hummm, ca va être choli !

 

800x260http://perso.orange.fr/abcad/XCP/divers/Baden1.jpg[/img]

 

[Edité le 14/10/2006 par Tramber]

[(gile)]

Salut,

 

Un petit truc vite fait (encore avec SelByObj), sûrement à améliorer (pas encore de traitement des régions).

 

Version 1.2

 

Supprimer les espaces entre les

 

;;; TEXTRUDE Extrude les objets (cercle, ellipse, lwpolyligne) du calque spécifié
;;; de la hauteur donnée dans le texte contenu dans chaque objet.

 (defun textrude_err (msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (command "_.undo" "_end")
   (setvar "CMDECHO" echo)
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

(defun c:textrude (/ textrude_err laytxt layobj ssobj echo sstxt alt)
 (setq	m:err	*error*
*error*	textrude_err
echo	(getvar "CMDECHO")
 )
 (if
   (and (setq
   laytxt (getlayer "Calque des textes de hauteur d'extrusion")
 )
 (setq layobj (getlayer "Calque des objets à extruder"))
   )
    (progn
      (setq ssobj (ssget "_X"
		  (list	'(-4 . "[color=#CC0000]				'(-4 . "[color=#CC0000]				'(0 . "CIRCLE")
			'(0 . "ELLIPSE")
			'(-4 . "[color=#CC0000]				'(0 . "LWPOLYLINE")
			'(-4 . "&")
			'(70 . 1)
			'(-4 . "AND>")
			'(-4 . "OR>")
			(cons 8 layobj)
			'(-4 . "AND>")
		  )
	   )
      )
      (command "_.undo" "_begin")
      (setvar "CMDECHO" 0)
      (if ssobj
 (foreach e (mapcar 'cadr (ssnamex ssobj))
   (if
     (and (setq
	    sstxt (SelByObj e
			    "WP"
			    (list '(0 . "*TEXT") (cons 8 laytxt))
		  )
	  )
	  (numberp
	    (setq
	      alt (read (cdr (assoc 1 (entget (ssname sstxt 0)))))
	    )
	  )
     )
      (if (		(command "_.extrude" e "" alt)
	(command "_.extrude" e "" alt 0.0)
      )
   )
 )
      )
      (command "_.undo" "_end")
      (setvar "CMDECHO" echo)
    )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

 

SelByObj

 

;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Crée un jeu de sélection avec tous les objets contenus ou 
;;; capturés, dans la vue courante, par l'objet sélectionné
;;; (cercle, ellipse, polyligne fermée).
;;; Arguments :
;;; - un nom d'entité (ename) 
;;; - un mode de sélection (Cp ou Wp)
;;; - un filtre de sélection ou nil

(defun SelByObj	(ent opt fltr / obj dist n lst prec dist p_lst)
 (vl-load-com)
 (if (= (type ent) 'ENAME)
   (setq obj (vlax-ename->vla-object ent))
 )
 (cond
   ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
    (setq dist	(/ (vlax-curve-getDistAtParam
	     obj
	     (vlax-curve-getEndParam obj)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   (T
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 42)
	      )
	    )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (append
    lst
    (list (trans (append (cdr (assoc 10 p_lst))
			 (list (cdr (assoc 38 (entget ent))))
		 )
		 ent
		 1
	  )
    )
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 50 (abs (cdadr p_lst)))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			obj
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			obj
			(vlax-curve-getEndParam obj)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (append
	     lst
	     (list
	       (trans
		 (vlax-curve-getPointAtDist
		   obj
		   (+ (vlax-curve-getDistAtPoint
			obj
			(trans (cdar p_lst) ent 0)
		      )
		      (* dist (setq n (1+ n)))
		   )
		 )
		 0
		 1
	       )
	     )
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 (ssget (strcat "_" opt) lst fltr)
) 

 

GETLAYER boite dialogue pour la sélection d'un calque.

 

Fichier DCL à enregistrer sous : getlayer.dcl dans un dossier du chemin de recherche des fichiers de support.

 

getlayer:dialog{
 label="Choisir un calque";
 initial_focus="lay";
 :boxed_column{
   :text{
     is_bold=true;
     key="titre";
   }
   spacer;
   :row{
     :column{
       :text{
         label="Sélectionner un objet";
         alignment=left;
       }
     }
     :column{
       :button{
         label=">>";
         key="obj";
         alignment=right;
         fixed_width=true;
       }
       spacer;
     }
   }
   :edit_box{
     key="tp";
     edit_width=25;
   }
   :popup_list{
     key="lay";
     edit_width=25;
   }
   spacer;
 }
 ok_cancel;
} 

 

GetLayer, le LISP :

 

;;; GetLayer Retourne le nom du calque entré ou choisi par l'utilisateur 
;;; dans une liste déroulante de la boite de dialogue ou en sélectionnant
;;; un objet à l'écran.
;;; Argument : un titre (string)

(defun getlayer	(titre / lay lst what_next dcl_id nom)
 (setq lay (tblnext "LAYER" T))
 (while lay
   (setq lst  (cons (cdr (assoc 2 lay)) lst)
  lay (tblnext "LAYER")
   )
 )
 (setq lst (acad_strlsort lst))
 (setq dcl_id (load_dialog "GetLayer.dcl"))
 (setq what_next 2)
 (while (>= what_next 2)
   (if	(not (new_dialog "getlayer" dcl_id))
     (exit)
   )
   (start_list "lay")
   (mapcar 'add_list lst)
   (end_list)
   (set_tile "titre" titre)
   (action_tile "obj" "(done_dialog 3)")
   (action_tile
     "tp"
     "(setq nom (get_tile \"tp\")) (done_dialog 4)"
   )
   (action_tile
     "accept"
     (strcat
"(progn"
"(setq nom (nth (atoi (get_tile \"lay\")) lst)))"
"(done_dialog 1))"
     )
   )
   (setq what_next (start_dialog))
   (cond
     ((= what_next 3)
      (if (setq nom (car (entsel)))
 (setq nom (cdr (assoc 8 (entget nom)))
       what_next 1)
 (setq what_next 2)
      )
     )
     ((= what_next 4)
      (cond
 ((tblsearch "LAYER" nom)
  (setq what_next 1)
 )
 (T
  (alert (strcat "Le calque \"" nom "\" est introuvable."))
  (set_tile "tp" "")
  (setq what_next 2)
 )
      )
     )
     ((= what_next 0)
(setq nom nil)
     )
   )
 )
 (unload_dialog dcl_id)
 nom
) 

[Edité le 15/10/2006 par (gile)][Edité le 16/10/2006 par (gile)]

 

[Edité le 16/10/2006 par (gile)]

[(gile)]

Première amélioration : le choix des calques se fait par une petite boite dialogue (version 1.1).

 

[Edité le 15/10/2006 par (gile)]

[phil_vsd]

Je m'incruste...

 

Pour reprendre l'idée de pline_block, pour sélectionner automatiquement les régions, il faudrait insérer un point sur chaques textes (Select all, for each...), puis sur ces points faire partir une pline, si elle croise deux fois la même région c'est que le point est "dedans", alors l'info pour extrusion de la polyligne est celle contenue dans le texte d'où est parti la pline...

 

Facile à dire. Dites moi si je fais un hors-sujet...

 

Phil, qui s'incruste, qui s'incruste assez... :P

[(gile)]

C'est dans l'autre sens, que le contrôle doit se faire : est-ce que le texte est bien à l'intérieur de la région ?

C'est comme ça que fonctionne SelPline, le fait que la ligne croise 2 fois la région ne prouverait rien, la région peut avoir une forme "biscornue" et/ou des ilots faits par soustraction.

[phil_vsd]

Je persiste peut-être trop mais si on inclut un point sur le centre de gravité de la région, et que du centre de gravité partent des cercles concentriques (J'ai cru lire ça de ta plume qqpart non ?) jusqu'a ce que le cercle touche, ou englobe une entité texte, alors cette entité texte est "choisie" comme source d'info pour l'extru.

 

Non ?

[lecrabe]

 

Hello Gilles & Tramber

 

Pour Mr Tramber: Oui j'ai déjà fait aussi ce genre de chose à la main ... :)

 

Je te remercie encore Gilles et je vais tester dans la semaine ta routine ! :D

 

En espérant qu'elle traitera dans les jours prochains les Régions ...

Car ainsi les batiments avec cours / patios / etc seront plus réalistes !

 

Avec DELOBJ = 0, on garde les objets d'origine: cercle, lwpline, ellipse.

 

Le Decapode "frétillant et heureux"

 

[(gile)]

Pour Phil,

Tu t'imagines bien que j'ai pensé à toutes les utilisations possibles de ces LISP que j'ai fait récemment.

 

Ce dont je voudrait être sûr, c'est que le texte est bien à l'intérieur de la région (si la région contient bien un texte, ce qui n'est pas, non plus, obligatoire).

 

J'aurais bien des idées, à partir de la bounbing box de la région, mais ce n'est pas suffisament rigoureux à mon goût.

 

Pour lecrabe,

En l'état la routine ne force pas la valeur de DELOBJ, je pensais laisser le choix à l'utilisateur.

 

[Edité le 15/10/2006 par (gile)]

[lecrabe]

 

Bonsoir Gilles

 

OUI c sur que trouver un texte dans une entité normale d'AutoCAD du genre: cercle, polyligne, ellipse, etc - cela ne me semble pas trop compliquée ... :)

 

Alors que savoir si il y a un texte à l'intérieur d'une région, c'est COTON ! :exclam: :casstet:

 

Sauf si on a gardé la polyligne extérieure de construction de la région !

On pourrait envisager cette contrainte en demandant le nom du calque en question où il y aurait QUE les polylignes de construction extérieure des Régions !!!

 

Qu'en penses tu ?

 

Sinon je vois très bien le problème ...

 

Si on suppose que le dessin est parfait donc avec toujours un seul et unique texte dans une région, es tu sur de chopper le texte et le bon surtout si la région est un peu biscornu ...

 

Par exemple, une région (Batiment en fait) en forme de U et juste au milieu du U, il y a un batiment normal en rectangle, la Bounding Box est mortelle sur cet exemple et aussi sur de simples batiments en L ... avec toujours un autre batiment simple au centre de gravité de U ou du L !!!

 

Le Decapode "embété"

 

[(gile)]

Bon, voici une version qui, d'après les quelques essais que j'ai fait, semble fonctionner avec les régions.

 

C'est du bricolage, je n'en garantis pas la fiabilité.

 

La région est densément hachurée (hachure ANSI31, échelle 0.01*), et si une intersection est trouvée entre la hachure et un texte du calque spécifié constitué d'un nombre uniquement, elle est extrudée.

 

* Suite à une suggestion de Zebulon (merci à lui), les hachures sont désormais un motif "utilisateur", l'espacement entre les lignes est égal à la moitié de la hauteur des textes recherchés.

 

Version 2.4 (SelByObj et GetLayer doivent être chargés)

 

Supprimer les espaces entre les

 

;;; TEXTRUDE Extrude les objets (cercle, ellipse, lwpolyligne) du calque spécifié
;;; de la hauteur donnée dans le texte contenu dans chaque objet.

(defun textrude_err (msg)
 (if (= msg "Fonction annulée")
   (princ)
   (princ (strcat "\nErreur: " msg))
 )
 (command)
 (command "_.zoom" "_previous")
 (setenv "MaxHatch" maxhatch)
 (command "_.undo" "_end")
 (setvar "CMDECHO" echo)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

(defun c:textrude (/ echo maxhatch laytxt layobj ssobj sstxt txtlst alt
	   hach	cnt)
 (setq	m:err	 *error*
*error*	 textrude_err
echo	 (getvar "CMDECHO")
maxhatch (getenv "MaxHatch")
 )
 (if (and
(setq
  laytxt (getlayer "Calque des textes de hauteur d'extrusion")
)
(setq layobj (getlayer "Calque des objets à extruder"))
     )
   (progn
     (setq ssobj (ssget "_X"
		 (list '(-4 . "			       '(-4 . "			       '(0 . "CIRCLE")
		       '(0 . "ELLIPSE")
		       '(-4 . "			       '(0 . "LWPOLYLINE")
		       '(-4 . "&")
		       '(70 . 1)
		       '(-4 . "AND>")
		       '(-4 . "OR>")
		       (cons 8 layobj)
		       '(-4 . "AND>")
		 )
	  )
     )
     (setq sstxt (ssget "_X" (list '(0 . "*TEXT") (cons 8 laytxt))))
     (if sstxt
(setq txtlst
       (vl-remove-if-not
	 '(lambda (x) (numberp (read (cdr (assoc 1 (entget x))))))
	 (mapcar 'cadr (ssnamex sstxt))
       )
)
     )
     (command "_.undo" "_begin")
     (setvar "CMDECHO" 0)
     (setenv "MaxHatch" "10000000")
     (command "_.zoom" "_extents")
     (if ssobj
(foreach e (mapcar 'cadr (ssnamex ssobj))
  (if
    (and
      (setq
	sstxt (SelByObj	e
			"WP"
			(list '(0 . "*TEXT") (cons 8 laytxt))
	      )
      )
      (member (setq alt (ssname sstxt 0)) txtlst)
    )
     (progn
       (if (		 (command "_.extrude" e "" (cdr (assoc 1 (entget alt))))
	 (command "_.extrude"
		  e
		  ""
		  (cdr (assoc 1 (entget alt)))
		  0.0
	 )
       )
       (setq txtlst (vl-remove alt txtlst))
     )
  )
)
     )
     ;; Traitement des régions
     (setq ssobj (ssget "_X" (list '(0 . "REGION") (cons 8 layobj))))
     (if (and ssobj txtlst)
(foreach reg (mapcar 'cadr (ssnamex ssobj))
  (command "_.bhatch"
	   "_p"
	   "_u"
	   0.0
	   (/ (cdr (assoc 40 (entget (car txtlst)))) 2)
	   "_n"
	   "_s"
	   reg
	   ""
	   ""
  )
  (setq	hach (entlast)
	cnt  (length txtlst)
  )
  (while (	    (if	(Intersect-p
	  hach
	  (setq alt (nth (setq cnt (1- cnt)) txtlst))
	  acExtendNone
	)
      (progn
	(if (		  (command "_.extrude"
		   reg
		   ""
		   (cdr (assoc 1 (entget alt)))
	  )
	  (command "_.extrude"
		   reg
		   ""
		   (cdr (assoc 1 (entget alt)))
		   0.0
	  )
	)
	(setq txtlst (vl-remove alt txtlst))
	(setq cnt -1)
      )
    )
  )
  (entdel hach)
)
     )
     (command "_.zoom" "_previous")
     (setenv "MaxHatch" maxhatch)
     (command "_.undo" "_end")
     (setvar "CMDECHO" echo)
   )
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)


;;; Intersect-p
;;; Évalue si deux objets (ename ou vla-object) ont une intersection

(defun intersect-p (e1 e2 opt)
 (vl-load-com)
 (foreach e '(e1 e2)
   (if	(= (type (eval e)) 'ENAME)
     (set e (vlax-ename->vla-object (eval e)))
   )
 )
 (if (atom (vlax-invoke e1 'IntersectWith e2 opt))
   nil
   T
 )
)

 

PS : J'apporte des modifications mineures à la première version (sans régions)[Edité le 16/10/2006 par (gile)][Edité le 16/10/2006 par (gile)][Edité le 16/10/2006 par (gile)][Edité le 16/10/2006 par (gile)]

 

[Edité le 18/10/2006 par (gile)]

[(gile)]

Pour essayer d'éviter au maximum le type d'erreur : "Les hachures sont trop denses ou la taille des discontinuités est trop petite.", tout en étant sûs d'avoir une intersection, l'échelle des hachures est calculé pour que l'espacement des lignes soit égal à la moitié de la hauteur de texte utilisé.

 

Le code ci-dessus est modifié (version 2.1).

 

PS : J'avais encore oublié de mettre des espaces entre

Toutes mes excuses à ceux qui avaient les codes avant que je ne répare cet oubli.

 

[Edité le 16/10/2006 par (gile)]

[zebulon_]

Bonjour Gile,

 

Est-ce que l'utilisation de la commande _bpoly ne pourrait s'avérer intéressante ?

 

OUI c sur que trouver un texte dans une entité normale d'AutoCAD du genre: cercle, polyligne, ellipse, etc - cela ne me semble pas trop compliquée ...

 

Alors que savoir si il y a un texte à l'intérieur d'une région, c'est COTON

 

en faisant un truc du style :

 

(setq pt ...) ;; le point d'insertion du texte

(setq e (car (entsel))) ;; sélectionner la région

(setq etl (entlast)) ;; la dernière entité

(command "_bpoly" "_a" "_o" "_p" "_b" "_n" e "" "" pt "")

(setq newetl (entlast)) ;; le nouvelle dernière entité

;; puis faire une comparaison des identificateurs de etl et newetl

(if (= (cdr (assoc 5 (entget etl))) (cdr (assoc 5 (entget newetl))))

(alert "Texte à l'extérieur")

(alert "Texte à l'intérieur")

)

 

 

Amicalement

 

Zebulon_

 

[(gile)]

Salut Zebulon,

 

Merci, j'avais pensé à utiliser Contour, mais si la région contient des ilots, la commande contour créera une polyligne par ilot en plus de celle du pourtour ce qui fait autant d'objets à gérer pour la sélection (ou l'exclusion de la sélection) du texte recherché.

[zebulon_]

Re,

 

j'ai fait une _bpoly en utilisant un jeu de sélection "options _b _n" ne contenant que la région (la variable e). S'il y a des îlots à l'intérieur, ils ne font pas partie du jeu de sélection et ne créent pas de polyligne. A l'issue du _bpoly, il n'y aura donc qu'une seule polyligne à gérer.

 

Enfin c'est ce qui me semble au vu de mes tests.

 

Amicalement

 

Zebulon_

 

[(gile)]

Pour Zebulon,

 

Je me suis mal exprimé, quand je parlais d'ilots, je voulais dire des ilots faits dans la région avec la commande soustraction (opération booléenne). Ces ilots font partie de l'entité région et créerons autant de polylignes.

 

De toutes façon, on n'est pas si loin les commandes contour et hachure ont un comportement assez proche.

 

PS : J'ajoute un zoom étendu avant de faire les différentes opération et un zoom précédent à la fin. (version 2.2)

[zebulon_]

Ok gile, mais peu m'importe le nombre de polylignes (ou régions, plutôt régions d'ailleurs) créées par bpoly. Du moment qu'il y en a une, ça veut dire que le texte est à l'intérieur.

 

Ce qui me gêne avec ta commande hachure, c'est le fait que tu choisisses un motif "ansi31" avec une echelle. Ce motif peut ne pas avoir le même aspect suivant la valeur de la variable MEASUREMENT.

 

Si déjà il faut utiliser la commande bhatch, alors il vaut peut être mieux choisir des hachures utilisateur qui s'en foutent royalement de MEASUREMENT

 

Du style :

(command "_bhatch" "_p" "_u" ANGLE ESPACEMENT "_y" ...)

 

Sinon, je vous propose une solution avec _bpoly

 

(defun main_txextrude ()
 (setq oldDELOBJ (getvar "DELOBJ"))
 (setvar "DELOBJ" 0)
 ;;sélectionner  tous les contours
 (setq sscont 
   (ssget "_X"
     (list 
       (cons 8 CONTLAY)
[surligneur]        '(-4 . "< OR")
         '(-4 . "< AND") [/surligneur] 
           '(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)
       (while (< J (sslength sstx))
         (setq etx (ssname sstx J))
         (setq PTINS (cdr (assoc 10 (entget etx))))
         ;; essaye de faire un _bpoly
         (setq etl (entlast))   ;; la dernière entité
         (command "_bpoly" "_a" "_o" "_r" "_b" "_n" etcont "" "" "_non" (trans ptins 0 1) "")
         (setq newetl (entlast)) ;; le nouvelle dernière entité
         (if (/= (cdr (assoc 5 (entget etl))) (cdr (assoc 5 (entget newetl))))
           (progn
             ;; _bpoly a fabriqué au moins un nouvel objet, donc le texte etx est à l'intérieur de etcont
             ;; j'efface ce que bpoly a fabriqué
             (while (setq etl (entnext etl))
               (command "_erase" etl "")
             )
             ;; 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 J (+ J 1))
       )
       (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_

 

 

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

[(gile)]

Une ou deux images valant mieux qu'un long discours, voilà une région (en gris) avec un "ilot" à l'intérieur, et un texte (rouge):

 

http://img238.imageshack.us/img238/4456/txtrude1ok3.png

 

avec ta méthode, deux polylignes sont créées et deux solides extrudés :

 

http://img360.imageshack.us/img360/6393/txtrude2fx6.png

 

D'autre part, si le texte est à l'intérieur de l'ilot (donc plus dans la région) ça fonctionne quand même, ce que je veux éviter.

 

Sinon je partage complètement tes réticences à utliser des hachures, c'est vraiment à contre-coeur que je me suis rabattu sur cette solution.

 

Je retiens ta proposition pour le motif de hachures et modifie le LISP (version 2.3).

[zebulon_]

Re,

avec ta méthode, deux polylignes sont créées et deux solides extrudés :

 

Avec un texte placé comme dans ta première image, je n'obtiens qu'un seul solide puisque je fais l'extrusion avec la région d'origine et non les régions créées par _bpoly (qui sont effacées)

 

D'autre part, si le texte est à l'intérieur de l'ilot (donc plus dans la région) ça fonctionne quand même, ce que je veux éviter

 

Effectivement, ça marche quand même puisque _bpoly peut fabriquer un contour avec l'ilôt.

 

Amicalement

 

Zebulon_

 

 

 

[(gile)]

Avec un texte placé comme dans ta première image, je n'obtiens qu'un seul solide

 

Je viens de faire de nouveaux essai et effectivement ...

 

... au temps pour moi , en fait les polylignes ayant servi à faire la region étaient toujours présentes (DELOBJ à 0). C'est la poly intérieure qui générait le solide de l'ilot. :calim:

[zebulon_]

Bonjour,

 

Sinon je partage complètement tes réticences à utliser des hachures, c'est vraiment à contre-coeur que je me suis rabattu sur cette solution

 

Il y a peut-être une autre voie à explorer. En quelques mots, l'idée est de tracer une demi-droite (la commande _ray) à partir du point d'insertion du texte, avec un angle quelconque. Puis déterminer le nombre de points d'intersections avec le contour. Si ce nombre est pair (y compris 0), le point est à l'extérieur du contour, sinon il est à l'intérieur.

 

Et comme une petite image parle mieux qu'un long discours :

http://img133.imageshack.us/img133/2776/interswn4.jpg

 

Et si la demi-droite traverse un ilôt d'une région, la règle semble valable aussi

http://img245.imageshack.us/img245/2908/inters1yj0.jpg

 

Et si le point d'origine est à l'intérieur d'un ilôt, ça semble marcher aussi

http://img133.imageshack.us/img133/1052/inters2yd4.jpg

 

 

Votre avis sur la question ?

 

Amicalement

 

Zebulon_

 

 

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

[zebulon_]

Voilà ce que ça donnerait en vrai

 

 
(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 ()
 (setq oldDELOBJ (getvar "DELOBJ"))
 (setvar "DELOBJ" 0)
 ;;sélectionner  tous les contours
 (setq sscont 
   (ssget "_X"
     (list 
       (cons 8 CONTLAY)
[surligneur] '(-4 . "< OR")
         '(-4 . "< AND")[/surligneur] 
           '(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)
       (while (< J (sslength sstx))
         (setq etx (ssname sstx J))
         (setq PTINS (cdr (assoc 10 (entget etx))))
         ;; faire la demi-droite, on va dire à 45°
         (command "_ray" "_non" (trans PTINS 0 1) "_non" (polar (trans PTINS 0 1) (/ pi 4) 1) "")
         (setq eray (entlast))
         (setq nbpts (nb_intersect eray etcont))
         ;; j'efface la demi_droite
         (command "_erase" eray "")
         (if (not (zerop (rem nbpts 2)))  ;; nbpts est impair
           ;; 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 J (+ J 1))
       )
       (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)
)

 

 

Le vlax-invoke qui revoie la liste de points 3d d'intersection entre deux entités, c'est bien pratique.

 

Amicalement

 

Zebilon_

[phil_vsd]

Salut !

 

Et si le point d'origine est à l'intérieur d'un ilôt, ça semble marcher aussi

 

Il me semble que non, Si un texte est au milieu de l'îlot, et s'il croise un autre îlot commme sur le troisième dessin, on a un nombre pair, donc on est Off...

Ceci dit, la probabilité d'avoir un texte dans un îlot dont la ligne coupe un autre îlot me semble faible donc ça peut coller.

 

Peut-être en faisant partir 4 lignes (Nord sud est ouest) du texte et si les 4 lignes coupent l'aire on est dedans. Si <4 on est dehors. Si une seule des 4 lignes ne coupe rien on est dehors aussi.

 

Hum, non, le texte peut être dans un "fer à cheval" et le lignes peuvent quand même couper l'aire...

 

Faudrait coupler le coup des 4 lignes et des pairs-impairs...

 

Ca devient un problème de topologie... Je vais chercher un livre et je reviens...

 

 

 

[Edité le 17/10/2006 par phil_vsd]

[(gile)]

Super idée Zebulon :D

 

Ça marche bien.

 

Pour Phil,

Il me semble que non, Si un texte est au milieu de l'îlot, et s'il croise un autre îlot commme sur le troisième dessin, on a un nombre pair, donc on est Off...

C'est bien le but :

- soit "l'ilot" est une entité : une seule intersection, elle est extrudée.

- soit "l'ilot" est un ""trou" dans la région : 6 intersections, le texte n'est pas dans la région, elle n'est pas extrudée.

 

Ceci dit, la probabilité d'avoir un texte dans un îlot dont la ligne coupe un autre îlot me semble faible donc ça peut coller.

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

 

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

 

[Edité le 17/10/2006 par (gile)]

[phil_vsd]

J'avais cru comprendre, selon l'image 3, que le texte source d'info pouvait être dans un îlot à exclure (Un trou). C'est probable non ? Rassurez moi : je ne dis pas que des bêtises depuis le début ? Dites le moi si je polue le post, je ne serai pas vêxé... :(

 

Même si je n'ai pas les connaissances lisp, le sujet me plait, voire même me passionne.

 

 

PS : De peur de me faire spamer j'ai changé ma signature, promis je ne recommencerai plus. Pas avant demain...