usegomme

Salut (gile), je n'avais jamais essayé DSTAR, mais ouah ! C'est extra. Bravo à retardement.

Bonjour Essai pour voir avec (setvar "delobj" 2) à la place de (command "_delobj" 2) qui renvoie un "entrée" en ligne de commande.

Bonjour Trés jolie ton étoile, Chti52, mais tu n'as pas joint la fonction DTR pour le fonctionnement du lisp. Je l'ai rajouté ci-dessous. ;;;Commande créant une étoile à 5 branches par Régis AGRAIN et Pierre BEAULIEU ;;; ;;; (defun c:etoile (/ dtr ptcent d pt1 pt2 pt3 pt4 pt5 pt1a pt2a pt3a pt4a pt5a) (defun dtr (a)(* pi (/ a 180.0))) (setq ptcent (getpoint "\nDesignez le centre de l'étoile :")) (setq d (getdist ptcent "\nSaisissez la longueur de la branche :")) (setq pt1 (polar ptcent (dtr 18) d)) (setq pt2 (polar ptcent (dtr (+ 72 18)) d)) (setq pt3 (polar ptcent (dtr (+ 144 18)) d)) (setq pt4 (polar ptcent (dtr (+ 216 18)) d)) (setq pt5 (polar ptcent (dtr (+ 288 18)) d)) (setq pt1a (inters pt1 pt3 pt2 pt5)) (setq pt2a (inters pt2 pt4 pt3 pt1)) (setq pt3a (inters pt3 pt5 pt4 pt2)) (setq pt4a (inters pt4 pt1 pt5 pt3)) (setq pt5a (inters pt5 pt2 pt1 pt4)) (setvar "cmdecho" 0) (command "_Pline" pt1 pt1a pt2 pt2a pt3 pt3a pt4 pt4a pt5 pt5a "c") (setvar "cmdecho" 1) (princ) )

Bonjour Un ancien post sur la question avec lisps

Coucou Les lisp aux lispeurs en somme ! La musique aux musiciens etc... Bel esprit pour un philosophe et ce n'est pas l'esprit d'internet même si certains exagèrent malheureusement. En tout cas j'ai été heureux toutes ces années de pouvoir bénéficier de quelques développements que je suis incapable de produire même avec la meilleure des volontés. Cordialement

Curve2pipe de (gile) et 3Dpolyfillet dans les lisp de (gile) Inserer/Etirer en 3D de (gile)

A cette adresse un ensemble de fichiers pour tracer des profilés métalliques : IPN IPE IPEA UAP UPN UPE HEA HEB HEM L U avec : profil.lsp ---------> section fer en polyligne 2d ftd.lsp (fers 3D) --> qui extrude les profils ci-dessus ftda.lsp -----------> fers 3D suivant un axe peut être utilisé via ftd.lsp ftdr.lsp -----------> fers 3D renseigné

A cette adresse quelques lisp pour tracer des fonds et de la tuyauteries 2D. brid2d.lsp ------> bride (lisp à compléter et à mettre à jour) calo.lsp --------> représenter un bout de calo sur tuyauterie 2d fe2d.lsp --------> fond elliptique fgrc2d.lsp ------> fond GRC redacier2d.lsp --> réduction acier et inox rediso2d.lsp ----> réduction inox roulée soudée tuyau.lsp -------> tracé bifilaire et axe + calo si besoin. ftube.lsp -------> échangeur tubulaire en coupe par BONUSCAD je n'ai pas retrouvé le post d'origine.

