Tronc de cône 3d plein ou creux et déport

[usegomme]

Bonjour , c'est un petit lisp pour faire des troncs de cônes en solide 3d plein ou creux avec une épaisseur , et on peut aussi désaxer les bases.

Cela vous sera peut être utile si vous avez besoin de dessiner des réductions de tuyauterie ou des entonnoirs.

Le code suit.

[usegomme]

; usegomme le 17/12/2008
; tronc de cone plein ou creux en 3d  version 1.1

(defun c:trc (/ pd pf pfd eptub b r b2 r2 r3 axered trc h) 
 (if (not tuy:ep) (setq tuy:ep 0));; définie aussi par tuy.lsp
 (setq pd "Epaisseur")
 (while (= pd "Epaisseur")
   (initget "Epaisseur")
   (setq pd (getpoint (strcat "\nPoint de départ de la reduction ou  = "(rtos tuy:ep 2 4)"  :")))
   (if (not pd) (setq pd "Epaisseur"))
   (if (= pd "Epaisseur")
     (progn
       (setq eptub (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos tuy:ep 2 4) ">: ")))
       (if eptub (setq tuy:ep eptub))
     ) 
   )
 )
 (initget "Hauteur")
 (if pd (setq pf ( getpoint  pd "\n direction et  : ")))
 (if (or (not pf)(= pf "Hauteur"))
  (progn
  (setq h (getdist "\nHauteur du tronc de cone:")) 
   (setq pf (list (car pd)(cadr pd) h))
  )
 )
 (cond
   ((and pd pf) 
     (command "_undo" "_be")
     (command "_line" "_none" pd "_none" pf "") 
     (setq axered (entlast))
     (command "_ucs" "_zaxis" "_none" pd "_none" pf)
     (setq pd (trans (cdr (assoc 10 (entget axered))) 0 1))
     (setq pf (trans (cdr (assoc 11 (entget axered))) 0 1))
     (command "_circle" "_none" pd)
     (while (not (zerop (getvar "cmdactive")))(command pause))
     (setq b (entlast))
     (setq r (cdr (assoc 40 (entget b))))
     (command "_circle" "_none" pf)
     (while (not (zerop (getvar "cmdactive")))(command pause))
     (setq b2 (entlast))
     (setq r2 (cdr (assoc 40 (entget b2))))
     (initget "Tangent")
     (setq pfd (getpoint pf "\déport [/Tangent]:"))
     (cond ((= pfd "Tangent")(setq pfd nil)
         (setq a (getangle  pf "\n Tangent de quel coté ?"))        
        (if a (setq pfd (polar pf a (- r r2))))
       )
     )
     (if pfd (command "_move" b2 "" "_none" pf "_none" pfd))
     (entdel axered)
     (command "_loft" b b2 "" "")
     (setq trc (entlast))
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;; entonnoir si épaisseur définie 
     (cond 
       ((< 0.0 tuy:ep)
         (if (>= 0 (setq r (- r tuy:ep))) (setq r 0.00001)) 
         (command "_circle" "_none" pd r)
         (setq b (entlast))
         (if (>= 0 (setq r3 (- r2 tuy:ep))) (setq r3 0.00001))
         (if pfd (setq pf pfd))
         (command "_circle" "_none" pf r3)
         (setq b2 (entlast))
          ;;; pour conserver par défaut le dernier rayon valable
         (command "_circle" "_none" pf r2)
         (entdel (entlast))
          ;;;
         (command "_loft" b b2 "" "")
         (command "_subtract" trc "" "_L" "")
       )
     )
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;   
     (command "_ucs" "_p")
     (command "_undo" "_e")
   ) 
 ) 
 (princ)
) 

 

 

Une petite modif pour concerver le dernier rayon de cercle valable , c'est à dire sans l'épaisseur

déduite par défaut dans la cde cercle , ce qui permet de repartir avec le bon rayon si par exemple on veut tracer le tube qui prolonge l' entonnoir , avec le même lisp bien sûr.

 

[Edité le 17/12/2008 par usegomme]

[thry0]

Bjr,

 

La Cde _loft est inconnue sur une 2006, peut-on y remédier ?

[usegomme]

Désolé ,mais je n'en sais rien ,et je n'ai plus mes anciennes version d'autocad depuis un mauvais virus . Peut être que notre (super) modérateur a une solution.

[Tramber]

Je crains franchement qu'il n'yait pas d'alternative à cette commande sur les anciennes versions.

 

Je vois qu'il y a une soustraction et donc des solides....

[thry0]

Re,

 

Testé sur une 2007 ... fonctionne parfaitement comme d'habitude !

Très bonne application très fonctionnelle et facile à appréhender, merci.

 

[fanlou]

Bonsoir a toutes et tous.

 

Ouai, encore un super Lisp. :P

Merci. :D

[usegomme]

Merci les gars , je ne pensais pas avoir du succès avec ma routine à entonnoir .

C'est une idée pour Noël , Acheter une collection d'entonnoir pour faire des cadeaux

pas chers. Peut être que ça plaira aussi. qui sait ?

Bonne journée.