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]

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.

Pas de doute , ils sont fort les programmeurs, il me faudrait pouvoir télécharger un peu de leurs méninges pour faire tout ce que tu veux , etude0. Pour l'instant j' avance à petits pas de bricoleur et je ne sais pas ce que je peux arriver à faire . D'autre part mon lisp n'utilise pas de bloc et je ne connais absoluement rien aux informations intelligentes pouvant être liées aux entités. Pour étirer manuellement axe et tube en même temps ,il faut le faire avec les poignées mais à condition que le tube soit dessiné plein. D'autre part j'ai peu de lisp sur cadxp , car c'est déjà trés bien fourni par nos excellents lispeurs comme Patrick_35 par exemple, et que j'ai bien du mal à amener qlq chose d'intéressant, d'autant que je n'ai pas leur niveau et qu' ayant arrêté le lisp pendant plusieurs années mes lisps sont devenus + ou - obsolete avec l'évolution d'autocad , ou souvent ils sont liés au menu et spécifiques et donc difficile à partager sans un travail d'adaptation qui prend beaucoup de temps.

Salut , bon pour répondre à la demande d' etude0 j'ai intégré l' option calorifuge au lisp ,et c'est par son épaisseur que l'on définit sa présence ou non (épaisseur >0 = oui). On peut aussi dessiner le calo seul pour le rajouter sur une tuyauterie soit en sélectionnant un axe ou par 2 points. commande : CALOS Nota: un calque de couleur 9 est créer automatiquement pour le calo. Si le calque courant est "VAPEUR" le calque du calo sera "VAPEUR-CALO". J'ai aussi rajouté l'option : Norme , pour l'instant iln'y en a que 2. Il y a toujours la cde : TU pour dessiner le tuyau en sélectionnant des axes et qui est complétée par la cde : CDT qui joint 2 axes et place un coude. Il ya aussi TSA pour ceux qui ne veulent pas d'axe dans leurs tuyaux .bof! Rappel c'est l'épaisseur donnée au tube qui définie si le tuyau et le calo sont dessinés en creux ou en plein. (une épaisseur négative de tube donne un tube plein et un calo creux). Rappel également, un tuyau dessiné plein s'étire avec les poignées (trés pratique). J'ai été long , aussi j'espère qu'etude0 n'a pas changé de métier entre temps . ;; usegomme 5-2-2007 8-4-2009 version 2.02 ;; Tuyau 3d pour autocad à partir de version 2007 ;; et avec ou sans calorifuge (defun choixnorme () (initget 1 "ISO3D ISO5D") ;;;; bit refus reponse nulle (setq norme (getkword "\nChoisir une Norme [iSO3D/ISO5D] : ") ) ) (Defun getDNtuy( a b d e f g / c) ;(setq c (strcat a d g "<" b ">" e f " ")) (setq c (strcat a d g "<" b ">" " ")) (setq c (getreal c)) ) (defun diam-t3d (/ dn diam) (setq dn "Norme") (if (not norme) (setq norme "ISO3D")) ;; par defaut (if (not epcalo)(setq epcalo 0)) ;; par defaut ;(setq msgdn " DN:") (while (or(= dn "Norme")(= dn "Calo")) (if (> epcalo 0) (setq msgcalo "CALO ep" msgecalo (rtos epcalo 2 0)) (setq msgcalo " Sans" msgecalo " calo") ) (cond ((= norme "ISO3D") (setq msgdn " DN:") (if (and (/= iso3d:dn "Autre")(/= iso3d:dn nil)) (setq dn (rtos iso3d:dn 2 0)) (setq dn "Autre") ) (setq choixdn (strcat "\n" msgcalo msgecalo " " norme " DN[8/10/15/21/20/25/32/40/50/65/80/100/125/150/200/250/300/350/400/450/500/600/Autre/Calo/Norme]") ) ) ((= norme "ISO5D") (setq msgdn " DN:") (if (and (/= iso5d:dn "Autre")(/= iso5d:dn nil)) (setq dn (rtos iso5d:dn 2 0))(setq dn "Autre") ) (setq choixdn (strcat "\n" msgcalo msgecalo " " norme " DN[20/25/32/40/50/65/80/100/125/150/200/250/300/350/Autre/Calo/Norme]") ) ) ) ;; fin cond (initget "Autre Norme Calo") (setq dn (getDNtuy choixdn dn norme msgcalo msgecalo msgdn )) (if (= dn "Norme") (choixnorme)) (if (= dn "Calo") (if (setq epc (getdist (strcat "\nEpaisseur calo ou 2 pts <" (rtos epcalo 2 0) ">: "))) (setq epcalo epc epc nil) ) ) ) ;; while dn= norme (cond ((= norme "ISO3D")(setq surep 0) (cond ((and (/= dn "A") (/= dn nil))(setq iso3d:dn dn)) ((= dn nil) (if iso3d:dn (setq dn iso3d:dn))) ) (cond ((= dn 8) (setq diam 13.5 rayo 20 )) ((= dn 10) (setq diam 17.2 rayo 25 )) ((= dn 15) (setq diam 21.3 rayo 28 )) ;27 ((= 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 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 (autrediametre) ) ) ) ((= norme "ISO5D")(setq surep 0) (cond ((and (/= dn "A") (/= dn nil))(setq iso5d:dn dn)) ((= dn nil) (if iso5d:dn (setq dn iso5d:dn))) ) (cond ((= dn 20) (setq diam 26.9 rayo 57.5)) ((= dn 25) (setq diam 33.7 rayo 72.5)) ((= dn 32) (setq diam 42.4 rayo 92.5)) ((= dn 40) (setq diam 48.3 rayo 109.5)) ((= dn 50) (setq diam 60.3 rayo 137.5)) ((= dn 65) (setq diam 76.1 rayo 175)) ((= dn 80) (setq diam 88.9 rayo 207.5)) ((= dn 100) (setq diam 114.3 rayo 270)) ((= dn 125) (setq diam 139.7 rayo 330)) ((= dn 150) (setq diam 168.3 rayo 390)) ((= dn 200) (setq diam 219.1 rayo 515)) ((= dn 250) (setq diam 273 rayo 650)) ((= dn 300) (setq diam 323.9 rayo 770)) ((= dn 350) (setq diam 355.6 rayo 850)) (t (autrediametre) ) ) ) ) ; fin cond dn suivant norme (setq ddia (/ diam 2)) (if (not (> rayo (+ ddia surep))) (setq rayo (* (+ ddia surep) 1.01))) ) (defun autrediametre () (setq surep 0) (if (not tuy:dia)(if ddia (setq tuy:dia (* ddia 2))(setq tuy:dia 8))) (setq diam (getdist (strcat "\nDiametre Exterieur Tuyauterie ou 2 pts <" (rtos tuy:dia 2 4) ">: "))) (if diam (setq tuy:dia diam) (setq diam tuy:dia)) (if (not tuy:ray)(setq tuy:ray (* diam 1.01))) (setq rayo (getdist (strcat "\nRayon coude ou 2 pts <" (rtos tuy:ray 2 4) ">: "))) (if rayo (setq tuy:ray rayo) (setq rayo tuy:ray)) ) (defun tubage (ent typ / lent) ;change proprietes de l'axe (setq lent (entget ent)) ;; si le code 62 pour la couleur est présent ... (if (assoc 62 lent) ;; ... le remplacer par un nouveau (setq lent (subst (cons 62 6) ;;Nouvelle couleur magenta (assoc 62 lent) lent) ) ;; sinon, en ajouter un (setq lent (append lent (list (cons 62 6)))) ;; magenta ) ;; idem pour type de ligne (if (assoc 6 lent) (setq lent (subst (cons 6 "AXES2") (assoc 62 lent) lent) ) (setq lent (append lent (list (cons 6 "AXES2")))) ) (entmod lent) (setq pt (trans (cdr (assoc 10 (entget ent))) 0 1)) (generetube ent pt typ) ) (defun generetube (ent pt typ / circonftuy) (if (or (= tuy:ep nil) (<= tuy:ep 0.0)) (progn (command "_circle" "_none" pt) (if (= typ 1) (command (+ ddia surep)) (command ddia)) (if (= 0 (getvar "delobj"))(setq circonftuy (entlast))(setq circonftuy nil)) (command "_sweep" "_L" "" ent) ;; balayage (if circonftuy (entdel circonftuy)) (if (> epcalo 0) (progn (if (= 2 (getvar "delobj"))(entdel ent)) (if (= (cdr (assoc 0 (setq lent (entget ent)))) "ARC") (if (> (cdr (assoc 40 lent)) (+ ddia epcalo)) (if (< tuy:ep 0.0)(calocreux ent pt)(caloplein ent pt)) ) (if (< tuy:ep 0.0)(calocreux ent pt)(caloplein ent pt)) ) ) ) ) (progn (command "_circle" "_none" pt) (if (= typ 1) (command (+ ddia surep)) (command ddia)) (if (= 0 (getvar "delobj"))(setq circonftuy (entlast))(setq circonftuy nil)) (command "_sweep" "_L" "" ent) (if (= 2 (getvar "delobj"))(entdel ent)) (if circonftuy (entdel circonftuy)) (setq tubext (entlast)) (command "_circle" "_none" pt (- ddia tuy:ep)) (if (= 0 (getvar "delobj"))(setq circonftuy (entlast))(setq circonftuy nil)) (command "_sweep" "_L" "" ent) (if circonftuy (entdel circonftuy)) (command "_subtract" tubext "" "_L" "") (if (> epcalo 0) (progn (if (= 2 (getvar "delobj"))(entdel ent)) (if (= (cdr (assoc 0 (setq lent (entget ent)))) "ARC") (if (> (cdr (assoc 40 lent)) (+ ddia epcalo))(calocreux ent pt)) (calocreux ent pt) ) ) ) ) ) ) (defun caloplein (ent pt / circonftuy calo) (command "_circle" "_none" pt(+ ddia epcalo)) (if (= 0 (getvar "delobj"))(setq circonftuy (entlast))(setq circonftuy nil)) (command "_sweep" "_L" "" ent) ;; balayage (setq calo (entlast)) (if circonftuy (entdel circonftuy)) (command "_change" calo "" "_p" "_layer" calqcalo "") ) (defun calocreux (ent pt / circonftuy calo) (command "_circle" "_none" pt(+ ddia epcalo)) (if (= 0 (getvar "delobj"))(setq circonftuy (entlast))(setq circonftuy nil)) (command "_sweep" "_L" "" ent) ;; balayage (if (= 2 (getvar "delobj"))(entdel ent)) (if circonftuy (entdel circonftuy)) (setq tubext (entlast)) (command "_circle" "_none" pt ddia) (if (= 0 (getvar "delobj"))(setq circonftuy (entlast))(setq circonftuy nil)) (command "_sweep" "_L" "" ent) (if circonftuy (entdel circonftuy)) (command "_subtract" tubext "" "_L" "") (setq calo (entlast)) (command "_change" calo "" "_p" "_layer" calqcalo "") ) (defun descoude ( L1 L2 pt long) (command "_fillet" L1 L2) (setq coude (entlast)) (if (or del1 (if dminp (= (- long dminp) dmin) (= long dmin))) (entdel L1) (tubage L1 lg) ) (setq del1 nil) (tubage coude cd) ) (defun deterdmin ( / a a90 p) ;; determine la distance mini pour placer un coude (if dmin (setq dminp dmin)) ;;; dminp = dmin du coude precedent (if (= b (+ d01 d10)) (setq a180 t) (setq a180 nil)) ;; si angle 180 pas de coude mais prolongement (if (or (= d01 (+ b d10)) (= d10 (+ b d01))) (setq a0 t) (setq a0 nil) ;; si angle 0 pas possible alors arret ) (if (= (* b b) (+ (* d01 d01) (* d10 d10))) ;; si angle 90 dmin = rayon (setq a90 t dmin rayo) (setq a90 nil) ) (if (and (not a0) (not a90)(not a180)) ;;; si autre alors calcul (progn (setq p (/ (+ d01 d10 b) 2)) ;;; p=1/2 perimetre (setq a (abs (atan (sqrt (/ (* (- p d01)(- p d10)) (* p (- p b))))))) ;; 1/2 angle (setq dmin (* (cos a) (/ rayo (sin a)))) ) ) ) (defun onfekoi (L1 L2 pt1 pt2 pt3 d1 d2) (cond (a180 (tubage L1 lg)) (a0 (tubage L1 lg) (entdel L2) (setq p0 nil p1 nil)) ((and (not a0) (not a180)) (if (> rayo 0) (cond ((and (if dminp (>= (- d1 dminp) dmin) (>= d1 dmin)) (>= d2 dmin) ) (descoude L1 L2 pt2 d1) ) ((or (if dminp (< (- d1 dminp) dmin) (< d1 dmin)) (< d2 dmin) ) (correction L1 L2 pt1 pt2 pt3 d1 d2) ) ) (tubage L1 lg) ;;; si rayon 0 pas de raccordement ) ) ) ) (defun correction (L1 L2 pt1 pt2 pt3 d1 d2) (setq lg (if dminp (+ dmin dminp) dmin)) (if (< d1 lg) (progn (setq pt1 (trans (cdr (assoc 10 (entget L1))) 0 1)) (redefsommet pt1 pt2 d1 dmin) (entdel L1) (command "_line" "_none" pt1 "_none" sbn "") (setq L1 (entlast) ) (command "_move" L2 "" "_none" pt2 "_none" sbn) (setq pt2 sbn del1 t) ) ;;; progn ) ;;; if (cond ((> d2 dmin) (setq pt3 (trans (cdr (assoc 11 (entget L2))) 0 1)) (if (= dp t) (setq p1 pt3 p0 pt2) (setq p0 pt3 p1 pt2) ) (descoude L1 L2 pt2 lg) ;; pas modif ok ) ((= d2 dmin) (descoude L1 L2 pt2 lg) (entdel L2) (setq p0 nil p1 nil) ;;; arret sur coude ) ((< d2 dmin) ;; modification L2 (if (< d1 lg) (progn (setq pt2 sbn) (setq pt3 (trans (cdr (assoc 11 (entget L2))) 0 1)) (setq d1 lg) ) ) (redefsommet pt2 pt3 d2 dmin) (command "_move" L2 "" "_none" pt3 "_none" sbn) (descoude L1 L2 pt2 d1) (entdel L2) (setq p0 nil p1 nil) ;;; arret sur coude ) ) ) (defun redefsommet (sa sb ab dist / h a za zb z y x b bn hn ap psbn) (setq h (- (caddr sb)(caddr sa))) ;;; hauteur triangle (if (= h 0.0) ;; si parallele plan xy (progn (setq a (angle sa sb)) (setq sbn (polar sa a dist)) ) ;; si vertical suivant axe Z (if (and (= (rtos (car sa) 2 1) (rtos (car sb) 2 1)) ;; probleme de precision avec deplacement ligne (= (rtos (cadr sa) 2 1) (rtos (cadr sb) 2 1)) ) (progn (setq za (caddr sa) zb (caddr sb)) (if (> za zb) (setq z (- za dist)) (setq z (+ za dist)) ) (setq x (car sa) y (cadr sa)) (setq sbn (list x y z)) ;;; nouv sommet b ) ;; orientation quelconque (progn (setq b (sqrt (- (* ab ab) (* h h)))) ;;; base triangle (setq hn (/ (* h dist) ab)) ;;; nouvelle hauteur (setq bn (/ (* b dist) ab)) ;;; nouvelle base (setq ap (angle sa sb)) ;;; angle projeté de ab (setq psbn (polar sa ap bn)) ;;; projection nouv sommet b (setq z (+ (caddr sa) hn)) ;;; z nouv pb (setq x (car psbn)) (setq y (cadr psbn)) (setq sbn (list x y z)) ;;; nouv sommet b ) ) ) ) (defun creercalqueCALO ();creer calque pour calorifuge (setq calqcalo (strcat (getvar "clayer") "-CALO")) (if (not (tblsearch "layer" calqcalo)) ; s'il n'existe pas le calque est créé avec la couleur 9 (command "_-layer" "_n" calqcalo "_co" "9" calqcalo "") ) ) (defun c:TUY (/ p0 p1 L01 L10 coude mtrim ent eptub) (diam-t3d) (setq p1 nil dmin nil dminp nil L10 nil del1 nil cd 1 lg 0) (if (not (tblsearch "ltype" "axes2")) (command "_-linetype" "_l" "AXES2" "" "")) (if (> epcalo 0)(creercalquecalo)) (setvar "FILLETRAD" rayo) (setq mtrim (getvar "trimmode"))(setvar "trimmode" 1) (if (not tuy:ep) (setq tuy:ep 0)) (setq p0 "Epaisseur") (while (= p0 "Epaisseur") (initget "Epaisseur") (setq p0 (getpoint (strcat "\nPOINT DE DEPART ou = "(rtos tuy:ep 2 4)" :"))) (if (not p0) (setq p0 "Epaisseur")) (if (= p0 "Epaisseur") (progn (setq eptub (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos tuy:ep 2 4) ">: "))) (if eptub (if (< eptub ddia)(setq tuy:ep eptub))) ) ) ) (while p0 (if p1 (setq pd p1)) ;;; pd point de depart (setq p1 (getpoint p0 "\nPoint suivant : ")) (if p1 (progn (command "_line" "_none" p0 "_none" p1 "") (setq L01 (entlast) d01 (distance p0 p1) dp t) ;;; dp = dernier point p1 (if l10 ;;; si plusieurs boucles ;;;;;;; (progn (setq b (distance p1 pd)) ;;; b base triangle (deterdmin) (onfekoi L10 L01 pd p0 p1 d10 d01) ) ) (if p0 (setq pd p0)) (if p1 (setq p0 (getpoint p1 "\nPoint suivant : "))) (if p0 (progn (command "_line" "_none" p1 "_none" p0 "") (setq l10 (entlast) d10 (distance p1 p0) dp nil) (setq b (distance p0 pd)) (deterdmin) (onfekoi L01 L10 pd p1 p0 d01 d10) ) ) ) ;;; si p1 nil (progn (if (and l10 p0 ) (tubage l10 lg)) ;; si plusieurs boucles ;;;;;;; (setq p0 nil) ) ) ;;;; fin if p1 ) ;;; fin while (if (and l01 p1)(tubage l01 lg)) ;;;; termine dernier tronçon (setvar "trimmode" mtrim) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:cdt (/ lo ) ;; pour raccorder 2 axes et tracer un coude de tuy. (diam-t3d) (if (> epcalo 0)(creercalquecalo)) (setq mtrim (getvar "trimmode")) (setvar "FILLETRAD" rayo) (setvar "trimmode" 1) (setq lo (entlast)) (command "_fillet") (while (not (zerop (getvar "cmdactive")))(command pause)) (cond ((not (equal lo (setq coude (entlast)))) (setq pt (trans (cdr (assoc 10 (entget coude))) 0 1)) (generetube coude pt 1) ) ) (while (not (equal coude (setq lo (entlast)))) (command "_fillet") (while (not (zerop (getvar "cmdactive")))(command pause)) (cond ((not (equal lo (setq coude (entlast)))) (setq pt (trans (cdr (assoc 10 (entget coude))) 0 1)) (generetube coude pt 1) ) ) ) (setvar "trimmode" mtrim) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; calo seul ;; Pour ne tracer que le calorige par sélection de l'axe ou par deux points (defun c:calos (/ sel typent ent pt eptub axetemp rep) (diam-t3d) (while (or (>= 0 epcalo)(not epcalo)) (setq epcalo (getdist "\nEpaisseur calorifuge ou 2 pts : ")) ) (creercalquecalo) (if(= tuy:ep nil) ; si utilisation avant lisp tuy (progn (initget "Creux Plein") (setq rep (getstring "\n Calo dessiné [/Creux]:")) (if (or (= rep "")(= rep "Plein")) (setq tuy:ep 0.0) (setq tuy:ep -1)) ) ) (setq sel t) (while sel (setq sel (entsel "\nSélectionner l'AXE du TUBE ou par < 2 Points> :")) (if (not sel) (progn (setq sel t) (setq p1 (getpoint "\nPoint de départ : ")) (if p1 (setq p2 (getpoint p1 "\nPoint final : "))) (if (and p1 p2) (progn (command "_line" "_none" p1 "_none" p2 "") (setq axetemp (entlast))(setq pt (trans (cdr (assoc 10 (entget axetemp))) 0 1)) (if (or (= tuy:ep nil) (= tuy:ep 0.0)) (caloplein axetemp pt ) (calocreux axetemp pt ) ) (if (/= 2 (getvar "delobj"))(entdel axetemp)) ) (setq sel nil) ) ) (progn (setq typent (cdr (assoc 0 (entget (setq ent(car sel)))))) (cond ((or (= typent "LINE")(= typent "ARC")(= typent "POLYLINE")(= typent "LWPOLYLINE") (= typent "ELLIPSE")(= typent "CIRCLE")(= typent "SPLINE")(= typent "HELIX") ) (setq pt (cadr sel)) (if (or (= tuy:ep nil) (= tuy:ep 0.0)) (progn (if (> epcalo 0) (progn (if (= (cdr (assoc 0 (setq lent (entget ent)))) "ARC") (if (> (cdr (assoc 40 lent)) (+ ddia epcalo))(caloplein ent pt)) (caloplein ent pt) ) ) ) ) (progn (if (> epcalo 0) (progn (if (= (cdr (assoc 0 (setq lent (entget ent)))) "ARC") (if (> (cdr (assoc 40 lent)) (+ ddia epcalo))(calocreux ent pt)) (calocreux ent pt) ) ) ) ) ) ) ) ) ) ;; if ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; génère le tuyau à partir de l'axe sélectionné (defun c:TU (/ sel typent ent pt eptub ) (diam-t3d) (if (> epcalo 0)(creercalquecalo)) (if (not tuy:ep) (setq tuy:ep 0)) (initget "Epaisseur") (while (setq sel (entsel (strcat "\nSélectionner l'AXE du TUBE ou E,[Epaisseur] = "(rtos tuy:ep 2 4)" :"))) (if (= sel "Epaisseur") (progn (setq eptub (getdist (strcat "\nEpaisseur tube ou 2 pts <" (rtos tuy:ep 2 4) ">: "))) (if eptub (if (< eptub ddia)(setq tuy:ep eptub))) ) (progn (setq typent (cdr (assoc 0 (entget (setq ent(car sel)))))) (cond ((or (= typent "LINE")(= typent "ARC")(= typent "POLYLINE")(= typent "LWPOLYLINE") (= typent "ELLIPSE")(= typent "CIRCLE")(= typent "SPLINE")(= typent "HELIX") ) (setq pt (cadr sel)) (generetube ent pt nil) ) ) ) ) ;; if ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;; TSA tuyau sans axe (defun erreurtsa (msg) (setvar "delobj" delobjet) (setq *error* m:err m:err nil) (princ) ) (defun c:tsa () (setq m:err *error* *error* erreurtsa) (setq delobjet (getvar "delobj")) (setvar "delobj" 2) (c:tuy) (setvar "delobj" delobjet) (setq *error* m:err m:err nil) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (prompt "\nCommandes dispo: TUY tuyau 3D,TSA sans axe,TU depuis axe,CDT coude,CALOS seul") (princ) [Edité le 12/1/2009 par usegomme] [Edité le 8/4/2009 par usegomme]

Je ne comprend vraiment pas ta réponse ! Le calcul informatique par son impossibilité à aboutir montre justement que ce phénomène ne peut pas être aléatoire . C'est pourtant clair et simple à comprendre. cordialement

Salut Thierryd, désolé mais j'ai vraiment mal fait mon entrée en matière , quand j'ai parlé d'ordinateur ultime au tout début , j'aurais du préciser qu'il s'agissait d'ordinateur quantique voici un extrait de l'article: C'est donc sur cette base de calcul qu'est obtenue une durée de 10 puissance 174, fois l'âge de l'univers pour évaluer toutes les configurations possible de repliement d'une protéine de 500 acides aminés. Sidérant n'est-ce pas ? Et quant bien même ce ne serait qu'une seule année , comment fait la protéine pour réussir l'opération en un millème de seconde , "le temps de Planck" est valable aussi pour la protéine forcément. La prédétermination ou préprogrammation semble très probable, seulement le hic c'est que l'ARN qui produit la protéine n'a pas la moindre intelligence pour ce genre d' anticipation c'est bien pour cela que ce n'est pas envisagé par les scientifiques.... Alors ????? Et ...et alors ....Yzonpukachercher , j'espère qu'ils iront plus vite que l'ordinateur ! Je m'emballe certainement, il doit y avoir une combine intelligente quelque part. Intelligente ,hé oui comme d'habitude avec mère nature , on pourrait finir par croire que cette mère nature est quelqu' Un.

