Lisp gaine souple

[Laucri67]

Bonjour

Voila mon souci, j'ai un lisp de gaine souple que je voudrais améliorer depuis longtemps, mais étant novice dans la conception de ce genre de programme :blink:

 

Quelqu'un pourrait t'il m'aider à le faire

 

je voudrais pouvoir au moment du lancement lui attribuer un calque

et si cela est possible pour représenter la " flexibilitée " au lieu de trait oblique avoir une élipse (ellipse en 2 point)

je vous joint mon lisp est si une bonne âme

alors je vous remercie d'avance

 

 

 

 

 

 

-----------------------------------------------------

 

 

;=============================================================================

 

; SP permet de tracer une gaine en souple … partir de la s‚lection

; de l'axe du trajet.

 

;=============================================================================

(defun *error* (ch)

(princ ch)

(princ)

) ;Fin de error

 

;------------- Transformation d'un angle de radians en degres ---------------

 

(defun DGR (a)

(* 180 (/ a PI))

); Fin de defun

 

;------------- Recouvrement des extr‚mit‚s -----------------------------------

 

(defun EXT ()

(setq Ex1D1 (cdr (assoc 10 (entget D1))))

(setq Ex2D1 (cdr (assoc 11 (entget D1))))

(setq Ex1D2 (cdr (assoc 10 (entget D2))))

(setq Ex2D2 (cdr (assoc 11 (entget D2))))

); Fin de defun

 

;------------- Constitution de la s‚lection pour le r‚seau -------------------

 

(defun AJED ()

(ssadd (entlast) rsel)

); Fin de defun

 

;============= Commande SCU ==================================================

 

(defun SP:SCU (rep / PTP vers lang)

(setq vers (atoi (substr (getvar "acadver") 1 2)))

(if (wcmatch (getvar "acadver") "*Hardware Lock*")

(setq lang "fr")

(setq lang "en")

);if

 

(cond

((= rep "SG")

(setq PTP (trans pt1 1 0))

(if (> vers 11)

(command "_ucs" "")

(if (= lang "fr")

(command "scu" "")

(command "ucs" "")

);if

);if

(setq PT1 (trans ptp 0 1))

(setq TSCU T);SCU General

)

 

((= rep "S3")

(setq PTP (trans pt1 1 0))

(if (> vers 11)

(command "_ucs" "_z" 30)

(if (= lang "fr")

(command "scu" "z" 30)

(command "ucs" "z" 30)

);if

);if

(setq PT1 (trans ptp 0 1))

(setq TSCU T);SCU Z 30

)

 

((= rep "S4")

(setq PTP (trans pt1 1 0))

(if (> vers 11)

(command "_ucs" "_z" 45)

(if (= lang "fr")

(command "scu" "z" 45)

(command "ucs" "z" 45)

);if

);if

(setq PT1 (trans ptp 0 1))

(setq TSCU T);SCU Z 45

)

 

((= rep "S6")

(setq PTP (trans pt1 1 0))

(if (> vers 11)

(command "_ucs" "_z" 60)

(if (= lang "fr")

(command "scu" "z" 60)

(command "ucs" "z" 60)

);if

);if

(setq PT1 (trans ptp 0 1))

(setq TSCU T);SCU Z 60

)

 

((= rep "SCu")

(initget "Entite Z General")

(setq repsc (getkword "\nSCU : Entite/Z/<General> :"))

(if (= nil repsc)

(setq repsc "General")

);if

 

(cond

((= repsc "Entite")

(setvar "osmode" 512)

(setq ptsc (getpoint "\nChoix d'objet correspondant au SCU :"))

(setq Etsc (ssget ptsc))

(setq PTP (trans pt1 1 0))

(if (> vers 11)

(command "_ucs" "_e" Etsc)

(if (= lang "fr")

(command "scu" "e" Etsc)

(command "scu" "e" Etsc)

);if

);if

(setq PT1 (trans ptp 0 1))

(setq TSCU T)

(setvar "osmode" 0)

)

 

((= repsc "Z")

(setq D1 (getreal "\n Angle de rotation autour de l'axe Z :"))

(setq PTP (trans pt1 1 0))

(if (> vers 11)

(command "_ucs" "_z" D1)

(if (= lang "fr")

(command "scu" "z" D1)

(command "ucs" "z" D1)

);if

);if

(setq PT1 (trans ptp 0 1))

(setq TSCU T)

)

 

((= repsc "General")

(setq PTP (trans pt1 1 0))

(if (> vers 11)

(command "_ucs" "")

(if (= lang "fr")

(command "scu" "")

(command "ucs" "")

);if

);if

(setq PT1 (trans ptp 0 1))

(setq TSCU T);SCU General

)

); Fin de cond

)

);Fin de cond

);Fin de defun

 

