PHILPHIL

hello DenisHen a rajouter dans un de tes lisp qui s'exécute a l'ouverture d'un fichier ca rajoute au fichier *.dwg une propriété personnalisée : UNITE_ECHELLE_FICHIER que j'utilise dans mes lisp (setcustombykey "UNITE_ECHELLE_FICHIER" 1) oui (defun gc:getcustombykey (key / val) (vl-catch-all-apply '(lambda () (vla-getcustombykey (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key 'val) ) ) val ) (defun setcustombykey1 (key val) (vl-load-com) (not (vl-catch-all-apply '(lambda () (vla-setcustombykey (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key val) ) ) ) ) (defun setcustombykey (key val) (vl-load-com) (not (vl-catch-all-apply '(lambda () (vla-addcustominfo (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key val) ) ) ) ) je n'en ai pas u l utilité pour le moment j'ai ca sinon , je ne connais pas l'auteur, et je n'ai pas tester, merci a lui escalier_balance_complet.lsp.zip je travaille en cm et des fois je recois des fichiers en metre, j'utilise ce lisp pour pas tout changer dans mes lisp mais pour changer cette variable ( propriété personnalisée) qui m'est propre si tu bosse en cm : unite echelle fichier = 0.01 en m : unite echelle fichier = 1 ; -------------------------------------------------------------------- ; defini l'echelle du dessin valeur d'une unite pour un metre ------ ; -------------------------------------------------------------------- (defun c:unite_echelle_fichier () (setvar "cmdecho" 0) (setq unite_echelle_fichier (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) (initget 4) ; No negative values allowed (setq tmp (getdist (strcat "\nENTRER LA VALEUR D'UNE UNITE DESSIN EN METRE <" (rtos unite_echelle_fichier 2 8) ">: ") ) ) (if tmp (setq unite_echelle_fichier tmp) ) (setcustombykey1 "UNITE_ECHELLE_FICHIER" (rtos unite_echelle_fichier 2 8)) (princ) ) tu vas avoir besoin de ca aussi ; ------------------ ; defini l'echelle du TEXTE ------- (defun c:txtech () (setvar "cmdecho" 0) (setq txtech (atof (getcfg "APPDATA/TXTECH"))) ;(prompt ; (strcat ; "\nLA VALEUR D'ECHELLE DE REFERENCE DU TEXTE ACTUELLE EST DE " ; (rtos TXTECH 2 8) ; " " ;) ; ) (initget 4) ; No negative values allowed (setq tmp (getdist (strcat "\nENTRER LA VALEUR D'ECHELLE DU TEXTE <" (rtos txtech 2 8) ">: "))) (if tmp (setq txtech tmp) ) (setcfg "APPDATA/TXTECH" (rtos txtech 2 8)) ;;; (setvar "cmdecho" 1) (princ) ) ; ------------------

Hello Max voici un lisp qui devrait t'aider, je l'utilise pour faire du rapport de traits entre coupes et façades quand je bosse en 2D. au risque de passer pour un "vieux CON" et comme je l'ai appris ( en dessinant sur une planche a dessin a la mano ) et appliqué depuis sur autocad bien vite. je bosse avec la méthode européenne sous autocad en 2D les different niveaux l'un au dessus de l'autre a distance fixe exact ( 5000 unites par exemple ) facades, coupes vue de droite projetées a gauche et inversement la fonction autocad " UCSFOLLOW" permettant de s'y retrouvé ( la fonction a du etre inventé pour ca non ? je ne connais pas l historique des fonctions autocad ) je dirais que la méthode de dessin me fait hurler quand je vois ca. ( le calque zero ne doit jamais etre utilisé, car il est commun a tous les fichiers encore plus quand ceux ci sont en XREF ) quand je reçois encore des fichiers ou toutes les façades sont alignées comme ça n'importe ou dans l'espace papier a des kilomètres du 0,0,0 ça ne permet pas de vérifier l'exactitude des fichiers. en balançant sur le plan des "_XLINE" voir si les fenêtres des façades sont bien alignées aux fenêtre en plan. on m'a dit une fois , "il est pas interdit de vérifier le boulot des autres" https://fr.wikipedia.org/wiki/Dessin_technique ( faire une charrette sans méthode on finit le dimanche soir, une charrette avec méthode on finit le vendredi avec l'apéro ) ca reflète ou réfracte des LIGNES ( pas des polylignes ) par rapport a une ligne si tu as déja des polylignes, tu refais des lignes dans le prolongement ( meme calque ) a+ Phil (Vc)( déja ?) (defun c:reflet () (setvar "cmdecho" 0) (setq typeactionreflet (getcfg "APPDATA/typeactionreflet")) (prompt "\n 1 : SELECTIONNER LES LIGNES A REFLETER >|< :") (prompt "\n 2 : SELECTIONNER LES LIGNES A REFRACTER /|\\ :") (prompt "\n 3 : SELECTIONNER LES LIGNES A REFLETER ( EN FAISANT UNE COPIE ) >>|<< :") (prompt "\n 4 : SELECTIONNER LES LIGNES A REFRACTER ( EN FAISANT UNE COPIE ) //|\\\\ :") (prompt "\n 5 : SELECTIONNER LES LIGNES A REFLETER et PROLONGER ( EN FAISANT UNE COPIE ) :") (prompt "\n 6 : SELECTIONNER LES LIGNES A REFRACTER et PROLONGER ( EN FAISANT UNE COPIE ) :") ;;; (prompt "\n 7 : SELECTIONNER LES LIGNES A REFRACTER et PROLONGER et A JOINDRE( EN FAISANT UNE COPIE ) :") (initget "1 2 3 4 5 6") (setq tmp (getkword (strcat "\nSELECTIONNER LE TYPE D'ACTION DESIRE ( 1 2 3 4 5 6 ) <" typeactionreflet "> : ") ) ) (if tmp (setq typeactionreflet tmp) ) (setcfg "APPDATA/typeactionreflet" typeactionreflet) (if (= typeactionreflet "1") (progn ;;;--------------------------------------------------------- ;;;CRER UNE LIGNE REFLET D'UNE LIGNE PAR RAPPORT A UNE AUTRE ;;;--------------------------------------------------------- ;;(setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) (setvar "cmdecho" 0) (setq cav (getvar "clayer")) (setq osm (getvar "osmode")) (setq cecol (getvar "cecolor")) (setq cety (getvar "celtype")) (setq celtsca (getvar "celtscale")) (setvar "osmode" 0) (prompt "SELECTIONNER LES LIGNES A REFLETER :") (setq listeligne nil) (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE"))))) (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "") (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : "))) (command-s "-calque" "ch" "0" "in" "T_ATT" "") (setq p3 (cdr (assoc 10 (entget ss2)))) (setq p4 (cdr (assoc 11 (entget ss2)))) (setq ucsfo (getvar "ucsfollow")) (setvar "ucsfollow" 0) (command-s "scu" "") (setq compt 0) (setq com (sslength listeligne)) (while (< compt com) (progn (setq ss1 (ssname listeligne compt)) (setq p1 (cdr (assoc 10 (entget ss1)))) (setq p2 (cdr (assoc 11 (entget ss1)))) (setq calq1 (cdr (assoc 8 (entget ss1)))) (setq typelig1 (cdr (assoc 6 (entget ss1)))) (setq couleur1 (cdr (assoc 62 (entget ss1)))) (setq echl1 (cdr (assoc 48 (entget ss1)))) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ang1 (angle ptinter p1)) (setq ang2 (min (angle p3 p4) (angle p4 p3))) (setq angop (+ (- pi ang2) ang1)) (setq angok (- ang2 angop)) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ptalong1 (polar ptinter angok 10000 ;;(/ 1000 techl) )) (setq ent (entget ss1)) (if (< (distance ptinter p1) (distance ptinter p2)) (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent))) (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent))) ) (entmod ent) (if (/= couleur1 nil) (setvar "cecolor" (rtos couleur1 2 0)) (setvar "cecolor" "ducalque") ) (if (/= typelig1 nil) (setvar "celtype" typelig1) (setvar "celtype" "ducalque") ) (if (/= echl1 nil) (setvar "celtscale" echl1) ) (if (/= calq1 nil) (setvar "clayer" calq1) ) (command-s "ligne" ptinter ptalong1 "") (setq couleur1 nil) (setq typelig1 nil) (setq echl1 nil) (setq calq1 nil) ) (command-s "effacer" ss1 "") (setq compt (1+ compt)) ) (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "") (setvar "clayer" cav) (setvar "cecolor" cecol) (setvar "celtype" cety) (setvar "celtscale" celtsca) (setvar "osmode" osm) (command-s "scu" "P") (setvar "ucsfollow" ucsfo) ) ) (if (= typeactionreflet "2") (progn ;;;----------------------------------------------------------- ;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE ;;;----------------------------------------------------------- ;; (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) (setvar "cmdecho" 0) (setq cav (getvar "clayer")) (setq osm (getvar "osmode")) (setq cecol (getvar "cecolor")) (setq cety (getvar "celtype")) (setq celtsca (getvar "celtscale")) (setq osm (getvar "osmode")) (setvar "osmode" 0) (prompt "SELECTIONNER LES LIGNES A REFRACTER :") (setq listeligne nil) (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE"))))) (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "") (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : "))) (command-s "-calque" "ch" "0" "in" "T_ATT" "") (setq p3 (cdr (assoc 10 (entget ss2)))) (setq p4 (cdr (assoc 11 (entget ss2)))) (setq ucsfo (getvar "ucsfollow")) (setvar "ucsfollow" 0) (command-s "scu" "") (setq compt 0) (setq com (sslength listeligne)) (while (< compt com) (progn (setq ss1 (ssname listeligne compt)) (setq p1 (cdr (assoc 10 (entget ss1)))) (setq p2 (cdr (assoc 11 (entget ss1)))) (setq calq1 (cdr (assoc 8 (entget ss1)))) (setq typelig1 (cdr (assoc 6 (entget ss1)))) (setq couleur1 (cdr (assoc 62 (entget ss1)))) (setq echl1 (cdr (assoc 48 (entget ss1)))) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ang1 (angle p1 ptinter)) (setq ang2 (min (angle p3 p4) (angle p4 p3))) (setq angop (+ (- pi ang2) ang1)) (setq angok (- ang2 angop)) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ptalong1 (polar ptinter angok 10000 ;;(/ 1000 techl) )) (setq ent (entget ss1)) (if (< (distance ptinter p1) (distance ptinter p2)) (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent))) (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent))) ) (entmod ent) (if (/= couleur1 nil) (setvar "cecolor" (rtos couleur1 2 0)) (setvar "cecolor" "ducalque") ) (if (/= typelig1 nil) (setvar "celtype" typelig1) (setvar "celtype" "ducalque") ) (if (/= echl1 nil) (setvar "celtscale" echl1) ) (if (/= calq1 nil) (setvar "clayer" calq1) ) (command-s "ligne" ptinter ptalong1 "") (setq couleur1 nil) (setq typelig1 nil) (setq echl1 nil) (setq calq1 nil) ) (command-s "effacer" ss1 "") (setq compt (1+ compt)) ) (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "") (setvar "clayer" cav) (setvar "cecolor" cecol) (setvar "celtype" cety) (setvar "celtscale" celtsca) (setvar "osmode" osm) (command-s "scu" "P") (setvar "ucsfollow" ucsfo) ) ) (if (= typeactionreflet "3") (progn ;;;------------------------------------------------------------------------------ ;;;CRER UNE LIGNE REFLET D'UNE LIGNE PAR RAPPORT A UNE AUTRE EN FAISANT UNE COPIE ;;;------------------------------------------------------------------------------ ;; (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) (setvar "cmdecho" 0) (setq cav (getvar "clayer")) (setq osm (getvar "osmode")) (setq cecol (getvar "cecolor")) (setq cety (getvar "celtype")) (setq celtsca (getvar "celtscale")) (setvar "osmode" 0) (prompt "SELECTIONNER LES LIGNES A REFLETER ( EN FAISANT UNE COPIE ) :") (setq listeligne nil) (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE"))))) (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "") (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : "))) (command-s "-calque" "ch" "0" "in" "T_ATT" "") (setq p3 (cdr (assoc 10 (entget ss2)))) (setq p4 (cdr (assoc 11 (entget ss2)))) (setq ucsfo (getvar "ucsfollow")) (setvar "ucsfollow" 0) (command-s "scu" "") (setq compt 0) (setq com (sslength listeligne)) (while (< compt com) (progn (setq ss1 (ssname listeligne compt)) (command-s "COPIER" ss1 "" "0,0" "0,0") (setq p1 (cdr (assoc 10 (entget ss1)))) (setq p2 (cdr (assoc 11 (entget ss1)))) (setq calq1 (cdr (assoc 8 (entget ss1)))) (setq typelig1 (cdr (assoc 6 (entget ss1)))) (setq couleur1 (cdr (assoc 62 (entget ss1)))) (setq echl1 (cdr (assoc 48 (entget ss1)))) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ang1 (angle ptinter p1)) (setq ang2 (min (angle p3 p4) (angle p4 p3))) (setq angop (+ (- pi ang2) ang1)) (setq angok (- ang2 angop)) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ptalong1 (polar ptinter angok 10000 ;;(/ 1000 techl) )) (setq ent (entget ss1)) (if (< (distance ptinter p1) (distance ptinter p2)) (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent))) (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent))) ) (entmod ent) (if (/= couleur1 nil) (setvar "cecolor" (rtos couleur1 2 0)) (setvar "cecolor" "ducalque") ) (if (/= typelig1 nil) (setvar "celtype" typelig1) (setvar "celtype" "ducalque") ) (if (/= echl1 nil) (setvar "celtscale" echl1) ) (if (/= calq1 nil) (setvar "clayer" calq1) ) (command-s "ligne" ptinter ptalong1 "") (setq couleur1 nil) (setq typelig1 nil) (setq echl1 nil) (setq calq1 nil) ) (command-s "effacer" ss1 "") (setq compt (1+ compt)) ) (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "") (setvar "clayer" cav) (setvar "cecolor" cecol) (setvar "celtype" cety) (setvar "celtscale" celtsca) (setvar "osmode" osm) (command-s "scu" "P") (setvar "ucsfollow" ucsfo) ) ) (if (= typeactionreflet "4") (progn ;;;----------------------------------------------------------- ;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE ;;;----------------------------------------------------------- ;; (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) (setvar "cmdecho" 0) (setq cav (getvar "clayer")) (setq osm (getvar "osmode")) (setq cecol (getvar "cecolor")) (setq cety (getvar "celtype")) (setq celtsca (getvar "celtscale")) (setq osm (getvar "osmode")) (setvar "osmode" 0) (prompt "SELECTIONNER LES LIGNES A REFRACTER ( EN FAISANT UNE COPIE ) :") (setq listeligne nil) (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE"))))) (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "") (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : "))) (command-s "-calque" "ch" "0" "in" "T_ATT" "") (setq p3 (cdr (assoc 10 (entget ss2)))) (setq p4 (cdr (assoc 11 (entget ss2)))) (setq ucsfo (getvar "ucsfollow")) (setvar "ucsfollow" 0) (command-s "scu" "") (setq compt 0) (setq com (sslength listeligne)) (while (< compt com) (progn (setq ss1 (ssname listeligne compt)) (command-s "COPIER" ss1 "" "0,0" "0,0") (setq p1 (cdr (assoc 10 (entget ss1)))) (setq p2 (cdr (assoc 11 (entget ss1)))) (setq calq1 (cdr (assoc 8 (entget ss1)))) (setq typelig1 (cdr (assoc 6 (entget ss1)))) (setq couleur1 (cdr (assoc 62 (entget ss1)))) (setq echl1 (cdr (assoc 48 (entget ss1)))) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ang1 (angle p1 ptinter)) (setq ang2 (min (angle p3 p4) (angle p4 p3))) (setq angop (+ (- pi ang2) ang1)) (setq angok (- ang2 angop)) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ptalong1 (polar ptinter angok 10000 ;;(/ 1000 techl) )) (setq ent (entget ss1)) (if (< (distance ptinter p1) (distance ptinter p2)) (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent))) (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent))) ) (entmod ent) (if (/= couleur1 nil) (setvar "cecolor" (rtos couleur1 2 0)) (setvar "cecolor" "ducalque") ) (if (/= typelig1 nil) (setvar "celtype" typelig1) (setvar "celtype" "ducalque") ) (if (/= echl1 nil) (setvar "celtscale" echl1) ) (if (/= calq1 nil) (setvar "clayer" calq1) ) (command-s "ligne" ptinter ptalong1 "") (setq couleur1 nil) (setq typelig1 nil) (setq echl1 nil) (setq calq1 nil) ) (command-s "effacer" ss1 "") (setq compt (1+ compt)) ) (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "") (setvar "clayer" cav) (setvar "cecolor" cecol) (setvar "celtype" cety) (setvar "celtscale" celtsca) (setvar "osmode" osm) (command-s "scu" "P") (setvar "ucsfollow" ucsfo) ) ) (if (= typeactionreflet "5") (progn ;;;--------------------------------------------------------- ;;;CRER UNE LIGNE REFLET D'UNE LIGNE PAR RAPPORT A UNE AUTRE et LA PROLONGE ;;;--------------------------------------------------------- ;; (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) (setvar "cmdecho" 0) (setq cav (getvar "clayer")) (setq osm (getvar "osmode")) (setq cecol (getvar "cecolor")) (setq cety (getvar "celtype")) (setq celtsca (getvar "celtscale")) (setvar "osmode" 0) (prompt "SELECTIONNER LES LIGNES A REFLETER et PROLONGER ( EN FAISANT UNE COPIE ) :") (setq listeligne nil) (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE"))))) (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "") (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : "))) (command-s "-calque" "ch" "0" "in" "T_ATT" "") (setq p3 (cdr (assoc 10 (entget ss2)))) (setq p4 (cdr (assoc 11 (entget ss2)))) (setq ucsfo (getvar "ucsfollow")) (setvar "ucsfollow" 0) (command-s "scu" "") (setq compt 0) (setq com (sslength listeligne)) (while (< compt com) (progn (setq ss1 (ssname listeligne compt)) (setq p1 (cdr (assoc 10 (entget ss1)))) (setq p2 (cdr (assoc 11 (entget ss1)))) (setq calq1 (cdr (assoc 8 (entget ss1)))) (setq typelig1 (cdr (assoc 6 (entget ss1)))) (setq couleur1 (cdr (assoc 62 (entget ss1)))) (setq echl1 (cdr (assoc 48 (entget ss1)))) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ang1 (angle ptinter p1)) (setq ang2 (min (angle p3 p4) (angle p4 p3))) (setq angop (+ (- pi ang2) ang1)) (setq angok (- ang2 angop)) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ptalong1 (polar ptinter angok 10000 ;;(/ 1000 techl) )) (setq ent (entget ss1)) (if (< (distance ptinter p1) (distance ptinter p2)) (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent))) (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent))) ) (entmod ent) (if (/= couleur1 nil) (setvar "cecolor" (rtos couleur1 2 0)) (setvar "cecolor" "ducalque") ) (if (/= typelig1 nil) (setvar "celtype" typelig1) (setvar "celtype" "ducalque") ) (if (/= echl1 nil) (setvar "celtscale" echl1) ) (if (/= calq1 nil) (setvar "clayer" calq1) ) (command-s "ligne" ptinter ptalong1 "") (setq couleur1 nil) (setq typelig1 nil) (setq echl1 nil) (setq calq1 nil) ) (setq compt (1+ compt)) ) (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "") (setvar "clayer" cav) (setvar "cecolor" cecol) (setvar "celtype" cety) (setvar "celtscale" celtsca) (setvar "osmode" osm) (command-s "scu" "P") (setvar "ucsfollow" ucsfo) ) ) (if (= typeactionreflet "6") (progn ;;;----------------------------------------------------------- ;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE et LA PROLONGE ;;;----------------------------------------------------------- ;; (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) (setvar "cmdecho" 0) (setq cav (getvar "clayer")) (setq osm (getvar "osmode")) (setq cecol (getvar "cecolor")) (setq cety (getvar "celtype")) (setq celtsca (getvar "celtscale")) (setq osm (getvar "osmode")) (setvar "osmode" 0) (prompt "SELECTIONNER LES LIGNES A REFRACTER et PROLONGER ( EN FAISANT UNE COPIE ) :") (setq listeligne nil) (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE"))))) (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE,T_ATT NIVEAU AXE MIROIR" "") (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : "))) (command-s "-calque" "ch" "0" "in" "T_ATT" "") (setq p3 (cdr (assoc 10 (entget ss2)))) (setq p4 (cdr (assoc 11 (entget ss2)))) (setq ucsfo (getvar "ucsfollow")) (setvar "ucsfollow" 0) (command-s "scu" "") (setq compt 0) (setq com (sslength listeligne)) (while (< compt com) (progn (setq ss1 (ssname listeligne compt)) (setq p1 (cdr (assoc 10 (entget ss1)))) (setq p2 (cdr (assoc 11 (entget ss1)))) (setq calq1 (cdr (assoc 8 (entget ss1)))) (setq typelig1 (cdr (assoc 6 (entget ss1)))) (setq couleur1 (cdr (assoc 62 (entget ss1)))) (setq echl1 (cdr (assoc 48 (entget ss1)))) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ang1 (angle p1 ptinter)) (setq ang2 (min (angle p3 p4) (angle p4 p3))) (setq angop (+ (- pi ang2) ang1)) (setq angok (- ang2 angop)) (setq ptinter (inters p1 p2 p3 p4 nil)) (setq ptalong1 (polar ptinter angok 10000 ;;(/ 1000 techl) )) (setq ent (entget ss1)) (if (< (distance ptinter p1) (distance ptinter p2)) (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent))) (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent))) ) (entmod ent) (if (/= couleur1 nil) (setvar "cecolor" (rtos couleur1 2 0)) (setvar "cecolor" "ducalque") ) (if (/= typelig1 nil) (setvar "celtype" typelig1) (setvar "celtype" "ducalque") ) (if (/= echl1 nil) (setvar "celtscale" echl1) ) (if (/= calq1 nil) (setvar "clayer" calq1) ) (command-s "ligne" ptinter ptalong1 "") (setq couleur1 nil) (setq typelig1 nil) (setq echl1 nil) (setq calq1 nil) ) (setq compt (1+ compt)) ) (command-s "-calque" "IN" "T_ATT,T_ATT NIVEAU COUPE" "") (setvar "clayer" cav) (setvar "cecolor" cecol) (setvar "celtype" cety) (setvar "celtscale" celtsca) (setvar "osmode" osm) (command-s "scu" "P") (setvar "ucsfollow" ucsfo) ) ) ;;; (if (= typeactionreflet "7") ;;; (progn ;;;;;;----------------------------------------------------------- ;;;;;;CRER UNE LIGNE REFRACTE D'UNE LIGNE PAR RAPPORT A UNE AUTRE et LA PROLONGE ET A JOINDRE ;;;;;;----------------------------------------------------------- ;;; (setq techl (atof (gc:getcustombykey "UNITE_ECHELLE_FICHIER"))) ;;; (setvar "cmdecho" 0) ;;; (setq cav (getvar "clayer")) ;;; (setq osm (getvar "osmode")) ;;; (setq cecol (getvar "cecolor")) ;;; (setq cety (getvar "celtype")) ;;; (setq celtsca (getvar "celtscale")) ;;; (setq osm (getvar "osmode")) ;;; (setvar "osmode" 0) ;;; (prompt "SELECTIONNER LES LIGNES A REFRACTER et PROLONGER et A JOINDRE( EN FAISANT UNE COPIE ) :") ;;; (setq listeligne nil) ;;; (while (null listeligne) (setq listeligne (ssget (list (cons 0 "LINE"))))) ;;; (command-s "-calque" "AC" "T_ATT,T_ATT NIVEAU COUPE" "") ;;; (setq ss2 (car (nentsel "\nSELECTIONNER LA LIGNE DE MIROIR : "))) ;;; (command-s "-calque" "ch" "0" "in" "T_ATT" "") ;;; (setq p3 (cdr (assoc 10 (entget ss2)))) ;;; (setq p4 (cdr (assoc 11 (entget ss2)))) ;;; (setq ucsfo (getvar "ucsfollow")) ;;; (setvar "ucsfollow" 0) ;;; (command-s "scu" "") ;;; (setq compt 0) ;;; (setq com (sslength listeligne)) ;;; (while (< compt com) ;;; (progn (setq ss1 (ssname listeligne compt)) ;;;;;; (command-s "COPIER" ss1 "" "0,0" "0,0") ;;; (setq p1 (cdr (assoc 10 (entget ss1)))) ;;; (setq p2 (cdr (assoc 11 (entget ss1)))) ;;; (setq calq1 (cdr (assoc 8 (entget ss1)))) ;;; (setq typelig1 (cdr (assoc 6 (entget ss1)))) ;;; (setq couleur1 (cdr (assoc 62 (entget ss1)))) ;;; (setq echl1 (cdr (assoc 48 (entget ss1)))) ;;; (setq ptinter (inters p1 p2 p3 p4 nil)) ;;; (setq ang1 (angle p1 ptinter)) ;;; (setq ang2 (min (angle p3 p4) (angle p4 p3))) ;;; (setq angop (+ (- pi ang2) ang1)) ;;; (setq angok (- ang2 angop)) ;;; (setq ptinter (inters p1 p2 p3 p4 nil)) ;;; (setq ptalong1 (polar ptinter angok (/ 1000 techl))) ;;; (setq ent (entget ss1)) ;;; (if (< (distance ptinter p1) (distance ptinter p2)) ;;; (progn (setq ent (subst (cons 10 ptinter) (assoc 10 ent) ent))) ;;; (progn (setq ent (subst (cons 11 ptinter) (assoc 11 ent) ent))) ;;; ) ;;; (entmod ent) ;;; (if (/= couleur1 nil) ;;; (setvar "cecolor" (rtos couleur1 2 0)) ;;; (setvar "cecolor" "ducalque") ;;; ) ;;; (if (/= typelig1 nil) ;;; (setvar "celtype" typelig1) ;;; (setvar "celtype" "ducalque") ;;; ) ;;; (if (/= echl1 nil) ;;; (setvar "celtscale" echl1) ;;; ) ;;; (if (/= calq1 nil) ;;; (setvar "clayer" calq1) ;;; ) ;;; (command-s "ligne" ptinter ptalong1 "") ;;; (setq couleur1 nil) ;;; (setq typelig1 nil) ;;; (setq echl1 nil) ;;; (setq calq1 nil) ;;; (setq test102 entlast) ;;; (setq test103 (entget (entlast))) ;;; (setq test301 (cdr (assoc -1 ent))) ;;; (setq test300 (cdr (assoc -1 (entget (entlast))))) ;;; ;;; (setq test205 (cdr (assoc -1 (entget (entlast))))) ;;; (setq test206 (cdr (assoc -1 ent))) ;;; (setq test104 (ssname (entlast))) ;;; (setq test204 (ssname ent)) ;;; ;;;;;;(setq ent (entget (ssname (entlast)))) ;;;;;; (setq nonent (cdr (assoc -1 (entget (ssname (entlast))))) ;;; ;;; ;;; ;;; ;;; ;;;;;; (command-s "JOINDRE" test104 test204 "") ;;; (command-s "JOINDRE" test301 test300 "") ;;; ) ;;;;;; (command-s "effacer" ss1 "") ;;; (setq compt (1+ compt)) ;;; ) ;;; (setvar "clayer" cav) ;;; (setvar "cecolor" cecol) ;;; (setvar "celtype" cety) ;;; (setvar "celtscale" celtsca) ;;; (setvar "osmode" osm) ;;; (command-s "scu" "P") ;;; (setvar "ucsfollow" ucsfo) ;;; ) ;;; ) (if (= typeactionreflet "8") (progn) ) (princ) )

bonjour ayant pas mal utilisé les connaissances de CADXP pour ces lisp et travaillant des fois en 2D. voici des lisp pour faire des escaliers si ca interesse new : les escaliers sont placés dans un groupe a la fin vue en coupe c:escalier_montant_droite c:escalier_descendant_droite c:escalier_montant_gauche c:escalier_descendant_gauche vue en plan c:escalier_droit_plan c:escalier_colimacon_descendant_droite_plan c:escalier_colimacon_descendant_gauche_plan c:escalier_colimacon_montant_droite_plan c:escalier_colimacon_montant_gauche_plan new : c:escalier_droit_2_volee_plan vue de face c:escalier_droit_face bloc "FLECHE ESCALIER" a mettre dans ce sous répertoire "c:/PERSO/bibliotheque/ESCALIER/FLECHE ESCALIER" a tester Phil FLECHE ESCALIER.dwg ESCALIER.lsp

hello j'utilise "intersDC" de ZEBULON dans un lisp pour trouver le(s) point(s) de croisement entre une ligne et un cercle. il me donne deux points, ce qui est logique. je comprend. meme si la ligne ne coupe qu'une seule fois le cercle. mais si je ne voulais que le point de coupe entre une ligne qui ne coupe le cercle que UNE SEULE fois ? comment faut il modifier le lisp "intersdc" ? ou dois je vérifier apres coup lequel des deux points ( "C" et "D" ) se trouve entre les deux points de cette ligne ( "A" et "B" ). si la distance "AC" + "BC" est supérieure a la distance "AB" alors "C" n'est pas entre "A" et "B" ( ou avez vous une autre méthode plus "CARTESIENNE" plus jolie ?) MERCI Phil

hello ma trigo est loin je cherche en lisp a calculer l'angle en connaissant le rayon et la corde. merci Phil

hello Gile comment faire comprendre qu'il doit aller dans le fichier nouvellement ouvert ? et en ressortir la réponse me permet de regler d'autre lisp que celui ci. et je ne veux pas utiliser SAS (vla-active.... merci Phil

bonjour j'essaie de modifier un LISP ( de Gile) pour qu'il travaille sur tous les fichier d'un répertoire sans passer par LISPTOR ou SUPERAUTOSCRIPT c'est dans le bout de lisp "TESTOUVRIRFERMER" que ca plante j'arrive a ouvrir le fichier, mais apparemment, le lisp ne travaille pas dans le fichier nouvellement ouvert, mais dans le fichier de base ou a été lancer le lisp comment faire comprendre qu'il doit etre dans le fichier nouvellement ouvert ? apres ((vla-open (vla-get-documents (vlax-get-acad-object)) (strcat rep "/" filename))) je suppose que apres le travail dans le fichier ouvert, il faudra retourner dans le fichier de base et dire de fermer le fichier ouvert non ? comment ? Merci Phil (defun c:travailsousrepertoire (/ filename dirbox rep ) (defun dirbox (txt / cdl rep) (if (setq cdl (vlax-create-object "Shell.Application")) (progn (and (setq rep (vlax-invoke cdl 'browseforfolder 0 txt 512 "")) (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path)) ) (vlax-release-object cdl) ) ) rep ) (setq rep (dirbox "Choisissez un répertoire pour traiter tous les dessins.")) (foreach filename (append (vl-directory-files rep "*.dwg" 1) (vl-directory-files rep "*.dwt" 1)) (setq filename1 (strcat rep "/" filename)) (if (testouvrirfermer) (princ (strcat "\nLe traitement du fichier " filename " terminée.")) (princ (strcat "\nLe traitement du fichier " filename " a échoué.")) ) ) (princ) ) (defun testouvrirfermer () ((vla-open (vla-get-documents (vlax-get-acad-object)) (strcat rep "/" filename))) (setvar "cmdecho" 0) (command-s "-calque" "ch" 0 "") (command-s "zoom" "et") (command-s "-purger" "APPSENREG" "*" "n") (command-s "_close" "n") (princ) )

hello Luna merci pour l'info je l'utilise beaucoup pour garder des infos, et pas a avoir a les réécrire au clavier. pour le moment ca marche encore, puis c'est bien plus pratique que ca soit dans un petit fichier propre a autocad, que de le placer dans la base de registre énorme de windows ( enfin je pense que ca va la vue la commande "vl-registry-read".) a+ Phil ( pas expert programmeur, juste de la bidouille )

hello netparty nom type de mes présentations A1H RDC 1-50 PL001- type de feuille : "A1" VERTICALE ou HORIZONTALE : "V" ou "H" nom variable de présentation : "RDC", "COUPE", "plan du niveau 3 bat z" ..... echelle variable de la planche, la feuille : "1-50", "1-100" .... planche : "PL" numero de la planche sur 3 chiffres ( récupérée dans cartouche) : "001" indice de planche : "-" ceci récupere le dernier caractere du nom de ma présentation. c'est un champ, dans un texte, il me sert pour donner l'indice de mon plan a mettre dans un cartouche $(substr,$(getvar, ctab),$(-,$(strlen,$(getvar,ctab)),0),1) ceci récupere les 3 chiffres composant le numero de la planche du nom de ma présentation a mettre dans un cartouche $(substr,$(getvar, ctab),$(-,$(strlen,$(getvar,ctab)),3),3) et apres des lisp pour changer facilement les noms de présentations. j'en ai peut etre oublié certains bout, dites moi si ca plante, je les rajouterai. pour les fonctions "10" "11" "12" et "13" , il faut que TOUS LES NOMS de présentations du fichier *.dwg soit du meme type et correspondent a la recherche du lisp, sinon ca plante. 10 : A1H RDC 1-50 PL001-, A1H R 1 1-50 PL002-, A1H R 2 1-50 PL003- 11, 12, 13 : A1H R 1 1-50 PL001-, A1H R 1 1-50 PL002-, A1H R 1 1-50 PL003-, A1H R 2 1-50 PL011A, A1H R 2 1-50 PL012A, A1H R 2 1-50 PL013A ;;;----------------------------------- ;;;CHANGE_NOM_PRESENTATION ;;;----------------------------------- (defun c:change_nom_presentation () (setq typeactioncnp (getcfg "APPDATA/typeactioncnp")) (prompt "\n 1 : REMPLACER LE DERNIER CARACTERE DU NOM DES PRESENTATIONS" ) (prompt "\n 2 : REMPLACER LE PREMIER CARACTERE DU NOM DES PRESENTATIONS" ) (prompt "\n 3 : REMPLACER A PARTIR DE Y CARACTERES DEPUIS LE DEBUT SUR LE(S) X CARACTERE(S) [SI X=0 CORRESPOND A INSERER]" ) (prompt "\n 4 : SOUSTRAIRE LES X DERNIERS CARACTERES DU NOM" ) (prompt "\n 5 : SOUSTRAIRE LES X PREMIERS CARACTERES DU NOM" ) (prompt "\n 6 : INCREMENTER SUR 3 CARACTERES EN RAJOUTANT DEVANT LE NOM DE PRESENTATION" ) (prompt "\n 7 : INCREMENTER SUR 3 CARACTERES EN REMPLACANT LES 4 IEME A 2 IEME A PARTIR DE LA FIN" ) (prompt "\n 8 : INCREMENTER SUR 5 CARACTERES EN REMPLACANT LES 6 IEME A 2 IEME A PARTIR DE LA FIN" ) (prompt "\n 9 : REMPLACER DES CARACTERES DANS LE NOM") (prompt "\n 10 : TRIER LES NOMS DE PRESENTATIONS SUR LES 4 IEME A 2 IEME CARACTERE A PARTIR DE LA FIN") (prompt "\n 11 : TRIER LES NOMS DE PRESENTATIONS SUR 4 à X et LES 4 IEME A 2 CARACTERE A PARTIR DE LA FIN VERSION A") (prompt "\n 12 : TRIER LES NOMS DE PRESENTATIONS SUR 4 à X et LES 4 IEME A 2 CARACTERE A PARTIR DE LA FIN VERSION B") (prompt "\n 13 : TRIER LES NOMS DE PRESENTATIONS SUR 4 à X et LES 4 IEME A 2 CARACTERE A PARTIR DE LA FIN VERSION C") (initget "1 2 3 4 5 6 7 8 9 10 11 12 13") (setq tmp (getkword (strcat "\nSELECTIONNER LE TYPE D'ACTION DESIRE ( 1 2 3 4 5 6 7 ... ) <" typeactioncnp "> : " ) ) ) (if tmp (setq typeactioncnp tmp) ) (setcfg "APPDATA/typeactioncnp" typeactioncnp) (if (= typeactioncnp "1") (progn (c:cnpfin)) ) (if (= typeactioncnp "2") (progn (c:cnpdebut)) ) (if (= typeactioncnp "3") (progn (c:cnpdepuisysurx)) ) (if (= typeactioncnp "4") (progn (c:cnpsoutrairxcaractdefin)) ) (if (= typeactioncnp "5") (progn (c:cnpsoutrairxcaractdepuisdebut)) ) (if (= typeactioncnp "6") (progn (c:cnpincrementer3DEBUT)) ) (if (= typeactioncnp "7") (progn (c:cnpincrementer4a2fin)) ) (if (= typeactioncnp "8") (progn (c:cnpincrementer6a2fin)) ) (if (= typeactioncnp "9") (progn (c:cnpremplacecaract)) ) (if (= typeactioncnp "10") (progn (c:cnpTRIER4a2fin)) ) (if (= typeactioncnp "11") (progn (c:cnpTRIER4axet4a2finA)) ) (if (= typeactioncnp "12") (progn (c:cnpTRIER4axet4a2finB)) ) (if (= typeactioncnp "13") (progn (c:cnpTRIER4axet4a2finC)) ) (princ) ) (defun c:cnpfin () (setq cnpcdefin (getcfg "APPDATA/CNPCDEFIN")) (setq com1 (getstring t (strcat "\nVEUILLEZ ENTRER LE(S) CARACTERE(S) EN REMPLACEMENT DU DERNIER CARACTERE DU NOM <" cnpcdefin "> : " ) ) ) (if (/= com1 "") (setq cnpcdefin com1) ) (setcfg "APPDATA/CNPCDEFIN" cnpcdefin) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (setq nouveaunom (strcat (substr layout 1 (- (strlen layout) 1)) cnpcdefin ) ) (command "_.layout" "_ren" layout nouveaunom) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpdebut () (setq cnpcdedebut (getcfg "APPDATA/CNPCDEDEBUT")) (setq com1 (getstring t (strcat "\nVEUILLEZ ENTRER LE(S) CARACTERE(S) EN REMPLACEMENT DU PREMIER CARACTERE DU NOM <" cnpcdedebut "> : " ) ) ) (if (/= com1 "") (setq cnpcdedebut com1) ) (setcfg "APPDATA/CNPCDEDEBUT" cnpcdedebut) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (setq nouveaunom (strcat cnpcdedebut (substr layout 2))) (command "_.layout" "_ren" layout nouveaunom) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpdepuisysurx () (setq cnpcdepuisysurx (getcfg "APPDATA/CNPCDEPUISYSURX")) (prompt "\nREMPLACER A PARTIR DE Y CARACTERES DEPUIS LE DEBUT SUR LE(S) X CARACTERE(S) [SI X=0 CORRESPOND A INSERER]" ) (setq com1 (getstring t (strcat "\nVEUILLEZ ENTRER LE(S) CARACTERE(S) EN REMPLACEMENT DES CARACTERES DU NOM <" cnpcdepuisysurx "> : " ) ) ) (if (/= com1 "") (setq cnpcdepuisysurx com1) ) (setcfg "APPDATA/CNPCDEPUISYSURX" cnpcdepuisysurx) (setq cnpcdepuisdebut (atoi (getcfg "APPDATA/CNPCDEPUISDEBUT"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LE DEBUT DU REMPLACEMENT DEPUIS LE DEBUT DU NOM [ MINIMUM : 1]<" (rtos cnpcdepuisdebut 2 0) ">: " ) ) ) (if tmp (setq cnpcdepuisdebut tmp) ) (setcfg "APPDATA/CNPCDEPUISDEBUT" (rtos cnpcdepuisdebut 2 0) ) (setq cnpcsurx (atoi (getcfg "APPDATA/CNPCSURX"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LA PLAGE DU REMPLACEMENT DU NOM <" (rtos cnpcsurx 2 0) ">: " ) ) ) (if tmp (setq cnpcsurx tmp) ) (setcfg "APPDATA/CNPCSURX" (rtos cnpcsurx 2 0)) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (setq nouveaunom (strcat (substr layout 1 (- cnpcdepuisdebut 1)) cnpcdepuisysurx (substr layout (+ cnpcdepuisdebut cnpcsurx)) ) ) (command "_.layout" "_ren" layout nouveaunom) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpsoutrairxcaractdefin () (setq cnpsoustraicaractalafin (atoi (getcfg "APPDATA/CNPSOUSTRAICARACTALAFIN") ) ) (initget 4) (setq tmp (getint (strcat "\nENTRER LE NOMBRE DE CARACTERES A SUPPRIMER A LA FIN DU NOM <" (rtos cnpsoustraicaractalafin 2 0) ">: " ) ) ) (if tmp (setq cnpsoustraicaractalafin tmp) ) (setcfg "APPDATA/CNPSOUSTRAICARACTALAFIN" (rtos cnpsoustraicaractalafin 2 0) ) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (setq nouveaunom (strcat (substr layout 1 (- (strlen layout) cnpsoustraicaractalafin) ) ) ) (command "_.layout" "_ren" layout nouveaunom) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpsoutrairxcaractdepuisdebut () (setq cnpsoustraicaractdepuisdebut (atoi (getcfg "APPDATA/CNPSOUSTRAICARACTDEPUISDEBUT" ) ) ) (initget 4) (setq tmp (getint (strcat "\nENTRER LE NOMBRE DE CARACTERES A SUPPRIMER DEPUIS LE DEBUT DU NOM <" (rtos cnpsoustraicaractdepuisdebut 2 0) ">: " ) ) ) (if tmp (setq cnpsoustraicaractdepuisdebut tmp) ) (setcfg "APPDATA/CNPSOUSTRAICARACTDEPUISDEBUT" (rtos cnpsoustraicaractdepuisdebut 2 0) ) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (setq nouveaunom (strcat (substr layout (+ cnpsoustraicaractdepuisdebut 1)) ) ) (command "_.layout" "_ren" layout nouveaunom) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpincrementer3debut () (setq cnpnbdpincrement (atoi (getcfg "APPDATA/CNPNBDPINCREMENT"))) (initget 4) (setq tmp (getint (strcat "\nENTRER LE NOMBRE DE DEBUT D'INCREMENTATION DU NOM <" (rtos cnpnbdpincrement 2 0) ">: " ) ) ) (if tmp (setq cnpnbdpincrement tmp) ) (setcfg "APPDATA/CNPNBDPINCREMENT" (rtos cnpnbdpincrement 2 0) ) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (setq nouveaunom (strcat (rtos cnpnbdpincrement 2 0) " " layout)) (command "_.layout" "_ren" layout nouveaunom) (setq cnpnbdpincrement (1+ cnpnbdpincrement)) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpincrementer4a2fin () (setq cnpnbdpincrement (atoi (getcfg "APPDATA/CNPNBDPINCREMENT"))) (initget 4) (setq tmp (getint (strcat "\nENTRER LE NOMBRE DE DEBUT D'INCREMENTATION DU NOM <" (rtos cnpnbdpincrement 2 0) ">: " ) ) ) (if tmp (setq cnpnbdpincrement tmp) ) (setcfg "APPDATA/CNPNBDPINCREMENT" (rtos cnpnbdpincrement 2 0) ) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (if (= (strlen (rtos cnpnbdpincrement 2 0)) 1) (setq nombre (strcat "00" (rtos cnpnbdpincrement 2 0))) ) (if (= (strlen (rtos cnpnbdpincrement 2 0)) 2) (setq nombre (strcat "0" (rtos cnpnbdpincrement 2 0))) ) (if (= (strlen (rtos cnpnbdpincrement 2 0)) 3) (setq nombre (strcat (rtos cnpnbdpincrement 2 0))) ) (setq nouveaunom (strcat (substr layout 1 (- (strlen layout) 4)) nombre (substr layout (strlen layout)) ) ) (command "_.layout" "_ren" layout nouveaunom) (setq cnpnbdpincrement (1+ cnpnbdpincrement)) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpincrementer6a2fin () (setq cnpnbdpincrement (atoi (getcfg "APPDATA/CNPNBDPINCREMENT"))) (initget 4) (setq tmp (getint (strcat "\nENTRER LE NOMBRE DE DEBUT D'INCREMENTATION DU NOM <" (rtos cnpnbdpincrement 2 0) ">: " ) ) ) (if tmp (setq cnpnbdpincrement tmp) ) (setcfg "APPDATA/CNPNBDPINCREMENT" (rtos cnpnbdpincrement 2 0) ) (setq layouts (getlayouts nil t)) (foreach layout layouts (progn (if (= (strlen (rtos cnpnbdpincrement 2 0)) 1) (setq nombre (strcat "0000" (rtos cnpnbdpincrement 2 0))) ) (if (= (strlen (rtos cnpnbdpincrement 2 0)) 2) (setq nombre (strcat "000" (rtos cnpnbdpincrement 2 0))) ) (if (= (strlen (rtos cnpnbdpincrement 2 0)) 3) (setq nombre (strcat "00" (rtos cnpnbdpincrement 2 0))) ) (if (= (strlen (rtos cnpnbdpincrement 2 0)) 4) (setq nombre (strcat "0" (rtos cnpnbdpincrement 2 0))) ) (if (= (strlen (rtos cnpnbdpincrement 2 0)) 5) (setq nombre (strcat (rtos cnpnbdpincrement 2 0))) ) (setq nouveaunom (strcat (substr layout 1 (- (strlen layout) 6)) nombre (substr layout (strlen layout)) ) ) (command "_.layout" "_ren" layout nouveaunom) (setq cnpnbdpincrement (1+ cnpnbdpincrement)) (princ) ) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnptrier4a2fin (/ acdoc leslayouts layouts ;;; i layout ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq leslayouts (vla-get-layouts acdoc)) (setq layouts (getlayouts nil t) layoutsold layouts ) (setq layouts (vl-sort layouts '(lambda (a b) (< (atoi (substr a (- (strlen a) 3) 3)) (atoi (substr b (- (strlen b) 3) 3)) ) ) ) ) (setq i (vla-get-taborder (vla-item leslayouts (nth 0 layouts)))) (foreach name layouts (setq layout (vla-item leslayouts name)) (vla-put-taborder layout i) (setq i (1+ i)) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnpTRIER4axet4a2finA ( / acdoc leslayouts layouts i layout ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq leslayouts (vla-get-layouts acdoc)) (setq layouts (getlayouts nil t) layoutsold layouts ) (setq layouts (vl-sort layouts '(lambda (a b) (< (atoi (substr a (- (strlen a) 3) 3)) (atoi (substr b (- (strlen b) 3) 3)))) ) ) (setq i (vla-get-taborder (vla-item leslayouts (nth 0 layouts)))) (foreach name layouts (setq layout (vla-item leslayouts name)) (vla-put-taborder layout i) (setq i (1+ i)) ) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) ) (defun c:cnptrier4axet4a2finb (/ acdoc layouts layout layoutsname name) (setq cnpcdepuisdebut1 (atoi (getcfg "APPDATA/CNPCDEPUISDEBUT1"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LE DEPART DE LA PLAGE DE TRIE DEPUIS LE DEBUT DU NOM [ MINIMUM : 1]<" (rtos cnpcdepuisdebut1 2 0) ">: " ) ) ) (if tmp (setq cnpcdepuisdebut1 tmp) ) (setcfg "APPDATA/CNPCDEPUISDEBUT1" (rtos cnpcdepuisdebut1 2 0) ) (setq cnpcsurx1 (atoi (getcfg "APPDATA/CNPCSURX1"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LA PLAGE DE TRIE PRIMAIRE DU NOM <" (rtos cnpcsurx1 2 0) ">: " ) ) ) (if tmp (setq cnpcsurx1 tmp) ) (setcfg "APPDATA/CNPCSURX1" (rtos cnpcsurx1 2 0)) (decomptedebut) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq layouts (vla-get-layouts acdoc)) ;; récupérer la liste des noms de présentations (vlax-for layout layouts (setq layoutsname (cons (vla-get-name layout) layoutsname)) ) ;; supprimer la présentation "Model" de cette liste (setq layoutsname (vl-remove "Model" layoutsname)) ;; nombre de presentations (setq nblayouts (length layoutsname) listelayoutsdecomp nil listelayoutrecomp nil ) ;;décomposer le nom de la présentation en 5 morceaux et en faire une liste (foreach name layoutsname (setq nbc (strlen name)) (setq listelayoutsdecomp (cons (list (substr name 1 (- cnpcdepuisdebut1 1)) (substr name cnpcdepuisdebut1 cnpcsurx1) (substr name (+ cnpcdepuisdebut1 cnpcsurx1) (- nbc 3 (+ cnpcdepuisdebut1 cnpcsurx1)) ) (substr name (- nbc 3) 3) (substr name nbc) ) listelayoutsdecomp ) ) ) ;; trier la liste sur 2 et 4 morceaux (setq listelayoutsdecomp1 (vl-sort listelayoutsdecomp '(lambda (a b) (if (eq (cadr a) (cadr b)) (< (cadddr a) (cadddr b)) (< (cadr a) (cadr b)) ) ) ) ) ;;reconstituer le noms des présentations et la lister (foreach decomp listelayoutsdecomp1 (setq listelayoutrecomp (cons (strcat (nth 0 decomp) (nth 1 decomp) (nth 2 decomp) (nth 3 decomp) (nth 4 decomp) ) listelayoutrecomp ) ) ) ;inverser la liste (setq listelayoutrecomp (reverse listelayoutrecomp)) ;; attribuer l'ordre à chaque présentation (setq i 1) ;; l'ordre 0 est réservé à la présentation "Model" (acet-ui-progress-init "AVANCEMENT" nblayouts) (foreach name listelayoutrecomp (setq layout (vla-item layouts name)) (vla-put-taborder layout i) (princ (strcat "\n" (itoa i) " SUR " (itoa nblayouts) " : " name) ) (acet-ui-progress-init (strcat "AVANCEMENT " (rtos (/ (* i 100) (float nblayouts)) 2 2) " %" ) nblayouts ) (acet-ui-progress-safe I) (setq i (1+ i)) ) (decomptefin) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) (princ) ) ;;;(vl-sort lst ;;; '(lambda (s1 s2 / x1 x2) ;;; (if (= (setq x1 (substr s1 5 13)) ;;; (setq x2 (substr s2 5 13)) ;;; ) ;;; (< (substr s1 (- (strlen s1) 5)) ;;; (substr s2 (- (strlen s2) 5)) ;;; ) ;;; (< x1 x2) ;;; ) ;;; ) ;;;) (defun c:cnptrier4axet4a2finC (/ acdoc layouts layout layoutsname name) (setq cnpcdepuisdebut1 (atoi (getcfg "APPDATA/CNPCDEPUISDEBUT1"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LE DEPART DE LA PLAGE DE TRIE DEPUIS LE DEBUT DU NOM [ MINIMUM : 1]<" (rtos cnpcdepuisdebut1 2 0) ">: " ) ) ) (if tmp (setq cnpcdepuisdebut1 tmp) ) (setcfg "APPDATA/CNPCDEPUISDEBUT1" (rtos cnpcdepuisdebut1 2 0) ) (setq cnpcsurx1 (atoi (getcfg "APPDATA/CNPCSURX1"))) (initget 4) (setq tmp (getint (strcat "\nENTRER UN NOMBRE POUR DEFINIR LA PLAGE DE TRIE PRIMAIRE DU NOM <" (rtos cnpcsurx1 2 0) ">: " ) ) ) (if tmp (setq cnpcsurx1 tmp) ) (setcfg "APPDATA/CNPCSURX1" (rtos cnpcsurx1 2 0)) (decomptedebut) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (setq layouts (vla-get-layouts acdoc)) ;; récupérer la liste des noms de présentations (vlax-for layout layouts (setq layoutsname (cons (vla-get-name layout) layoutsname)) ) ;; supprimer la présentation "Model" de cette liste (setq layoutsname (vl-remove "Model" layoutsname)) ;; nombre de presentations (setq nblayouts (length layoutsname) ;;; listelayoutsdecomp nil ;;; listelayoutrecomp nil ) ;;décomposer le nom de la présentation en 5 morceaux et en faire une liste ;;; (foreach name layoutsname ;;; (setq nbc (strlen name)) ;;; (setq listelayoutsdecomp (cons (list (substr name 1 (- cnpcdepuisdebut1 1)) ;;; (substr name cnpcdepuisdebut1 cnpcsurx1) ;;; (substr name (+ cnpcdepuisdebut1 cnpcsurx1) (- nbc 3 (+ cnpcdepuisdebut1 cnpcsurx1))) ;;; (substr name (- (strlen name) 3) 3) ;;; (substr name nbc) ;;; ) ;;; listelayoutsdecomp ;;; ) ;;; ) ;;; ) ;; trier la liste sur 2 et 4 morceaux (setq layoutsname (vl-sort layoutsname '(lambda (s1 s2 / x1 x2) (if (= (setq x1 (substr s1 cnpcdepuisdebut1 cnpcsurx1) ) (setq x2 (substr s2 cnpcdepuisdebut1 cnpcsurx1) ) ) (< (substr s1 (- (strlen s1) 3) 3) (substr s2 (- (strlen s2) 3) 3) ) (< x1 x2) ) ) ) ) ;;reconstituer le noms des présentations et la lister ;;; (foreach decomp listelayoutsdecomp1 ;;; (setq listelayoutrecomp (cons (strcat (nth 0 decomp) (nth 1 decomp) (nth 2 decomp) (nth 3 decomp) (nth 4 decomp)) ;;; listelayoutrecomp ;;; ) ;;; ) ;;; ) ;inverser la liste ;;; (setq layoutsname (reverse layoutsname)) ;; attribuer l'ordre à chaque présentation (setq i 1) ;; l'ordre 0 est réservé à la présentation "Model" (acet-ui-progress-init "AVANCEMENT" nblayouts) (foreach name layoutsname (setq layout (vla-item layouts name)) (vla-put-taborder layout i) (princ (strcat "\n" (itoa i) " SUR " (itoa nblayouts) " : " name) ) (acet-ui-progress-init (strcat "AVANCEMENT " (rtos (/ (* i 100) (float nblayouts)) 2 2) " %" ) nblayouts ) (acet-ui-progress-safe I) (setq i (1+ i)) ) (decomptefin) (getlayouts "POUR VERIFICATION DES NOMS DE PRESENTATION" t) (princ) ) (defun decomptedebut () (setq datede (rtos (getvar "cdate") 2 8)) ; année (setq anneede (substr datede 1 4)) ; mois (setq moisde (substr datede 5 2)) ; jour (setq jourde (substr datede 7 2)) ; heure (setq heurede (substr datede 10 2)) ; minute (setq minutede (substr datede 12 2)) ; seconde (setq secondede (substr datede 14 2)) ; concatenation de la date ;;; (setq seconde10de (substr datede 16 2)) ; concatenation de la date (setq totaldesondede (+ (atoi secondede) (* (atoi minutede) 60) (* (atoi heurede) 3600))) ; vous pouvez modifier ici le suffixe "le" et les séparateurs "/" ; exemple : ; (setq n-date (strcat "agence toto le : "jour"-"mois"-"annee)) (setq n-datede (strcat "\nDEBUT le : " jourde "/" moisde "/" anneede " à " heurede ":" minutede ":" secondede)) (princ) ) (defun decomptefin () (setq datefin (rtos (getvar "cdate") 2 8)) ; année (setq anneefin (substr datefin 1 4)) ; mois (setq moisfin (substr datefin 5 2)) ; jour (setq jourfin (substr datefin 7 2)) ; heure (setq heurefin (substr datefin 10 2)) ; minute (setq minutefin (substr datefin 12 2)) ; seconde (setq secondefin (substr datefin 14 2)) ; concatenation de la date ;;; (setq seconde10fin (substr datefin 16 2)) ; concatenation de la date (setq totaldesondefin (+ (atoi secondefin) (* (atoi minutefin) 60) (* (atoi heurefin) 3600))) (setq totalsecondetravail (- totaldesondefin totaldesondede)) ; vous pouvez modifier ici le suffixe "le" et les séparateurs "/" (setq n-datefin (strcat "\nFIN le : " jourfin "/" moisfin "/" anneefin " à " heurefin ":" minutefin ":" secondefin) ) (setq heuret (fix (/ totalsecondetravail 3600))) ;heure (setq minutet (fix (/ (- totalsecondetravail (* heuret 3600)) 60))) ; minute (setq secondet (- totalsecondetravail (* heuret 3600) (* minutet 60))) ; concatenation de la date (setq n-datetravail (strcat "\nSOIT " (rtos heuret 2 0) ":" (rtos minutet 2 0) ":" (rtos secondet 2 0) " DE TRAVAIL" ) ) (prompt n-datede) (prompt n-datefin) (prompt n-datetravail) (princ) ) ;; GETLAYOUTS (gile) 03/12/07 ;; Retourne la liste des présentations choisies dans la boite de dialogue ;; ;; arguments ;; titre : titre de la boite de dialogue ou nil, défauts = Choisir la (ou les) présentation(s) ;; mult : T ou nil (pour choix multiple ou unique) (defun getlayouts (titre mult / lay tmp file ret) (setq lay (vl-sort (layoutlist) (function (lambda (x1 x2) (< (taborder x1) (taborder x2))))) tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "GetLayouts:dialog{label=" (if titre (vl-prin1-to-string titre) (if mult "\"Choisir les présentations du fichier\"" "\"Choisir une présentation\"" ) ) ";:list_box{height = 100;key=\"lst\";multiple_select=" (if mult "true;width = 150;}:row{:retirement_button{label=\"Toutes\";key=\"all\";} ok_button;cancel_button;}}" "false;}ok_cancel;}" ) ) file ) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "GetLayouts" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list lay) (end_list) (action_tile "all" "(setq ret (reverse lay)) (done_dialog)") (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (foreach n (str2lst (get_tile \"lst\") \" \") (setq ret (cons (nth (atoi n) lay) ret)))) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) (reverse ret) ) a+ Phil

hello Luna je suis seul utilisateur d'autocad un fichier lisp regroupant moult fonctions/ commandes ( defun c:.... ) ayant un rapport entre eux, dans un fichier *.lsp bien nommé pour que je m'y retrouve dans les 3300 commandes c'est moins le bordel, je te l'accord. ba justement en connaissant ce fichier qui regroupe la liste des lisp a charger, on ne devrait en fait que charger celui ci au final, et l'implanter sur chaque ordi. c'était pas le role de AutoCAD.lsp d'ailleurs ? a+ Phil

bonjour savez vous ou est le fichier regroupant la liste des fichiers *.lsp *.fas *.vlx ... qui peuvent etre chargés a l'ouverture d'autocad. cette liste de fichiers que l'on retrouve par ordre alphabétique dans la fenetre "applications lancées au démarrage" en cliquant sur "contenu" dans la fenetre "charger/décharger les applications" si cette liste apparait en ordre alphabétique elle n'est pas chargé dans autocad dans cette ordre, mais plutot chargée par ordre d'ajout des fichiers *.lsp *.fas dans cette dite liste "applications lancées au démarrage" je le vois car en début et fin de mes lisp j'ai fait un "prompt" pour vérifier si le lisp ce charge bien, et ceci n'est pas dans l'ordre alphabétique CHANGER HAUTEUR TEXTE.FAS : DEBUT CHANGER HAUTEUR TEXTE.FAS : CHARGER ROTATION.FAS : DEBUT ROTATION.FAS : CHARGE ALIGNE.FAS : DEBUT ALIGNE.FAS : CHARGE ECHELLE BLOC.FAS : DEBUT ECHELLE BLOC.FAS : CHARGE FAUX PLAFOND.FAS : DEBUT FAUX PLAFOND.FAS : CHARGE "type d'argument incorrect: stringp nil" *Annuler* mon problème c'est que un lisp semble ne pas se charger et empêche les suivants de se charger donc en ouvrant ce fichier regroupant la liste des fichiers chargés je pourrais facilement trouvé le coupable sans devoir rajouter un par un les 156 fichiers *.lsp . merci a+ Phil

HELLO je suis novice en ferraillage ca m'aurait intéressé de bosser sur autocad en 2D ou 3D la dessus. Mais mon client travaille avec REVIT, donc je vais m'adapter. mais je vais suivre aussi les réponses. a+ Phil

bonjour quel logiciel de chez autodesk utilisez vous pour faire vos plans de ferrailage ? pour le beton autocad ca va, mais pour aller vite avec les armatures ca ce complique. il y a la possibilité d'utilisé des blocs paramétriques aussi, mais il faut tous les construire ( ce qui est possible remarque ). merci A+ Phil

HELLO trois petit lisp coc : remet le texte de cote au centre cog : met le texte de cote a gauche intérieur de la cote ( depend de la création de cote de gauche a droite ou de droite a gauche ) cod : met le texte de cote a droite intérieur de la cote ( depend de la création de cote de gauche a droite ou de droite a gauche ) a+ Phil (defun c:coc () (setvar "cmdecho" 0) (setvar "PICKSTYLE" 0) (setq osm (getvar "osmode")) (prompt "\nCLIQUER SUR LES OBJETS COTES A MODIFIER, TEXTE AU CENTRE:") (setq entites nil) (while (null entites) (setq entites (ssget '((0 . "DIMENSION"))))) (setvar "osmode" 0) (setq compt 0) (setq com (sslength entites)) (while (< compt com) (progn (setq obj (ssname entites compt)) (command-s "_dimtedit" obj "c") (setq compt (1+ compt))) (setvar "osmode" osm) (princ) ) ) (defun c:cod () (setvar "cmdecho" 0) (setvar "PICKSTYLE" 0) (setq osm (getvar "osmode")) (prompt "\nCLIQUER SUR LES OBJETS COTES A MODIFIER, TEXTE INTERIEUR DROIT :") (setq entites nil) (while (null entites) (setq entites (ssget '((0 . "DIMENSION"))))) (setvar "osmode" 0) (setq compt 0) (setq com (sslength entites)) (while (< compt com) (progn (setq obj (ssname entites compt)) (command-s "_dimtedit" obj "d") (setq compt (1+ compt))) (setvar "osmode" osm) (princ) ) ) (defun c:cog () (setvar "cmdecho" 0) (setvar "PICKSTYLE" 0) (setq osm (getvar "osmode")) (prompt "\nCLIQUER SUR LES OBJETS COTES A MODIFIER, TEXTE INTERIEUR GAUCHE :") (setq entites nil) (while (null entites) (setq entites (ssget '((0 . "DIMENSION"))))) (setvar "osmode" 0) (setq compt 0) (setq com (sslength entites)) (while (< compt com) (progn (setq obj (ssname entites compt)) (command-s "_dimtedit" obj "g") (setq compt (1+ compt))) (setvar "osmode" osm) (princ) ) )

hello LUNA ce que tu decris, est exactement ce que je fais depuis des lustres. je voudrais juste automatiser ca, en cliquant chaque mails, clic droit qui ouvrirait le tit menu, sélection du programme qui prendrait la fin de l'adresse de ce mail, pour le mettre dans la liste de la regle et gagner pas mal d'étapes. merci Phil

hello aux programmeurs je suis sous outlooks pour recevoir mes mails. et j'en recois des tonnes qui sont de la pub ou autres depuis longtemps j'ai créer une regle ayant pour liste la fin des adresses mails, qui me les déplace dans un dossier que je vide de temps en temps, il y a souvent des mails de n'importe quoi qui arrive d'une meme adresse type "*****anichoice@menustreetanalys.fr" donc j'écris a la mano dans la liste de la regle "menustreetanalys", c'est long car je dois cliquer chaque mail, ouvrir la regle, ouvrir la liste, écrire le truc, fermer la liste, fermer la regle et recommencer. vous n'auriez pas un programme en BASIC a rajouter au menu ( clic droit sur le mail) qui chercherai la fin du nom de l'adresse ( apres l @ : "nenustreetanalys" , avant le "fr" ) et qui le mettrai directement dans la liste des nom d'une regle prédéfinie. histoire de gagner un peu de temps, et eviter les faute de frappe merci Phil

hello Bruno je vais creuser ca ca permet que le lisp de Gile fonctionne avec deux entrées a traiter, donc de faire des paires pointés, qui irait plus vite a traiter merci Phil

HELLO merci Gile le truc c'est que je vais surement avoir d'autre parametres qui vont rentrer en jeux, pour le moment je teste avec des barres qui on toutes le meme diametres, ou la meme couleur, mais quand je vais rajouter un paramètre que va donner la liste ? je ne pourrais pas faire de paire pointé car j'aurais ca comme liste ( handle longueur couleur ) ou ( handle longueur diametre ) il faudrait plutot que je construise ma liste comme ceci ( couleur longueur handle ) ou ( diametre longueur handle ) et avec ca je pense que ca ne marche plus, car ca ne tiens pas compte des differentes couleurs, merci Phil (defun c:testlongbarre () (setq listebarre '(("a" 120.0 "a") ("a" 156.8 "b") ("a" 120.0 "c") ("a" 148.5 "d" ) ("a" 147.8 "e") ("a" 120.0 "f") ("a" 120.0 "g" ) ("a" 47.9 "h") ("b" 50.5 "i" ) ("b" 256.7 "j") ("b" 233.5 "k") ("b" 120.0 "l") ("b" 159.7 "m") ("b" 256.7 "n") ("a" 233.5 "o") ("c" 120.0 "p") ("c" 148.5 "q") ("c" 156.8 "r") ("c" 147.8 "s") ("c" 47.9 "t") ("c" 159.7 "u" ) ("c" 120.0 "v") ("c" 120.0 "x") ("a" 148.5 "y") ("a" 156.8 "z") ("a" 147.8 "aa") ("a" 50.5 "ab") ("c" 148.5 "ac") ("b" 156.8 "ad") ("d" 147.8 "ae") ("d" 50.5 "af") ("d" 47.9 "ag") ("d" 50.5 "ah") ("d" 47.9 "ai") ) lgbarre 500.0 ) (setq resultat (miseenbarre listebarre lgbarre)) (setq chute (mapcar '(lambda (l) (- lgBarre (apply '+ (mapcar 'cadr l)))) resultat)) )

hello Gile Merci j'ai testé ton bout de lisp j'ai ca comme données d'entrées pour tester, les "a" "b" "c" seront dans le future les handles des blocs avec attribut que je voudrais filtrer (defun c:testlongbarre () (setq listebarre '(("a" 120.0) ("d" 156.8) ("b" 120.0) ("c" 148.5) ("e" 147.8) ("f" 120.0) ("g" 120.0) ("n" 47.9) ("o" 50.5) ("r" 256.7) ("s" 233.5) ("t" 120.0) ("af" 159.7) ("ag" 256.7) ("ah" 233.5) ("u" 120.0) ("v" 148.5) ("w" 156.8) ("x" 147.8) ("p" 47.9) ("q" 159.7) ("y" 120.0) ("z" 120.0) ("aa" 148.5) ("ab" 156.8) ("ac" 147.8) ("ad" 50.5) ("h" 148.5) ("i" 156.8) ("j" 147.8) ("k" 50.5) ("l" 47.9) ("m" 50.5) ("ae" 47.9) ) lgbarre 500.0 ) (miseenbarre1 listebarre lgbarre) ) une fois que j'aurais "resultat" je pourrais attribuer des numéros a chaque barre ( regroupement de liste formé par ton lisp ) puis grace aux handles aller modifier un attribut dans chaque bloc correspondant au numéro de barre. donc j'ai modifie ton bout de lisp comme ceci en pensant que comme j'ai une liste de liste a deux entrées, je devais donc prendre la seconde entrée pour les calculs de debit, mais ca ne marche pas (defun miseenbarre1 (listedebit lgbarre / mettreenbarre) (defun mettreenbarre (listedebit lgrestante barre debitrestant) (setq resultat (cond ((null listedebit) (cons (reverse barre) (if debitrestant (mettreenbarre (reverse debitrestant) lgbarre nil nil) ) ) ) ((<= (cadr (car listedebit)) lgrestante) (mettreenbarre (cadr (cdr listedebit)) (- lgrestante (cadr (car listedebit))) (cons (cadr (car listedebit)) barre) debitrestant ) ) (t (mettreenbarre (cadr (cdr listedebit)) lgrestante barre (cons (cadr (car listedebit)) debitrestant)) ) ) ) ) (mettreenbarre (vl-sort listedebit '(lambda (a b) (if (eq (cadr a) (cadr b)) (< (car a) (car b)) (< (cadr a) (cadr b)) ) ) ) lgbarre nil nil ) ) merci Phil

bonjour avez vous un algorithme sous LISp pour optimiser des barres. soit une liste de longueurs et handle d'objet et une longueur de barres but du lisp faire des listes regroupant les ( longueur, handle ) en optimisant les barres et minimisant les chutes. merci Phil

hello merci Olivier , merci Gile j'ai pris la méthode 2 de Gile , en corrigeant la faute de frappe (setq n (mapcar '- b a) a (trans a 0 n) c (trans c 0 n) ) (trans (list (car a) (cadr C) (caddr c)) n 0) Phil

bonsoir je n'arrive pas a retrouvé la méthode ( en lisp ou autre ) j'ai 3 points dont je connais les coordonnées A B C. et je cherche en lisp les coordonnées du point D sachant que CD est perpendiculaire a AB merci Phil

hello quelques routines, pour extraire sans ou avec destruction des entites dans l'XREF ou bloc, pour incorporer avec ou sans destruction d'entité dans l'Xref ou bloc les Xref ne doivent pas etre ouvert dans autocad pour extraire d'un Xref, le plus simple et de ne faire apparaitre que la couche a extraire. et pour la routine "c:extraire_entite_xref_bloc_copie_CALQUE" il suffit d'etre déja dans le calque ou l'on veut que la copie soit faite SANS DESTRUCTION DES ENTITES c:extraire_entite_xref_bloc_copie c:extraire_entite_xref_bloc_copie_CALQUE c:INCORPORER_entite_xref_bloc_copie AVEC DESTRUCTION DES ENTITES c:extraire_entite_xref_bloc_efface c:INCORPORER_entite_xref_bloc_efface a+ Phil ;;;------------------------------------------ ;;;EXTRAIRE DES ENTITEES D'UN BLOC OU XREF ;;;------------------------------------------ (defun c:extraire_entite_xref_bloc_copie () (setq osm (getvar "osmode")) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'EXTRACTION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (prompt "\nCLIQUER SUR LES OBJETS A EXTRAIRE :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "ALIGNER3D" obj "" "c" "0,0,0" "100000,0,0" "" "0,0,0" "100000,0,0" "q") (command-s "_refset" "S" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:extraire_entite_xref_bloc_copie_CALQUE () (setq osm (getvar "osmode")) (setq cav (getvar "clayer")) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'EXTRACTION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (prompt "\nCLIQUER SUR LES OBJETS A EXTRAIRE :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "ALIGNER3D" obj "" "c" "0,0,0" "100000,0,0" "" "0,0,0" "100000,0,0" "q") (command "_laymch" obj "" "N" cav) (command-s "_refset" "S" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:INCORPORER_entite_xref_bloc_copie () (setq osm (getvar "osmode")) (prompt "\nCLIQUER SUR LES OBJETS A INCORPORER :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "ALIGNER3D" obj "" "c" "0,0,0" "100000,0,0" "" "0,0,0" "100000,0,0" "q") (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'INCORPORATION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (command-s "_refset" "A" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:extraire_entite_xref_bloc_efface () (setq osm (getvar "osmode")) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'EXTRACTION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (prompt "\nCLIQUER SUR LES OBJETS A EXTRAIRE :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (command-s "_refset" "S" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) ) (defun c:INCORPORER_entite_xref_bloc_efface () (setq osm (getvar "osmode")) (prompt "\nCLIQUER SUR LES OBJETS A INCORPORER :") (setq obj nil) (while (null obj) (setq obj (ssget))) (setvar "osmode" 0) (prompt "\nVEUILLEZ SELECTIONNER UN XREF OU BLOC POUR L'INCORPORATION D'ENTITES ") (command-s "-editref" pause "" "OK" "T" "N") (command-s "_refset" "A" obj "") (command-s "_refclose" "e" "d" "0,0,0" "0,0,0" ) (setvar "osmode" osm) )

hello La Lozere une piste peut etre, ca "bave" parce qu'il y a des lignes superposées "pile poil". quand c'est une seule ligne, c'est plus nette, j'ai l'impression, ou la ligne semble moins épaisse après sélection. un moyen de vérifier les superpositions d’entités a+ Phil

bonjour OUPPSSS je viens de comprendre comment ca marche. pour sauvegarder l'etat de calque il faut sélectionner la fenêtre dans la présentation et non pas par rapport a la liste dans la fenêtre GEF. puis sélectionner la liste des fenetres que l'on veut modifier dans la liste de gauche GEF pour la restauration j'ai testé sur GEF 3.22 le fait de sauvegarder l'etat de calque d'une fenetre, puis de restaurer cet etat pour d'autres fenetres, mais ca ne semble pas fonctionner. avez vous utilisé ces fonctions de GEF et si oui, est ce que ca fonctionne chez vous ? en ouvrant le fichier de sauvegarde généré on a bien la liste de tous les calques, mais rien dans la liste indiquant que le calque est gelé ou dégélé Merci Phil