Fond Elliptique 2D-3D Tuyauterie

kohen.g · le 8 juin 2009

Bonsoir,

Usegomme

Ci joint un nouveau fichier cela sert a dessiner des fonds GRC et PRC

peux tu le modifier pour en faire de la 3D avec?

;; FondB.lsp
;; Version 1.0
;; Objet: Tracé de fonds bombés suivant NF A 49-185.

(defun c:FB (/ DiamExt RayInt RayCar Ep	HtBD HtTot PtIns X0 X1 Y0 Y1
     Ang1)
 (setvar "OSMODE" 0)
 (setq
   DiamExt (getreal "\nDiamètre extérieur: ")
   RayInt  (getreal "\nRayon intérieur: ")
   RayCar  (getreal "\nRayon de carre: ")
   Ep	    (getreal "\nEpaisseur: ")
   HtBD    (getreal "\nHauteur du bord droit: ")
   HtTot   (getreal "\nHauteur totale: ")
   PtIns   (getpoint "\nPoint d'insertion: ")
   X0	    (- (nth 0 PtIns) (/ DiamExt 2))
   X1	    (+ (nth 0 PtIns) (/ DiamExt 2))
   Y0	    (- (+ (nth 1 PtIns) HtTot) RayInt Ep)
   Y1	    (+ (nth 1 PtIns) HtBD)
 )
 (command "_.PLINE"
   (list X1 (nth 1 PtIns))
   (list X1 Y1)
   "_A"
   "_CE"			; Arc défini par son centre
   (list (- X1 RayCar Ep) Y1)
   "_A"				; Angle...
   (setq Ang1 (/ (* 180
		    (angle (list (nth 0 PtIns) Y0)
			   (list (- X1 RayCar Ep) Y1)
		    )
		 )
		 pi
	      )
   )
   "_CE"
   (list (nth 0 PtIns) Y0)
   "_A"				; Angle...
   (- 180 (* 2 Ang1))
   "_CE"
   (list (+ X0 RayCar Ep) Y1)
   "_A"				; Angle...
   Ang1
   "_L"				; Ligne...
   (list X0 (nth 1 PtIns))
   "_C"				; Ferme la polyligne
 )
)

(prompt "M.D.D. - FondB.lsp chargé.")
(prompt
 "\nTapez FB pour dessiner un fond bombé suivant NF A 49-185."
)
(princ)

[édité par (gile) : bbcodes]

(gile) · le 8 juin 2009

Penser à utiliser les balises bbcode :

 le code ici

usegomme · le 8 juin 2009

Bonsoir , ce lisp vient de ce sujet pour rappeller qu'un fond GRC n'est pas un fond elliptique et ne pas induire en erreur ceux qui ne connaissent pas et d'autre part que tu aurais pu laisser les noms de ceux qui ont contribuer au lisp.

;Programme AutoLISP écrit par Maxence Delannoy et modifié par Yann Nicollet avec l'aide de Bonuscad et Bred

. En tout cas merci de penser à moi , je vois que tu n'oublies pas les "copains".

Mais lispeur laborieux je suis et le temps fait défaut , pas sûr que tu mises sur le bon cheval , mais bon on verra ! A moins qu'une âme charitable ...

quenlys · le 9 juin 2009

Bonjour,

Il y a aussi des fonds GRC ici:

http://sites.google.com/site/tecnoarte69/autolisp

Cordialement.

kohen.g · le 9 juin 2009

Merci pour ton lien mais le pgm ne peux etre télécharger le liens ne fonctionne pas pour les fond GrC et de plus il n'est pas gratuit

usegomme · le 4 juillet 2009

Bonjour , voilà j'ai fait un lisp pour les fonds elliptiques en 3 D , celui pour les fonds GRC étant ici .

J'ai fait 2 versions une plutôt bricolisp et une deuxième plus travaillé avec équation paramétrique d' ellipse ,

mais étonnament la strucure 3d du solide n'est pas identique.

Contrairement à FGRC , j'ai procédé par soustraction de solide pour faire l'épaisseur ,

d'abord parce que je n'arrivais pas à un résultat satisfaisant ( déformation de la courbe),