Tant mieux, ça m'ennuie de ne bricoler que pour moi. Et non, aucune chance, et la réponse de (gile) est sans équivoque sur la difficulté du problème. Ci-dessous PLA.lsp un dérivé de TR.lsp (tube Rectangulaire) que je viens de mettre en ligne. Quand on veut du plat c'est plus direct, et par rapport à la commande POLYSOLIDE (autocad 2009 je ne connais pas les autres), le lisp permet d'aller dans les 3 axes pour rajouter des tronçons, ça peut servir. ;; pour tracer en 3d des profils rectangulaires pleins (defun c:PLA (/ pt_i_fer ftd:clore ftd:ps ftd:sommets ftd:profmet ftd:point ftd:fer ftd:pp ftd:axefer i pt_i_fer_SCG ftd:ps_SCG unit_draw tubext tubint dynm CFOLLOW ep la ha r typar ) ;; 16/04/2010 usegomme ;; 25/5/2010 option nouveau point de base (setvar "USERS5" "qz1") ;; FORCE unité mm choix désactivé ;; definition de l'unité de dessin , en cas d'erreur de choix réinitialisé "users5" via la ligne de commande (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz"))) (progn (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 "ME CM MM") (if (not (setq unit_key (getkword "\nDessin réalisé en [MM/CM/ME] <MM>: "))) (setq unit_key "MM") ) (cond ((eq unit_key "ME") (setq unit_draw 1000) ) ((eq unit_key "CM") (setq unit_draw 10) ) ((eq unit_key "MM") (setq unit_draw 1) ) ) (setvar "USERS5" (strcat "qz" (itoa unit_draw))) (setq unit_draw (/ 1.0 unit_draw)) (if sv_dm (setvar "DYNMODE" sv_dm)) ) (setq unit_draw (/ 1.0 (atoi (substr (getvar "USERS5") 3)))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq CFOLLOW (getvar "UCSFOLLOW") pw (getvar "plinewid") tubint nil ) (setq pt_i_fer (getpoint "\n Point de départ du FER PLAT: ")) (if pt_i_fer (setq ftd:clore nil ftd:ps (getpoint pt_i_fer "\n point suivant DIRECTION et LONGUEUR : "))) (cond ((and pt_i_fer ftd:ps) (setvar "CMDECHO" 0) (command "_undo" "_be") ; sauve scu courant (command "_ucs" "_s" "tempftd") (if (not (zerop (getvar "cmdactive")))(command "_y")) (command "_line" "_none" pt_i_fer "_none" ftd:ps "") (setq ftd:axefer (entlast)) (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) (setq ftd:ps_SCG (trans ftd:ps 1 0)) (command "_ucs" "_zaxis" "_none" pt_i_fer "_none" ftd:ps) (setq pt_i_fer (trans pt_i_fer_SCG 0 1)) (setq ftd:ps (trans ftd:ps_SCG 0 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (not plat:la) (setq plat:la 100.0)) ; par défaut (setq la (getdist (strcat "\nLARGEUR PLAT <" (rtos plat:la 2 4) ">: "))) (if la (setq plat:la la) (setq la plat:la)) (if (not plat:ha) (setq plat:ha 20.0)) (setq ha (getdist (strcat "\nEPAISSEUR DU PLAT <" (rtos plat:ha 2 4) ">: "))) (if ha (setq plat:ha ha) (setq ha plat:ha)) (setq ep0 0) ;; fer plat et barre (setq typar "Vives") (setq la (* 0.5 la) ha (* 0.5 ha)) (setq P1 '(0. 0. 0.)) (cond ((and (> ep0 0)(<= 3)) (setq r (+ ep0 1))) ((> ep0 3) (setq r (+ ep0 2))) (t (setq r 3)) ) (setq i 1) (repeat 2 (if (= i 2) (cond ((> ep0 0.0) (setq tubext (entlast)) (cond ((and (> ep0 0)(<= 3)) (setq r 1)) ((> ep0 3) (setq r 2)) ) (setq la (- la ep0) ha (- ha ep0)) (setq i 3) ) ) ) (cond ((/= i 2) (cond ((= typar "Arrondies") (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" ) ) ((= typar "Vives") (command "_PLINE" "_non" (list (* la -1) (* ha -1)) "_non" (list la (* ha -1)) "_non" (list la ha) "_non" (list (* la -1) ha) "_c" ) ) ) )) ; cond (if (= i 1)(setq i 2)) ) ; repeat (setvar "plinewid" pw) (setvar "CMDECHO" 1) ;;; pour commande rotation ci-dessous (cond ((= i 2) (setq tubext (entlast)) (command "_rotate" tubext "" "_non" p1) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq pc (getpoint p1 "\n nouveau point de référence <>:")) (if pc (command "_move" tubext "" "_non" pc "_non" p1)) ) ((= i 3) (setq la (+ la ep) ha (+ ha ep)) (setq tubint (entlast)) (command "_rotate" tubint tubext "" "_non" p1) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq pc (getpoint p1 "\n nouveau point de référence <>:")) (if pc (command "_move" tubint tubext "" "_non" pc "_non" p1)) ) ) ; pivotements scu (setvar "CMDECHO" 0) (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) (setq ftd:ps_SCG (trans ftd:ps 1 0)) (command "_ucs" "_x" "-90") (setq pt_i_fer (trans pt_i_fer_SCG 0 1)) (setq ftd:ps (trans ftd:ps_SCG 0 1)) (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) (setq ftd:ps_SCG (trans ftd:ps 1 0)) (command "_ucs" "_Z" "-90") (setq pt_i_fer (trans pt_i_fer_SCG 0 1)) (setq ftd:ps (trans ftd:ps_SCG 0 1)) (setq ftd:sommets (list ftd:ps)) ;; extrusion suivant chemin (path) (command "_extrude" tubext "" "_p" ftd:axefer) (setq ftd:fer (entlast)) (if tubint (progn (if (= (getvar "delobj") 2) (entdel ftd:axefer)) (command "_extrude" tubint "" "_p" ftd:axefer) (command "_subtract" ftd:fer "" "_L" "") (setq ftd:fer (entlast)) ) ) (while ftd:ps (setq ftd:pp ftd:ps) (if (< i 2) (setq ftd:ps (getpoint ftd:pp "\n point suivant :")) (progn (initget "Clore") (setq ftd:ps (getpoint ftd:pp "\n point suivant [Clore] :")) (if (= ftd:ps "Clore") (setq ftd:clore t) ) ) ) (if ftd:ps (progn (if ftd:clore (setq ftd:ps nil) (setq ftd:sommets (append ftd:sommets (list ftd:ps))) ) (entdel ftd:fer); efface fer 3d ;;efface AXE précédent (if (or (= 0 (getvar "delobj"))(= 1 (getvar "delobj"))) (entdel ftd:axefer) ) (command "_3dpoly" "_none" pt_i_fer) (setq i 0) (repeat (length ftd:sommets) (setq ftd:point (nth i ftd:sommets)) (command "_none" ftd:point) (setq i (1+ i)) ) (if (not ftd:clore) (command "") (command "_c") ) (setq ftd:axefer (entlast)) (if (or (= 1 (getvar "delobj"))(= 2 (getvar "delobj"))) (progn (entdel tubext) ; restaure profil 2d (if tubint (entdel tubint)) ) ) (command "_extrude" tubext "" "_p" ftd:axefer) (setq ftd:fer (entlast)) (if tubint (progn (if (= (getvar "delobj") 2) (entdel ftd:axefer)) (command "_extrude" tubint "" "_p" ftd:axefer) (command "_subtract" ftd:fer "" "_L" "") (setq ftd:fer (entlast)) ) ) ) ) ) ;; AXE présent ou pas suivant variable delobj en désactivant les 2 options ci-dessous ;; ou bien ; AXE TOUJOURS EFFACé (oter les ;) (if (= 1 (getvar "delobj")) (entdel ftd:axefer) ;efface AXE ) ;; ou AXE TOUJOURS PRESENT (oter les ;) ; (if (= 2 (getvar "delobj")) ; (entdel ftd:axefer) ;restaure AXE ; ) (setvar "UCSFOLLOW" CFOLLOW) ; restoration scu (command "_ucs" "_r" "tempftd") (command "_undo" "_e") (setvar "CMDECHO" 1) ) ) (princ) )

Un lisp qui était resté dans mon placard, remettre un peu d'ordre ça fait pas de mal. Pour tracer du tube ou profil rectangulaire en 3D en complément de "ax2pr" que je viens de mettre à jour sur le sîte. Le choix des unités est verrouillé sur mm, mais il suffit d'un point virgule devant la ligne (setvar "USERS5" "qz1") pour le rétablir. J'espère qu'il pourra être utile. ps: j'ai le même simplifier qui ne fait que du plein et qui s'appelle PLA.lsp c'est plus rapide et on concerve les valeurs par défaut de chacun. Je le mettrai dans les petits outils 3D. ;; trace en solide 3d ;; tube carré ou rectangulaire ;; plat, barre carré ou rectangulaire ;; on peut changer le point de référence mais dans le cas d'un tube (ep>0) on ne pourra tracer qu'un seul segment. ;;;;;pour plat ou barre (ep=0) le nombre de segment n'est pas limité ;;;;;il est préférable de prendre un point sur la section 2D pour un résultat prévisible ;; 16/04/2010 usegomme ;; 30/5/2010 option nouveau point de base ne permet qu'1 seul segment si tube (defun c:TR (/ pt_i_fer ftd:clore ftd:ps ftd:sommets ftd:profmet ftd:point ftd:fer ftd:pp ftd:axefer i pt_i_fer_SCG ftd:ps_SCG unit_draw sv_dm dm unit_key pw tubext tubint dynm CFOLLOW ep la ha r typar npr ) (setvar "USERS5" "qz1") ;; FORCE unité mm le choix est désactivé ;; definition de l'unité de dessin , en cas d'erreur de choix réinitialisé "users5" via la ligne de commande (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz"))) (progn (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 "ME CM MM") (if (not (setq unit_key (getkword "\nDessin réalisé en [MM/CM/ME] <MM>: "))) (setq unit_key "MM") ) (cond ((eq unit_key "ME") (setq unit_draw 1000) ) ((eq unit_key "CM") (setq unit_draw 10) ) ((eq unit_key "MM") (setq unit_draw 1) ) ) (setvar "USERS5" (strcat "qz" (itoa unit_draw))) (setq unit_draw (/ 1.0 unit_draw)) (if sv_dm (setvar "DYNMODE" sv_dm)) ) (setq unit_draw (/ 1.0 (atoi (substr (getvar "USERS5") 3)))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq CFOLLOW (getvar "UCSFOLLOW") pw (getvar "plinewid") tubint nil npr nil ) (setq pt_i_fer (getpoint "\n Point de départ du TUBE RECTANGULAIRE ou du FER PLAT: ")) (if pt_i_fer (setq ftd:clore nil ftd:ps (getpoint pt_i_fer "\n point suivant DIRECTION et LONGUEUR : "))) (cond ((and pt_i_fer ftd:ps) (setvar "CMDECHO" 0) (command "_undo" "_be") ; sauve scu courant (command "_ucs" "_s" "tempftd") (if (not (zerop (getvar "cmdactive")))(command "_y")) (command "_line" "_none" pt_i_fer "_none" ftd:ps "") (setq ftd:axefer (entlast)) (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) (setq ftd:ps_SCG (trans ftd:ps 1 0)) (command "_ucs" "_zaxis" "_none" pt_i_fer "_none" ftd:ps) (setq pt_i_fer (trans pt_i_fer_SCG 0 1)) (setq ftd:ps (trans ftd:ps_SCG 0 1)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (if (not ax2pr:la) (setq ax2pr:la 40.0)) ; par défaut (setq la (getdist (strcat "\nLARGEUR tube ou du plat <" (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 du tube ou épaisseur du plat <" (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 pour tube A METTRE A ZERO POUR PLAT ou Barre <" (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)) (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 "Arrondies Vives") (setq typar (getkword "\nProfilé avec arêtes : <Vives>[Arrondies] : ")) (if (/= typar "Arrondies") (setq typar "Vives")) (if sv_dm (setvar "DYNMODE" sv_dm)) (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)) (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) (cond ((= typar "Arrondies") (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" ) ) ((= typar "Vives") (command "_PLINE" "_non" (list (* la -1) (* ha -1)) "_non" (list la (* ha -1)) "_non" (list la ha) "_non" (list (* la -1) ha) "_c" ) ) ) )) ; cond (if (= i 1)(setq i 2)) ) ; repeat (setvar "plinewid" pw) (setvar "CMDECHO" 1) ;;; pour commande rotation ci-dessous (cond ((= i 2) (setq tubext (entlast)) (command "_rotate" tubext "" "_non" p1) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq npr (getpoint p1 "\n nouveau point de référence <>:")) (if npr (command "_move" tubext "" "_non" npr "_non" p1)) ) ((= i 3) (setq la (+ la ep) ha (+ ha ep)) (setq tubint (entlast)) (command "_rotate" tubint tubext "" "_non" p1) (while (not (zerop (getvar "cmdactive")))(command pause)) (setq npr (getpoint p1 "\n nouveau point de référence <>:")) (if npr (command "_move" tubint tubext "" "_non" npr "_non" p1)) ) ) ; pivotements scu (setvar "CMDECHO" 0) (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) (setq ftd:ps_SCG (trans ftd:ps 1 0)) (command "_ucs" "_x" "-90") (setq pt_i_fer (trans pt_i_fer_SCG 0 1)) (setq ftd:ps (trans ftd:ps_SCG 0 1)) (setq pt_i_fer_SCG (trans pt_i_fer 1 0)) (setq ftd:ps_SCG (trans ftd:ps 1 0)) (command "_ucs" "_Z" "-90") (setq pt_i_fer (trans pt_i_fer_SCG 0 1)) (setq ftd:ps (trans ftd:ps_SCG 0 1)) (setq ftd:sommets (list ftd:ps)) ;; extrusion suivant chemin (path) (command "_extrude" tubext "" "_p" ftd:axefer) (setq ftd:fer (entlast)) (if tubint (progn (if (= (getvar "delobj") 2) (entdel ftd:axefer)) (command "_extrude" tubint "" "_p" ftd:axefer) (command "_subtract" ftd:fer "" "_L" "") (setq ftd:fer (entlast)) ) ) (while (and ftd:ps (not (and (/= 0.0 ax2pr:ep) npr))) (setq ftd:pp ftd:ps) (if (< i 2) (setq ftd:ps (getpoint ftd:pp "\n point suivant :")) (progn (initget "Clore") (setq ftd:ps (getpoint ftd:pp "\n point suivant [Clore] :")) (if (= ftd:ps "Clore") (setq ftd:clore t) ) ) ) (if ftd:ps (progn (if ftd:clore (setq ftd:ps nil) (setq ftd:sommets (append ftd:sommets (list ftd:ps))) ) (entdel ftd:fer); efface fer 3d ;;efface AXE précédent (if (or (= 0 (getvar "delobj"))(= 1 (getvar "delobj"))) (entdel ftd:axefer) ) (command "_3dpoly" "_none" pt_i_fer) (setq i 0) (repeat (length ftd:sommets) (setq ftd:point (nth i ftd:sommets)) (command "_none" ftd:point) (setq i (1+ i)) ) (if (not ftd:clore) (command "") (command "_c") ) (setq ftd:axefer (entlast)) (if (or (= 1 (getvar "delobj"))(= 2 (getvar "delobj"))) (progn (entdel tubext) ; restaure profil 2d (if tubint (entdel tubint)) ) ) (command "_extrude" tubext "" "_p" ftd:axefer) (setq ftd:fer (entlast)) (if tubint (progn (if (= (getvar "delobj") 2) (entdel ftd:axefer)) (command "_extrude" tubint "" "_p" ftd:axefer) (command "_subtract" ftd:fer "" "_L" "") (setq ftd:fer (entlast)) ) ) ) ) ) ;; AXE présent ou pas suivant variable delobj en désactivant les 2 options ci-dessous ;; ou bien ; AXE TOUJOURS EFFACé (oter les ;) (if (= 1 (getvar "delobj")) (entdel ftd:axefer) ;efface AXE ) ;; ou AXE TOUJOURS PRESENT (oter les ;) ; (if (= 2 (getvar "delobj")) ; (entdel ftd:axefer) ;restaure AXE ; ) (setvar "UCSFOLLOW" CFOLLOW) ; restoration scu (command "_ucs" "_r" "tempftd") (command "_undo" "_e") (setvar "CMDECHO" 1) ) ) (princ) )

Mise à jour du sujet avec beaucoup de retard. ; ax2pr Axe to profil rectangulaire (creux si epaisseur supérieure 0) ; version 5 le 01-12-2009 version avec demande de rotation de la section du profil ;; 5.1 validation scu ;; 5.2 correction delobj 2 27 07 2012 ; usegomme ;;===================================================;; ;; 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:ax2pr (/ la ha ep r ax p2 p1 tubext i l1 tubint CECHO CFOLLOW typar sv_dm pw dm elst pe cen elv ext pa1 pa2 grd prd ang pt1 pt2 mat a1 a2 aec rep ) (setq CFOLLOW (getvar "UCSFOLLOW") CECHO (getvar "CMDECHO") sv_dm (getvar "DYNMODE") pw (getvar "plinewid") ) (setvar "UCSFOLLOW" 0) (setvar "plinewid" 0) (setvar "CMDECHO" 1) ; 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, 0 = plein <" (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)) (cond ((< sv_dm 0) (setq dm (* sv_dm -1)) (setvar "DYNMODE" dm)) (t (setq sv_dm nil dm nil)) ) (initget "Arrondies Vives") (setq typar (getkword "\nProfilé avec arêtes : <Vives>[Arrondies] : ")) (if (/= typar "Arrondies") (setq typar "Vives")) (if sv_dm (setvar "DYNMODE" sv_dm)) (while (setq ax (entsel "\nSélectionner l'AXE du TUBE rectangulaire :")) (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 ;;; validation SCU ;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq rep "Non" i 0) (while (= rep "Non") (setq i (+ 1 i)) (initget "Oui Non") (setq rep (getkword "\nLe SCU est-il correct avec le Z dans la direction d'extrusion ? [Non] <Oui> : ")) (if (= rep "Non") (if (= i 1) (command "_ucs" "_zaxis" pause pause) (progn (command "_ucs" ) (while (not (zerop (getvar "cmdactive")))(command pause))) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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)) (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) (cond ((= typar "Arrondies") (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" ) ) ((= typar "Vives") (command "_PLINE" "_non" (list (* la -1) (* ha -1)) "_non" (list la (* ha -1)) "_non" (list la ha) "_non" (list (* la -1) ha) "_c" ) ) ) )) ; cond (if (= i 1)(setq i 2)) ) ; repeat (cond ((= i 2) (setq tubext (entlast)) (command "_rotate" tubext "" "_non" p1) (while (not (zerop (getvar "cmdactive")))(command pause)) (command "_sweep" tubext "" ax) ;; balayage ) ((= i 3) (setq la (+ la ep) ha (+ ha ep)) (setq tubint (entlast)) (command "_rotate" tubint tubext "" "_non" p1) (while (not (zerop (getvar "cmdactive")))(command pause)) (command "_sweep" tubext "" ax) ;; balayage (setq tubext (entlast)) (if (= 2 (getvar "delobj"))(entdel (car ax))) (command "_sweep" tubint "" ax) ;; balayage (command "_subtract" tubext "" "_L" "") ) ) (command "_ucs" "_r" "tempftd") ) (setvar "UCSFOLLOW" CFOLLOW)(setvar "plinewid" pw)(setvar "CMDECHO" CECHO) (gc) (princ) )

