Aller au contenu

usegomme

Membres
  • Compteur de contenus

    621
  • Inscription

  • Dernière visite

Tout ce qui a été posté par usegomme

  1. S' il y en a qui veulent du rectangulaire barre ou tube il faut télécharger AX2PR.lsp qui m'a servi à faire le montage précédent car il fonctionne sur le même principe. a+
  2. Salut , ce sera le choix d'une autre commande et d'un autre lisp mais qui fait toujours appel à PROFIL.lsp que j' invite à retélécharger car j'y ai rectifié un petit oubli. ; FTDA Fer Trois D suivant un Axe sélectionné , fonctionne avec PROFIL.lsp ; version 1 le 05-11-2010 ; Usegomme sur Cadxp.com , avec du code à (gile) pour les ellipses ;------------------------------------------------------------------------------ ;; MXV ;; Applique une matrice de transformation à un vecteur -Vladimir Nesterovsky- ;; ;; Arguments : une matrice et un vecteur (defun mxv (m v) (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m) ) ;---------------------------------------------------------------------------------- (defun c:FTDA (/ pt_i_fer ax p1 p2 i l1 CFOLLOW elst pe cen elv ext pa1 pa2 grd prd ang pt1 pt2 mat a1 a2 aec) (if (null c:PROFIL)(load "PROFIL")) (setq CFOLLOW (getvar "UCSFOLLOW")) (setvar "UCSFOLLOW" 0) ; sauve scu courant (command "_ucs" "_s" "tempftd")(if (not (zerop (getvar "cmdactive")))(command "_y")) (while (setq ax (entsel "\nSélectionner l'AXE pour le Profilé Métallique:")) (cond ((= "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) ) ((and (= 1 (cdr (assoc 70 (entget (car ax))))) (= "LWPOLYLINE" (cdr (assoc 0 (entget (car ax)))))) (command "_ucs" "_e" (car ax)) (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) ((or (= "CIRCLE" (cdr (assoc 0 (entget (car ax))))) (= "ARC" (cdr (assoc 0 (entget (car ax))))) ) (command "_ucs" "_e" (car ax)) (setq p1 (polar '(0. 0. 0.) 0.0 (cdr (assoc 40 (entget (car ax)))))) (command "_ucs" "_o" "_non" p1 ) (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) ((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 ent (car ax)) ;; le code traitant les ellipses provient du lisp PELL.lsp de (gile) sur cadxp.com (setq elst (entget ent)) (or (equal (trans '(0 0 1) 1 0 T) (cdr (assoc 210 elst)) 1e-9) (and (setq ucs T) (command "_.ucs" "_zaxis" "_non" '(0 0 0) "_non" (trans (cdr (assoc 210 elst)) ent 1 T)) ) ) (setq pe (getvar "pellipse") elst (entget ent) cen (cdr (assoc 10 elst)) elv (caddr (trans cen 0 (cdr (assoc 210 elst)))) ext (trans (mapcar '+ cen (cdr (assoc 11 elst))) 0 1) cen (trans cen 0 1) pa1 (cdr (assoc 41 elst)) ; angle pa2 (cdr (assoc 42 elst)) grd (distance cen ext) prd (* grd (cdr (assoc 40 elst))) ang (angle cen ext) ) (if (or (/= pa1 0.0) (/= pa2 (* 2 pi))) (progn ; "ellipse coupée" (setq pt1 (list (* grd (cos pa1)) (* prd (sin pa1))) pt2 (list (* grd (cos pa2)) (* prd (sin pa2))) mat (list (list (cos ang) (- (sin ang)) 0) (list (sin ang) (cos ang) 0) '(0 0 1) ) pt1 (mapcar '+ cen (mxv mat pt1)) pt2 (mapcar '+ cen (mxv mat pt2)) a1 (angtos (angle cen pt1) 0 2) a2 (angtos (angle cen pt2) 0 2) ) (cond ((or (= a1 "0") (= a1 (angtos pi 0 2))) (command "_ucs" "_o" "_non" pt1) (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) ((or (= a1 (angtos (* 0.5 pi) 0 2)) (= a1 (angtos (* 1.5 pi) 0 2))) (command "_ucs" "_o" "_non" pt1) (command "_ucs" "_y" (angtos (/ pi 2) (getvar "AUNITS") 16)) (command "_ucs" "_z" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) ((or (= a2 "0") (= a2 (angtos pi 0 2))) (command "_ucs" "_o" "_non" pt2) (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) ((or (= a2 (angtos (* 0.5 pi) 0 2)) (= a2 (angtos (* 1.5 pi) 0 2))) (command "_ucs" "_o" "_non" pt2) (command "_ucs" "_y" (angtos (/ pi 2) (getvar "AUNITS") 16)) (command "_ucs" "_z" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) (t (command "_ucs" "_o" "_non" pt1) (command "_ucs" "_y" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) ) ) (progn ; "ellipse entière" (setq aec (angle ext cen)) (command "_ucs" "_o" "_non" ext) (command "_ucs" "_z" (angtos aec (getvar "AUNITS") 16)) (command "_ucs" "_x" (angtos (/ pi 2) (getvar "AUNITS") 16)) ) ) ) (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 pt_i_fer '(0. 0. 0.)) (c:profil) (setq ftd:profmet (entlast)) (command "_sweep" ftd:profmet "" ax) (command "_ucs" "_r" "tempftd") ) (setvar "UCSFOLLOW" CFOLLOW) (princ) ) [Edité le 13/2/2011 par usegomme]
  3. usegomme

    Cours lisp

    Pour les débutants , un cours qui n'est plus commercialisé.
  4. Salut , il y a qlq mois j'avais fait une bidouille pour des dessinateurs qui avaient des problèmes avec la cotation associative en espace présentation. Je m' étais servi , comme exemple d'un lisp de Zébulon_ que je remercie. Son lisp peut servir de base pour le sujet me semble -t-il. ;; zebulon_ 28/1/2010 ;;; Lisp à charger uniquement ... ne pas exécuter !!! (vl-load-com) (vlr-sysvar-reactor nil '((:vlr-sysvarchanged . plinewidcallback)) ) (defun plinewidcallback (event parameter / lst CLAY) (setq lst '(("HA6" 0.07) ("HA8" 0.10) ("HA10" 0.12) ("HA12" 0.14) ("HA14" 0.16) ("HA16" 0.19) ("HA20" 0.24) ("HA25" 0.30) ("HA32" 0.38) ("HA40" 0.48) ) ) (If (eq (car parameter) "CLAYER") (progn (setq CLAY (strcase (getvar "CLAYER"))) (if (member CLAY (mapcar 'car lst)) (setvar "PLINEWID" (cadr (assoc CLAY lst))) (setvar "PLINEWID" 0) ) ) ) ) que j'ai transformé comme suit: ;; Réacteur sur variable DIMASSOC 2 (actif) ou 1 (inactif) ;; règle associativité des cotes selon le style de cotation courant (vl-load-com) (vlr-sysvar-reactor nil '((:vlr-sysvarchanged . dimassoccallback)) ) (defun dimassoccallback (event parameter / lst dst) ;; liste des style de cote pour lesquel dimassoc doit être à 1 (setq lst '( ("ISO-5") ("ISO-10") ("ISO-20") ) ) (If (eq (car parameter) "DIMSTYLE") (progn (setq dst (getvar "DIMSTYLE")) (if (member dst (mapcar 'car lst)) (setvar "DIMASSOC" 1) (setvar "DIMASSOC" 2) ;; valeur par défaut ) ) ) )
  5. Avec une boucle sur la cde étirer ,il y a pas mal d'exemple de ce genre sur le forum, tu pourras modifier la sélection d'objets si nécessaire. (defun C:GL (/ osn omo sel) (SETQ OSN (GETVAR "OSMODE")) (SETQ OMO (GETVAR "ORTHOMODE")) (setq sel (entsel ));select obj to SCU (command "_UCS" "OB" sel) (SETVAR "ORTHOMODE" 1) (command "_stretch" "_crossing" ) (while (not (zerop (getvar "cmdactive")))(command pause)) (command "_UCS" "p") (SETVAR "OSMODE" OSN) (SETVAR "ORTHOMODE" OMO) (princ) )
  6. Salut (defun C:GLo () (SETQ OSN (GETVAR "OSMODE")) (SETQ OMO (GETVAR "ORTHOMODE")) (setq sel (entsel ));select obj to SCU (command "_UCS" "OB" sel) (SETVAR "ORTHOMODE" 1) (command "_stretch" "_crossing" pause pause "" pause pause) ;;; <<<<<< (command "_UCS" "p") ;;;;;; <<< (SETVAR "OSMODE" OSN) (SETVAR "ORTHOMODE" OMO) (princ) ) A noter : que les modes d'accrochage "extension" ou "parallèle" peuvent te dispenser de ce bricolage. [Edité le 8/10/2010 par usegomme]
  7. Salut à tous. Voici une petite correction du fichier de données des profils HEA. profil_HEA.DAT ;Base de données écrit par L.BOUQUILLON le 27.03.97 ;Modifié le 15-09-2010 MT .Rajouté HEA400 et rectifié HEA360. ;Objet : HEA. -hh-----h----b----a----e-----r---h1 1000,990,300,16.5,31.0,30,868 0900,890,300,16.0,30.0,30,770 0800,790,300,15.0,28.0,30,674 0700,690,300,14.5,27.0,27,582 0650,640,300,13.5,26.0.27,534 0600,590,300,13.0,25.0,27,486 0550,540,300,12.5,24.0,27,438 0500,490,300,12.0,23.0,27,390 0450,440,300,11.5,21.0,27,344 0400,390,300,11.0,19.0,27,298 0360,350,300,10.0,17.5,27,261 0340,330,300,09.5,16.5,27,243 0320,310,300,09.0,15.5,27,225 0300,290,300,08.5,14.0,27,208 0280,270,280,08.0,13.0,24,196 0260,250,260,07.5,12.5,24,177 0240,230,240,07.5,12.0,21,164 0220,210,220,07.0,11.0,18,152 0200,190,200,06.5,10.0,18,134 0180,171,180,06.0,09.5,15,122 0160,152,160,06.0,09.0,15,104 0140,133,140,05.5,08.5,12,092 0120,114,120,05.0,08.0,12,074 0100,096,100,05.0,08.0,12,056
  8. Salut. Il y a ce lisp avec case de dialogue qui fera peut être ton affaire. // 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; } } } et 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)
  9. usegomme

    Elevation courante

    Salut, tu peux aussi essayer autres choses, - associer à ta cde polyligne la cde osnapz à 1 (qui correspond à ton option) dans un bouton spécial que tu peux créer dans un palette d'outil. - ou encore tracer ta polyligne en espace papier sans avoir à te préoccuper de l'échelle de dessin et des élévations de tes points d'accrochages et une fois terminer, la réexpédier dans l'espace objet avec la commande CHANGESPACE ou modifier l'espace (dans le menu). Pense qu'en même à verrouiller la fenêtre pour éviter un zoom malencontreux.
  10. usegomme

    TUYAU 2D

    Merci monsieur le testeur, n'étant pas actuellement utilisateur de cette routine j' ai zappé le problème bien qu'il soit commun, j' ai mis une rustine sur le code en basculant le scu au moment de tracer les contours, c'est rapide et pas cher, et ça semble suffisant , je tacherai de faire mieux ultérieurement. Oui, je pense , mais je n'ai pas l'expérience de ce genre de truc , il se pourrait que ce soit compliqué avec les angles et les orientations. [Edité le 17/7/2010 par usegomme]
  11. usegomme

    TUYAU 2D

    Salut , petite amélioration pour les tubes emboités ou vissés. Modif : version 1.2 les emboitements aux coudes sont symbolisés par un rectangle.
  12. usegomme

    Relier 2 blocs

    Salut Guigues , Il me semble que tu ne suis pas attentivement les leçons de maitre (gile) car il y a un exemple ici pour relier des points il suffit de modifier le filtre de sélection "POINT" par "INSERT" (defun c:gagb (/ ss n lst) (if (setq ss (ssget '((0 . "INSERT")))) (progn (setq n -1) (while (setq pt (ssname ss (setq n (1+ n)))) (setq lst (cons (cdr (assoc 10 (entget pt))) lst)) ) (command "_.pline") (mapcar '(lambda (x) (command "_non" x)) lst) (command) ) ) (princ) )
  13. usegomme

    TUYAU 2D

    Bonsoir Je n'avais pas suffisamment testé et j'ai donc réparé quelques oublis.
  14. usegomme

    TUYAU 2D

    Salut , Voici une version plus moderne de tuyau.lsp ,mais qui n'est pas encore terminée puisque les emboitements ne sont pas dessinés. C'est un dérivé du lisp pour la 3D , le fonctionnement est donc identique , et c'est aussi pour cette raison que le code est parfois bizarre. Modif : version 1.2 les emboitements aux coudes sont symbolisés par un rectangle 17-07-10 version 1.3 " SCU" ;; Tuyau 2d ;; et avec ou sans calorifuge ;; fait à partir de tuy.lsp ( tuyau 3 D ) ;;usegomme 17-07-2010 version 1.3 (defun choixnormetdd (/ sv_dm dm) (setq sv_dm (getvar "DYNMODE")) (cond ((< sv_dm 0) (setq dm (* sv_dm -1)) (setvar "DYNMODE" dm)) (t (setq sv_dm nil dm nil)) ) (initget 1 "ISO3D ISO5D INOX-VIS 3000Lbs-VIS PE-PP-EMB PVC-PRESSION PVC-ECOUL CINTRE-SGN") ;;;; bit refus reponse nulle (setq norme (getkword "\nChoisir une Norme [iSO3D/ISO5D/INOX-VIS/3000Lbs-VIS/PE-PP-EMB/PVC-PRESSION/PVC-ECOUL/CINTRE-SGN] : ")) (if sv_dm (setvar "DYNMODE" sv_dm)) ) (Defun getDNtuytdd ( 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 (strcat a g "<" b ">" " ")) (setq c (getreal c)) ) (defun diam-tdd (/ dn diam d b) (setq dn "Norme" epcd 0 emboit 0 EPemboit nil L90 nil L45 nil ecart 0) (if (not norme) (setq norme "ISO3D")) ;; par defaut (if (not epcalo)(setq epcalo 0)) ;; par defaut (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 " norme msgcalo msgecalo msgdn "[Norme/Calo/8/10/15/21/20/25/32/40/50/65/80/100/125/150/200/250/300/350/400/450/500/600/Autre]") ) ) ((= norme "CINTRE-SGN") (setq msgdn " DN:") (if (and (/= CINTRE-SGN:dn "Autre")(/= CINTRE-SGN:dn nil)) (setq dn (rtos CINTRE-SGN:dn 2 0)) (setq dn "Autre") ) (setq choixdn (strcat "\n " norme msgcalo msgecalo msgdn "[Norme/Calo/8/10/15/20/25/32/40/Autre]") ) ) ((= 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 " norme msgcalo msgecalo msgdn "[Norme/Calo/20/25/32/40/50/65/80/100/125/150/200/250/300/350/Autre]") ) ) ((= norme "INOX-VIS") (setq msgdn " DN:") (if (and (/= inox-vis:dn "Autre")(/= inox-vis:dn nil)) (setq dn (rtos inox-vis:dn 2 0)) (setq dn (rtos 25 2 0) inox-vis:dn 25) ) (setq choixdn (strcat "\n " norme msgcalo msgecalo msgdn "[Norme/Calo/6/8/10/15/20/25/32/40/50/65/80]") ) ) ((= norme "3000Lbs-VIS") (setq msgdn " DN:") (if (and (/= 3000Lbs-VIS:dn "Autre")(/= 3000Lbs-VIS:dn nil)) (setq dn (rtos 3000Lbs-VIS:dn 2 0)) (setq dn (rtos 50 2 0) 3000Lbs-VIS:dn 50) ) (setq choixdn (strcat "\n " norme msgcalo msgecalo msgdn "[Norme/Calo/6/8/10/15/20/25/32/40/50/65/80]") ) ) ((= norme "PE-PP-EMB") (setq msgdn " DN:") (if (and (/= PE-PP-EMB:dn "Autre")(/= PE-PP-EMB:dn nil)) (setq dn (rtos PE-PP-EMB:dn 2 0)) (setq dn (rtos 50 2 0) PE-PP-EMB:dn 50) ) (setq choixdn (strcat "\n " norme msgcalo msgecalo msgdn "[Norme/Calo/10/15/20/25/32/40/50/65/80/100]") ) ) ((= norme "PVC-PRESSION") (setq msgdn " Diam:") (if (and (/= PVC-P:dn "Autre")(/= PVC-P:dn nil)) (setq dn (rtos PVC-P:dn 2 0)) (setq dn (rtos 50 2 0) PVC-P:dn 50) ) (setq choixdn (strcat "\n " norme msgcalo msgecalo msgdn "[Norme/Calo/6/8/10/12/16/20/25/32/40/50/63/75/90/110/125/140/160/200/225/250]") ) ) ((= norme "PVC-ECOUL") (setq msgdn " Diam:") (if (and (/= PVC-ECOUL:dn "Autre")(/= PVC-ECOUL:dn nil)) (setq dn (rtos PVC-ECOUL:dn 2 0)) (setq dn (rtos 40 2 0) PVC-ECOUL:dn 40) ) (setq choixdn (strcat "\n " norme msgcalo msgecalo msgdn "[Norme/Calo/32/40/50]") ) ) ) ;; fin cond (initget "Autre Norme Calo") (setq dn (getDNtuytdd choixdn dn norme msgcalo msgecalo msgdn )) (if (= dn "Norme") (choixnormetdd)) (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") (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 (autrediametretdd) ) ) ) ((= norme "CINTRE-SGN") ;;;; cintrage tube d'après un document SGN (cond ((and (/= dn "A") (/= dn nil))(setq CINTRE-SGN:dn dn)) ((= dn nil) (if CINTRE-SGN:dn (setq dn CINTRE-SGN:dn))) ) (cond ((= dn 8) (setq diam 13.5 rayo 70 )) ((= dn 10) (setq diam 17.2 rayo 90 )) ((= dn 15) (setq diam 21.3 rayo 110 )) ((= dn 20) (setq diam 26.9 rayo 135)) ((= dn 25) (setq diam 33.7 rayo 170)) ((= dn 32) (setq diam 42.4 rayo 215)) ((= dn 40) (setq diam 48.3 rayo 245)) (t (autrediametretdd) ) ) (setq ecart 110) ;;; longueur droite entre 2 courbes ) ((= norme "ISO5D") (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 (autrediametretdd) ) ) ) ((= norme "INOX-VIS") (cond ((and (/= dn "A") (/= dn nil))(setq inox-vis:dn dn)) ((= dn nil) (if inox-vis:dn (setq dn inox-vis:dn))) ) (cond ;; d diametre ext coude ((= dn 6) (setq diam 10.2 L90 19 d 14.5)) ((= dn 8) (setq diam 13.5 L90 21 d 17.5)) ((= dn 10) (setq diam 17.2 L90 25 d 21.5)) ((= dn 15) (setq diam 21.3 L90 28 d 27)) ((= dn 20) (setq diam 26.9 L90 33 d 33.5)) ((= dn 25) (setq diam 33.7 L90 38 d 40.5)) ((= dn 32) (setq diam 42.4 L90 45 d 50)) ((= dn 40) (setq diam 48.3 L90 50 d 57)) ((= dn 50) (setq diam 60.3 L90 58 d 70)) ((= dn 65) (setq diam 76.1 L90 75 d 86)) ((= dn 80) (setq diam 88.9 L90 85 d 100)) (t (autrediametretdd) ) ) (setq epcd (* (- d diam) 0.5)) ; epaisseur coude (setq rayo (+ (* diam 0.5) epcd 1) emboit (- l90 rayo) epemboit epcd) ) ((= norme "3000Lbs-VIS") (cond ((and (/= dn "A") (/= dn nil))(setq 3000Lbs-VIS:dn dn)) ((= dn nil) (if 3000Lbs-VIS:dn (setq dn 3000Lbs-VIS:dn))) ) (cond ;;;; b = diametre "manchon" ((= dn 8) (setq diam 13.5 L90 24.5 l45 22 b 26.5)) ((= dn 10) (setq diam 17.2 L90 28.5 l45 22 b 34)) ((= dn 15) (setq diam 21.3 L90 33.5 l45 25 b 38.5)) ((= dn 20) (setq diam 26.9 L90 38 l45 28.5 b 46.5)) ((= dn 25) (setq diam 33.7 L90 44.5 l45 33.5 b 56.5)) ((= dn 32) (setq diam 42.4 L90 51 l45 38 b 62.5)) ((= dn 40) (setq diam 48.3 L90 60.5 l45 41.5 b 76)) ((= dn 50) (setq diam 60.3 L90 63.5 l45 50.5 b 92)) ((= dn 65) (setq diam 76.1 L90 82.5 l45 63.5 b 110)) ((= dn 80) (setq diam 88.9 L90 95.5 l45 63.5 b 122)) ((= dn 100)(setq diam 114.3 L90 114.5 l45 80 b 152)) (t (autrediametretdd) ) ) (setq epcd (* (- b diam) 0.25)) ;; ep coude = moitie epaisseur manchon ?.. (setq rayo (+ (* diam 0.5) epcd 1) emboit (- l90 rayo) epemboit (* 2 epcd)) ) ((= norme "PE-PP-EMB") (cond ((and (/= dn "A") (/= dn nil))(setq PE-PP-EMB:dn dn)) ((= dn nil) (if PE-PP-EMB:dn (setq dn PE-PP-EMB:dn))) ) (cond ;;;; d= diametre ext coudes ((= dn 10) (setq diam 16 L90 25 L45 20 d 26)) ((= dn 15) (setq diam 20 L90 28 L45 21 d 30.5)) ((= dn 20) (setq diam 25 L90 32 L45 24 d 36)) ((= dn 25) (setq diam 32 L90 38 L45 28 d 43.5)) ((= dn 32) (setq diam 40 L90 44 L45 33 d 53.5)) ((= dn 40) (setq diam 50 L90 51 L45 36 d 66)) ((= dn 50) (setq diam 63 L90 62 L45 43 d 82)) ((= dn 65) (setq diam 75 L90 75.5 L45 51 d 92.5)) ((= dn 80) (setq diam 90 L90 88 L45 58 d 110)) ((= dn 100) (setq diam 110 L90 106 L45 68 d 134)) (t (autrediametretdd) ) ) (setq epcd (* (- d diam) 0.5)) ; ep coude (setq rayo (+ (* diam 0.5) epcd 1) emboit (- l90 rayo) epemboit epcd ecart 5) ) ((= norme "PVC-PRESSION") (cond ((and (/= dn "A") (/= dn nil))(setq PVC-P:dn dn)) ((= dn nil) (if PVC-P:dn (setq dn PVC-P:dn))) ) (cond ;;;; D diam ext coude ((= dn 6) (setq diam dn L90 16 D 11)) ((= dn 8) (setq diam dn L90 17 D 13)) ((= dn 10) (setq diam dn L90 18 D 14)) ((= dn 12) (setq diam dn L90 19 D 17)) ((= dn 16) (setq diam dn L90 23 L45 18.5 D 21)) ((= dn 20) (setq diam dn L90 27 L45 21 D 25)) ((= dn 25) (setq diam dn L90 33 L45 25 D 30.5)) ((= dn 32) (setq diam dn L90 39 L45 30 D 38.2)) ((= dn 40) (setq diam dn L90 49 L45 36 D 47.2)) ((= dn 50) (setq diam dn L90 57 L45 42.5 D 58.5)) ((= dn 63) (setq diam dn L90 71 L45 52 D 73.4)) ((= dn 75) (setq diam dn L90 83 L45 60.5 D 87.2)) ((= dn 90) (setq diam dn L90 97 L45 70.5 D 105)) ((= dn 110) (setq diam dn L90 116 L45 86 D 127)) ((= dn 125) (setq diam dn L90 172 L45 97 D 146.2)) ((= dn 140) (setq diam dn L90 146 L45 108 D 162)) ((= dn 160) (setq diam dn L90 166 L45 122 D 185)) ((= dn 200) (setq diam dn L90 207 L45 149 D 225.2)) ((= dn 225) (setq diam dn L90 233 L45 168 D 250)) ((= dn 250) (setq diam dn L90 263 L45 191.5 D 282)) (t (autrediametretdd) ) ) (setq epcd (* (- d diam) 0.5)) ;; ep coude (setq rayo (+ (* diam 0.5) epcd 1) emboit (- L90 rayo) epemboit epcd ecart 5) ) ((= norme "PVC-ECOUL") (cond ((and (/= dn "A") (/= dn nil))(setq PVC-ECOUL:dn dn)) ((= dn nil) (if PVC-ECOUL:dn (setq dn PVC-ECOUL:dn))) ) (cond ;;;; L87 longueur pour coude 87.5° ((= dn 32) (setq diam dn L87 48 L45 34 emboit 26)) ;; +3 ((= dn 40) (setq diam dn L87 58 L45 40 emboit 30)) ((= dn 50) (setq diam dn L87 71 L45 49 emboit 35)) (t (autrediametretdd) ) ) (setq L90 (/ (- (* L87 45)(* L45 2.5)) 42.5)) ;; 90-87.5=2.5 et 45-2.5=42.5 (setq rayo (- L90 emboit) epemboit 2 epcd 0 ecart 5) ;;; ecart = ecartement mini entre 2 embouts de coude ) ) ; fin cond dn suivant norme (setq ddia (/ diam 2)) (if (not (> rayo (+ ddia epcd))) (setq rayo (* (+ ddia epcd) 1.01))) ) (defun autrediametretdd () (setq epcd 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)) (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 tubagetdd (ent typ / lent p10 a50 a51 p11 pw) (command "_ucs" "") ;; dessine les contours du tube (cond ((= typ 1) ;; coude (setq p10 (trans (cdr (assoc 10 (entget ent))) 0 1)) (setq a50 (cdr (assoc 50 (entget ent)))) (setq a51 (cdr (assoc 51 (entget ent)))) (command "_offset" ddia ent "_non" p10 "") (command "_offset" ddia ent "_non" (polar p10 a50 (* 2 rayo)) "") (cond ((and (> emboit 0)(> epemboit 0)) (setq pw (getvar "plinewid")) (setvar "plinewid" 0) (command "_pline" "_non" (polar p10 a50 (+ rayo ddia epemboit)) "_non" (polar p10 a50 (- rayo ddia epemboit)) "_non" (polar (polar p10 a50 (- rayo ddia epemboit)) (- a50 (* 0.5 pi)) emboit) "_non" (polar (polar (polar p10 a50 (- rayo ddia epemboit)) (- a50 (* 0.5 pi)) emboit) a50 (+ (* 2 ddia) (* 2 epemboit)) ) "_c" ) (command "_pline" "_non" (polar p10 a51 (+ rayo ddia epemboit)) "_non" (polar p10 a51 (- rayo ddia epemboit)) "_non" (polar (polar p10 a51 (- rayo ddia epemboit)) (- a51 (* 1.5 pi)) emboit) "_non" (polar (polar (polar p10 a51 (- rayo ddia epemboit)) (- a51 (* 1.5 pi)) emboit) a51 (+ (* 2 ddia) (* 2 epemboit)) ) "_c" ) (setvar "plinewid" pw) ) (t (command "_line" "_non" (polar p10 a50 (+ rayo ddia)) "_non" (polar p10 a50 (- rayo ddia)) "" ) (command "_line" "_non" (polar p10 a51 (+ rayo ddia)) "_non" (polar p10 a51 (- rayo ddia)) "" ) ) ) (cond ((and (> epcalo 0) (> rayo (+ ddia epcalo))) (command "_offset" (+ ddia epcalo) ent "_non" p10 "") (setq lent (entget (entlast))) (setq lent (subst (cons 8 calqcalo) (assoc 8 lent) lent)) (entmod lent) (command "_offset" (+ ddia epcalo) ent "_non" (polar p10 a50 (* 2 rayo)) "") (setq lent (entget (entlast))) (setq lent (subst (cons 8 calqcalo) (assoc 8 lent) lent)) (entmod lent) ) ) ) (t ;; tube (setq p10 (trans (cdr (assoc 10 (entget ent))) 0 1)) (setq p11 (trans (cdr (assoc 11 (entget ent))) 0 1)) (command "_offset" ddia ent "_non" (polar p10 (+ (* 0.5 pi)(angle p10 p11)) ddia ) "") (command "_offset" ddia ent "_non" (polar p10 (+ (* 0.5 pi)(angle p11 p10)) ddia ) "") (cond ((> epcalo 0) (command "_offset" (+ ddia epcalo) ent "_non" (polar p10 (+ (* 0.5 pi)(angle p10 p11)) ddia) "") (setq lent (entget (entlast))) (setq lent (subst (cons 8 calqcalo) (assoc 8 lent) lent)) (entmod lent) (command "_offset" (+ ddia epcalo) ent "_non" (polar p10 (+ (* 0.5 pi)(angle p11 p10)) ddia) "") (setq lent (entget (entlast))) (setq lent (subst (cons 8 calqcalo) (assoc 8 lent) lent)) (entmod 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) (command "_ucs" "_p") ) (defun descoudetdd ( L1 L2 pt long) (command "_fillet" L1 L2) (setq coude (entlast)) (if (or del1 (if dminp (= (- long dminp) dmin) (= long dmin))) (entdel L1) (tubagetdd L1 lg) ) (setq del1 nil) (tubagetdd coude cd) ) (defun deterdmintdd ( / a a90 p) ;; determine la distance mini pour placer un coude (cond ;; restauration rayon original ((and l90 l45 epemboit) (setq rayo (- l90 emboit)) (setvar "FILLETRAD" rayo)) ) (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 at (* 2 (* a (/ 180 pi)))) ;; angle tuyauterie (cond ((and l90 l45 epemboit (> at 90)) (setq dmin (- (- l90 emboit) (* (/ (- (- l90 emboit)(- l45 emboit)) 45)(- at 90)))) (setq rayo (/ (* (sin a) dmin) (cos a))) (if (not (> rayo (+ ddia epemboit))) (setq rayo (* (+ ddia epemboit) 1.01) dmin (* (cos a) (/ rayo (sin a))) ) ) (setvar "FILLETRAD" rayo) ) (t (setq dmin (* (cos a) (/ rayo (sin a))))) ) ) ) (if a90 (setq at 90.0)) (if a180 (setq at 180.0)) ) (defun onfekoitdd (L1 L2 pt1 pt2 pt3 d1 d2) (cond (a180 (tubagetdd L1 lg)) (a0 (tubagetdd L1 lg) (entdel L2) (setq p0 nil p1 nil)) ((and (not a0) (not a180)) (if (> rayo 0) (cond ((and (if dminp (>= (- d1 dminp) (+ dmin (* 2 emboit) ecart)) (>= d1 dmin)) (>= d2 dmin) ) (descoudetdd L1 L2 pt2 d1) ) ((or (if dminp (< (- d1 dminp) (+ dmin (* 2 emboit) ecart)) (< d1 dmin)) (< d2 dmin) ) (correctiontdd L1 L2 pt1 pt2 pt3 d1 d2) ) ) (tubagetdd L1 lg) ;;; si rayon 0 pas de raccordement ) ) ) ) (defun correctiontdd (L1 L2 pt1 pt2 pt3 d1 d2) (setq lg (if dminp (+ dmin dminp (* 2 emboit) ecart) dmin)) (if (< d1 lg) (progn (setq pt1 (trans (cdr (assoc 10 (entget L1))) 0 1)) (if dminp (setq lgmin (+ dmin (* 2 emboit) ecart))(setq lgmin dmin)) (redefsommettdd pt1 pt2 lgmin) (entdel L1) (command "_line" "_none" pt1 "_none" sbn "") (setq L1 (entlast)) (command "_move" L2 "" "_none" pt2 "_none" sbn) (setq pt2 sbn) (if (and (= emboit 0)(= ecart 0))(setq 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) ) (descoudetdd L1 L2 pt2 lg) ;; pas modif ok ) ((= d2 dmin) (descoudetdd 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) ) ) (redefsommettdd pt2 pt3 dmin) (command "_move" L2 "" "_none" pt3 "_none" sbn) (descoudetdd L1 L2 pt2 d1) (entdel L2) (setq p0 nil p1 nil) ;;; arret sur coude ) ) ) (defun redefsommettdd (sa sb dist / h a ab 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 ab (distance sa sb)) (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 creercalqueAXEtdd (/ calqax) ;;; pas utilisé *** ;creer calque de l'axe (setq calqax (strcat (getvar "clayer") "-AXE")) (if (not (tblsearch "layer" calqax)) ; (command "_-layer" "_n" calqax "" "" ) (command "_-layer" "_n" calqax "_co" "6" calqax "_lt" "axes2" calqax "") ) ) (defun creercalqueCALOtdd ();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:TUYAU (/ L01 L10 p0 p1 coude mtrim ent eptub at) (setvar "cmdecho" 0) (diam-tdd) (setq p1 nil dmin nil dminp nil L10 nil del1 nil cd 1 lg 0) ;(creercalqueaxetdd) ;; pas utilisé (if (not (tblsearch "ltype" "axes2")) (command "_-linetype" "_l" "AXES2" "" "")) (if (> epcalo 0)(creercalquecalotdd)) (setvar "FILLETRAD" rayo) (setq mtrim (getvar "trimmode"))(setvar "trimmode" 1) (if (not tuy:ep) (setq tuy:ep 0)) (setq p0 (getpoint (strcat "\nPOINT DE DEPART :"))) (while p0 (if p1 (setq pd p1)) ;;; pd point de depart (cond (at (princ "Angle tuyauterie ")(princ at)(princ "°") (princ " et Coude ")(princ (- 180 at))(princ "°") ) ) (princ " Rayon ")(princ rayo) (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 (deterdmintdd) (onfekoitdd L10 L01 pd p0 p1 d10 d01) ) ) (if p0 (setq pd p0)) (cond (at (princ "Angle tuyauterie ")(princ at)(princ "°") (princ " et Coude ")(princ (- 180 at))(princ "°") )) (princ " Rayon ")(princ rayo) (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)) (deterdmintdd) (onfekoitdd L01 L10 pd p1 p0 d01 d10) ) ) ) ;;; si p1 nil (progn (if (and l10 p0 ) (tubagetdd l10 lg)) ;; si plusieurs boucles ;;;; (setq p0 nil ) ) ) ;;;; fin if p1 ) ;;; fin while (cond ((and l01 p1)(tubagetdd l01 lg))) ;;;; termine dernier tronçon (setvar "trimmode" mtrim)(setvar "cmdecho" 1) (cond (at (princ "\nAngle tuyauterie ")(princ at)(princ "°") (princ " et Coude ")(princ (- 180 at))(princ "°") )) (cond (rayo (princ " Rayon ")(princ rayo))) (gc) (prin1) ) [Edité le 8/7/2010 par usegomme][Edité le 11/7/2010 par usegomme] [Edité le 17/7/2010 par usegomme]
  15. usegomme

    TUYAU 2D

    Bonjour , ça fait un bon moment que je n'ai plus rien fait dans ce domaine, et je n'ai donc pas fait l'équivalent de la 3d . Mais dis toujours ce que tu souhaiterais , on verra aprés s'il y a moyen et temps...
  16. Salut Ce qu' a indiqué Lecrabe mais sous forme de commande (defun c:ssh () (sssetfirst nil (ssget "x" '((0 . "HATCH"))))) [Edité le 20/7/2010 par usegomme]
  17. usegomme

    Demande de lisp

    Salut Rhymone, une petite remise en question de soi à parfois du bon, et il ne serait pas inutile que tu repenses à ta demande . Gile fait un boulot énorme sur les forums , y compris sur ACADLABS et si tu l'agaces , c'est qu' il y a certainement une bonne raison . Amicalement.
  18. usegomme

    Demande de lisp

    Coucou Peut être mais quelques routines basiques , utilitaires ou des explications sur du code lisp et vlisp seraient pas mal sur ACADLABS pour lui donner un peu d'intérêt , sinon à quoi ça sert que ton fils se décarcasse. amicalement
  19. usegomme

    battman sur les valeurs

    Merci Zebulon_ , battval est un bel outil qui m'est devenu trés utile depuis peu et pour longtemps je pense.
  20. usegomme

    Lisps de Patrick_35

    Patrick_35 , ton lisp ONG m' a rendu un grand service pour réparer une mauvaise initiative sur une bonne série de plans , il fonctionne parfaitement avec une case de dialogue trés efficace et rapide. Si j'avais eu à supprimer la ribambelle d'onglets un part un , j'aurais maintenant la main en compote. Merci beaucoup
  21. Eh bien t'en mieux et bonne nuit , demain je travaille , il est grand temps d'aller au lit. En passant, windows 7 et ses gros icones , est trés bien pour consulter les bibliothéques de dessins. A+
  22. Je me sers de l'explorateur windows , je n'aime guère le DC.
  23. Tous je ne sais pas , mais plusieurs oui !
  24. Salut Lili2006 On peut faire un copier/coller des fichiers du dossier vers la palette , en tout cas avec 2008.
  25. Merci Tramber ,c'est plus clair maintenant. Et merci (Gile) pour tes explications toujours bien détaillées. a+
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité