usegomme

Salut bennane01 , pour concerver les axes de tes gaines , il suffit que tu places un ; devant toutes les lignes du lisp contenant : " _erase" ou "effacer" exemple : (command "effacer" D "") remplacé par : ;(command "effacer" D "") la commande n´est alors plus exécutée et les axes restent en place.

Si tu veux que la pause soit pour le seuil et le trajet pour les objet à ajuster , il faut un espace ou un point-virgule aprés la pause de manière à terminer ta sélection de seuil. Si je n'ai pas compris détaille ce que tu veux faire.

Bonjour . De passer les commandes en anglais ne changera rien . Je n'ai jamais utilisé la 2005 , mais de mémoire et sur les versions antérieures , je sais que l'option "trajet" était accessible pour sélectionner plusieurs objets , mais pour le reste ? Donc T sur la ligne de commande et tant qu' a y être essaie aussi C pour capture ça fonctionne peut être.

Escusez moi de vous déranger , monsieur Open-mind est-il là ? C'est juste pour lui dire qu'ici il y a des icones dont ceux d'autocad 2008 renommés avec un -8 à la fin. Il y avait déjà eu un post d' échange d'icones mais je ne l'ai pas retrouvé. Au revoir, bonne journée.

Après le point de base , il ne faut pas valider mais choisir une option , car valider par défaut renvoie sur l'option quitter, (mais ça pourrait être modifier).

Bonjour , j'ai rajouté une option rotation avec copie au lisp "XE" , car la base y était déjà, regarde si ça va dans le sens que tu souhaites.

Bonjour , j'ai rajouté au lisp "XE" une option rotation avec copie . ;; 18-11-2009 ;; adaptation v 1.6 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 sv_dm dm) (setvar "cmdecho" 1) (setq js nil act T sel (ssget)) (if sel (command "_select" sel )) ;; pour surbrillance (if sel (setq pdr (getpoint "\nSpécifiez le point de base:"))) (command "") ;; fin surbrillance (setq sv_dm (getvar "DYNMODE")) (cond ((< sv_dm 0) (setq dm (* sv_dm -1)) (setvar "DYNMODE" dm)) (t (setq sv_dm nil dm nil)) ) (while (and sel pdr act) (initget "Copier Deplacer Rotation rOtation+copie Aligner Echelle Scale-ref Miroir Pt-base Quitter") (setq act (getkword "\n [Copier/Deplacer/Rotation/rOtation+copie/Aligner/Echelle/Scale-ref/Miroir/Pt-base/Quitter] :")) (cond ((= act "Copier") (setq elast (entlast)) (command "_copy" sel) (if js (command "_r" js "" "_none" pdr)(command "" "_none" pdr)) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq pdr (getvar "LASTPOINT")) (nsel-xe) ) ((= act "Deplacer") (command "_move" sel) (if js (command "_r" js "" "_none" pdr)(command "" "_none" 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 "" "_none" pdr)(command "" "_none" pdr)) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq nelast (entlast)) (if (not (equal elast nelast))(nsel-xe)) ) ((= act "rOtation+copie") (setq act "Oui") (while (= act "Oui") (setq elast (entlast)) (command "_rotate" sel ) (if js (command "_r" js "" "_none" pdr)(command "" "_none" pdr)) (command "_c") (while (not (zerop (getvar "cmdactive")))(command pause)) (setq nelast (entlast)) (if (not (equal elast nelast))(nsel-xe)) (initget "Oui Non") (setq act (getkword "\nCopie supplémentaire [Non] :")) (if (not act) (setq act "Oui")) ) ) ((= act "Aligner") (command "_align" sel) (if js (command "_r" js "" "_none" pdr)(command "" "_none" pdr)) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq pdr (getvar "LASTPOINT")) ) ((= act "Echelle") (setq elast (entlast)) (command "_scale" sel ) (if js (command "_r" js "" "_none" pdr)(command "" "_none" 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 "" "_none" pdr "_r" )(command "" "_none" 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 "Pt-base") (setq pdr (getpoint "\n Spécifiez le nouveau point de base :")) ) (t ; (= act "Quitter") (if sv_dm (setvar "DYNMODE" sv_dm)) (setq act nil) (gc) ) ) ;;; fin cond ) ;; fin while (princ) ) ;;; fin xe