Salut, je réactive ce post qui était resté sans suite et retrouvé "en promenant", par une petite liste rapide que je complèterai ultérieurement. A cette adresse : Tuyauterie 3D On trouve: Ax2pr.lsp (axe to profil rectangulaire) génère un profil plein ou creux svt l'axe sélectionné. BBride.lsp bride 3d en bloc norme NF 2007 jusqu'au PN40 Brid.lsp bride 3d simplifiée Bride.lsp bride en solide 3d, norme NF 2007 jusqu'au PN40 Fellip et Fellipt.lsp fond elliptique (en solide 3D) Fgrc .lsp fond GRC (en solide 3D) Fprc.lsp fond PRC (en solide 3D) Fta.lsp fond pour tube (en solide 3D) Redacier.lsp réduction pour tuyauterie acier (en solide 3D) Rediso.lsp réduction pour tuyauterie inox roulée soudée (en solide 3D) TRC.lsp tronc de cône creux ou plein, avec ou sans déport (en solide 3D) Tuy.lsp tuyauterie 3d voir options dans lisp TR.lsp tube ou profil rectangulaire 3D

Salut, un peu tard mais je n'avais pas vu ta demande. Essai cette modif de BURST en "BIGBURST" ça fera peut être ton affaire.

Salut, mauvaise manip ou chemin de recherche car ça marche: (defun c:FTD (/ pt_i_fer ftd:clore ftd:ps ftd:sommets ftd:profmet ftd:point ftd:fer ftd:pp ftd:axefer i pt_i_fer_SCG ftd:ps_SCG) (if (null c:PROFIL)(load "PROFIL")) ;;; etc (c:profil) ;;; etc

Evidemment, vu sous cet angle... Mais ça ne semble pas être l'avis d'une bonne part de la communauté internationale.

l'Iran n'est pas le problème, le problème c'est Israel Vraiment !

Un autre petit lisp pour couper les solides 3D, mais pas gadget cette fois, pour les coupures de ce genre : avant _______________ .................................................: aprés _____.........._____ C'est un bricolage à utiliser suivant la bonne méthode pour ne pas retrouver des solides superposés. Comme j'aime les raccourcis clavier, il s'appelle CS (coupure solide). ;; Coupe une partie "centrale" des solides sélectionnés ;; ou au choix un coté, et cela pour toute la sélection. ;; il ne peut pas y avoir de mix dans la même opération. ;; IMPORTANT: Le ou les points de COUPURE finaux ne doivent pas se situer aux extrémités ;; ou en dehors des solides à couper en coordonnée X du scu défini par les deux premiers points, ;; les positions en Y ou Z non pas d'importances. ;; UNE MAUVAISE EXECUTION LAISSE DES DOUBLONS DES SOLIDES. ;; le deuxième point est demandé 2 fois, la 2eme fois est pour valider (par espace ou entrée) ou ;; pour le redéfinir (mais pas la direction) et permet aussi de redéfinir le premier point. ;; si la valeur X de p2 (2eme définitions) est inférieure à la valeur X de p1 alors la partie du solide ;; située coté p1 est supprimée comme avec l'usage classique de la commande SECTION. ;; En pratique on coupe directement avec les deux premiers points ;; ou bien on indique une direction et on coupe avec 1 ou 2 points supplémentaires pris sur des repères. ;; La ou les coupes étant toujours perpendiculaire à la direction de l'axe des X. ;; usegomme ;; 24 05 2012 ;; 31 07 2012 accepte "m2p" milieu entre 2 points. (defun c:CS (/ elast ud sac csac p1 p2 p2_SCG p3 ercs u:g u:f uf) (defun ercs (msg) (eval(read U:F)) (command "_u") (setvar "cmdecho" 1) (setq *error* m:err m:err nil) (princ) ) (setq m:err *error* *error* ercs) (setvar "CMDECHO" 0) ;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:F)) (setq U:G "(command \"_UNDO\" \"_G\")" U:F "(command \"_UNDO\" \"_E\")" ) (eval(read U:G)) (setq elast (entlast)) (princ " Sélectionnez les solides à couper.") (setq sac (ssget '((0 . "3DSOLID"))) ud (getvar "UCSDETECT") uf (getvar "UCSFOLLOW")) (if (= 1 uf) (setvar "UCSFOLLOW" 0)) (prompt "\n 1er point de coupure ou de base: ") (command "_ucs" pause ) ;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. (while (not (equal (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause)) (command "") (setvar "UCSDETECT" 0) (setq p2 (getpoint '(0. 0. 0.) "\n2eme point de coupure ou Direction de la coupe:")) (setq p2_SCG (trans p2 1 0) p3 "Premier" p1 '(0. 0. 0.)) (command "_.ucs" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ) "" ) (while (= p3 "Premier") (initget "Premier") (prompt "\n Si point vers axe -X seul ce coté est concerver") (setq p3 (getpoint p1 "\n 2 eme point de coupure,[Premier] ou <valider>:")) (cond ((= p3 "Premier") (setq p3 (getpoint p1 "\n 1er point de coupure ou <valider>:")) (if p3 (setq p1 p3 p3 "Premier")) ) ) ) (if (not p3) (setq p3 (trans p2_SCG 0 1 ))) (if (not p1) (setq p1 '(0. 0. 0.))) (if (> (nth 0 p1) (nth 0 p3)) (command "_.slice" sac "" "_non" p1 "_non" (list (nth 0 p1) (+ 10 (nth 1 p1)) (nth 2 p1)) "_non" (list (- (nth 0 p1) 10) (nth 1 p1) (nth 2 p1))) (progn (command "_copy" sac "" "" "") (setq csac nil csac (ssadd)) (while (entnext elast) (ssadd (entnext elast) csac) (setq elast (entnext elast)) ) (command "_.slice" sac "" "_non" p1 "_non" (list (nth 0 p1) (+ 10 (nth 1 p1)) (nth 2 p1)) "_non" (list (- (nth 0 p1) 10) (nth 1 p1) (nth 2 p1))) (command "_.slice" csac "" "_non" p3 "_non" (list (nth 0 p3) (+ 10 (nth 1 p3)) (nth 2 p3)) "_non" (list (+ 10 (nth 0 p3)) (nth 1 p3) (nth 2 p3)) ) ) ) (repeat 2 (command "_ucs" "_p")) (if (= 1 uf) (setvar "UCSFOLLOW" 1)) (setvar "UCSDETECT" ud) (eval(read U:F)) (setq *error* m:err m:err nil) (setvar "CMDECHO" 1) (princ) )