;============== Dessin d'une partie rectiligne ================================

 

(defun LG (D / vers lang)

(setq vers (atoi (substr (getvar "acadver") 1 2)))

(if (wcmatch (getvar "acadver") "*Hardware Lock*")

(setq lang "fr")

(setq lang "en")

);if

(setq rsel nil)

(setq rsel (ssadd)) ; Creation de la selection pour le reseau

(if (> vers 11)

(command "_ucs" "")

(if (= lang "fr")

(command "scu" "")

(command "ucs" "")

);if

);if

(setq Ex1D (cdr (assoc 10 (entget D))))

(setq Ex2D (cdr (assoc 11 (entget D))))

(setq lgD (distance Ex1D Ex2D))

(setq angD1 (angle Ex1D Ex2D))

(setq Nbr (atoi (rtos (/ LgD pasR) 2 0)))

(if (<= Nbr 0)

(setq Nbr 1)

);if

(setq sp_p (/ lgD Nbr))

(setq A1 (polar Ex1D (+ angD1 (/ PI 2)) (/ diam 2)))

(setq B1 (polar Ex1D (- angD1 (/ PI 2)) (/ diam 2)))

(if (> vers 11)

(command "_line" A1 B1 "")

(if (= lang "fr")

(command "ligne" A1 B1 "")

(command "line" A1 B1 "")

);if

);if

(AJED)

 

(setq IpD (polar Ex1D angD1 (/ sp_p 2)))

(setq A2 (polar IpD (+ angD1 (/ PI 2)) (/ (+ diam ep) 2)))

(setq B2 (polar IpD (- angD1 (/ PI 2)) (/ (+ diam ep) 2)))

(if (> vers 11)

(progn

(command "_line" A1 A2 "") (AJED)

(command "_line" B1 B2 "") (AJED)

(command "_line" A2 B2 "") (AJED)

);progn

(if (= lang "fr")

(progn

(command "ligne" A1 A2 "") (AJED)

(command "ligne" B1 B2 "") (AJED)

(command "ligne" A2 B2 "") (AJED)

);progn

(progn

(command "line" A1 A2 "") (AJED)

(command "line" B1 B2 "") (AJED)

(command "line" A2 B2 "") (AJED)

);progn

);if

);if

 

(setq IpD (polar Ex1D angD1 sp_p))

(setq A3 (polar IpD (+ angD1 (/ PI 2)) (/ diam 2)))

(setq B3 (polar IpD (- angD1 (/ PI 2)) (/ diam 2)))

 

(if (> vers 11)

(progn

(command "_line" A2 A3 "") (AJED)

(command "_line" B2 B3 "") (AJED)

(command "_ucs" "_e" D)

(command "_erase" D "")

(if (/= Nbr 1) (command "_array" rsel "" "_r" 1 Nbr sp_p))

(command "_ucs" "")

);progn

(if (= lang "fr")

(progn

(command "ligne" A2 A3 "") (AJED)

(command "ligne" B2 B3 "") (AJED)

(command "scu" "e" D)

(command "effacer" D "")

(if (/= Nbr 1) (command "reseau" rsel "" "r" 1 Nbr sp_p))

(command "scu" "")

);progn

(progn

(command "line" A2 A3 "") (AJED)

(command "line" B2 B3 "") (AJED)

(command "ucs" "e" D)

(command "erase" D "")

(if (/= Nbr 1) (command "array" rsel "" "r" 1 Nbr sp_p))

(command "ucs" "")

);progn

);if

);if

 

(setq A4 (polar Ex2D (+ angD1 (/ PI 2)) (/ diam 2)))

(setq B4 (polar Ex2D (- angD1 (/ PI 2)) (/ diam 2)))

(if (> vers 11)

(command "_line" A4 B4 "")

(if (= lang "fr")

(command "ligne" A4 B4 "")

(command "line" A4 B4 "")

);if

);if

 

) ; Fin de defun

 

;============== Dessin d'une partie arrondie ==================================

 

(defun AR (C / vers lang)

(setq vers (atoi (substr (getvar "acadver") 1 2)))

(if (wcmatch (getvar "acadver") "*Hardware Lock*")

(setq lang "fr")

(setq lang "en")

);if

 

(setq rsel nil)

(setq rsel (ssadd)) ; Creation de la selection pour le reseau

(if (> vers 11)

(command "_ucs" "")

(if (= lang "fr")

(command "scu" "")

(command "ucs" "")

);if

);if

 

(setq Ag1C (cdr (assoc 50 (entget C))))

(setq Ag2C (cdr (assoc 51 (entget C))))

(setq rayC (cdr (assoc 40 (entget C))))

(setq cenC (cdr (assoc 10 (entget C))))

 

(setq AgC (- Ag2C Ag1C))

(if (= T (< AgC 0))

(setq AgC (+ AgC (* 2 PI)))

);if

 

(setq lgC (* rayc AgC))

(setq Nbr (atoi (rtos (/ lgC pasA) 2 0)))

(if (<= Nbr 0)

(setq Nbr 1)

);if

 

(setq sp_p (/ lgC Nbr))

(setq agpas (/ AgC Nbr 2))

 

(setq Ex1C (polar cenc Ag1C rayc))

(setq AngC (angle CenC Ex1C))

 

(setq A1 (polar Ex1C AngC (/ diam 2)))

(setq B1 (polar Ex1C (+ AngC PI) (/ diam 2)))

(if (> vers 11)

(progn

(command "_line" A1 B1 "") (AJED)

);progn

(if (= lang "fr")

(progn

(command "ligne" A1 B1 "") (AJED)

);progn

(progn

(command "line" A1 B1 "") (AJED)

);progn

);if

);if

 

(setq IpD (polar cenC (+ Ag1C agpas) rayc))

(setq A2 (polar IpD (+ ag1C agpas) (/ (+ diam ep) 2)))

(setq B2 (polar IpD (+ ag1C agpas) (- (/ (+ diam ep) 2))))

(if (> vers 11)

(progn

(command "_line" A1 A2 "") (AJED)

(command "_line" B1 B2 "") (AJED)

(command "_line" A2 B2 "") (AJED)

);progn

(if (= lang "fr")

(progn

(command "ligne" A1 A2 "") (AJED)

(command "ligne" B1 B2 "") (AJED)

(command "ligne" A2 B2 "") (AJED)

);progn

(progn

(command "line" A1 A2 "") (AJED)

(command "line" B1 B2 "") (AJED)

(command "line" A2 B2 "") (AJED)

);progn

);if

);if

 

(setq IpD (polar cenC (+ Ag1C (* agpas 2)) rayc))

(setq A3 (polar IpD (+ ag1C (* agpas 2)) (/ diam 2)))

(setq B3 (polar IpD (+ ag1C (* agpas 2)) (- (/ diam 2))))

(if (> vers 11)

(progn

(command "_line" A2 A3 "") (AJED)

(command "_line" B2 B3 "") (AJED)

(command "_erase" C "")

(if (/= Nbr 1)

(command "_array" rsel "" "_p" cenC Nbr (DGR (- AgC (* agpas 2))) "_y")

);if

);progn

(if (= lang "fr")

(progn

(command "ligne" A2 A3 "") (AJED)

(command "ligne" B2 B3 "") (AJED)

(command "effacer" C "")

(if (/= Nbr 1)

(command "reseau" rsel "" "p" cenC Nbr (DGR (- AgC (* agpas 2))) "o")

);if

);progn

(progn

(command "line" A2 A3 "") (AJED)

(command "line" B2 B3 "") (AJED)

(command "erase" C "")

(if (/= Nbr 1)

(command "array" rsel "" "p" cenC Nbr (DGR (- AgC (* agpas 2))) "y")

);if

);progn

);if

);if

 

(setq Ex2C (polar cenc Ag2C rayc))

(setq A4 (polar Ex2C Ag2C (/ diam 2)))

(setq B4 (polar Ex2C (+ Ag2C PI) (/ diam 2)))

(if (> vers 11)

(command "_line" A4 B4 "")

(if (= lang "fr")

(command "ligne" A4 B4 "")

(command "line" A4 B4 "")

);if

);if

 

) ; Fin de defun

 

;============== D‚but du programme ==========================================

 

(defun C:SP (/ ct r sel k nom typ sb D1 D2 testw vers lang)

(setq vers (atoi (substr (getvar "acadver") 1 2)))

(if (wcmatch (getvar "acadver") "*Hardware Lock*")

(setq lang "fr")

(setq lang "en")

);if

(setq cmde (getvar "cmdecho"))

(setq blip (getvar "blipmode"))

(setq pdmd (getvar "pdmode"))

(setq pdsz (getvar "pdsize"))

(setq osmd (getvar "osmode"))

 

(setvar "cmdecho" 0)

(setvar "blipmode" 0)

(setvar "osmode" 0)

(if (> vers 11)

(command "_ucs" "")

(if (= lang "fr")

(command "scu" "")

(command "ucs" "")

);if

);if

 

;-------------- V‚rification de l'‚chelle de dessin du menu CLIM ------------

 

(if (= nil echte)

(progn

(princ "\n** ATTENTION : Echelle de dessin non definie **")

(initget 1 "ME CM MM")

(setq echte (getkword "\nVeuillez preciser l'echelle de travail (MEtre, CentiMetre, MilliMetre) : "))

(cond ((= echte "ME")

(setq echte 0.001)

)

((= echte "CM")

(setq echte 0.1)

)

((= echte "MM")

(setq echte 1)

)

);cond

;(princ "\nEntrez l'echelle de dessin dans le menu Clim.")

;(error1)

) ; Fin de progn

) ; Fin de if

 

;-------------- Test de l'existance d'une valeur pour le diamŠtre -----------

 

(if (= nil sp_d) (setq diam 125) (setq diam sp_d))

 

;-------------- Saisie de la valeur du diamŠtre de la gaine souple ----------

 

(setq tx (strcat "\nDiamŠtre de la gaine <" (rtos diam 2 0) ">:"))

(setq rep (getreal tx))

(if (= nil rep) (setq diam (* echte diam)) (setq diam (* echte rep)))

(setq sp_d (/ diam echte))

 

;============== Initialisation des variables configurables =================

 

; pasR : Pas d'une spire complŠte en mm en rectiligne

; pasA : Pas d'une spire complŠte en mm en arrondi

; ep : Epaisseur de d‚bordement sur le diamŠtre en mm

; coef : Coefficient de trac‚ du coude (Coef x DiamŠtre)

 

(setq pasR (* (+ (* 0.36 sp_d) 0.0011) echte))

(if (< (/ pasR echte) 45.0011)(setq pasR (* 45.0011 echte)))

(setq pasA (- pasR echte))

(setq ep (- pasA echte))

(setq coef 1.5)

(setq e1 (entlast))

 

;------------- Dessin par trajet et s‚lection d'entit‚s ----------------------

 

(setq sel nil selE nil)

(setq sel (ssadd) selE (ssadd))

(initget "SCu SG S3 S4 S6 Entite")

(setq pt1 (getpoint "\nConstruction d'un point/Entite/<Debut de la ligne d'axe> :"))

 

(cond

 

((= "Entite" pt1)

(setq selE (ssget))

(setq testW "Fin"))

); Fin de cond

 

(while (/= "Fin" testw)

(initget 32 "SCu SG S3 S4 S6 U")

(setq rep (getpoint pt1 "\nConstruction d'un point/U/<Autre point de l'axe> :"))

 

(SP:SCU rep)

 

(cond

 

((/= T TSCU)

(setq pt rep)

 

(if (/= nil pt)

(progn

(if (> vers 11)

(command "_line" pt1 pt "")

(if (= lang "fr")

(command "ligne" pt1 pt "")

(command "line" pt1 pt "")

);if

);if

(ssadd (entlast) sel) (redraw (entlast) 3)

(setq prov pt1 pt1 pt pt prov)

) ; fin de progn

 

(setq testw "Fin")

 

)) ; fin de if et condition

) ; Fin de cond

 

(setq TSCU nil)

); Fin de while

(setq testw nil)

 

(if (> vers 11)

(command "_ucs" "")

(if (= lang "fr")

(command "scu" "")

(command "ucs" "")

);if

);if

 

;------------- Tri de la s‚lection entre trajet et Entit‚s -------------------

 

(if (/= 0 (sslength sel))

 

(progn

 

;------------- Cr‚ation des coudes … partir des entit‚s crois‚es -------------

 

(setq k 0)

(setq lgsel (sslength sel))

(setvar "FILLETRAD" (* coef diam))

 

(while (< k (- lgsel 1))

(setq D1 (ssname sel k))

(setq D2 (ssname sel (+ k 1)))

(EXT) ; recouvrement des extr‚mit‚s

(if (/= nil (inters Ex1D1 Ex2D1 Ex1D2 Ex2D2))

(progn

(if (> vers 11)

(progn

(command "_fillet" D1 D2)

(ssadd (entlast) sel)

);progn

(if (= lang "fr")

(progn

(command "raccord" D1 D2)

(ssadd (entlast) sel)

);progn

(progn

(command "fillet" D1 D2)

(ssadd (entlast) sel)

);progn

);if

);if

) ; Fin de progn

) ; Fin de if

 

(setq k (1+ k))

) ;Fin de while

 

) ; Fin de progn

 

(setq sel selE)

 

) ; Fin de if

 

;============= V‚rification de la s‚lection ==================================

 

(princ "\nTraitement en cours, patientez s.v.p...\n")

 

(setq lst (list (list "LINE") (list "ARC")))

(setq selt (ssadd))

(setq k 0)

 

(while (< k (sslength sel))

(setq nom (ssname sel k) typ (entget nom))

(if (/= nil (assoc (cdr (assoc 0 typ)) lst))

(ssadd nom selt)

) ;Fin de if

(setq k (1+ k))

) ;Fin de while

 

(setq pts (assoc 10 (entget (ssname selt 0))))

 

;============= Traitement de la s‚lection ====================================

 

(setq k 0)

 

(while (< k (sslength sel))

(setq nom (ssname sel k) typ (entget nom))

 

(if (= "LINE" (cdr (assoc 0 typ))) (LG nom))

 

(if (= "ARC" (cdr (assoc 0 typ))) (AR nom))

 

(setq k (1+ k))

) ;Fin de while

(if (> vers 11)

(command "_ucs" "")

(if (= lang "fr")

(command "scu" "")

(command "ucs" "")

);if

);if

 

;============== Fin du Traitement ============================================

 

(defun *error* (ch)

(princ ch)

(princ)

) ;Fin de error

 

(princ)

 

) ;Fin de defun

SP-lm.LSP

[mikl63]

sympa mais impossible à modifier par quelqu'un d'autre s'il ne possède pas ce lisp. Perso j'utilise une polyligne dont je modifie les propriétés : largeur et ligne en pointillés