Adaptation de Lisp

[Phil24]

bonjour a tous

j'ai recupéré le lisp d' USEGOMME qui a des applications tres interressantes

je ne suis pas un specialiste en LISP et je souhaiterait le faire evoluer

a savoir: le trait d'axe qui est généré est une ligne type Axes2 avec autant de segment que comportre le tuyau

 

question : est t-il possible de générer, quelque soit le nombre de segments, une polyligne unique

la raison etant :si on veut calculer la longueur du tuyau c'est plus facile avec une polyligne

 

en esperant avoir ete essez clair

merci d'avance

Phil

 

 

;;;; TUYAU.LSP  usegomme  
;;; version acad2002   ---> 2007 et peut être 2000
(defun ertuyau ()    
 (setvar "snapang" res)
 (setvar "offsetdist" of7)
 (setvar "filletrad" fil)
 (setq res nil pt nil pd nil pti nil ang nil sommets nil lang nil
   i1 nil  point nil rayo nil diam nil ddia nil ent1 nil angp90 nil
   angm90 nil pd1 nil pd2 nil of7 nil fil nil pw nil
   dn nil 
 )
 (redraw)
 (setvar "cmdecho" 1)
 (setq *error* m:err m:err nil)
 (princ)
)

(defun soudure (/ pt0 ang1 ang2 angt dang long pa pb pc paa pbb pcc)
 (setq i2 1)
 (repeat (- (length sommets) 2)
   (setq pt0 (nth i2 sommets))
   (setq ang1 (- (nth i2 lang) pi))
   (setq ang2 (nth (1+ i2) lang))
   (if (> ang1 ang2)
     (setq angt (- ang1 ang2))
     (setq angt (- ang2 ang1))
   )
   (if (> angt pi) (setq angt (- (* 2 pi) angt)))
   (if (= (abs angt) pi) (setq long rayo)
     (progn
       (setq dang (/ (abs angt) 2 ))
       (setq long (* (cos dang) (/ rayo (sin dang))))
     )
   )
   (setq pa (polar pt0 ang1 long)
     pb (polar pa (+ ang1 (/ pi 2)) ddia)
     pc (polar pb (- ang1 (/ pi 2)) (* ddia 2))
     paa (polar pt0 ang2 long)
     pbb (polar paa (+ ang2 (/ pi 2)) ddia)
     pcc (polar pbb (- ang2 (/ pi 2)) (* ddia 2))
   )
   (command "_line" "_none" pb "_none" pc "" )
   (command "_line" "_none" pbb "_none" pcc "")
   (setq i2 (1+ i2))
 )
)

