Aller au contenu

Décaler une polyligne en conservant les 2 extrémités


mocsar

Messages recommandés

Bonjour à tous,

 

Je travaille actuellement sur un projet de pose de câbles. Sur le plan, je me retrouve avec x câbles superposés, mon client me demande donc de décaler chaque polyligne afin d'éviter la superposition. C'est là que j'ai besoin de votre aide, je cherche un moyen (lisp, astuce, routine...) pour décaler ma polyligne, mais en conservant les points de départ et de fin de celle-ci. Contrainte supplémentaire, je ne peux pas utiliser de multilignes, et chaque polyligne doit être sur un calque différent.

 

Merci d'avance pour votre aide.

 

Bonne journée

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

J'ai tenté ceci sans avoir testé en profondeur (donc certainement améliorable)

(defun C:Offset4Scheme ( / obj ent vla-ent pt_sel param deriv alpha dis_offset where_pt v1 v2 det_or e_last obj_vlax AcDoc Space)

 (while (not (setq obj (entsel "\nSélectionner l'objet à décaler: "))))
 (setq ent (car obj) vla-ent (vlax-ename->vla-object ent))
 (cond
   ((member
     (vlax-get-property vla-ent 'ObjectName)
     '("AcDbPolyline" "AcDb2dPolyline")
    )
     (setq
       pt_sel (vlax-curve-getClosestPointTo vla-ent (trans (cadr obj) 1 0))
       param (vlax-curve-getparamatpoint vla-ent pt_sel)
       deriv (vlax-curve-getfirstderiv vla-ent param)
       alpha (atan (cadr deriv) (car deriv))
       pt1_start (vlax-curve-getStartPoint vla-ent)
       pt1_end (vlax-curve-getEndPoint vla-ent)
       par (vlax-curve-getParamAtPoint vla-ent pt1_end)
     )
     (redraw ent 3)
     (initget "Par _Through")
     (setvar "OFFSETDIST"
       (if (not (setq dis_offset (getdist (strcat "\nSpécifiez la distance de décalage ou [Par] <" (if (< (getvar "OFFSETDIST") 0) "Par" (rtos (getvar "OFFSETDIST"))) ">: "))))
         (progn (if (< (getvar "OFFSETDIST") 0) (setq dis_offset "Through")) (getvar "OFFSETDIST"))
         (if (eq dis_offset "Through") -1 dis_offset)
       )
     )
     (if (< (getvar "OFFSETDIST") 0)
       (princ "\nAttribuez une valeur à \"Par le point\": ")
       (princ "\nSpécifiez un point sur le côté à décaler: ")
     )
     (initget 9)
     (setq where_pt (getpoint))
     (if (< (getvar "OFFSETDIST") 0)
       (setvar "OFFSETDIST"
         (distance
           (vlax-curve-getClosestPointToProjection vla-ent
             (trans where_pt 1 0)
             (mapcar '- (trans (getvar "VIEWDIR") 1 0) (trans '(0 0 0) 1 0))
             T
           )
           (list (car (trans where_pt 1 0)) (cadr (trans where_pt 1 0)))
         )
       )
     )
     (redraw ent 4)
     (setq alpha (atan (cadr deriv) (car deriv)))
     (setq
       v1 (mapcar '- (polar pt_sel alpha 1.0) pt_sel)
       v2 (mapcar '- (trans where_pt 1 0) pt_sel)
     )
     (setq det_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2)))
     (cond
       ((> det_or 0.0) (setvar "OFFSETDIST" (- (abs (getvar "OFFSETDIST")))))
       ((< det_or 0.0) (setvar "OFFSETDIST" (abs (getvar "OFFSETDIST"))))
     )
     (setq e_last ent)
     (if
       (and
         e_last
         (vl-catch-all-error-p
           (vl-catch-all-apply
             'vla-Offset
             (list (vlax-ename->vla-object e_last)
               (getvar "OFFSETDIST")
             )
           )
         )
       )
       (progn (setq e_last nil) (princ "\nL'objet ne peut pas être décalé."))
       (progn
         (setq
           e_last (entlast)
           obj_vlax (vlax-ename->vla-object e_last)
           AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
           Space
           (if (eq (getvar "CVPORT") 1)
             (vla-get-PaperSpace AcDoc)
             (vla-get-ModelSpace AcDoc)
           )
           l_pt (cons (car pt1_start) (cons (cadr pt1_start) (cddr (reverse (cons (cadr pt1_end) (cons (car pt1_end) (cddr (reverse (vlax-get obj_vlax 'Coordinates)))))))))
         )
         (if (eq (vla-get-ObjectName obj_vlax) "AcDbPolyline")
           (vlax-invoke Space 'AddLightWeightPolyline l_pt)
           (vlax-invoke Space 'AddPolyline l_pt)
         )
         (entdel e_last)
       )
     )
   )
   (T (princ "\nL'objet ne peut pas être décalé."))
 )
 (princ)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité