besoin de modifier un lisp

[TPS001]

bonjour,

 

je viens de recevoir un lisp spéciale interessante a tous qui fera la climatisation et l'objectif de ce lisp est de faire dessiner des gaine souples (gaine flexible) mais malheureusement sans leur axes et je dois metre chaque fois les axes de la gaine et un autre probleme sur ce lisp c'est quand je dessine la gaine avec le calque courant je voudrais que la l'interieur de la gaine sera avec couleur gris 8 da la meme calque courant

le lisp c'est :

 

 

 

 

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

 

; 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/ :"))

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

(progn

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

(initget 1 "ME CM MM")

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

(cond ((= echt "ME")

(setq echt 0.001)

)

((= echt "CM")

(setq echt 0.1)

)

((= echt "MM")

(setq echt 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 (* echt diam)) (setq diam (* echt rep)))

(setq sp_d (/ diam echt))

 

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

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

(setq pasA (- pasR echt))

(setq ep (- pasA echt))

(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/ :"))

 

(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/ :"))

 

(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

 

 

 

 

 

il y a quelqu'un qui me fera cela rapidos?? merci beaucoup a tous le monde

 

merci

 

[zebulon_]

il y a quelqu'un qui me fera cela rapidos??

Le Père Noël ?

 

J'ai essayé le lisp et il dessine des gaines très jolies. Mais c'est graphiquement très compliqué, donc très lent, le fichier devient hyper lourd assez rapidement et c'est impossible à modifier (s'il y a modification, on efface tout et on recommence)

 

Question : ça vaut la peine de dessiner les gaines avec un tel niveau de précision ? La climatisation, ce n'est pas mon métier, mais j'imagine qu'une gaine de 200 représentée au 1:50ème sera pareil si on met les petits bourrelets ou non. Donc, ce serait plus simple de ne pas les mettre.

 

Il y a eu une demande pour un chemin de câble ici, qui est graphiquement plus simple, plus rapide et qui donne des objets plus faciles à manipuler et des fichiers moins lourds.

 

On peut l'adapter (enlever les hachures, rajouter un congé de raccordement ...)

 

Amicalement

Vincent

 

 

 

[jc1932]

Je reconnais ce listp réalisé par P.CHIALE en 99

 

Instable sur les versions récentes d'autocad.

 

J'ai testé la version d'évaluation d'autofluid 2009 (texacad), qui, enfin, propose un souple potable et efficace.

 

De plus, le lisp SP n'est pas compatible avec des anciens autofluid, si les deux sont chargés, ça les fait planter

[TPS001]

bonjour

est ce qu"on peut apprendre simplement ce lisp séparement d"autofluid

merci

 

[Edité le 19/12/2009 par bennane01]

[TPS001]

bonjour

merci a tous qu"est interesse a mon probleme et je suis tout a fait d"accord avec vous que ce lisp est graphiquement très compliqué, et hyper lourd

s"il vous plais si quelqu"un connait un lisp efficace et rapide que ce lisp SP c"est tres important pour mon travaille

et merci pour tous le monde

 

 

[usegomme]

Salut bennane01 , pour concerver les axes de tes gaines , il suffit que tu places un ; devant toutes les lignes du lisp contenant : " _erase" ou "effacer"

exemple : (command "effacer" D "")

remplacé par : ;(command "effacer" D "")

la commande n´est alors plus exécutée et les axes restent en place.

[TPS001]

salut usegomme

C’est géniale ce que vous m’apprendre, j’ai essayé ce que vous m'avez dite et c'est impressionnant mais le trais c'est pas un trais d'axes est ce que vous pouvez le transformer à un trais d'axes

et merci

 

[usegomme]

Bonjour , pour cela tu as deux lignes à rajouter.

Au dessus ou au dessous de :

;(command "_erase" D "")

rajoute :

(command "_change" D "" "_pr" "_lt" "axes2" "")

et

au dessus ou au dessous de :

;(command "_erase" C "")

rajoute :

(command "_change" C "" "_pr" "_lt" "axes2" "")

 

"axes2" étant le type de ligne , tu peux en choisir un autre.

[TPS001]

salut usegomme

je te remercier infiniment pour ton aide sur le lisp SP mais il ya un petite problème c'est qu'on je dessine la gaine souple sur un calque courant toute les entités du spirale est en même couleur du calque et ça un problème pour moi a cause de ma charte graphique ce que je veux s'il vous plie c'est si possible que l'intérieur de la gaine souple devient a couleur gris 8 et sauf les lignes ziczac de la gaine souple est en couleur du calque courant

merci infiniment usegomme et je m'excuse pour mon dérangement

[usegomme]

Voilà monsieur, ça devrait faire ton affaire.

J'ai élagué le lisp car je ne pense pas qu'il soit utile qu'il puisse fonctionner avec les très anciennes versions d'autocad.

 

;=============================================================================
; P.CHIALE en 99  modifié le 08-01-2010
; SP permet de tracer une gaine en souple à partir de la sélection
; de l'axe du trajet.

;;-------------  change la couleur de la dernière entite créée------------- 

(defun chgcolastent () 
(command "_change" "_l" "" "_pr" "_co" "8" "")
)
;------------- 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)

 (cond
   ((= rep "SG")
    (setq PTP (trans pt1 1 0))
    (command "_ucs" "")       							
    (setq PT1 (trans ptp 0 1))
    (setq TSCU T)			;SCU General
   )

   ((= rep "S30")
    (setq PTP (trans pt1 1 0))
    (command "_ucs" "_z" 30)				
    (setq PT1 (trans ptp 0 1))
    (setq TSCU T)			;SCU Z 30
   )

   ((= rep "S45")
    (setq PTP (trans pt1 1 0))
    (command "_ucs" "_z" 45) 									
    (setq PT1 (trans ptp 0 1))
    (setq TSCU T)			;SCU Z 45
   )

   ((= rep "S60")
    (setq PTP (trans pt1 1 0))    
    (command "_ucs" "_z" 60)       				     					
    (setq PT1 (trans ptp 0 1))
    (setq TSCU T)			;SCU Z 60
   )

   ((= rep "SCu")
    (initget "Entite Z General")
    (setq repsc (getkword "\nSCU : [Entite/Z/] :"))
    (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))	
(command "_ucs" "_e" Etsc)	  				
(setq PT1 (trans ptp 0 1))
(setq TSCU T)
(setvar "osmode" osmd) ; (setvar "osmode" 0)
      )

      ((= repsc "Z")
(setq D1 (getreal "\n Angle de rotation autour de l'axe Z :"))
(setq PTP (trans pt1 1 0))	
(command "_ucs" "_z" D1)
(setq PT1 (trans ptp 0 1))
(setq TSCU T)
      )

      ((= repsc "General")
(setq PTP (trans pt1 1 0))	
       (command "_ucs" "")	  									
(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 a1 a2 a3 a4 b1 b2 b3 b4 Ex1D Ex2D lgD angD1 Nbr)

 (setq rsel nil)
 (setq rsel (ssadd))			; Creation de la selection pour le reseau  
 (command "_ucs" "")    					  					
 (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)))  
 (command "_line" "_non" A1 "_non" B1 "")
 (chgcolastent)
   					  					
 (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)))
  
     (command "_line" "_non" A1 "_non" A2 "")
     (AJED)
     (command "_line" "_non" B1 "_non" B2 "")
     (AJED)
     (command "_line" "_non" A2 "_non" B2 "")
     (chgcolastent)
     (AJED)

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

     (command "_line" "_non" A2 "_non" A3 "")
     (AJED)
     (command "_line" "_non" B2 "_non" B3 "")
     (AJED)
     (command "_ucs" "_e" D)
     (command "_change" D "" "_pr" "_lt" "axes2" "")
				;(command "_erase" D "")
     (if (/= Nbr 1)
(command "_array" rsel "" "_r" 1 Nbr sp_p)
     )
     (command "_ucs" "")
   					    				 
 (setq A4 (polar Ex2D (+ angD1 (/ PI 2)) (/ diam 2)))
 (setq B4 (polar Ex2D (- angD1 (/ PI 2)) (/ diam 2)))
 
   (command "_line" "_non" A4 "_non" B4 "")
   (chgcolastent)

)					; Fin de defun

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