Bonjour Il serait aussi pas mal de désactiver l'accrochage objet en mode commande ici (command "_CHANGE" (car p1) "" "_non" pt1) (command "_CHANGE" (car p2) "" "_non" pt2) et là (command "_PLINE") (foreach n l (command "_non" n))

Bonjour , Merci pour le test, Lili2006. Quant à Philou2 , et au lisp , je constate que sur ce que tu as recopié , il manque une parenthèse avant le DEFUN defun c:JPedit (/ jpo:pa e elast ss s ep) Donc c'est pour cela que ça ne marche pas ! Il te faut utiliser l'editeur VLISP pour vérifier les parenthèses et au moyen du double clic.

Escuse-moi mais j' étais vraiment endormi et je ne me suis même plus rappellé de ton post sur les degrés , minutes etc.. que j'avais pourtant lu ! Je m'en suis souvenu ce matin dans le lit . Pour la peine j'ai arrangé le lisp avec le code que t'avait fait (gile). (defun Jeff2Rad (a / p) (setq p (vl-string-position 46 a)) (* (/ pi 180.) (+ (atoi (substr a 1 p)) (/ (atoi (substr a (+ 2 p) 2)) 60.) (/ (atoi (substr a (+ 4 p) 2)) 3600.) ) ) ) (defun c:pad (/ pt AngleDMS AngleRad d) (setq pt (getpoint "\n point de départ :") AngleDMS (getstring "\n Entrez une Angle DD.MMSS: ") AngleRad (Jeff2Rad AngleDMS) d (getdist "\n Distance :") ) (command "_line" "_non" pt "_non" (polar pt AngleRad d) "") (princ) ) Tu peux remplacer d (getdist "\n Distance :") par d (getdist pt "\n Distance :") pour avoir " l élastique". Sinon j'ai noté un petit problème : si on veut par exemple un angle de 45° tout rond , il faut taper 45.entrée si on ne met pas le point après 45 , il se produit une erreur qu'on a également avec le lisp "jeff". [Edité le 17/10/2009 par usegomme]

Salut Je suis peut être déjà endormi , mais je ne pige pas le truc car "getangle" retourne aussi un angle en radian . J'aurai vu un truc tout simple avec polar comme a indiqué Philphil (defun c:pad (/ p a d) (setq p (getpoint "\n point de départ :") a (getangle "\n Angle :") d (getdist "\n Distance :") ) (command "_line" "_non" p "_non" (polar p a d) "") (princ) )

Merci (gile) , t'es un "chef" et je pense avoir compris cet épisode :)

Je viens de l'essayer avec la 2009 et tout va bien , vérifie si tu as bien copier le code , sinon c'est le nom de la commande qu'il faut changer en priorité (defun c:JPe Si quelqu'un d'autre veut bien l'essayer , on verra un peu plus clair.

Salut , chez moi ça fonctionne (acad2008), essaie en changeant le nom du lisp , il y a peut être un doublon.

Re salut Voilà quelque chose de rapidos , qu'il faudrait améliorer au niveau des entrées utilisateur, pour ce qui est des lignes mal dessinées , je ne sais pas faire. (defun c:JPe (/ jpo:pa e elast ss s ep) (setq elast (entlast)) (or (setq e (getdist "\n Tolérance entre polylignes <1> :")) (setq e 1.0) ) (or (setq ep (getdist "\n Epaisseur polylignes <0.5> :")) (setq ep 0.5) ) (setq ss (ssget)) (setq jpo:pa (getvar "peditaccept" )) (setvar "peditaccept" 1) (vl-cmdf "_.pedit" "_m" ss "" "_j" e "") (setq s nil s (ssadd)) (while (entnext elast) (ssadd (entnext elast) s) (setq elast (entnext elast)) ) (vl-cmdf "_.pedit" "_m" ss s "" "_w" ep "") (setvar "peditaccept" jpo:pa) (princ) )

Bonjour (gile) , je trouve ce lisp vraiment très intêressant et j'essaie d'en comprendre le fonctionnement , avec beaucoup de mal d'ailleurs. Entre autre, je coince sur la notion de déplacement de la fonction "trans". Mon neurone lispeur est grippé , si tu as un peu d'huile ,ce sera bien volontier. Merci.

