Création de hachures internes

[Neophyte]

Bonjour

je suis à la recherche d'un coup de pouce pour créer des hachures internes.

(Avec l'aide de la pièce jointe) Le but est de créer des hachures entre la polyligne rouge qui vient d'être tracée (par un programme) et la polyligne jaune que l'on viendra sélectionner si nécessaire.

Merci.

[zebulon_]

Bonjour,

 

quand on fait une hachure, on a la possibilité de donner un point à l'intérieur d'une surface fermée pour obtenir une "inondation" de la hachure dans ladite surface. Dans le cas décrit par l'image jointe, cela risque de na pas marcher compte tenu de la présence d'éléments étrangers au projet (fond de plan...) qui risquent d'influer sur l'aspect de la hachure et, surtout, sur la durée de réalisation de la hachure. L'expérience montre que plus il y a d'éléments complexes à l'écran (blocs, xrefs etc...) plus la hachure par point met du temps à déterminer la zone à hachurer.

 

J'en arrive à la conclusion qu'il faut abandonner l'idée de la hachure par ajout de point et faire une hachure par contour.

 

Le schéma fait apparaitre une droite et une courbe. Le problème étant la courbe, on s'en doute ! En plus, comme il s'agit de tracé routier, ce bout de courbe peut aussi bien être un segment d'arc qu'une suite de segments droits formants une clothoïde. Je pense donc que le plus simple est de s'appuyer sur ces 2 polylignes pour tracer une surface polygonale fermée en plaçant des points tous les x mètres (en fonction de la précision voulue) le long de la courbe. La précision importe peu : ce n'est qu'une hachure ! Enfin, je pense ?

 

un exemple :

 

(defun c:hzone ()
 (vl-load-com) 
 (defun LM:intersections (ob1 ob2 mod / lst rtn)
   ;; Intersections  -  Lee Mac
   ;; Returns a list of all points of intersection between two objects
   ;; for the given intersection mode.
   ;; ob1,ob2 - [vla] VLA-Objects
   ;;     mod - [int] acextendoption enum of intersectwith method

   (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
   (repeat (/ (length lst) 3)
       (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
             lst (cdddr lst)
       )
   )
   (reverse rtn)
 )

 (defun do_hach_zone (p1 p2 / LSTPT PT1 PT2 pkPT1 pkPT2 nbpas PAS PLCONTOUR)

   ;; on suppose que p1 est courbe : arc ou succession de segments d'une clothoïde
   ;; et que p2 est une droite

   ;; on détermine les 2 points d'intersection entre p1 et p2    
   (setq
     p1 (vlax-ename->vla-object p1)
     p2 (vlax-ename->vla-object p2)
   )
   (setq LSTPT (LM:intersections p1 p2 acextendnone))
   (if (>= (length LSTPT) 2)
     (progn  ;; si on a trouvé au moins 2 points d'intersection
       (setq PT1 (car LSTPT))  ;; le premier point d'intersection
       (setq PT2 (cadr LSTPT)) ;; le deuxième point d'intersection
       (setq pkPT1 (vlax-curve-getDistAtPoint p1 PT1)) ;; le pk du premier point
       (setq pkPT2 (vlax-curve-getDistAtPoint p1 PT2)) ;; le pk du deuxième
       (setq nbpas 20)  ;; le nombre de pas fixé arbitrairement à 20, à augmenter si pas assez précis
       (setq PAS (/ (- pkPT2 pkPT1) nbpas))  ;; on calcule la valeur d'un pas
       ;; on trace la polyligne fermée de contour
       (command "_pline" "_non" (trans (vlax-curve-getPointAtDist p1 pkPT1) 0 1))
       (repeat (- nbpas 1)
         (setq pkPT1 (+ pkPT1 PAS))
         (command "_non" (trans (vlax-curve-getPointAtDist p1 pkPT1) 0 1))  
       )
       (command "_non" (trans (vlax-curve-getPointAtDist p1 pkPT2) 0 1) "_c")
       (setq PLCONTOUR (entlast))
       ;; et on fait la hachure avec ce contour
       ;; hachure "utilisateur" avec un angle de 45 et un espacement de 2.00
       (command "_hatch" "_p" "_u" "45" "2.00" "_n" "_s" PLCONTOUR "")
       ;; si on veut effacer le contour...
       ;; (command "_erase" PLCONTOUR "") 
     )
     (alert "Pas assez de points d'intersection !")
   )
 )


 (setq Jaune (car (entsel "\nSélectionner la courbe jaune : ")))
 (setq Rouge (car (entsel "\nSélectionner la droite rouge : ")))

 (do_hach_zone Jaune Rouge)
 (princ)
)

 

 

Amicalement

Vincent

[zebulon_]

j'ai oublié de rajouté (vl-load-com) au début du lisp

 

Amicalement

Vincent

[Tramber]

Salut Vincent, salut Neophyte.

Moi j'utiliserais plutôt CutPlineAtPoint de Gilles.

Je l'ai vue ici.

Cela fonctionnerait sans discrétisation avec un peu de bidouille.

Si l'auteur nous lit, il peut peut-être nous soumettre une source plus récente ;)

http://cadxp.com/topic/15453-creation-dintersection-et-reconstitution-de-contour/page__st__20

[zebulon_]

Salut Tramber,

 

l'objectif est d'éviter de saucissonner la polyligne de base et mon idée de départ était de recréer un bout de polyligne en partant d'un point d'intersection, pour la finir à l'autre point d'intersection en créant au passage les segments (droit ou courbes) à partir de la polyligne de base.

 

Mais cela me semblait un peu trop ardu pour un Néophyte que d'aller piocher dans les bulges et autres propriétés de polylignes et j'ai préféré passer par une solution de discrétisation qui me paraissait plus simple à appréhender et suffisante pour faire une hachure.

 

Peut être à tort ?

 

En fait, c'est assez simple si on a les outils qui vont bien :

- j'ai une fonction qui récupère les segments d'une polyligne sous forme de liste ((pt1 bulge1 pt2) ... (ptdn bulgen ptfn)) (voir afralisp)

- la fonction (vlax-curve-getParamAtPoint curve-obj point) peut s'avérer très utile pour déterminer sur quel segment de la polyligne curve-obj se situe le point. Le paramètre renvoyé s'il est par exemple 1.5, alors on sait que le point est au milieu du 2ème segment, s'il est 2.75 alors il est au 3/4 du 3ème segment... si le point est un sommet, on a une valeur entière. J'ai fait quelques essais sur une polyligne car je n'ai pas trouvé dans l'aide ce que signifie ce Param où on ne nous dit uniquement "A number representing a parameter..." ce qui n'est pas très parlant !

- on ne prend dans la liste de segments que ceux qui nous intéressent en raccourcissant le premier et le dernier

- on crée une nouvelle pline à partir de cette liste puis on fait la hachure sur cette base

 

voilà sur le principe

Amicalement

Vincent

[Olivier Eckmann]

Bonjour,

 

en s'inspirant de ce programme de LeeMac qui fait un décalage d'une portion de polyline, je pense qu'on peut la reconstruire au lieu de la décaler.

 

Olivier

[Tramber]

Oups !

J'ai relu le message vers lequel j'envoyais. Pour préciser la bonne routine (où l'on voit que les bulges ne sont pas un problème).

Sans trop suivre ce que vous dites, persuadé qu'il faut l'utiliser.

En bas, j'ai fourni une approche rapide c:voir.

Après, il n'y a plus qu'à fermer et hachurer.

Ca marche pour vous ?

 

Voici le lien exact vers la routine que j'ai copiée et qui est excellente pour ici :

http://cadxp.com/topic/15453-creation-dintersection-et-reconstitution-de-contour/page__view__findpost__p__80765

 

(defun sublst (lst start leng / rslt)
 (or (<= 1 leng (- (length lst) start))
     (setq leng (- (length lst) (1- start)))
 )
 (repeat leng
   (setq rslt  (cons (nth (1- start) lst) rslt)
         start (1+ start)
   )
 )
 (reverse rslt)
)
(defun ArcCenterBy3Points (p1 p2 p3)
 ((lambda (mid1 mid2)
    (inters mid1
            (polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0)
            mid2

            (polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0)

            nil
    )
  )
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2)
   (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p2 p3)
 )

)
(defun Angle2Bulge (a)
 (/ (sin (/ a 4.0)) (cos (/ a 4.0)))
)


;;; CutPlineAtPoint
;;; Coupe la polyligne au point spécifié et retourne la liste des deux objets générés
;;; (ename ou vla-object selon le type de l'argument pl)
;;; 
;;; Arguments
;;; pl : la polyligne à couper (ename ou vla-object)
;;; pt : le point de coupure sur la polyligne (coordonnées SCG)


(defun CutPlineAtPoint (pl  pt  /   en  no  pa  p0  p1  pn  cl  l0  l1
                       l2  ce  sp  c   b0  b1  b2  bp  a1  a2  n   wp
                       w0  w1  w2
                      )
 (vl-load-com)
 (or (= (type pl) 'VLA-OBJECT)
     (setq pl (vlax-ename->vla-object pl)
           en T
     )
 )

 (setq no (vlax-get pl 'Normal)
       pa (fix (vlax-curve-getParamAtPoint pl pt))
       p0 (vlax-curve-getPointAtparam pl pa)
       p1 (vlax-curve-getPointAtParam pl (1+ pa))
       pn (reverse (cdr (reverse (trans pt 0 no))))
       cl (vla-Copy pl)
       l0 (vlax-get pl 'Coordinates)
       l1 (append (sublst l0 1 (* 2 (1+ pa))) pn)
       l2 (append pn (sublst l0 (1+ (* 2 (1+ pa))) nil))
       ce (if (not (equal pt p0 1e-9))
            (ArcCenterBy3Points (trans p0 0 no) pn (trans p1 0 no))
          )
       sp (reverse
            (cdr (reverse (trans (vlax-curve-getStartPoint pl) 0 no)))
          )
 )
 (and (= (vla-get-Closed pl) :vlax-true)
      (setq c  T
            l2 (append l2 sp)
      )
 )
 (repeat (setq n (if c
                   (fix (vlax-curve-getendParam pl))
                   (fix (1+ (vlax-curve-getendParam pl)))
                 )
         )
   (setq b0 (cons (vla-getBulge pl (setq n (1- n))) b0))
   (vla-GetWidth pl n 'StartWidth 'EndWidth)
   (setq w0 (cons (list StartWidth EndWidth) w0))
 )
 (setq bp (nth pa b0))
 (if ce
   (progn
     (setq a1 (- (angle ce pn) (angle ce (trans p0 0 no)))
           a2 (- (angle ce (trans p1 0 no)) (angle ce pn))
     )
     (if (minusp bp)
       (foreach a '(a1 a2)
         (if (< 0 (eval a))
           (set a (- (eval a) (* 2 pi)))
         )
       )
       (foreach a '(a1 a2)
         (if (< (eval a) 0)
           (set a (+ (eval a) (* 2 pi)))
         )
       )
     )
   )
 )
 (setq b1 (append
            (if (zerop pa)
              nil
              (sublst b0 1 pa)
            )
            (if ce
              (list (Angle2Bulge a1))
              (list bp)
            )
          )
       b2 (append
            (if ce
              (list (Angle2Bulge a2))
              (list bp)
            )
            (sublst b0 (+ 2 pa) nil)
          )
       wp (if (equal pt p0 1e-9)
            (car (nth pa w0))
            (+ (car (nth pa w0))
               (* (- (cadr (nth pa w0)) (car (nth pa w0)))
                  (/ (- (vlax-curve-getDistAtPoint pl pt)
                        (vlax-curve-getDistAtParam pl pa)
                     )
                     (- (vlax-curve-getDistAtParam pl (1+ pa))
                        (vlax-curve-getDistAtParam pl pa)
                     )
                  )
               )
            )
          )
       w1 (append (if (zerop pa)
                    nil
                    (sublst w0 1 pa)
                  )
                  (list (list (car (nth pa w0)) wp))
          )
       w2 (append (list (list wp (cadr (nth pa w0))))
                  (sublst w0 (+ 2 pa) nil)
          )
 )
 (if c
   (progn
     (vla-put-Closed pl :vlax-false)
     (vla-put-Closed cl :vlax-false)
   )
 )

 (mapcar '(lambda (p l b w)
            (vlax-put p 'Coordinates l)
            (repeat (setq n (length B))
              (vla-SetBulge p (setq n (1- n)) (nth n B))
            )
            (repeat (setq n (length w))
              (vla-SetWidth
                p
                (setq n (1- n))
                (car (nth n w))
                (cadr (nth n w))
              )

            )
          )
         (list pl cl)
         (list l1 l2)
         (list b1 b2)
         (list w1 w2)
 )
 (if en
   (list (vlax-vla-object->ename pl)
         (vlax-vla-object->ename pl)
   )
   (list pl cl)
 )
)

(defun c:voir()
 (setq obj(vlax-ename->vla-object(car(entsel))))
 (cond((=(vla-get-Objectname obj)"AcDbPolyline")
	(setq p1(getpoint"\nSpécifiez le point 1 sur la polyligne")
      p2(getpoint"\nSpécifiez le point 2"))
(cond((and(vlax-curve-getParamAtPoint obj p1)(vlax-curve-getParamAtPoint obj p2))
      (setq result(CutPlineAtPoint obj p1))
      (setq obj2(car result)obj(cadr result))
      (setq result(CutPlineAtPoint obj p2))
      (setq obj2(cadr result)obj(car result)))))))


;;;;; (setq polycoupée(c:voir))
;;;(vla-put-color polycoupée 1)

[zebulon_]

Coupe la polyligne au point spécifié et retourne la liste des deux objets générés

 

c'est un problème, a priori. Lequel des 2 objets générés on garde ? Par ailleurs, c'est bien trop compliqué pour un débutant, même si c'est sans doute une voie vers laquelle il faut aller, mais pas tout de suite !

 

J'ai pensé à encore plus simple en se débrouillant avec des (command ...) :

- on duplique la polyligne courbe

- on fait un ajuster de la copie de la polyligne jaune par rapport à la polyligne rouge

mais je n'ai pas le temps d'approfondir

 

Amicalement

Vincent

[Tramber]

c'est un problème, a priori. Lequel des 2 objets générés on garde ?

Tu décris plutôt le problème avec la commande "_break". Je crois savoir que les retours sont indifférenciés, j'utilisais la notion de (entlast) pour m'en sortir et les distinguer en comparant les handle.

 

En revanche, avec la routine de Gilles, tu vas dans le sens de la polyligne par deux fois le même donc il n'y a pas de problème si tu vas dans le sens de la polyligne. On peut supposer qu'il est connu. Sinon c'est vite fait de retourner le problème ou la polyligne... et la routine sera robuste.

[zebulon_]

Salut Tramber,

 

ok, mais il n'en reste pas moins que Néophyte, comme son nom l'indique, viens juste d'apprendre à marcher, et encore, il trébuche souvent. Et tu lui proposes d'emblée de piloter un avion de chasse... :)

 

Amicalement

Vincent