Salut , il existe un lisp avec son dcl qui s'appelle "CUT" et qui marche pas mal. ;;;;; cut.lsp (defun c:cut () ;;gratuiciel ;;Enhansed Multi-Trim Commands by Bob Jones With Dialog Box interface ;;added by Jim Arthur ;;This program is an enhansment of: ;;SECTION Release1.0 ;;Copyright (C) 1996, Bob Jones ;;courriel: bcjones@io.com ;;WWW: http://www.io.com/~bcjones ;;Permission to use, copy, modify, and distribute this software for any purpose ;;and without fee is hereby granted, provided that the above copyright notice ;;appears in all copies and that both that copyright notice and this permission ;;notice appear in all supporting documentation. ;;Bob Jones makes no warranty, including but not limited to any implied ;;warranties of merchantability or fitness for a particular purpose, ;;regarding the software and accompanying materials. The software and ;;accompanying materials are provided solely on an "as-is" basis. ;;In no event shall Bob Jones be liable to any special, collateral, incidental, ;;or consequential damages in connection with or arising out of the use of ;;the software or accompanying materials. ;;This routine can be called by typing one of three commands at the command prompt. ;;All three commands will ask the user to select to corners of a rectangle. ;;The first command, SCB, will erase and trim all entities outside of the rectangle ;;and leave a polyline border. ;;The second command, SC, will erase and trim all entities outside of the rectangle ;;but will not leave a border. ;;The final command, SCD, will erase and trim all entities inside of the rectangle ;;and will not leave a border. ;;Please feel free to rename these commands as you desire. (defun c:scb () (section t nil)); SECTION W/ BORDER (defun c:sc () (section nil nil)); SECTION W/O BORDER (defun c:scd () (section nil t)); DELETE INSIDE RECTANGLE * * * * * ERROR ROUTINE * * * * * (defun newerr (msg) (prompt (strcat "\nSection cancelled: " msg)); PRINT ERROR (setvar "cmdecho" cmd); RESET COMMAND ECHO (setvar "highlight" hlt); RESET HIGHLIGHT ) * * * * * MAIN FUNCTION * * * * * ;If the first argument has any value other than nil then the border will be left. If it is nil ;then the border is erased. ;If the second argument is has any value other than nil then entities inside the border will be erased. ;If it is nil then entities outside the border are erase. ;For very large area drawings (maps or something), the DST variable may need to be changed. If you ;find that not all entities are being trimmed properly try increasing the number higher than 1000. (defun section (bdr n / olderr newerr cmd hlt p1 p2 p1x p1y p2x p2y p3 p4 dst plus minus p1a p2a p3a p4a lst) (graphscr); CHANGE TO GRAPHICS SCREEN (setq olderr *error* ; SET UP NEW *error* newerr ; ERROR ROUTINE cmd (getvar "cmdecho"); SAVE COMMAND ECHO SETTING hlt (getvar "highlight"); SAVE HIGHLIGHT SETTING p1 (getpoint "\nSelect first corner of rectangle: "); GET LL CORNER OF RECTANGLE p2 (getcorner p1 "\nSelect other corner: "); GET UR CORNER p1x (car p1) p1y (cadr p1) p2x (car p2) p2y (cadr p2) p3 (list p2x p1y); BUILD LR CORNER p4 (list p1x p2y); BUILD UL CORNER dst (/ (distance p1 p2) 1000.0); OFFSET FACTOR FOR TRIMMING plus (if n - +) minus (if n + -) );END SETQ (cond ((and (< p1x p2x) (< p1y p2y)); P1 IS LL CORNER (setq p1a (list (minus p1x dst) (minus p1y dst)); BUILD LL TRIM LINE POINT p2a (list (plus p2x dst) (plus p2y dst))); BUILD UR TRIM LINE POINT ) ((and (> p1x p2x) (< p1y p2y)); P1 IS UL CORNER (setq p1a (list (plus p1x dst) (minus p1y dst)); BUILD LL TRIM LINE POINT p2a (list (minus p2x dst) (plus p2y dst))); BUILD UR TRIM LINE POINT ) ((and (> p1x p2x) (> p1y p2y)); P1 IS UR CORNER (setq p1a (list (plus p1x dst) (plus p1y dst)); BUILD LL TRIM LINE POINT p2a (list (minus p2x dst) (minus p2y dst))); BUILD UR TRIM LINE POINT ) ((and (< p1x p2x) (> p1y p2y)); P1 IS LR CORNER (setq p1a (list (minus p1x dst) (plus p1y dst)); BUILD LL TRIM LINE POINT p2a (list (plus p2x dst) (minus p2y dst))); BUILD UR TRIM LINE POINT ) ); END COND (setq p3a (list (car p2a) (cadr p1a)); BUILD LR TRIM LINE POINT p4a (list (car p1a) (cadr p2a)); BUILD UL TRIM LINE POINT ); END SETQ (setvar "cmdecho" 0); TURN OFF COMMAND ECHO (setvar "highlight" 0); TURN OFF HIGHLIGHT (command "_.pline" p1 p3 p2 p4 "_c"); DRAW POLYLINE BORDER (setq lst (entlast)); SAVE POLYLINE ENTITY NAME (if n ;ERASE ENTITIES (command "_.erase" "_w" p1 p2 "_r" lst "") ;INSIDE RECTANGLE (command "_.erase" "_all" "_r" "_c" p1 p2 "") ;OUTSIDE RECTANGLE ); END IF (command "_.trim" lst "" "_f" p1a p3a "" ;TRIM ENTITIES AROUND BORDER "_f" p3a p2a "" ;DO TO THE FINICKY NATURE OF TRIMMING "_f" p2a p4a "" ;WITH THE FENCE OPTION, I HAVE USED FOUR "_f" p4a p1a "" "" ;FENCE LINES INSTEAD OF ONE LONG ONE ); END COMMAND (if (not bdr) (entdel lst)); DELETE POLYLINE BORDER IF DESIRED (setq *error* olderr); RESTORE ORIGINAL ERROR ROUTINE (setvar "highlight" hlt); RESTORE HIGHLIGHT (setvar "cmdecho" cmd); RESTORE COMMAND ECHO (princ); EXIT CLEANLY ) ;;The following prompts are disabled when section.lsp is used with dialog box. ;(prompt "\nType SCB to create a section with a border.") ;(prompt "\nType SC to create a section without a border.") ;(prompt "\ntype SCD to delete entities inside rectangle.") ;(princ) (defun cut_x () (setq C 0 dcl_id (load_dialog "cut.dcl")) (if (not (new_dialog "cut" dcl_id))(exit)) (action_tile "cut_outp" "(setq c 1)(done_dialog)") (action_tile "cut_out" "(setq c 2)(done_dialog)") (action_tile "cut_in" "(setq c 3)(done_dialog)") (action_tile "cancel" "(done_dialog)(exit)") (start_dialog) (unload_dialog dcl_id) (COND ((= C 1)(c:scb)) ((= C 2)(c:sc)) ((= C 3)(c:scd)) ) (princ) ) (cut_x) ) ;;__________________________________________________________________ ;;messages (prompt "\nCut.LSP loaded - Type Cut to begin.") (princ) ;;;; cut.dcl // Cut.dcl // By: Jim Arthur // 2/8/97 // used with Cut.lsp cut : dialog { label = "Trim In Trim Out"; :row { :boxed_column { : button { key = "cut_outp"; label = "Trim Out w/ Boarder"; } : button { key = "cut_out"; label = "Trim Out No Boarder"; } : button { key = "cut_in"; label = "Trim Inside Boundry"; } } } : row { : spacer { width = 1; } : button { label = "Cancel" ; is_cancel = true; key = "cancel" ; width = 8; fixed_width = true; } : spacer { width = 1; } } }