Un petit gadget de + pour couper depuis un point de référence et avec un angle, on fait pareil avec les accrochages temporaires mais j'ai souvent des difficultés avec mon autocad en 3d, et d'autre part la routine redéfinie un plan scu ce qui donne un petit avantage. ;; section de solides 3d par deux points depuis un point de référence ;; définissant un plan xy et un angle de coupe sur ce plan. ;; les 3 points ne doivent pas être alignés ;; SCU dynamique utilisable ;; SEA -> SEction Angle (prononcer "scie") ;; section objet(s) suivant angle p2 p3 ;; usegomme ;; 10 04 2012 ;; 18 06 2012 coupe sans le pt de référence ;; 31 07 2012 accepte "m2p" milieu entre 2 points. (defun c:SEA (/ js p2 p3 p2_SCG p3_SCG) (prompt "\n Sélectionner les Objets à Couper") (setq js (ssget)) (if js (progn (setvar "CMDECHO" 0) (prompt "\n Point de référence HORS AXE DE COUPE ou 1er pt de C: ") (command "_ucs" pause ) ;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. (while (not (equal (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause)) (command "") (setq p2 (getpoint '(0. 0. 0.) "\n Point sur l'axe de coupe :")) (setq p3 (getpoint p2 "\n Point suivant sur l'axe de coupe <Terminer>:")) (if p3 (progn (setq p2_SCG (trans p2 1 0)) (setq p3_SCG (trans p3 1 0)) (grdraw p2 p3 -1) (command "_.ucs" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 )) (setvar "CMDECHO" 1) (command "_.slice" js "" "_non" (trans p2_SCG 0 1 ) "_non" (trans p3_SCG 0 1 )) (while (not (zerop (getvar "cmdactive")))(command pause)) (setvar "CMDECHO" 0) (command "_.ucs" "_P") (grdraw p2 p3 -1) ) (progn (setvar "CMDECHO" 1) (grdraw '(0. 0. 0.) p2 -1) (command "_.slice" js "" "_non" '(0. 0. 0.) "_non" p2) (while (not (zerop (getvar "cmdactive")))(command pause)) (grdraw '(0. 0. 0.) p2 -1) (setvar "CMDECHO" 0) ) ) (command "_.ucs" "_P") (setvar "CMDECHO" 1) )) (princ) )

Bonjour, pour l'instant je n'arrive pas à accéder au site pour copier le lien, mais la dernière version est la 6 qui se trouve au #32 page 2 de ce post. Edit: j'ai trouvé le lien dans un autre post, je ne peux pas le tester, mais il doit être bon: A cette adresse on retrouve les lisps pour la tuyauterie et chaudronnerie 3 D dont les brides.

Un essai de commande aligner 3d, mais par 2 points + une rotation. Il y a aussi une option "copier". Chez moi ça marche bien sauf quand la mémoire "graphique" sature dans ce cas le point d'insertion est "out". ;; Alignement objets sur 2 points 3D et rotation ;; 26 05 2012 ;; 12 12 2012 amélioration gestion erreur ;; usegomme (defun c:az (/ js ns elast p0 p n o_SCG p_SCG c eraz uf) (defun eraz (msg) (if n (repeat n (command "_ucs" "_p"))) (setvar "UCSFOLLOW" uf) (setvar "cmdecho" 1) (setq *error* m:err m:err nil) (princ) ) (setq m:err *error* *error* eraz) (setvar "CMDECHO" 0) (setq js (ssget) n 0 elast (entlast) uf (getvar "UCSFOLLOW")) (if (= 1 uf) (setvar "UCSFOLLOW" 0)) (command "_ucs" "") ;;; SCU général (setq n (1+ n)) (initget "Copier") (setq p0 (getpoint "\n Point de base [Copier]: ")) (if (= p0 "Copier") (progn (setq c t)(setq p0 (getpoint "\n Point de base: ")))(setq c nil)) (setq p (getpoint p0 "\n Orientation de référence :")) (setq p_SCG (trans p 1 0)) (command "_ucs" "_non" p0 "_non" (trans p_SCG 0 1) "") (setq n (1+ n)) (command "_copybase" "_non" '(0. 0. 0.) js "") (setq o_SCG (trans '(0. 0. 0.) 1 0)) (command "_ucs" "") ;;; SCU général (setq n (1+ n)) (setq p (getpoint o_SCG "\nNouveau point d'origine <concerver>:")) (if p (command "_ucs" "_non" p "")(command "_ucs" "_non" o_SCG "")) (setq n (1+ n)) (setq p (getpoint '(0. 0. 0.) "\nNouvelle orientation <concerver>:")) (if p (progn (command "_ucs" "_non" '(0. 0. 0.) "_non" p "")(setq n (1+ n)))) (command "_pasteclip" "_non" '(0. 0. 0.)) (setq ns nil ns (ssadd)) (while (entnext elast) (ssadd (entnext elast) ns) (setq elast (entnext elast)) ) (command "_ucs" "_x" "90") (setq n (1+ n)) (command "_ucs" "_y" "90") (setq n (1+ n)) (setvar "CMDECHO" 1) (command "_rotate" ns "" "_non" '(0. 0. 0.))(while (not (zerop (getvar "cmdactive")))(command pause)) (setvar "CMDECHO" 0) (if (not c)(command "_erase" js "")) (command "_select" ns "") ;; pour mémoriser la dernière sélection (repeat n (command "_ucs" "_p")) (setq *error* m:err m:err nil) (if (= 1 uf) (setvar "UCSFOLLOW" 1)) (setvar "CMDECHO" 1) (princ) )

J'ai remplacé le lisp au dessus qui n'était pas bien par celui ci-dessous. C'est une commande rotation 3D qui me semble mieux que celle d'Autocad. Comme point de départ de l'angle de rotation éviter de prendre la verticale sinon il faudra donner un point supplémentaire pour indiquer de quel coté tourner. ;; rotation 3d ;; ok avec scu dynamique ;; 10 05 2012 ;; usegomme ;; <rotation // XY> rotation classique parallèle au plan XY mais avec référence, accés par espace ou entrée ;; modif 11 05 2012 la verticale est relative à l'axe Z ;; 31 07 2012 accepte "m2p" milieu entre 2 points. ;; 23 11 2012 options copier et axe + gestion erreur selon (gile) (defun c:rz (/ js n p2 p2_SCG p3 p3_SCG ud uf *error* c i) (defun *error* (msg) (if n (repeat n (command "_ucs" "_p"))) (setvar "UCSDETECT" ud) (if (= 1 uf) (setvar "UCSFOLLOW" 1)) (setvar "cmdecho" 1) (princ) ) (setq js (ssget) n 1 i 0 ud (getvar "UCSDETECT") uf (getvar "UCSFOLLOW")) (setvar "CMDECHO" 0)(if (= 1 uf) (setvar "UCSFOLLOW" 0)) (prompt "\n Centre de Rotation: ") (command "_ucs" pause ) ;; ligne ci-dessous pour "m2p" si problème mettre un ; devant pour la désactiver. (while (not (equal (getvar "lastpoint") '(0.0 0.0 0.0) 0.01))(command pause)) (command "") (setvar "UCSDETECT" 0) (while (or (= p2 "Copier") (= p2 "Axe") (= i 0)) (setq i 1) (initget "Copier Axe") (setq p2 (getpoint '(0. 0. 0.) "\nPoint de référence pour basculement [Copier/Axe] ou <rotation // XY>:")) (if (= p2 "Copier") (setq c t)) (if (= p2 "Axe")(progn (setvar "CMDECHO" 1) (command "_ucs" "_zaxis" "" pause) (setvar "CMDECHO" 0) (setq n (1+ n)))) ) (cond (p2 (setq p2_SCG (trans p2 1 0)) (if (and (equal 0 (nth 0 p2) 0.001) (equal 0 (nth 1 p2) 0.001)) (progn (setq p3 (getpoint '(0. 0. 0.) "\n Rotation de quel coté hors axe Z ?:")) (while (and (equal 0 (nth 0 p3) 0.001) (equal 0 (nth 1 p3) 0.001)) (setq p3 (getpoint '(0. 0. 0.) "\n***INCORRECT*** Rotation de quel coté hors axe Z ?:")) ) (setq p3_SCG (trans p3 1 0)) (command "_.ucs" "_non" '(0. 0. 0.) "_non" (list (nth 0 (trans p3_SCG 0 1 )) (nth 1 (trans p3_SCG 0 1 )) 0) "" ) (command "_ucs" "_x" "90") (setq n (+ 2 n)) ) (progn (command "_.ucs" "_non" '(0. 0. 0.) "_non" (list (nth 0 (trans p2_SCG 0 1 )) (nth 1 (trans p2_SCG 0 1 )) 0) "" ) (command "_ucs" "_x" "90") (setq n (+ 2 n)) ) ) (setvar "CMDECHO" 1) (if c (command "_rotate" js "" "_non" '(0. 0. 0.) "_c" "_ref" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 )) (command "_rotate" js "" "_non" '(0. 0. 0.) "_ref" "_non" '(0. 0. 0.) "_non" (trans p2_SCG 0 1 )) ) (while (not (zerop (getvar "cmdactive")))(command pause)) ) (t (setvar "CMDECHO" 1) (if c (progn (command "_rotate" js "" "_non" '(0. 0. 0.)"_c" "_ref" "_non" "@")(while (not (zerop (getvar "cmdactive")))(command pause))) (progn (command "_rotate" js "" "_non" '(0. 0. 0.) "_ref" "_non" "@")(while (not (zerop (getvar "cmdactive")))(command pause))) ) ) ) (*error* nil) )

Salut, il te faut utiliser COND et non pas IF et getkword retoune un mot et pas un nombre. (cond ((= typ-Grue "170") ....... Egalement faire attention aux parentheses, ce que tu mets en ligne ne colle pas. Et (vl-load-com) ne sert que pour l´utilisation de fonctions vlisp ce qui n´est pas le cas. Ceci est mal ecrit egalement (setq typ-Grue (getkword "\n Donner le type de grue : \n [170, 210, 290, 550] ")) (setq typ-Grue (getkword "\nDonner le type de grue [170/210/290/550]:")) Je pense que cela devrait te permettre de reprendre ton lisp, mais tu ne dois pas te fier a ta memoire, le code n´est pas de la prose.

J'ai refait la routine, l'autre n'était vraiment pas au point, j'y ai inclus ce que je fais habituellement pour ce genre de manip, c'est à dire le copier/coller. Bizarrement je n'y ai pas pensé le 12/4, ça devient grave ! :blink:

Lisp supprimé

Bonjour, j'ai fait une petite routine qui, je pense répond à ta demande. Les objets sélectionnés sont orientés en 3D par 2 points, l'angle de base étant le Z du SCU courant ou nouveau éventuellement avec le scu dynamique actif. A tester ! ;; Rotation objet depuis orientation Z (scu) vers orientation 3D choisie ;; 19 04 2012 ;; usegomme (defun c:rz (/ js) (setvar "CMDECHO" 0) (setq js (entsel)) (prompt "\n Centre de Rotation: ") (command "_ucs" pause "") (command "_copybase" "_non" '(0. 0. 0.) js "") (setvar "CMDECHO" 1) (command "_ucs" "_zaxis" pause pause) (command "_pasteclip" "_non" '(0. 0. 0.)) (command "_rotate" "_l" "" "_non" '(0. 0. 0.))(while (not (zerop (getvar "cmdactive")))(command pause)) (entdel (nth 0 js)) (repeat 2 (command "_ucs" "_p")) (princ) )