(defun AR (C / vers lang a1 a2 a3 a4 b1 b2 b3 b4 Ag1C Ag2C rayC cenC
              AgC Ag2C Ag1C lgC Nbr sp_p agpas Ex1C AngC IpD)


 (setq rsel nil)
 (setq rsel (ssadd))			; Creation de la selection pour le reseau
 
 (command "_ucs" "")
   				
 (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)))
     
     (command "_line" "_non" A1 "_non" B1 "")
     (chgcolastent)
     (AJED)
       					
 (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))))
     
     (command "_line" "_non" A1 "_non" A2 "")
     (AJED)
     (command "_line" "_non" B1 "_non" B2 "")
     (AJED)
     (command "_line" "_non" A2 "_non" B2 "")
     (chgcolastent)
     (AJED)
       				
 (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))))
 
     (command "_line" "_non" A2 "_non" A3 "")
     (AJED)
     (command "_line" "_non" B2 "_non" B3 "")
     (AJED)
     (command "_change" C "" "_pr" "_lt" "axes2" "")
				;(command "_erase" C "")
     (if (/= Nbr 1)
(command "_array"
	 rsel
	 ""
	 "_p"
	 "_non" cenC
	 Nbr
	 (DGR (- AgC (* agpas 2)))
	 "_y"
)
     )					;if
   
 (setq Ex2C (polar cenc Ag2C rayc))
 (setq A4 (polar Ex2C Ag2C (/ diam 2)))
 (setq B4 (polar Ex2C (+ Ag2C PI) (/ diam 2)))
 
 (command "_line" "_non" A4 "_non" B4 "")
 (chgcolastent)

)					; Fin de defun