Salut Ce postulat n'a rien d'une plaisanterie, c'est un moyen de savoir qu'un modèle théorique ne correspond pas à la réalité et qu'il faut chercher d'autre piste. C'est sûr que ma présentation du sujet, trop brève et mal faite , ne rend pas l'article de science&vie. Voici une explication de la notion du temps raisonnable: Voilà pour le principe qui est justifié car il est aussi écrit: que pour calculer toutes les configurations d'une protéine à 500 acides aminés, il faudrait approximativement 10 puissance174, fois l'âge de l'univers , certes c' est très imprécis mais quand on sait que le processus de repliement de la dite protéine prend entre 1 millionième et 1 millième de seconde , il n'est pas besoin de sortir de Saint-Cyr pour comprendre que l'algorithme basé sur le hasard des fluctuations d'énergie pour trouver la bonne configuration, n'est pas le bon. "10 puissance174 fois l'âge de l'univers" ça parait invraisemblable, mais vu qu'il n'y a pas eu d'erratum de publier depuis ce n° 1090 c'est que personne n'a du le contester, et de toute manière si ce n'était que qlq milliers d'années on ne serait pas plus avancé. Certes pour "vous", le hasard n'a pas dit son dernier mot, mais sur ce coup , il est mal en point.

salut Je crois qu'il va falloir commencer par les recruter pour Cadxp ! Je pense que les Profilés Reconstitués Soudés ne doivent être réalisés qu'à la demande . Et pour les inclure dans le lisp il faudrait avoir un catalogue de dimensions standard.