(defun diametre ()
 (cond
   ((and (/= tuy:dn "Autre") (/= tuy:dn " ") (/= tuy:dn nil))
     (setq dn tuy:dn)
     (initget "Autre")
     (setq dn (getreal (strcat "\nDiametre en DN [8/10/15/21/20/25/32/40/50/65/80/100/125/150/200/250/300/350/400/450/500/600/Autre en mm] DN<" (rtos dn 2 0) ">: ")))    
   )
   (T 
     (initget "Autre")
     (setq dn (getreal (strcat "\nDiametre en DN [8/10/15/21/20/25/32/40/50/65/80/100/125/150/200/250/300/350/400/450/500/600/Autre en mm] : ")))
   ) 
 )
 (cond
   ((and (/= dn "A") (/= dn nil))  (setq tuy:dn dn))
   ((= dn nil) (if tuy:dn (setq dn tuy:dn)))
   ((= dn "A") (setq dn nil))
 )
 (cond
   ((= dn 8) (setq diam 13.5  rayo 20 ))
   ((= dn 10) (setq diam 17.2  rayo 25 ))
   ((= dn 15) (setq diam 21.3  rayo 27.5 ))
   ((= dn 21) (setq diam 21.3  rayo 38 )) ; dn15 inox
   ((= dn 20) (setq diam 26.9 rayo 28.5)) 
   ((= dn 25) (setq diam 33.7 rayo 38))
   ((= dn 32) (setq diam 42.4 rayo 47.5))
   ((= dn 40) (setq diam 48.3 rayo 57))
   ((= dn 50) (setq diam 60.3 rayo 76))   
   ((= dn 505) (setq diam 60.3 rayo 137))  ;  rayon 5d
   ((= dn 60) (setq diam 63.5 rayo 70)) ; soudure orbitale
   ((= dn 65) (setq diam 76.1 rayo 95))
   ((= dn 80) (setq diam 88.9 rayo 114.5))
   ((= dn 100) (setq diam 114.3 rayo 152.5))
   ((= dn 125) (setq diam 139.7 rayo 190.5))
   ((= dn 150) (setq diam 168.3 rayo 228.5))
   ((= dn 200) (setq diam 219.1 rayo 305))
   ((= dn 250) (setq diam 273 rayo 381))
   ((= dn 300) (setq diam 323.9 rayo 457))
   ((= dn 350) (setq diam 355.6 rayo 533.5))
   ((= dn 400) (setq diam 406.4 rayo 609.5))
   ((= dn 450) (setq diam 458 rayo 686))
   ((= dn 500) (setq diam 508 rayo 762))
   ((= dn 600) (setq diam 610 rayo 914))
   ( T 
     (cond
       ((and tuy:dia tuy:ray)
         (setq diam (getdist (strcat "\nDiametre Exterieur Tuyauterie ou 2 pts <" (rtos tuy:dia 2 4) ">: ")))
         (setq rayo (getdist (strcat "\nRayon coude ou 2 pts <" (rtos tuy:ray 2 4) ">: ")))
         (if diam (setq tuy:dia diam) (setq diam tuy:dia))
         ; (setq ddia (/ diam 2))
         (if rayo (setq tuy:ray rayo) (setq rayo tuy:ray))
       )
       (T
         (setq diam (getdist "\nDiametre Exterieur Tuyauterie ou 2 pts : "))
         ; (setq ddia (/ diam 2))
         (setq rayo (getdist "\nRayon coude , 2 pts ou <>: "))
         (if (= rayo nil) (setq rayo (* diam 1.1)))
         (setq tuy:dia diam tuy:ray rayo)
       )
     )
   )
 )
 (setq ddia (/ diam 2))
)

(defun c:TUYAU ()
 (setq m:err *error* *error* ertuyau)
 (setvar "cmdecho" 0)
 (setq res (getvar "snapang")
   of7 (getvar "offsetdist")
   fil (getvar "filletrad")
 )
 (diametre)
 (while
   (setq pt (getpoint "\nPoint Depart Tuyauterie : "))
   (setq pd pt pti pt ang 0 sommets (list pt) lang   (list ang))
   (while (setq pt (getpoint pti "\nPoint suivant  : "))
     (grdraw pti pt 1)
     (setq ang (angle pti pt) sommets (append sommets (list pt))
       lang (append lang (list ang))  pti pt
     )
   )
   (if (= (length sommets) 1) (exit))
   
   (command "_undo" "_be")
   
   (setq pw (getvar "plinewid"))
   (setvar "plinewid" 0)
   (command "_pline" "_none" pd )
   (setq i1 1)
   (repeat (- (length sommets) 1)
     (setq point (nth i1 sommets))
     (command "_none" point)
     (setq i1 (1+ i1))
   )
   (command )
   (setvar "plinewid" pw)
   (setq ent1 (entlast))
   (command "_fillet" "_r" rayo)
   (command "_fillet" "_p" ent1)
   (setq angp90 (+ ang (/ pi 2))
     angm90 (- ang (/ pi 2))
     pd1 (polar pti angp90 ddia)
     pd2 (polar pti angm90 ddia)
     pti (cons ent1 (list pti))
   )
   (command "_offset" "_through" "_none" pti "_none" pd1 "")
   (setq ent2 (entlast))
   (command "_offset" "_through" "_none" pti "_none" pd2 "")     ; par
   (setq ent3 (entlast))
   (command "_change" ent1 "" "_pr" "_lt" "axes2" "")
   (command "_explode"  ent1)
   (command "_explode"  ent2)
   (command "_explode"  ent3)
   (if (>= rayo ddia)  
     (if (= ddia 31.75)   ;; soudure orbitale
       (progn (setq rayo 105) (soudure) (setq rayo 70))
       (soudure)
     )
   )
   (command "_undo" "_e")
   (redraw)  
 )
 (ertuyau)
)