Polyligne croisée

[VDH-Bruno]

Bonjour,

 

Qui aurait un lien, routine, co-routine ou extrait de code lisp, de décalage des lwpolyligne croisées.

Pour être un peu plus clair sur ma version (peut-être cela à évolué depuis), une polyligne optimisé lorsqu'elle est décalé se coupe à chaque croisement…

 

Je cherche une routine ou extrait de code qui traite ce décalage de polyligne en la gardant en un seul morceau continu, dans l'optique d'avoir une base de départ à adapter rapidement pour à un besoin ponctuel.

 

D'avance merci

VDH-Bruno

[zebulon_]

Bonjour,

 

(defun offsetpline (e d pt1 / lseg I seg PTD BULGE PTF ARCINFO A1 aDroite angd angf R RES)
 (setq aDroite (PtaDroiteObj e PT1))
 (setq RES nil)

 ;; trouver la liste des segments de polyligne
 (setq lseg (getpolysegs e))

 ;; faire les offsets de chaque segment
 (if aDroite
   (setq ANG (* 3 (/ pi 2)))
   (setq ANG (/ pi 2))
 )
 (setq I 0)
 (repeat (length lseg)
   (setq seg (nth I lseg))
   (setq PTD (car seg))
   (setq BULGE (cadr seg))
   (setq PTF (caddr seg))
   (if (zerop bulge)
     (progn
       (setq A1 (angle PTD PTF))
       (setq PTD (polar PTD (+ A1 ANG) D))
       (setq PTF (polar PTF (+ A1 ANG) D))
       (vla-addline space (vlax-3d-point PTD) (vlax-3d-point PTF))
       (setq RES (cons (entlast) RES))
     )
     (progn
       (setq ARCINFO (getArcInfo seg))
       (if (> bulge 0)
         (progn
           (setq angd (angle (car ARCINFO) PTD))
           (setq angf (angle (car ARCINFO) PTF))
           (if aDroite
              (setq R (+ (cadr ARCINFO) D))
              (setq R (- (cadr ARCINFO) D))
           )
         )
         (progn
           (setq angd (angle (car ARCINFO) PTF))
           (setq angf (angle (car ARCINFO) PTD))
           (if aDroite
              (setq R (- (cadr ARCINFO) D))
              (setq R (+ (cadr ARCINFO) D))
           )
         )
       ) 
       (vla-addarc space (vlax-3d-point (car ARCINFO)) R angd angf)
       (setq RES (cons (entlast) RES))
     )
   )
   (setq I (+ I 1))
 )
 (reverse RES)
)

 

qui utilise aussi :

  (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
       Space (if (= (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc) 
             )
 )

et

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

 

En principe, offsetpline crée l'offset de chaque segment et renvoie une liste contenant chaque segment créé. J'ai créé cette fonction pour gérer des polylignes dont les segments successifs sont tangents (une droite, un arc, une droite, un arc, etc...) et je n'ai pas eu à me préoccuper du raccord entre chaque segment décalé nouvellement créé.

 

(offsetpline e d PT1)

 

e : ename ou obj de la polyligne à décaler

d : la distance

pt1 : le point indiquant le côté (en SCG)

 

Amicalement

Vincent

 

PS : si j'ai oublié une fonction, n'hésite pas à me solliciter.

[(gile)]

Salut Bruno,

 

Tu peux aussi peut-être trouver un peu d'inspiration dans PolySegments.lsp qui permet de copier ou décaler un ou plusieurs segments de polyligne.

[VDH-Bruno]

Un grand merci à vous 2, j'ai regardé et testé vos 2 codes (très complémentaire pour mon besoin), j'ai là toute la matière pour arriver à ce que je souhaiterai, il y a plus cas.. ;)

 

A+ Bruno