A priori l' UAP serait remplacé par l' UPE , j'ai essayé de me renseigner mais ça reste trés flou car ça dépend des fournisseurs , des dimensions, des stocks , des quantités voulues . Si un charpentier peut apporter un peu d'éclairage ça serait bien.

Petit nota au cas où : certains profils de la bibliothèque ne se trouvent plus dans le commerce , mais sont utiles pour redessiner d'anciennes installations. a+

Oui , belle astuce de (gile), mais tu as de la chance que ce ne soit pas mon lisp , sinon je ne t'aurais pas accordé ce droit !... :) Plaisanterie à part , dans le gratuit il n' y a donc rien de nouveau ! Avant j'utilisais PROFBEAT , mais il n'ont pas suivi l' évolution d'autocad dommage mais compréhensible.

Bonjour , perso je suis emballé et impressionné .C'est du super boulot plein de logique et de bon sens et j'espère que tu arriveras à tes fins. Mais pour les égyptologues .... Je suis allé voir le site officiel de la grande pyramide , le grand boss qui se met en scène , ça m'a laissé une très mauvaise impression . Je ne sais pas s'il se croit sorti de la cuisine de Jupiter mais en tout cas il a l'air d'être fier comme un bar tabac ce qui est de mauvaise augure , faudra peut être attendre son départ en retraite pour espérer investiguer d'avantage.