et aussi qu' avec une épaisseur 0 , je peux faire un fond non évidé si ce n'est pas utile.

De comparer les 2 versions peut aussi être intéressant pour les apprentis.

EDIT: pour ne pas dessiner la partie intérieure en creux indiquer une épaisseur négative.

 
;FELLIPT.lsp Version 1.1 le 09-07-2009
;dessine un fond ELLIPTIQUE en 3D suivant NF E 81-103
;usegomme

(defun erreurFellipt (msg)
 (setvar "pellipse" pellips)(setvar "angdir" adir)(setvar "angbase" abase)
 (setvar "OSMODE" osm)(setvar "plinewid" pw)(setvar "ELEVATION" elev)(setvar "CMDECHO" echo)
 (setq *error* m:err m:err nil) (princ)
)

(defun c:Fellipt (/ abase adir aun elv echo osm pellips pw
                   diamext ep htbd ptins pdir rot
	    p1 p2 p3 p4 p5 p6 p7 p8 h2 erreurFellipt
	  )
 (setq m:err *error* *error* erreurFellipt)
 (if (not fellipt:diamext) (setq fellipt:diamext 250 fellipt:ep 4 ))
 (command "_undo" "_be")
 (setq
   abase   (getvar "angbase")
   adir    (getvar "angdir")
   aun     (getvar "aunits")
   elev    (getvar "elevation")
   echo    (getvar "cmdecho")
   osm	    (getvar "osmode")
   pellips (getvar "pellipse")
   pw      (getvar "plinewid")
 ) 
 (setvar "cmdecho" 0)(setvar "angbase" 0)(setvar "angdir" 0)(setvar "aunits" 0)
 (setq
   DiamExt (getdist
      (strcat"\nDiametre Extérieur de la partie cylindrique ou 2 pts <"
	(rtos fellipt:diamext 2 4)
	">: "
      )
    )
 )
 (if DiamExt (setq fellipt:diamext DiamExt) (setq DiamExt fellipt:diamext))
  
 (setq	Ep (getdist (strcat "\nEpaisseur de la tôle ou 2 pts <"
		    (rtos fellipt:Ep 2 4)
		    ">: "
	    )
   )
 )
 (if Ep (setq fellipt:ep Ep) (setq Ep fellipt:Ep))
 (cond
   ((<= (abs ep) 6) (setq fellipt:htbd 40))
   ((<= (abs ep) 10) (setq fellipt:htbd 50))
   ((<= (abs ep) 12) (setq fellipt:htbd 56))
   ((<= (abs ep) 14) (setq fellipt:htbd 60))
   ((<= (abs ep) 16) (setq fellipt:htbd 65))
   ((<= (abs ep) 20) (setq fellipt:htbd 70))
   ((<= (abs ep) 22) (setq fellipt:htbd 75))
   ((<= (abs ep) 25) (setq fellipt:htbd 80))
   ((<= (abs ep) 28) (setq fellipt:htbd 90))
   ((<= (abs ep) 32) (setq fellipt:htbd 100))
   ((<= (abs ep) 35) (setq fellipt:htbd 110))
   ((<= (abs ep) 40) (setq fellipt:htbd 120))
   ((<= (abs ep) 60) (setq fellipt:htbd 130))
   ((<= (abs ep) 70) (setq fellipt:htbd 140))
   (t (setq fellipt:htbd 150))
 )

 (setq HtBD (getdist (strcat "\nHauteur du bord droit cylindrique ou 2 pts <" (rtos fellipt:HtBD 2 4) ">: "))
 )
 (if (not HtBD) (setq HtBD fellipt:HtBD))
 (setq PtIns  (getpoint "\nPoint d'insertion <0,0>: "))
 (if (not PtIns) (setq PtIns '(0. 0.))) ;; z suivant élévation
 	; sauve scu courant
 (command "_ucs" "_s" "tempftd")
 (if (not (zerop (getvar "cmdactive"))) (command "_y"))
 (initget "Rotation")
 (setq	pdir (getpoint PtIns "\n Orientation du fond ELLIPTIQUE ou : "))
 (if (= pdir "Rotation") (setq pdir nil))
 (cond
   (pdir
    (setvar "ELEVATION" 0)
    (command "_ucs" "_zaxis" "_none" PtIns "_none" pdir)
    (command "_ucs" "_x"  "90")    
    (command "_ucs" "_y" "180")           
    (setq PtIns '(0. 0. 0.) rot nil)
   )
   (T
    (setq rot (getangle "\n Angle de rotation du fond GRC  <0 , suivant axe X>: " ))
    (if rot (setq rot (- rot (* 0.5 pi))) (setq rot (* 1.5 pi)))
   )
 )
 ;;;;;;;;;; points de construction
 (setq p1 (list (+ (nth 0 ptins)(* 0.5 diamext)) (+ (nth 1 ptins) htbd)))
 (setq p7 (list (+ (nth 0 ptins)(* 0.5 diamext)) (nth 1 ptins))) 
 (setq p4 (list (+ (nth 0 ptins)(- (* 0.5 diamext) (abs ep))) (+ (nth 1 ptins) htbd)))
 (setq p8 (list (+ (nth 0 ptins)(- (* 0.5 diamext) (abs ep))) (nth 1 ptins))) 
 (setq p3 (list (- (nth 0 ptins)(* 0.5 diamext)) (+ (nth 1 ptins) htbd)))
 (setq p6 (list (- (nth 0 ptins)(- (* 0.5 diamext) (abs ep))) (+ (nth 1 ptins) htbd)))
 (setq h2 (/ (- diamext (* (abs ep) 2.0)) 3.8))
 (setq p5 (list (nth 0 ptins) (+ (nth 1 ptins) htbd h2))) 
 (setq p2 (list (nth 0 ptins) (+ (nth 1 ptins) htbd h2 (abs ep))))
 ;;;;;;;;;;;
 (setvar "OSMODE" 0)
 (setvar "plinewid" 0)
 (setvar "pellipse" 1)
 
 (cond ((> ep 0)
  (command "_ellipse" p4 p6 p5)
  (command "_break" "_l" p5 "@")
  (entdel (entlast))
  (setq elint (entlast))
  (command "_pline" p5 ptins p8 P4 "")
  (command "_pedit" elint "_j" "_l" "" "")
  (command "_revolve" "_l" "" PtIns (list (nth 0 ptins) 100)  "")
  (setq elint (entlast))
 ))	 
 
 (command "_ellipse" p1 p3 p2)
 (command "_break" "_l" p2 "@")
 (entdel (entlast))
 (setq elext (entlast))
 (command "_pline" p2 ptins p7 P1 "")
 (command "_pedit" elext  "_j" "_l" "" "")
 (command "_revolve" "_l" "" PtIns (list (nth 0 ptins) 100)  "")

 (if (> ep 0) (command "_subtract" "_l" "" elint ""))
  
 (if rot (command "_rotate" "_l" "" PtIns (angtos rot (getvar "AUNITS") 16)))
 (if pdir (command "_ucs" "_r" "tempftd"))
 (setvar "pellipse" pellips)
 (setvar "angdir" adir)(setvar "angbase" abase)
 (setvar "OSMODE" osm)(setvar "plinewid" pw)
 (setvar "ELEVATION" elev)
 (command "_undo" "_e")
 (setvar "CMDECHO" echo)
 (setq *error* m:err m:err nil)
 (princ)
)

(prompt " fellipt.lsp chargé.")
(prompt
 "\nTapez FELLIPT pour dessiner un fond ELLIPTIQUE en 3D suivant NF E 81-103."
)
(princ)

[Edité le 11/7/2009 par usegomme]

usegomme · le 4 juillet 2009

Et la deuxième version

EDIT: pour ne pas dessiner la partie intérieure en creux indiquer une épaisseur négative.

;FELLIP.lsp Version 2.1 le 09-07-2009
;dessine un fond ELLIPTIQUE en 3D suivant NF E 81-103
; usegomme

(defun erreurfellip (msg)
 (setvar "angdir" adir)(setvar "angbase" abase)(setvar "ELEVATION" elev)
 (setvar "OSMODE" osm)(setvar "plinewid" pw)(setvar "CMDECHO" echo)
 (setq *error* m:err m:err nil) (princ)
)

(defun c:Fellip (/ abase adir aun elv echo osm  pw
                   diamext ep htbd ptins pdir rot
	    h2 erreurfellip
	  )
 (setq m:err *error* *error* erreurfellip)
 (if (not fellip:diamext) (setq fellip:diamext 250 fellip:ep 4 ))
 (command "_undo" "_be")
 (setq
   abase   (getvar "angbase")
   adir    (getvar "angdir")
   aun     (getvar "aunits")
   elev    (getvar "elevation")
   echo    (getvar "cmdecho")
   osm	    (getvar "osmode")
   pw      (getvar "plinewid")
 ) 
 (setvar "cmdecho" 0)(setvar "angbase" 0)(setvar "angdir" 0)(setvar "aunits" 0)
 (setq
   DiamExt (getdist
      (strcat"\nDiametre Extérieur de la partie cylindrique ou 2 pts <"
	(rtos fellip:diamext 2 4)
	">: "
      )
    )
 )
 (if DiamExt (setq fellip:diamext DiamExt) (setq DiamExt fellip:diamext))
  
 (setq	Ep (getdist (strcat "\nEpaisseur de la tôle ou 2 pts <"
		    (rtos fellip:Ep 2 4)
		    ">: "
	    )
   )
 )
 (if Ep (setq fellip:ep Ep) (setq Ep fellip:Ep))
 (cond
   ((<= (abs ep)  6) (setq fellip:htbd 40))
   ((<= (abs ep)  10) (setq fellip:htbd 50))
   ((<= (abs ep)  12) (setq fellip:htbd 56))
   ((<= (abs ep)  14) (setq fellip:htbd 60))
   ((<= (abs ep)  16) (setq fellip:htbd 65))
   ((<= (abs ep)  20) (setq fellip:htbd 70))
   ((<= (abs ep)  22) (setq fellip:htbd 75))
   ((<= (abs ep)  25) (setq fellip:htbd 80))
   ((<= (abs ep)  28) (setq fellip:htbd 90))
   ((<= (abs ep)  32) (setq fellip:htbd 100))
   ((<= (abs ep)  35) (setq fellip:htbd 110))
   ((<= (abs ep)  40) (setq fellip:htbd 120))
   ((<= (abs ep)  60) (setq fellip:htbd 130))
   ((<= (abs ep)  70) (setq fellip:htbd 140))
   (t (setq fellip:htbd 150))
 )

 (setq HtBD (getdist (strcat "\nHauteur du bord droit cylindrique ou 2 pts <" (rtos fellip:HtBD 2 4) ">: "))
 )
 (if (not HtBD) (setq HtBD fellip:HtBD))
 (setq PtIns  (getpoint "\nPoint d'insertion <0,0>: "))
 (if (not PtIns) (setq PtIns '(0. 0.))) ;; z suivant élévation
 	; sauve scu courant
 (command "_ucs" "_s" "tempftd")
 (if (not (zerop (getvar "cmdactive"))) (command "_y"))
 (initget "Rotation")
 (setq	pdir (getpoint PtIns "\n Orientation du fond ELLIPTIQUE ou : "))
 (if (= pdir "Rotation") (setq pdir nil))
 (cond
   (pdir
    (setvar "ELEVATION" 0)
    (command "_ucs" "_zaxis" "_none" PtIns "_none" pdir)
    (command "_ucs" "_x"  "90")    
    (command "_ucs" "_y" "180")           
    (setq PtIns '(0. 0. 0.) rot nil)
   )
   (T
    (setq rot (getangle "\n Angle de rotation du fond GRC  <0 , suivant axe X>: " ))
    (if rot (setq rot (- rot (* 0.5 pi))) (setq rot (* 1.5 pi)))
   )
 )

 (setvar "OSMODE" 0)
 (setvar "plinewid" 0)

 (defun fellip:tqe (a b / x y)
   ; trace quart ellipse ; a= 1/2 grand diam ; b= 1/2 petit diam
  (command "_pline" (list (+ (nth 0 ptins) a) (+ htbd (nth 1 ptins))) "_a" "_s")
  (foreach x 
       ; ;   '(0.98 0.96 0.87 0.75 0.6 0.45 0.3 0.0)    ;  valeurs perso
                    '(0.9843 0.94 0.7071 0.4044 0.0)            ;  valeurs autocad
   (progn
    (setq x (* a x))
    (setq y (sqrt (* (expt b 2) (- 1 (/ (expt x 2) (expt a 2))))))
    (command (list (+ (nth 0 ptins) x) (+ y htbd (nth 1 ptins))))
   )
  ) 
  (command "")
 )
 
 (setq h2 (/ (- diamext (* (abs ep) 2.0)) 3.8))
 
 (cond ((> ep 0)
  (setq a (- (* 0.5 diamext) ep)) 
  (fellip:TQE a h2)                  	 
  (setq elint (entlast))
  (command "_pline" (list (nth 0 ptins) (+ (nth 1 ptins) htbd h2))
    ptins
    (list (+ (nth 0 ptins)(- (* 0.5 diamext) ep)) (nth 1 ptins))
    (list (+ (nth 0 ptins)(- (* 0.5 diamext) ep)) (+ (nth 1 ptins) htbd))
    ""
  )
  (command "_pedit" elint "_j" "_l" "" "")
  (command "_revolve" "_l" "" PtIns (list (nth 0 ptins) 100)  "")
  (setq elint (entlast))
 ))	 

 (setq a (* 0.5 diamext) b (+ h2 (abs ep)))
 (fellip:TQE a b)                           
 (setq elext (entlast))
 
 (command "_pline" (list (nth 0 ptins) (+ (nth 1 ptins) htbd h2 (abs ep)))
   ptins
   (list (+ (nth 0 ptins)(* 0.5 diamext)) (nth 1 ptins))
   (list (+ (nth 0 ptins)(* 0.5 diamext)) (+ (nth 1 ptins) htbd))
   ""
 )
 (command "_pedit" elext  "_j" "_l" "" "")
 (command "_revolve" "_l" "" PtIns (list (nth 0 ptins) 100)  "")

 (if (> ep 0) (command "_subtract" "_l" "" elint ""))
  
 (if rot (command "_rotate" "_l" "" PtIns (angtos rot (getvar "AUNITS") 16)))
 (if pdir (command "_ucs" "_r" "tempftd"))
 (setq a nil b nil)
 (setvar "angdir" adir)(setvar "angbase" abase)
 (setvar "OSMODE" osm)(setvar "plinewid" pw)
 (setvar "ELEVATION" elev)
 (command "_undo" "_e")
 (setvar "CMDECHO" echo)
 (gc)
 (setq *error* m:err m:err nil)
 (princ)
)

(prompt " fellip.lsp chargé.")
(prompt
 "\nTapez fellip pour dessiner un fond ELLIPTIQUE en 3D suivant NF E 81-103."
)
(princ)

[Edité le 11/7/2009 par usegomme]

usegomme · le 4 juillet 2009

Pour faire la partie cylindrique de la cuve TRC.lsp en autre , va bien , même si au départ il était pour faire des tronc de cône.

usegomme · le 4 juillet 2009

Encore moi, je suis "clavard" aujourd'hui , j'ai une question pour les "pro" :

Comment aurais-je pu écrire autrement mon

(foreach x 
                    '(0.9843 0.94 0.7071 0.4044 0.0)     
   (progn  etc ........

car je pédale dans la choucroute avec les fonctions compliquées genre lambda.

Merci.

usegomme · le 11 juillet 2009

Salut , j'ai modifié les lisp des réponses 5 et 6 , car si on ne veut pas dessiner le fond elliptique creusé à l'intérieur , indiquer une épaisseur 0 ne donne pas une géométrie correcte , la modif consiste à autoriser en entrée une valeur négative pour l'épaisseur qui n'est alors pas representée mais qui entre positivement dans le calcul géométrique du fond pour qu'extérieurement il soit aux bonnes dimensions. ouf!

Connexion

Fond Elliptique 2D-3D Tuyauterie

Messages recommandés

kohen.g

(gile)

usegomme

quenlys

kohen.g

usegomme

usegomme

usegomme

usegomme

usegomme

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante