usegomme

On "parle" en même temps , ta coupure démarre au sommet qui suit le premier point sur mon test et fini à la bonne distance du premier point à priori.

(gile) ! Aprés un bref essai Il y a un problème avec ton code ,celui de Tramber marche bien .

Tu as tout à fait raison (gile) , j'ai mal interprété le sujet.

Salut Tramber et tout le monde. Et bien masette c'est un impressionnant petit code , mais je pense qu' il va faire peur aux aspirants lispeurs. En comparaison j'ai fait un lispounet tout bête qui doit aussi faire l'affaire , reste à lui apporter quelques aménagements suivant l'utilisateur. ;; cptg coupure pour Thierry Garré (defun c:cptg (/ o p1 a l p2) (setq o (entsel "\n Coupure selectionnez l'objet: ")) (redraw (car o) 3) (setq p1 (getpoint "\n 1er point de coupure :") a (getangle p1 "\n orientation coupure :") l (getdist "\n longueur de la coupure :") p2 (polar p1 a l)) (command "_break" o "_f" "_none" p1 "_none" p2) )

Bonjour, j'ai fait une mise à jour , voir au-dessus la réponse n° 2.

Salut, j´ai tardé à répondre car je ne pouvais essayer ce que tu as posté cause congés. C´est vrai , mais le rayon reste en mémoire et cela m´ennuie un peu . Ce que tu fais est intéressant, tu pourrais en faire des scripts, mais ta méthode est peut ëtre plus pratique en tout cas je suis curieux de toutes astuces .

Bonjour , content que ça te convienne , j'ai fait la modif pour les rayons en utilisant la commande raccord par facilté mais j'ai coincé pour forcer le mode ajuster de la commande, donc à vérifier avant usage en attendant que je trouve ou que quelqu'un me donne l'info. Je ne sais pas si tu utilises parfois des tubes courbés , car dans ce cas le tube rectangulaire ne s'oriente pas correctement , se sera peut être une modif ultérieure quand j'aurai le temps. EDIT : dans la version 3 ci-dessous, je n'utilise plus la commande "raccord". ; ax2pr Axe to profil rectangulaire (creux si ep > 0) ; version 3 le 24-08-2009 ; usegomme sur Cadxp.com (defun c:ax2pr (/ la ha ep ax p1 p2 tubext i) (if (not ax2pr:la) (setq ax2pr:la 40.0)) ; par défaut (setq la (getdist (strcat "\nLargeur tube rectang ou 2 pts <" (rtos ax2pr:la 2 4) ">: "))) (if la (setq ax2pr:la la) (setq la ax2pr:la)) (if (not ax2pr:ha) (setq ax2pr:ha ax2pr:la)) (setq ha (getdist (strcat "\nHauteur tube rectang ou 2 pts <" (rtos ax2pr:ha 2 4) ">: "))) (if ha (setq ax2pr:ha ha) (setq ha ax2pr:ha)) (if (not ax2pr:ep) (setq ax2pr:ep 2.0)) ; par défaut (setq ep (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos ax2pr:ep 2 4) ">: "))) (if ep (if (< (* ep 2)(min la ha))(setq ax2pr:ep ep) (setq ep ax2pr:ep)) (setq ep ax2pr:ep) ) (setq la (* 0.5 la) ha (* 0.5 ha)) (while (setq ax (entsel "\nSélectionner l'AXE du TUBE rectangulaire :")) (setq p1 (osnap (cadr ax) "_endp")) (setq p2 (osnap (cadr ax) "_mid")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (setq P1 '(0. 0. 0.)) (cond ((and (> ep 0)(<= 3)) (setq r (+ ep 1))) ((> ep 3) (setq r (+ ep 2))) (t (setq r 3)) ) (setq i 1) (repeat 2 (if (= i 2) (cond ((> ep 0.0) (setq tubext (entlast)) (if (= 2 (getvar "delobj"))(entdel (car ax))) (cond ((and (> ep 0)(<= 3)) (setq r 1)) ((> ep 3) (setq r 2)) ) (setq la (- la ep) ha (- ha ep)) (setq i 3) ) ) ) (cond ((/= i 2) (command "_PLINE" "_non" (list (- la r) (* ha -1)) "_A" "_CE" "_non" (list (- la r) (* (- ha r) -1)) "_non" (list la (* (- ha r) -1)) "_L" "_non" (list la (- ha r)) "_A" "_CE" "_non" (list (- la r) (- ha r)) "_non" (list (- la r) ha) "_L" "_non" (list (* (- la r) -1) ha) "_A" "_CE" "_non" (list (* (- la r) -1) (- ha r)) "_non" (list (* la -1) (- ha r)) "_L" "_non" (list (* la -1) (* (- ha r) -1)) "_A" "_CE" "_non" (list (* (- la r) -1) (* (- ha r) -1)) "_non" (list (* (- la r) -1) (* ha -1)) "_L" "_c" ) (command "_sweep" "_L" "" ax) ;; balayage )) ; cond (if (= i 1)(setq i 2)) ) ; repeat (cond ((= i 3)(setq la (+ la ep) ha (+ ha ep)) (command "_subtract" tubext "" "_L" "") )) (command "_ucs" "_p") ) (princ) ) [Edité le 24/8/2009 par usegomme]