Salut , ici le lien vers une version complétée , celle de 2007, en espèrant que ça marche car je n'ai aucune pratique de ce genre de liaison.

Salut, concernant le générateur de profils en question , en 2007 je l'avais corrigé et complété avec des profils supplémentaires et placé dans "les téléchargements membres" , mais je viens de constater qu'il n'est plus accessible. http://www.cadxp.com/UpDownload+index-req-getit-lid-146.html S'il peut être amélioré autant repartir sur le dernier jus connu, d'autant que j'ai fait une petite modif pour qu'il fonctionne avec un bout de lisp qui extrude le profil en 3d (à condition de ne pas utiliser l'option "créer un bloc"). Si ce n'est pas réparable prochainement , je tâcherais de le mettre en ligne comme a fait zebulon_. a+

Salut La thèse d' autospeed me paraît tout à fait crédible et d'autant plus en sachant que cette pyramide a été construite avant les cataclysmes qui ont marqués la fin de la période glaciaire. J'imagine très bien que cette pyramide soit une espèce d'arche de Noê du savoir de l'époque et que les dirigeants d'alors sentant la fin prochaine, auraient voulu sauver et transmettre . Je pense que c'est la raison d'être de possible mécanismes d'ouverture. Il était peut être indiqué quelque part comment actionner le mécanisme , mais ceux qui ont réinvestis les lieux bien longtemps après , étaient retourné à l'état "tribal" sans moyen technique et incapable de déchiffrer les inscriptions. Tiens c'est amusant , j'ai mal lu et rien compris à la réponse 12 , car je ne crois pas non plus que le niveau d'eau à l'extérieur devait ouvrir la pyramide. [Edité le 2/11/2008 par usegomme]

Bonjour , c'est vrai il est toujours là, mais il tarde d'avantage a se manifester ce qui le rend moins génant. C'est déjà mieux , mais pour ce qui est de la résolution finale , je jette l'éponge . Je ne sais pas faire.

Bonjour, avec cette nouvelle version le problème ci-dessus doit être réglé. Simplement avec l'option retirer de la cde , j'ai essayé en lisp avec ssdel sans succés car autocad donne 2 noms différents à une même entité (bloc avec attribut) ! ;; adaptation v 1.3 par usegomme de XEDIT auteur inconnu (defun nsel-xe () ;; nouv objet-> nouv sélection (setq js (ssget "p")) (setq sel nil sel (ssadd)) (while (entnext elast) (ssadd (entnext elast) sel) (setq elast (entnext elast)) ) ) (defun c:xe (/ sel pdr npdr act elast nelast) (setq js nil act T sel (ssget)) (if sel (command "_move" sel "")) ;; pour surbrillance (if sel (setq pdr (getpoint "\nSpécifiez le point de base:"))) (command) ;; fin surbrillance (while (and sel pdr act) (initget "Copier Deplacer Rotation Echelle Scale-ref Miroir Pt-base Quitter") (setq act (getkword "\n [Copier/Deplacer/Rotation/Echelle/Scale-ref/Miroir/Pt-base/Quitter] :")) (cond ((= act "Copier") (setq elast (entlast)) (command "_copy" sel) (if js (command "_r" js "" pdr)(command "" pdr)) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq pdr (getvar "LASTPOINT")) (nsel-xe) ) ((= act "Deplacer") (command "_move" sel) (if js (command "_r" js "" pdr)(command "" pdr)) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq pdr (getvar "LASTPOINT")) ) ((= act "Rotation") (setq elast (entlast)) (command "_rotate" sel ) (if js (command "_r" js "" pdr)(command "" pdr)) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq nelast (entlast)) (if (not (equal elast nelast))(nsel-xe)) ) ((= act "Pt-base") (setq pdr (getpoint "\n Spécifiez le nouveau point de base :")) ) ((= act "Echelle") (setq elast (entlast)) (command "_scale" sel ) (if js (command "_r" js "" pdr)(command "" pdr)) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq nelast (entlast)) (if (not (equal elast nelast))(nsel-xe)) ) ((= act "Scale-ref") (setq elast (entlast)) (command "_scale" sel) (if js (command "_r" js "" pdr "_r" )(command "" pdr "_r")) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq nelast (entlast)) (if (not (equal elast nelast))(nsel-xe)) ) ((= act "Miroir") (setq elast (entlast)) (command "_mirror" sel ) (if js (command "_r" js "" )(command "")) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq npdr (getpoint "\n Nouveau Point de base <>:")) (if npdr (setq pdr npdr npdr nil)) (setq nelast (entlast)) (if (not (equal elast nelast))(nsel-xe)) ) ((= act "Quitter") (setq act nil) ) ) ;;; fin cond ) ;; fin while (princ) ) ;;; fin xe

