Décalage de polyligne - 2 valeurs différentes

[bonuscad]

Merci de vos felicitations, mais la routine bien que que pouvant être sastifaisante est loin d'être une Rools!

 

Pour ma part j'ai déja observé dans certain cas, un effet papillon (d'un bord à l'autre) sur le dernier segment.

Autre défaut; bien que censé fonctionner sur des entités dans des SCU particuliers, l'accroissement des segments peut être bizzare ou la routine se plante.

Des effets papillons sur le même bord lors de sucession d'un arc et ligne avec un angle serré. (un algorithme a implanter..)

 

Bref c'est loin d'être achevé!

 

Si (gile) peut apporté des améliorations, ça sera volontier, car j'atteint mes limites d'analyse.

 

Je me suis trouver confronter à un drôle de problème, cela concerne (atan (cadr deriv) (car deriv)), deriv étant le résultat de (vlax-curve-getFirstDeriv obj param)

 

(angtos (atan (cadr deriv) (car deriv))) me retourne bien le bon angle, mais les valeurs négatives ou positive de (cadr deriv) et de (car deriv) m'ont bien gêner pour trouver l'orientement correct des tangentes aux sommets (j'avais des valeur à pi prés, gênant pour orienter comme il faut.)

Ma surprise vient que si je manipule avec (angtos (atan)), je n'est plus de problème de signe, mais convertir pour faire des test de condition, ça devient lourd.

 

Donc du coup je me suis rabattu sur un orientement vectoriel. Bref, complétement perdu le bonhomme!

 

Donc si (gile) ou un autre, peuvent me pointer du doigt là où le mât blesse, c'est volontier...

 

Le challenge continu. A nous tous, on en aura une plus grosse qu'AutoDesk! :(rires forts):

[lili2006]

Bonsoir à toutes et tous,

 

Merci du partage tout d'abord, et je pense, que tout comme Didier dans ce genre de cas, j'aurai pratiqué comme lui, mais ça, c'est liè à notre métier ou des limites non aedificandi peuvent corresponde au cas cité dans cette image (la fameuse technique des droites décalées issus de la méthode d'intersection vu par Delambre,..)http://pix.toile-libre.org/upload/img/1507016928.png

[didier]

Coucou

C'est génial ce qui arrive

Chez otto daisque ils ont mis cadxp sur écoute pour implémenter de VRAIES nouvelles commandes.

La solution est dans l'union

[zebulon_]

Chez otto daisque ils ont mis cadxp sur écoute pour implémenter de VRAIES nouvelles commandes.

C'est sûr que ce cher (même très cher) otto y gagnerait :P

 

Une proposition en décalant segment par segment, bien entendu proportionnellement. Le lisp recherche l'intersection des segments adjacents et supprime ou rajoute les vertex pour que ça se raccorde bien. Il reste toujours le problème des très petits segments qui peuvent disparaitre entièrement du fait du décalage et qui provoque des erreurs.

 