Salut , si tu ne l'as pas déjà lu, va à cette adresse voir ma réponse.

Salut , un petit lisp pour répondre à la demande de moklaur dans le post tuyau 3d en espèrant que ça convient. ; ax2pr ; Axe to profil rectangulaire (creux si ep > 0) ; version 1 le 10-08-2009 ; usegomme sur Cadxp.com (defun c:ax2pr (/ la ha ep ax p1 p2 tubext) (if (not ax2pr:la) (setq ax2pr:la 30.0)) ; par défaut (setq la (getdist (strcat "\nLargeur tube rectang ou 2 pts <" (rtos ax2pr:la 2 4) ">: "))) (if la (setq ax2pr:la la) (setq la ax2pr:la)) (if (not ax2pr:ha) (setq ax2pr:ha ax2pr:la)) (setq ha (getdist (strcat "\nHauteur tube rectang ou 2 pts <" (rtos ax2pr:ha 2 4) ">: "))) (if ha (setq ax2pr:ha ha) (setq ha ax2pr:ha)) (if (not ax2pr:ep) (setq ax2pr:ep 0.0)) (setq ep (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos ax2pr:ep 2 4) ">: "))) (if ep (if (< (* ep 2)(min la ha))(setq ax2pr:ep ep) (setq ep ax2pr:ep)) (setq ep ax2pr:ep) ) (while (setq ax (entsel "\nSélectionner l'AXE du TUBE rectangulaire :")) (setq p1 (osnap (cadr ax) "_endp")) (setq p2 (osnap (cadr ax) "_mid")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (setq P1 '(0. 0. 0.)) (command "_PLINE" "_non" (list (* (* la 0.5) -1) (* (* ha 0.5) -1)) "_non" (list (* la 0.5) (* (* ha 0.5) -1)) "_non" (list (* la 0.5) (* ha 0.5)) "_non" (list (* (* la 0.5)-1) (* ha 0.5)) "_c" ) (command "_sweep" "_L" "" ax) ;; balayage (cond ((> ep 0.0) (setq tubext (entlast)) (if (= 2 (getvar "delobj"))(entdel (car ax))) (command "_PLINE" "_non" (list (* (- (* la 0.5) ep) -1) (* (- (* ha 0.5) ep) -1)) "_non" (list (- (* la 0.5) ep) (* (- (* ha 0.5) ep) -1)) "_non" (list (- (* la 0.5) ep) (- (* ha 0.5) ep)) "_non" (list (* (- (* la 0.5) ep) -1) (- (* ha 0.5) ep)) "_c" ) (command "_sweep" "_L" "" ax) (command "_subtract" tubext "" "_L" "") ) ) (command "_ucs" "_p") ) (princ) ) Attention au "pointage" de l'axe, avec osnap il peut y avoir une mauvaise sélection .

Bonjour , Le profil carre sans difficulte , mais pour le reste ?

Salut , tu pourrais peut être passer par une bibliothèque tampon , extraire vers cette bib. tous les blocs des dessins mis à jour avant de les insérer dans ton dessin et une fois l'assemblage fait faire une mise à jour des blocs à partir de la bibliothèque. un lisp export qui vient de Cadxp le post ? , il expédie les blocs dans mes documents si mes souvenirs sont bons. ;BtoWB=>Bloc to WBloc ;--------------------------- ;récuperer les blocs internes d'un fichier pour les passer en blocs externes (WBloc) ;-------------------------- (defun c:btowb () (setvar "cmdecho" 0) ; pour definier les noms longs à changer suivant la version d'autocad et de windows ;si nom_long = T alors nom long OK ;si nom_long = NIL alors pas de nom long (setq nom_long T) ;on liste tous les blocs internes contenus dans le fichier (setq lst_bloc nil) (setq bloc (tblnext "BLOCK" T)) (while (/= bloc nil) (if (/= (substr (cdr (assoc 2 bloc)) 1 1) "*") (if (/= (wcmatch (cdr (assoc 2 bloc)) "*|*") T) (setq lst_bloc (append lst_bloc (list (cdr (assoc 2 bloc))))) ) ) (setq bloc (tblnext "BLOCK")) ) (setq nb_bloc (length lst_bloc)) (prompt (strcat "\n" (itoa nb_bloc) " BLOCS TROUVES")) ;on défini si la création est totale ou si on passe les noms un par un (setq compte 0) (setq option nil) (initget "P T") (setq option (getkword "\nCréation Pas à pas ou Tout: ")) (if (= option "T") (progn (repeat nb_bloc (creation_bloc) (setq compte (1+ compte)))) (progn (repeat nb_bloc (setq choix nil) (initget "O N") (setq choix (getkword (strcat "\nBLOC " (itoa (1+ compte)) " = " (nth compte lst_bloc) " > O/N : ") ) ) (if (= choix "O") (creation_bloc) ) (setq compte (1+ compte)) ) ) ) (princ) ) ;--------------- ;sous programme creation de bloc ;-------------- (defun creation_bloc () (setq existe nil) ;on verifie que le bloc n'existe pas sinon on pose la question de le remplacer (setq existe (findfile (strcat (nth compte lst_bloc) ".dwg"))) (if (= existe nil) (if (= nom_long T) (command "WBLOC" (nth compte lst_bloc) (nth compte lst_bloc)) (command "WBLOC" (substr (nth compte lst_bloc) 1 8) (nth compte lst_bloc)) ) (progn (initget "O N") (setq efface (getkword (strcat "\nLe bloc " (nth compte lst_bloc) " éxiste déja, désirez vous le remplacer O/N:" ) ) ) (if (= efface "O") (if (= nom_long T) (command "WBLOC" (nth compte lst_bloc) "o" (nth compte lst_bloc)) (command "WBLOC" (substr (nth compte lst_bloc) 1 8) "o" (nth compte lst_bloc)) ) ) ) ) ;(princ) ) ;;;(prompt "\n======>BTOWB") ;;;(princ) ET un lisp pour mettre à jour les blocs du dessin à partir de la bibliothèque ( attention au chemin de recherche) , celui-ci ne met à jour que le bloc sélectionné. Il fait appel aussi à purgeimage de (gile) que tu trouveras sur Cadxp, c'est utile si des images sont incluses dans les blocs. (defun C:majbloc (/ ELST ENAM BLKNAME typent) (setq ENAM (car (entsel "\nSelectionner le bloc a mettre a jour: ")) ELST (entget ENAM) typent (cdr (assoc 0 ELST)) ) (cond ((= typent "INSERT") (setq BLKNAME (findfile (strcat (cdr (assoc 2 ELST)) ".dwg"))) (command "_-insert" (strcat (cdr (assoc 2 ELST)) "=")) (command) (if (cdr (assoc 66 ELST)) (command "_attsync" "_n" (cdr (assoc 2 ELST))) ) (if BLKNAME (prompt "\n Bloc mis à jour")) (if (not c:purgeimage) (load "purgeimage")) (c:purgeimage) ) (t (command "_-insert") (command) (prompt "\n Ce n'est pas un BLOC ") ) ) (princ) )

Encore une reprise , le sujet d'origine . Mais comme pour FGRC2D , je suis reparti de la version 3D que j'ai déjà fait . Et toujours pareil si la valeur d'épaisseur est négative ,celle-ci n'est pas dessinée. ;FE2D.lsp Version 1 ;usegomme le 14-07-2009 ;dessine un fond ELLIPTIQUE en 2D suivant NF E 81-103 (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:FE2D (/ 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:tde (a b / x y) ; trace Demi 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 -0.3 -0.45 -0.6 -0.75 -0.87 -0.96 -1.0) (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:TDE a h2) (setq elint (entlast)) (command "_pline" (list (+ (nth 0 ptins) a) (+ htbd (nth 1 ptins))) (list (+ (nth 0 ptins) a) (nth 1 ptins)) "" ) (command "_pedit" elint "_j" "_l" "" "") (setq elint (entlast)) (command "_pline" (list (- (nth 0 ptins) a) (+ htbd (nth 1 ptins))) (list (- (nth 0 ptins) a) (nth 1 ptins)) "" ) (command "_pedit" elint "_j" "_l" "" "") (command "_change" "_l" "" "_pr" "_lt" "cache" "") (setq elint (entlast)) )) (setq a (* 0.5 diamext) b (+ h2 (abs ep))) (fellip:TDE a b) (setq elext (entlast)) (command "_pline" (list (+ (nth 0 ptins) a) (+ htbd (nth 1 ptins))) (list (+ (nth 0 ptins) a) (nth 1 ptins)) (list (- (nth 0 ptins) a) (nth 1 ptins)) (list (- (nth 0 ptins) a) (+ htbd (nth 1 ptins))) "" ) (command "_pedit" elext "_j" "_l" "" "") (if rot (if (> ep 0) (command "_rotate" "_l" elint "" PtIns (angtos rot (getvar "AUNITS") 16)) (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 " FE2d.lsp chargé.") (prompt "\nTapez FE2D pour dessiner un fond ELLIPTIQUE en 2D suivant NF E 81-103." ) (princ)

Voila le sujet d'origine mais pour gagner du temps je suis reparti sur la version que j'ai faite pour la 3d fgrc.lsp ce qui fait qu'il y a du superflu mais l'épaisseur est dessiné sauf si on donne une épaisseur négative, comme "d'habitude". ; FGRC2D.lsp version 1 ;usegomme le 14-07-2009 ; adaptation de FGRC.lsp en 3D ;Objet: Tracé de fonds GRC en 2D suivant NF E 81-102. (defun c:Fgrc2d (/ DiamExt RayInt RayCar Ep HtBD HtTot PtIns X0 X1 Y0 Y1 Ang1 pdir osm echo elev rot abase adir elint ) (if (not fgrc:diamext) (setq fgrc:diamext 350 fgrc:ep 4 )) (command "_undo" "_be") (setq abase (getvar "angbase") adir (getvar "angdir") elev (getvar "elevation") echo (getvar "cmdecho") osm (getvar "osmode") DiamExt (getdist (strcat "\nDiametre Extérieur de la partie cylindrique ou 2 pts <" (rtos fgrc:diamext 2 4) ">: " ) ) ) (if DiamExt (setq fgrc:diamext DiamExt) (setq DiamExt fgrc:diamext) ) (setvar "angbase" 0) (setq Ep (getdist (strcat "\nEpaisseur de la tôle ou 2 pts <" (rtos fgrc:Ep 2 4) ">: " ) ) ) (if Ep (setq fgrc:ep Ep) (setq Ep fgrc:Ep) ) (cond ((<= (abs ep) 2) (setq fgrc:htbd 20)) ((<= (abs ep) 4) (setq fgrc:htbd 25)) ((<= (abs ep) 6) (setq fgrc:htbd 40)) ((<= (abs ep) 10) (setq fgrc:htbd 50)) ((<= (abs ep) 12) (setq fgrc:htbd 55)) ((<= (abs ep) 14) (setq fgrc:htbd 60)) ((<= (abs ep) 16) (setq fgrc:htbd 65)) ((<= (abs ep) 20) (setq fgrc:htbd 70)) ((<= (abs ep) 22) (setq fgrc:htbd 75)) ((<= (abs ep) 25) (setq fgrc:htbd 80)) ((<= (abs ep) 28) (setq fgrc:htbd 90)) ((<= (abs ep) 32) (setq fgrc:htbd 100)) ((<= (abs ep) 35) (setq fgrc:htbd 110)) ((<= (abs ep) 40) (setq fgrc:htbd 120)) (t (setq fgrc:htbd 150)) ) (setq HtBD (getdist (strcat "\nHauteur du bord droit cylindrique ou 2 pts <" (rtos fgrc:HtBD 2 4) ">: " ) ) ) (if (not HtBD) (setq HtBD fgrc:HtBD) ) (setq RayCar (/ DiamExt 10.0) HtTot (+ HtBD (abs ep) (- DiamExt (sqrt (- (expt (- DiamExt RayCar) 2.0) (expt (- (* DiamExt 0.5) (abs ep) RayCar) 2.0) ) ) ) ) PtIns (getpoint "\nPoint d'insertion <0,0>: ") ) (if (not PtIns) (setq PtIns '(0. 0.)) ) ;; z suivant élévation (setvar "cmdecho" 0) ; sauve scu courant (command "_ucs" "_s" "tempftd") (if (not (zerop (getvar "cmdactive"))) (command "_y") ) (setq pdir (getpoint PtIns "\n orientation du fond GRC : ") ) (cond (pdir (setvar "ELEVATION" 0) (command "_ucs" "_zaxis" "_none" PtIns "_none" pdir) (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16)) (command "_ucs" "_y" (angtos pi (getvar "AUNITS") 16)) (setq PtIns '(0. 0. 0.)) ) (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 "angdir" 0)(setvar "angbase" 0) (setq X0 (- (car PtIns) (* DiamExt 0.5)) X1 (+ (car PtIns) (* DiamExt 0.5)) Y0 (- (+ (cadr PtIns) HtTot) DiamExt (abs ep)) Y1 (+ (cadr PtIns) HtBD) ) (setvar "OSMODE" 0) (cond ((> ep 0) (command "_.PLINE" (list (- X1 ep) (nth 1 PtIns)) (list (- X1 ep) 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 ep) (nth 1 PtIns)) "" ; termine la polyligne ) (command "_change" "_l" "" "_pr" "_lt" "cache" "") (setq elint (entlast)) ) ) (command "_.PLINE" (list X1 (nth 1 PtIns)) (list X1 Y1) "_A" "_CE" ; Arc défini par son centre (list (- X1 RayCar (abs Ep)) Y1) "_A" ; Angle... (setq Ang1 (/ (* 180 (angle (list (nth 0 PtIns) Y0) (list (- X1 RayCar (abs Ep)) Y1))) pi)) "_CE" (list (nth 0 PtIns) Y0) "_A" ; Angle... (- 180 (* 2 Ang1)) "_CE" (list (+ X0 RayCar (abs Ep)) Y1) "_A" ; Angle... Ang1 "_L" ; Ligne... (list X0 (nth 1 PtIns)) "_C" ; Ferme la polyligne ) (if rot (if (> ep 0) (command "_rotate" "_l" elint "" PtIns (angtos rot (getvar "AUNITS") 16)) (command "_rotate" "_l" "" PtIns (angtos rot (getvar "AUNITS") 16)) ) ) (if pdir (command "_ucs" "_r" "tempftd") ) (setvar "angdir" adir)(setvar "angbase" abase) (setvar "OSMODE" osm) (setvar "ELEVATION" elev) (command "_undo" "_e") (setvar "CMDECHO" echo) (princ) ) (prompt " FGRC2D.lsp chargé.") (prompt "\nTapez FGRC2D pour dessiner un fond GRC en 2D suivant NF E 81-102." ) (princ)

Et la version 4 , j'ai opté pour la méthode par soustraction de solide comme ici avec les fond elliptique et donc si on entre une épaisseur négative l'intérieur du fond n'est pas représenté en creux. ; FGRC.lsp Version 4 ;usegomme le 11-07-2009 ;Fait à partir de FondB.lsp écrit par Maxence Delannoy et modifié par Yann Nicollet avec l'aide de Bonuscad et Bred ;Objet: Tracé de fonds GRC en 3D suivant NF E 81-102. (defun c:Fgrc (/ DiamExt RayInt RayCar Ep HtBD HtTot PtIns X0 X1 Y0 Y1 Ang1 fgrc:pdir osm echo elev fgrc:rot abase adir elint ) (if (not fgrc:diamext) (setq fgrc:diamext 350 fgrc:ep 4 )) (command "_undo" "_be") (setq abase (getvar "angbase") adir (getvar "angdir") elev (getvar "elevation") echo (getvar "cmdecho") osm (getvar "osmode") DiamExt (getdist (strcat "\nDiametre Extérieur de la partie cylindrique ou 2 pts <" (rtos fgrc:diamext 2 4) ">: " ) ) ) (if DiamExt (setq fgrc:diamext DiamExt) (setq DiamExt fgrc:diamext) ) (setvar "angbase" 0) (setq Ep (getdist (strcat "\nEpaisseur de la tôle ou 2 pts <" (rtos fgrc:Ep 2 4) ">: " ) ) ) (if Ep (setq fgrc:ep Ep) (setq Ep fgrc:Ep) ) (cond ((<= (abs ep) 2) (setq fgrc:htbd 20)) ((<= (abs ep) 4) (setq fgrc:htbd 25)) ((<= (abs ep) 6) (setq fgrc:htbd 40)) ((<= (abs ep) 10) (setq fgrc:htbd 50)) ((<= (abs ep) 12) (setq fgrc:htbd 55)) ((<= (abs ep) 14) (setq fgrc:htbd 60)) ((<= (abs ep) 16) (setq fgrc:htbd 65)) ((<= (abs ep) 20) (setq fgrc:htbd 70)) ((<= (abs ep) 22) (setq fgrc:htbd 75)) ((<= (abs ep) 25) (setq fgrc:htbd 80)) ((<= (abs ep) 28) (setq fgrc:htbd 90)) ((<= (abs ep) 32) (setq fgrc:htbd 100)) ((<= (abs ep) 35) (setq fgrc:htbd 110)) ((<= (abs ep) 40) (setq fgrc:htbd 120)) (t (setq fgrc:htbd 150)) ) (setq HtBD (getdist (strcat "\nHauteur du bord droit cylindrique ou 2 pts <" (rtos fgrc:HtBD 2 4) ">: " ) ) ) (if (not HtBD) (setq HtBD fgrc:HtBD) ) (setq RayCar (/ DiamExt 10.0) HtTot (+ HtBD (abs ep) (- DiamExt (sqrt (- (expt (- DiamExt RayCar) 2.0) (expt (- (* DiamExt 0.5) (abs ep) RayCar) 2.0) ) ) ) ) PtIns (getpoint "\nPoint d'insertion <0,0>: ") ) (if (not PtIns) (setq PtIns '(0. 0.)) ) ;; z suivant élévation (setvar "cmdecho" 0) ; sauve scu courant (command "_ucs" "_s" "tempftd") (if (not (zerop (getvar "cmdactive"))) (command "_y") ) (setq fgrc:pdir (getpoint PtIns "\n orientation du fond GRC : ") ) (cond (fgrc:pdir (setvar "ELEVATION" 0) (command "_ucs" "_zaxis" "_none" PtIns "_none" fgrc:pdir) (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16)) (command "_ucs" "_y" (angtos pi (getvar "AUNITS") 16)) (setq PtIns '(0. 0. 0.)) ) (T (setq fgrc:rot (getangle "\n angle de rotation du fond GRC <0 , suivant axe X>: " ) ) (if fgrc:rot (setq fgrc:rot (- fgrc:rot (* 0.5 pi))) (setq fgrc:rot (* 1.5 pi)) ) ) ) (setvar "angdir" 0)(setvar "angbase" 0) (setq X0 (- (car PtIns) (* DiamExt 0.5)) X1 (+ (car PtIns) (* DiamExt 0.5)) Y0 (- (+ (cadr PtIns) HtTot) DiamExt (abs ep)) Y1 (+ (cadr PtIns) HtBD) ) (setvar "OSMODE" 0) (cond ((> ep 0) (command "_.PLINE" (list (- X1 ep) (nth 1 PtIns)) (list (- X1 ep) Y1) "_A" "_CE" ; Arc défini par son centre (list (- X1 RayCar Ep) Y1) "_A" ; Angle... (angtos (setq angRad (angle (list (nth 0 PtIns) Y0) (list (- X1 RayCar Ep) Y1) ) ) (getvar "AUNITS") 16 ) "_CE" (list (nth 0 PtIns) Y0) "_A" ; Angle... (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16) "_L" ; Ligne... Ptins "_C" ; Ferme la polyligne ) (command "_revolve" "_l" "" PtIns (list (nth 0 PtIns) Y0) "" ) (setq elint (entlast)) )) (command "_.PLINE" (list X1 (nth 1 PtIns)) (list X1 Y1) "_A" "_CE" ; Arc défini par son centre (list (- X1 RayCar (abs ep)) Y1) "_A" ; Angle... (angtos (setq angRad (angle (list (nth 0 PtIns) Y0) (list (- X1 RayCar (abs ep)) Y1) ) ) (getvar "AUNITS") 16 ) "_CE" (list (nth 0 PtIns) Y0) "_A" ; Angle... (angtos (/ (- pi (* 2 angRad)) 2) (getvar "AUNITS") 16) "_L" ; Ligne... Ptins "_C" ; Ferme la polyligne ) (command "_revolve" "_l" "" PtIns (list (nth 0 PtIns) Y0) "" ) (if (> ep 0) (command "_subtract" "_l" "" elint "")) (if fgrc:rot (command "_rotate" "_l" "" PtIns (angtos fgrc:rot (getvar "AUNITS") 16) ) ) (if fgrc:pdir (command "_ucs" "_r" "tempftd") ) (setvar "angdir" adir)(setvar "angbase" abase) (setvar "OSMODE" osm) (setvar "ELEVATION" elev) (command "_undo" "_e") (setvar "CMDECHO" echo) (princ) ) (prompt " FGRC.lsp chargé.") (prompt "\nTapez FGRC pour dessiner un fond GRC en 3D suivant NF E 81-102." ) (princ)

Salut (gile) , merci pour les explications. Tu as oublier d'insérer dans ton lisp la fonction MXV ;; mxv Apply a transformation matrix to a vector by Vladimir Nesterovsky (defun mxv (m v) (mapcar '(lambda (row) (apply '+ (mapcar '* row v))) m) ) Sinon lorsqu' une portion d'ellipse a été créée directement avec la cde autocad , lors de la transformation en polyligne, il arrive que ce soit le morceau manquant qui soit reconstitué. Je crois que c'est une question de sens de création.

(gile), le champion des transformations , rien de te résiste et ce lisp je ne l'avais pas vu ou perdu de vue , screugneugneu , il n'est pas dans ta liste de lisp ! Ah! au fait , merci.

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!

Merci, Jifi , c'est intéressant et bien expliqué.

Salut Etude0 , la réponse est dans ce post de chris_mtp avec lwc_dim.lsp

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.

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.

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]

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]

Super , c'est du costaud , merci (gile) et meilleurs voeux pour ta reconversion . Et j'aimerais bien que ma boite me paie une petite formation lisp , qui sait ?

Salut Lilian , content que ça marche, l'astuce de (gile) c'était dans cette discussion , Je viens d'ailleur de voir que je n'avais pas suivi jusqu'au bout et donc pas répondu à etude0. Cela fait donc un mauvais point chacun :)