Aller au contenu

Comment déduire des longueurs de segment d'une polyligne ?


oran

Messages recommandés

Bonjour,

 

Je souhaite tracer une polyligne d'une longueur bien précise mais de façon qu'Autocad me déduise automatiquement les longueurs des segments que je trace afin que je sache au fur et à mesure ce qu'il me reste comme longueur.

 

Exemple: une polyligne de 10,00ml à tracer

- je trace mon 1er segment de 2,00ml ---> Autocad me dit qu'il reste 8,00ml

- je trace mon 2ème segment de 1.50ml ---> Autocad me dit qu'il reste encore 6,50ml etc ......

 

Est-ce faisable par lisp ??? :blink:

 

Merci d'avance.

Lien vers le commentaire
Partager sur d’autres sites

Salut,

 

Je pensais l'avoir déjà publiée ici mais je ne la retrouve pas.

 

La routine ci-dessous affiche dynamiquement la longueur restante (restrictions : plus d’accrochages aux objets et uniquement des segments droits).

 

;; PLL
;; Dessine un polyligne de longueur limitée
(defun c:PLL (/          *error*    drawSegment           drawPline  makePline  color
             segLen     cursor     loop       points     input      result     maxPt
             dist
            )

 ;; redéfinition locale de la fonction *error*
 (defun *error* (msg)
   (and msg
        (/= msg "Fonction annulée")
        (prompt (strcat "\nErreur: " msg))
   )
   (grtext)
   (redraw)
   (princ)
 )

 ;; affichage temporaire des segments déjà spécifiés
 (defun drawPline (points)
   (mapcar
     '(lambda (p1 p2) (grdraw p1 p2 color))
     points
     (cdr points)
   )
 )

 ;; mise à jour du point extreme et affichage temporaire du dernier segment
 (defun drawSegment (basePt dragPt segLen)
   (setq maxPt (polar basePt (angle basePt dragPt) segLen))
   (if (< (distance basePt dragPt) segLen)
     (progn
       (grdraw basePt dragPt -1)
       (grdraw dragPt maxPt 8 1)
     )
     (grdraw basePt maxPt -1)
   )
 )

 ;; création de la polyligne
 (defun makePline (points / ucszdir)
   (setq ucszdir (trans '(0 0 1) 1 0 T))
   (entmakex
     (append
       (list
         (cons 0 "LWPOLYLINE")
         (cons 100 "AcDbEntity")
         (cons 100 "AcDbPolyline")
         (cons 90 (length points))
         (cons 70 0)
         (cons 38 (caddr (trans '(0 0 0) 1 ucszdir)))
         (cons 210 ucszdir)
       )
       (mapcar
         '(lambda (p) (cons 10 (trans p 1 ucszdir)))
         points
       )
     )
   )
 )

 ;; fonction principale
 (sssetfirst nil nil)
 (or (numberp *PlineMaxLength*) (setq *PlineMaxLength* 5000.0)) ;_ valeur par défaut initiale
 (setq color (cdr (assoc 62 (tblsearch "layer" (getvar 'clayer)))))
 (if
   (and
     (or
       (and
         (setq
           segLen (getdist
                    (strcat "\nSpécifiez la longueur maximale <" (rtos *PlineMaxLength*) ">: ")
                  )
         )
         (setq *PlineMaxLength* segLen)
       )
       (setq segLen *PlineMaxLength*)
     )
     (setq basePt (getpoint "\nSpécifiez le premier point: "))
     (setq points (cons basePt points)
           input  ""
           loop   T
     )
   )
    (progn
      (prompt (strcat "\nCliquez le point suivant (longueur restante : " (rtos seglen) "): "))
      (while
        (and (setq result (grread T 12 0)) loop)
         (cond
           ;; mise à jour en fonction de la position du curseur
           ((= (car result) 5)
            (setq cursor (cadr result))
            (redraw)
            (drawPline points)
            (drawSegment (car points) cursor segLen)
           )
           ;; clic gauche
           ((= 3 (car result))
            (setq dist (distance (car points) cursor))
            (if (< dist segLen)
              (progn
                (setq points (cons cursor points)
                      segLen (- segLen dist)
                )
                (prompt (strcat "\nCliquez le point suivant ou validez (longueur restante : " (rtos seglen) "): "))
              )
              (progn
                (makePline (cons maxPt points))
                (setq loop nil)
              )
            )
           )
           ;; validation
           ((or (equal result '(2 13)) ;_ Entrée
                (equal result '(2 32)) ;_ Espace
                (= (car result) 25) ;_ clic droit
            )
            (makePline points)
            (setq loop nil)
           )
         )
      )
    )
 )
 (*error* nil)
)

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

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é