;============== Début du programme ==========================================

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

 (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)
 
   (command "_ucs" "")


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

 (if (= nil echt)
   (progn
     (princ "\n** ATTENTION : Echelle de dessin non definie **")
     (initget 1 "ME CM MM")
     (setq echt
     (getkword
       "\nVeuillez preciser l'echelle de travail [ME/CM/MM] : "
     )
     )
     (cond ((= echt "ME")
     (setq echt 0.001)
    )
    ((= echt "CM")
     (setq echt 0.1)
    )
    ((= echt "MM")
     (setq echt 1)
    )
     )					;cond
				
   )					; 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 (* echt diam))
   (setq diam (* echt rep))
 )
 (setq sp_d (/ diam echt))

;============== 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) echt))
 (if (< (/ pasR echt) 45.0011)
   (setq pasR (* 45.0011 echt))
 )
 (setq pasA (- pasR echt))
 (setq ep (- pasA echt))
 (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 "Entite")
 (setq pt1 (getpoint "\nPoint de départ ou [Entite] :"))
 (cond

   ((= "Entite" pt1)
    (setq selE (ssget))
    (setq testW "Fin")
   )
 )					; Fin de cond

 (while (/= "Fin" testw)
   (initget 32 "SCu SG S30 S45 S60")
   (setq rep (getpoint pt1 "\nPoint suivant ou [sCu/SG/S30/S45/S60] :"))

   (SP:SCU rep)

   (cond

     ((/= T TSCU)
      (setq pt rep)

      (if (/= nil pt)
 (progn
   
   (command "_line" "_non" pt1 "_non" pt "")
   
   (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)


 (command "_ucs" "")
 

;------------- 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	    
    (command "_fillet" D1 D2)
    (ssadd (entlast) sel)	    
  )				; 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
 
   (command "_ucs" "")


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

 (princ)

)					;Fin de defun

 

[Edité le 8/1/2010 par usegomme]