CADxp: Besoin d'aide, Lisp "PLL" à améliorer. - CADxp

Aller au contenu

Page 1 sur 1

Besoin d'aide, Lisp "PLL" à améliorer.

#1 L'utilisateur est hors-ligne   oran 

  • ceinture marron
  • Groupe : Membres
  • Messages : 225
  • Inscrit(e) : 16-mai 07

Posté 09 octobre 2019 - 08:00

Bonjour,

J'ai récupéré ce Lisp il y quelques temps maintenant (je remercie son auteur au passage)et je souhaiterai y apporter une petite amélioration mais malheureusement je n'y connais rien en Lisp ...!! ;)
Ce Lisp permet de tracer, par segments, une polyligne de longueur définie. Pour les connaisseurs elle est très utile pour tracer les volumes de sécurité dans les salles de bains.
Seul bémol au moment du tracé aucun "point d'accrochage" n'est validé.
Donc dans un premier temps est-ce possible de rajouter cette option ? Et j'ose abuser en demandant le "repérage polaire" également, dans la mesure du possible bien sûr.

Vous en remerciant sincèrement par avance.

Citation

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

0

#2 L'utilisateur est hors-ligne   didier 

  • ceinture rouge et blanche 8em dan
  • Groupe : Moderateurs
  • Messages : 8352
  • Inscrit(e) : 18-décembre 02
  • LocationPlanète : Terre

Posté 09 octobre 2019 - 08:30

Coucou

Du fait de l'utilisation de la fonction (grread) il ne va pas être possible d'utiliser l'accrochage aux objets sans alourdir notoirement le code (qui l'est déjà)
Du côté de chez LeeMac tu as quelque chose d'existant mais je laisse la main par manque de temps
Je te donne la piste de recherche...

Dans ton cas un cercle ferait l'affaire..., non ?

Amicalement
Éternel débutant ...
Programmer AutoCAD
0

#3 L'utilisateur est hors-ligne   oran 

  • ceinture marron
  • Groupe : Membres
  • Messages : 225
  • Inscrit(e) : 16-mai 07

Posté 09 octobre 2019 - 09:52

Merci de ta réponse,

Effectivement le cercle fait bien partie de la solution mais je t'invite à faire une recherche "volumes de sécurité
douche" sur GOOGLE, tu te rendras mieux compte et sûrement plus simple qu'un explication.
Merci encore,
Sylvain
0

#4 L'utilisateur est hors-ligne   oran 

  • ceinture marron
  • Groupe : Membres
  • Messages : 225
  • Inscrit(e) : 16-mai 07

Posté 10 octobre 2019 - 07:42

Super, trouvé sur LeeMac
TotalLengthPolylineV1-0.lsp
Exactement ce que je recherche,
Merci bcp
Sylvain
0

Partager ce sujet :


Page 1 sur 1


Réponse rapide

  

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)