(defun PTaDroiteObj (obj pt / PTN PM fder PT1DERIV)
 (if (= (type Obj) 'ENAME)
   (setq Obj (vlax-ename->vla-object Obj))
 )
 (setq PTN (vlax-curve-GetClosestPointTo obj PT))
 (setq PM (vlax-curve-GetParamAtPoint obj PTN))
 (setq fder (vlax-curve-getfirstderiv obj PM))
 (setq PT1DERIV (mapcar '+ PTN fder))
 (< (sin (- (angle PTN PT) (angle PTN PT1DERIV))) -1e-14)
)

(defun getpolySegs (ent / PTL I PTB SEG LSEG)
 (if (= (type ent) 'ENAME)
   (setq ent (vlax-ename->vla-object ent))
 )
 ;; collecter la liste des point sous la forme (x1 y1 x2 y2 ... xn yn)
 (setq PTL (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates ENT))))
 ;; collecter la liste des bulges
 (setq I 0) 
 (repeat (/ (length PTL) 2)
   (setq PTB (cons (vla-GetBulge ent I) PTB))
   (setq I (1+ I))
 )
 (setq PTB (reverse PTB))
 ;; polyligne fermée -> rajouter le premier point à la liste de points
 (if (= (vla-get-closed ent) :vlax-true)
   (setq PTL (append PTL (list (car PTL) (cadr PTL))))
 )
 ;; transformer en liste de segments
 (setq I 0)
 (repeat (- (/ (length PTL) 2) 1)
   (setq SEG
     (list
       (list (nth I PTL) (nth (+ I 1) PTL))
       (nth (/ I 2) PTB)
       (list (nth (+ I 2) PTL) (nth (+ I 3) PTL))
     )
   )
   (setq LSEG (cons SEG LSEG))
   (setq I (+ I 2))
 )
 (reverse LSEG)
)

(defun getArcInfo (segment / a p1 bulge p2 c p3 p4 p r s result)
 ;; assigner variables avec les valeurs de l'argument
 (mapcar 'set '(p1 bulge p2) segment)
 (if (not (zerop bulge))
   (progn
     ;; trouver la corde
     (setq c (distance p1 p2))
     ;; trouver la flèche
     (setq s (* (/ c 2.0) (abs bulge)))
     ;; trouver le rayon par Pythagore
     (setq r (/ (+ (expt s 2.0) (expt (/ c 2.0) 2.0)) (* 2.0 s)))
     ;; distance au centre
     (setq a (- r s))
     ;; coordonnées du milieu de p1 et P2
     (setq P4 (polar P1 (angle P1 P2) (/ c 2.0)))
     ;; coordonnées du centre
     (setq p
       (if (>= bulge 0)
         (polar p4 (+ (angle p1 p2) (/ pi 2.0)) a)
         (polar p4 (- (angle p1 p2) (/ pi 2.0)) a)
       )  
     )
     ;; coordonnées de P3
     (setq p3
       (if (>= bulge 0)
         (polar p4 (- (angle p1 p2) (/ pi 2.0)) s)
         (polar p4 (+ (angle p1 p2) (/ pi 2.0)) s)
       )  
     )
     (setq result (list p r))
   )
   (setq result nil)
 )
 result
)

(defun vlax-list->3D-point (lst / nlst)
 (while lst
   (setq nlst (cons (list (car lst) (cadr lst) (caddr lst)) nlst))
   (setq lst (cdddr lst))
 )
 (reverse nlst)
)

(defun list->variantArray (ptsList / arraySpace sArray)
 ; allocate space for an array of 2d points stored as doubles
 (setq arraySpace
   (vlax-make-safearray
     vlax-vbdouble ; element type
     (cons 0
       (- (length ptsList) 1)
     ) ; array dimension
   )
 )
 (setq sArray (vlax-safearray-fill arraySpace ptsList))
 ; return array variant
 (vlax-make-variant sArray)
)

(defun getptsegd (SEG PT)
   (mapcar 'set '(P1 BULGE P2) SEG)
   (if adroite 
      (setq ANG (* 3 (/ pi 2)))
      (setq ANG (/ pi 2))
   )
   (polar PT (+ (angle P1 P2) ANG) (+ decd (* (- decf decd) (/ (vlax-curve-getDistAtpoint obj PT) LongObj))))
)

(defun getptsegc (SEG PT)
   (mapcar 'set '(P1 BULGE P2) SEG)
   (setq PTC (car (getarcinfo SEG)))
   (if adroite 
      (setq ANG pi)
      (setq ANG 0)
   )
   (if (> BULGE 0)
     (setq ANG (+ (angle PT PTC) ANG))
     (setq ANG (+ (angle PTC PT) ANG))
   )
   (polar PT ANG (+ decd (* (- decf decd) (/ (vlax-curve-getDistAtpoint obj PT) LongObj))))
)


(defun c:decvarg ()

 ;; valeur de décalage au départ
 (if (not decd) (setq decd 0.20))
 (setq tmp (getdist (strcat "\nSpécifier la distance de décalage à l'origine  <" (rtos decd) "> : ")))
 (if tmp (setq decd tmp))

 ;; valeur de décalage à la fin
 (if (not decf) (setq decf 0.50))
 (setq tmp (getdist (strcat "\nSpécifier la distance de décalage à la fin  <" (rtos decf) "> : " )))
 (if tmp (setq decf tmp))

 (setq e (car (entsel "\nSélectionner la polyligne à décaler : ")))
 (setq pt (getpoint "\n Spécifiez un point sur le côté à décaler : "))

 ;; précision des parties courbes
 (if (not PREC_COURBE) (setq PREC_COURBE 0.1))
 (setq tmp (getreal (strcat "\nValeur approximative de la flèche de discrétisation des parties courbes  <" (rtos PREC_COURBE) "> : ")))
 (if tmp (setq PREC_COURBE tmp))
 
 (setq obj (vlax-ename->vla-object e))
 (setq LongObj (vla-get-length obj))

 (setq adroite (PTaDroiteObj obj (trans PT 1 0)))

 (setq Lsegs (getPolySegs obj))
 (setq Lename nil)

 (While LSegs
   (setq SEG (car Lsegs))
   (setq lsegs (cdr Lsegs))
   (mapcar 'set '(P1 BULGE P2) SEG)
   (if (zerop BULGE) ;; c'est un segment droit
     (progn
       (setq PT1 (getptsegd SEG P1))
       (setq PT2 (getptsegd SEG P2))
       (command "_pline" "_non" (trans PT1 0 1) "_non" (trans PT2 0 1) "")
       (setq Lename (cons (entlast) Lename))
     ) ;;progn
     (progn  ;; c'est un segment courbe
       (setq PKdebut (vlax-curve-GetDistAtPoint obj P1))
       (setq PKfin (vlax-curve-GetDistAtPoint obj P2))
       (setq Larc (- PKfin PKdebut))
       (setq R (cadr (getarcinfo SEG)))
       (setq X (* 2 (sqrt (* 2 R PREC_COURBE)))) ;; estimation corde
       (setq NBPAS (fix (/ Larc X)))
       (setq PAS (/ Larc NBPAS))  ;; je coupe les courbes en NBPAS segments droits de longueur environ X
       (setq PKcourant PKdebut)
       (command "_pline" "_non" (trans (getptsegc SEG (vlax-curve-GetPointAtDist obj PKcourant)) 0 1)) 
       (repeat NBPAS
         (setq PKcourant (+ PKcourant PAS))
         (command "_non" (trans (getptsegc SEG (vlax-curve-GetPointAtDist obj PKcourant)) 0 1))
       ) ;; repeat
       (command "")
       (setq Lename (cons (entlast) Lename))
     ) ;; progn
   );; if
 ) ;;  while

 (setq Lename (reverse Lename))

 ;; trouver les intersections
 (setq a 0) 
 (repeat (- (length lename) 1)
   (setq e1 (vlax-ename->vla-object (nth a lename)))
   (setq e2 (vlax-ename->vla-object (nth (+ a 1) lename)))
   (setq PTLISTe1 (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates e1))))
   (setq PTLISTe2 (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates e2))))
   (setq PTProche (vlax-curve-getPointAtDist e2 0))
   (setq LPTINT (vlax-list->3D-point (vlax-invoke e1 'IntersectWith e2 acExtendNone)))
   (if LPTINT
     (progn ;; les segments se croisent
       (setq RES (car LPTINT))
       (setq DMIN (distance PTPROCHE RES))
       (foreach PTINT LPTINT
         (if (< (distance PTProche PTINT) DMIN)
           (setq RES PTINT)
         )
       )
       ;; sur quel segment on se situe sur e1 et e2 ?
       (setq numseg1 (fix (vlax-curve-getParamAtPoint e1 RES)))
       (setq numseg2 (fix (vlax-curve-getParamAtPoint e2 RES)))

       ;; modifier PTLISTe1
       ;; supprimer les n dernières entrées de la liste
       (setq PTLISTe1 (reverse PTLISTe1))
       (repeat (* (- (fix (vlax-curve-getEndParam e1)) numseg1) 2)
          (setq PTLISTe1 (cdr PTLISTe1))
       )
       ;; rajouter x et y de l'intersection au début de la liste
       (setq PTLISTe1 (cons (car RES) PTLISTe1))     
       (setq PTLISTe1 (cons (cadr RES) PTLISTe1))     
       (setq PTLISTe1 (reverse PTLISTe1))
       (vla-put-Coordinates e1 (list->variantArray PTLISTe1))
  
       ;; modifier PTLISTe2
       ;; supprimer les n premières entrées de la liste
       (repeat (* (+ numseg2 1) 2)
         (setq PTLISTe2 (cdr PTLISTe2))
       )
       ;; rajouter x et y de l'intersection au début de la liste
       (setq PTLISTe2 (cons (cadr RES) PTLISTe2))     
       (setq PTLISTe2 (cons (car RES) PTLISTe2))     
       (vla-put-Coordinates e2 (list->variantArray PTLISTe2))
     )
     (progn ;; les segments ne se croisent pas
       (setq LPTINT (vlax-list->3D-point (vlax-invoke e1 'IntersectWith e2 acExtendBoth)))
       (setq RES (car LPTINT))
       (setq DMIN (distance PTPROCHE RES))
       (foreach PTINT LPTINT
         (if (< (distance PTProche PTINT) DMIN)
           (setq RES PTINT)
         )
       )
       ;; on rajoute un vertex à la fin de e1
       (vla-addvertex e1 (/ (length PTLISTe1) 2) (list->variantArray (list (car RES) (cadr RES))))

       ;; on rajoute un vertex au début de e2
       (vla-addvertex e2 0 (list->variantArray (list (car RES) (cadr RES))))
     )
   )
   (setq a (+ a 1))
 )

 ;; mettre toutes les pline ensemble
 (command "_pedit" (car lename) "_j")
 (setq lename (cdr lename))
 (foreach E lename
   (command E)
 )
 (command "" "")

 (princ)
)

 

Amicalement

Vincent

[bonuscad]

Vincent, j'ai essayé ton lisp sur des figures un peu complexe et sans vouloir te décevoir, ce n'est pas ça.

 

Pour ma part j'ai essayé de résoudre les phénomènes de boucle qui se croisent dans les segments décalés, mais je crois que je vais laisser tomber (trop complexe à analyser).

 

J'ai édité mon code précédent du 4 Octobre où j'ai corrigé les plantages ou bugs que j'ai pu observé lors de test plus poussés. Il peut en rester...

Donc à recopier pour tester!

 

En résumé la routine accepte de traiter des LWPOLYLIGNE et POLYLIGNE2D (non lissé ou spliné) qu'elles soient fermée ou ouverte et ce dans n'importe quel SCU avec des entité crées aussi dans des SCU particulier (même ceux non parallèle au SCG).

 

Je n'ai pas pu rivaliser avec l'algorithme d'Autodesk qui matérialise les épaisseurs en supprimant les boucles croisées et les rebroussements des bords droit ou arrondi, je m'incline :(

[zebulon_]

Vincent, j'ai essayé ton lisp sur des figures un peu complexe et sans vouloir te décevoir, ce n'est pas ça.

 

Bonjour,

disons que la partie qui décale segment par segment, ça marche assez bien. Mais alors pour trouver les intersections et couper les bons côtés des segments, c'est beaucoup plus difficile. J'ai essayé d'utiliser la commande native _fillet pour raccorder les différents segments sans trop me fatiguer, mais si on utilise _fillet en lisp, on ne maitrise pas le côté qu'on conserve et j'ai l'impression qu'autocad conserve toujours le plus grand côté résiduel.

 

Mais rassure-moi, sur des figures simples ça marche ?

 

De toute façon, je ne vais pas pousser plus loin, compte tenu que j'atteins mes limites également

 

Amicalement

Vincent

[bonuscad]

Mais rassure-moi, sur des figures simples ça marche ?

 

Oui, si on reste sur des tracés homogène (segment relativement régulier) et cohérent avec le décalage voulu.

 

si on utilise _fillet en lisp, on ne maitrise pas le côté qu'on conserve

 

De souvenir, il me semble que si tu fourni une liste semblable à ce que retourne (entsel) au lieu d'un simple ename cela à une influence sur la commande _fillet.

Donc en construisant une liste semblable avec un point d'extrémité de ta ligne et son ename tu devrait obtenir le résultat souhaité.

La commande _fillet va se comporter alors comme une utilisation manuelle, c'est à dire que le point de sélection à son importance suivant de quelle extrémité il est le plus proche.

[zebulon_]

De souvenir, il me semble que si tu fourni une liste semblable à ce que retourne (entsel) au lieu d'un simple ename cela à une influence sur la commande _fillet.

Donc en construisant une liste semblable avec un point d'extrémité de ta ligne et son ename tu devrait obtenir le résultat souhaité.

La commande _fillet va se comporter alors comme une utilisation manuelle, c'est à dire que le point de sélection à son importance suivant de quelle extrémité il est le plus proche.

 

ok merci, je vais tester cela, parce que ça me simplifierait grandement le problème si je peux refiler le raccordement entre les différents segments à une commande native.

 

Amicalement

Vincent