Salut Philou2 , je ne sais pas si j'ai bien compris et je n' ai pas essayé ta macro , mais ci-dessous un petit lisp que j'utilise avec l'écart entre polylignes fixé à 1. (valeur après le "_j" ) ; joindre arc ligne polyligne (defun c:JPO (/ jpo:pa) (setq jpo:pa (getvar "peditaccept" )) (setvar "peditaccept" 1) (vl-cmdf "_.pedit" "_m" (ssget) "" "_j" 1.0 "") ;; (ssget) (command "pedit" "_m" "_p" "" "_j" "0.0" "") ;; ancienne methode (setvar "peditaccept" jpo:pa) (princ) ) on peut en faire ça (defun c:JPo (/ jpo:pa e) (or (setq e (getdist "\n Tolérance entre polylignes <1> :")) (setq e 1.0) ) (setq jpo:pa (getvar "peditaccept" )) (setvar "peditaccept" 1) (vl-cmdf "_.pedit" "_m" (ssget) "" "_j" e "") (setvar "peditaccept" jpo:pa) (princ) ) [Edité le 15/10/2009 par usegomme]

Ben ici , monsieur Fraid: (or (setq tl (assoc 6 (entget ent)))

Version 4.2 avec quelques corrections voir réponse n°6 [Edité le 6/10/2009 par usegomme]

Salut Binoit, Comme tu l´as certainement constater autocad génére le solide avec une continuité des arêtes et si la section du tube tracée au départ selon une orientation "standard" n´est pas aligné avec le plan formé par les segments de la polyligne , il y a une déformation . De mëme lors d´un changement de direction avec changement de niveau . Dans ce cas il faut se déporter jusqu´à la génératrice extérieure du tube avant de changer de niveau. A part demander à l´utilisateur un angle de rotation de la section de départ, je ne vois pas ce que je peux faire . Je te renvoie donc la balle , détaille un peu mieux ton soucis , sait-on jamais !

Merci Carboleum , je n´y avais pas pensé , où avais-je la tête ? :casstet: Et comme je ne me souviens plus de ce que je voulais en faire précisément , je m´auto-upgrade la ceinture en ceinture noire 1er d´âne.

Salut Sada20 , je pense avoir qlq chose pour toi, qui marche assez bien. (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) Sans oublier le fichier DCL pour le dialogue // 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; } } }

Bonjour à tous, Salut Guigues , il manque 2 parenthèses fermantes ci dessous ((= a 2)(c:GA3) ((= a 3)(c:GA2) et aussi comment fait tu le chargement de Ga1 etc autrement tu peux éventuellement remplacer (command "-inserer" "Cotation" "0,0" "1" "1" "0") (command "_erase" "to" "") par (command "-inserer" "Cotation") (command) cela incorpore le bloc à ton dessin sans l'insérer à l'écran. et puis bon courage . Et pour Patrick_35 , j'aimerais savoir à quoi sert le numéro d'ordre à "(done_dialog 1)" , merci. [Edité le 14/9/2009 par usegomme] [Edité le 14/9/2009 par usegomme]

Merci A+

Bonjour , j'ai fait une mise à jour pour qu'on puisse utiliser autre chose que les lignes droites comme axe pour le profil. C'est toujours dans mon style bricolo , mais dans la plupart des cas le résultat est bon. ; ax2pr Axe to profil rectangulaire (creux si ep > 0) ; version 4.2 le 06-10-2009 ; usegomme sur Cadxp.com (defun c:ax2pr (/ la ha ep r ax p1 p2 tubext i l1 cfollow) (setq CFOLLOW (getvar "UCSFOLLOW")) (setvar "UCSFOLLOW" 0) ; sauve scu courant (command "_ucs" "_s" "tempftd")(if (not (zerop (getvar "cmdactive")))(command "_y")) (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 :")) (cond ((or (and (= 1 (cdr (assoc 70 (entget (car ax))))) (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ax)))))) (= "SPLINE" (cdr (assoc 0 (entget (car ax))))) ) (command "_ucs" "") (setq i 9 ok nil p1 nil) (while (and (= ok nil) (nth (setq i (+ i 1)) (entget (car ax)))) (if (= 10 (car (nth i (entget (car ax))))) (if p1 (setq p2 (cdr (nth i (entget (car ax)))) ok T) (setq p1 (cdr (nth i (entget (car ax))))) ) ) ) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) ) ((or (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 9 (cdr (assoc 70 (entget (car ax)))))) (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 1 (cdr (assoc 70 (entget (car ax)))))) ) (command "_ucs" "") (setq l1 (entget (entnext (cdr (assoc -1 (entget (car ax))))))) (setq p1 (cdr (assoc 10 l1))) (setq l1 (entget (entnext (cdr (assoc -1 l1))))) (setq p2 (cdr (assoc 10 l1))) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) ) ((= "ELLIPSE" (cdr (assoc 0 (entget (car ax))))) (setq p1 (osnap (cadr ax) "_qua")) (setq p2 (osnap (cadr ax) "_cen")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (command "_ucs" "_y" "-90") ) (T (if (setq p1 (osnap (cadr ax) "_endp")) (if (setq p2 (osnap (cadr ax) "_cen")) (progn (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (command "_ucs" "_y" "-90") ) (progn (setq p2 (osnap (cadr ax) "_mid")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) ) ) (progn (setq p1 (osnap (cadr ax) "_qua")) (setq p2 (osnap (cadr ax) "_cen")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (command "_ucs" "_y" "-90") ) ) ; if ) ; T ) ; cond (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" "_r" "tempftd") ) (setvar "UCSFOLLOW" CFOLLOW) (princ) ) Et le même sans les arêtes arrondies , il doit bien y avoir quelqu'un pour qui ça a un intérêt. ; ax2pr0 Axe to profil rectangulaire (creux si ep > 0) mais arêtes sans rayon ; version 4.2 bis le 06-10-2009 ; usegomme sur Cadxp.com (defun c:ax2pr0 (/ la ha ep ax p1 p2 tubext i l1 cfollow) (setq CFOLLOW (getvar "UCSFOLLOW")) (setvar "UCSFOLLOW" 0) ; sauve scu courant (command "_ucs" "_s" "tempftd")(if (not (zerop (getvar "cmdactive")))(command "_y")) (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 0.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 :")) (cond ((or (and (= 1 (cdr (assoc 70 (entget (car ax))))) (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ax)))))) (= "SPLINE" (cdr (assoc 0 (entget (car ax))))) ) (command "_ucs" "") (setq i 9 ok nil p1 nil) (while (and (= ok nil) (nth (setq i (+ i 1)) (entget (car ax)))) (if (= 10 (car (nth i (entget (car ax))))) (if p1 (setq p2 (cdr (nth i (entget (car ax)))) ok T) (setq p1 (cdr (nth i (entget (car ax))))) ) ) ) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) ) ((or (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 9 (cdr (assoc 70 (entget (car ax)))))) (and (= "POLYLINE" (cdr (assoc 0 (entget (car ax))))) (= 1 (cdr (assoc 70 (entget (car ax)))))) ) (command "_ucs" "") (setq l1 (entget (entnext (cdr (assoc -1 (entget (car ax))))))) (setq p1 (cdr (assoc 10 l1))) (setq l1 (entget (entnext (cdr (assoc -1 l1))))) (setq p2 (cdr (assoc 10 l1))) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) ) ((= "ELLIPSE" (cdr (assoc 0 (entget (car ax))))) (setq p1 (osnap (cadr ax) "_qua")) (setq p2 (osnap (cadr ax) "_cen")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (command "_ucs" "_y" "-90") ) (T (if (setq p1 (osnap (cadr ax) "_endp")) (if (setq p2 (osnap (cadr ax) "_cen")) (progn (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (command "_ucs" "_y" "-90") ) (progn (setq p2 (osnap (cadr ax) "_mid")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) ) ) (progn (setq p1 (osnap (cadr ax) "_qua")) (setq p2 (osnap (cadr ax) "_cen")) (command "_ucs" "_zaxis" "_non" p1 "_non" p2) (command "_ucs" "_y" "-90") ) ) ; if ) ; T ) ; cond (setq P1 '(0. 0. 0.)) (setq i 1) (repeat 2 (if (= i 2) (cond ((> ep 0.0) (setq tubext (entlast)) (if (= 2 (getvar "delobj"))(entdel (car ax))) (setq la (- la ep) ha (- ha ep)) (setq i 3) ) ) ) (cond ((/= i 2) (command "_PLINE" "_non" (list (* la -1) (* ha -1)) "_non" (list la (* ha -1)) "_non" (list la ha) "_non" (list (* la -1) ha) "_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" "_r" "tempftd") ) (setvar "UCSFOLLOW" CFOLLOW) (princ) ) [Edité le 5/10/2009 par usegomme] [Edité le 6/10/2009 par usegomme]