Salut Bonuscad Ton écrou est sympa , c'est marrant de le voir se constuire seul et l' écriture du lisp est instructive pour les poireaux de mon genre. Pour autocad 2007 et + , les options de la commande extrusion ayant changées, à la ligne: (command "_.extrude" "_last" "" h_ecr 0.0) Il faut supprimer le 0.0 final pour éviter le blocage du lisp.

Je vois que vous n'aimez pas les histoires de déluge , c'est pourtant fort intéressant (voir le post de la grande pyramide par autospeed). Probablement que cela vous rappelle l'apocalypse de St Jean , mais il ne faut pas oublier que l'histoire n'est pas écrite d'avance , elle est juste prévisible et une prophétie est un avertissement. On a l'exemple de Ninive qui n'a pas été détruite , les avertissements de Jonas ont permi d'éviter le pire. On est entré dans le 3e millénaire , feu l'apocalypse est derrière nous. Reste le réchauffement climatique , mais c'est une autre histoire. [Edité le 22/9/2008 par usegomme]

J'ai pas encore intégré que les jeunes apprennent autocad à l'école ! Dur dur le 3eme age.

Salut , tu peux essayer comme ça : (setq p1 (getpoint "\n point de départ :")) (setq d 10.0) (command "ligne" p1) (setq a (getangle p1 "\n specifier l'angle")) (setq p2 (polar p1 a d)) (command p2 "")

Bien compris chef ! j'vais tâcher d'faire sobr'. :) A propos de ruban , quand on désactive l'ancrage ,il redevient tableau de bord . Pour l'instant je n 'aime guère le ruban , mais mon collègue qui était perdu depuis qu'il a laché sa version 14 , y trouve son compte , comme quoi chez autodesk , ils ne sont pas complètement idiot , ils pensent aux débutants et à ceux qui ne sont pas passionnés par l'outil.

C'est bien . Pour les cotes , je connais le problème , mais est-ce que tu cotes sur les xref , car dans ce cas ,les cotes ne suivent pas les modifs et cela m'indispose.

Je ne sais pas si c'est déjà signalé mais dans le fichier AutoCAD.pgp il y a une faute d'orthographe sur le remplacement d'un nom de cde 2008. Il est écrit FERMERUBAN au lieu de FERMERRUBAN et d'autre part il manque le renvoi de la cde en anglais pour ceux qui récupère leur ancien menu. ; Alias des commandes qui ne sont plus utilisées dans AutoCAD 2009: TABLEAUDEBORD, *RUBAN FERMERTABLEAUDEBORD, *FERMERRUBAN et à compléter avec DASHBOARD, *RUBAN DASHBOARDCLOSE, *FERMERRUBAN