bonuscad

Hier soir, les infos télévisés de Arte, parlaient enfin de la situation des réacteurs percés de Fukishima. Bien qu'assez bref, ils ont le mérite d"en avoir parler. Cela donne bien confirmation des infos délivré par le blog de Kokopelli (merci à eux pour ce travail sérieux) Aujourd'hui (pour ceux qui ne suivent pas le blog), je viens d'apprendre que le surgénérateur de Monju est dans une situation Kafkaïenne: Ce réacteur (fonctionnant lui aussi au Mox) ne peut pas être arrêté. On ne peut pas enlever les barres de combustible car le système de chargement est tombé au fond de la cuve. Impossible de l'ouvrir pour retirer le combustible à cause du refroidissement par le sodium. Il suffit d'un problème sur le système de refroidissement pour perdre le contrôle de ce réacteur. (en aucun cas il ne pourra être refroidi avec de l'eau) Sachant qu'il est construit sur une faille sismique... En résumé c'est une formule1 lancée à fond de ballon, où il faut attendre que le carburant soit épuisé pour en reprendre le contrôle total.(10 ans) En attendant le pilote serre les fesses. Incroyable, mais vrai! Ce lobbying nucléaire va rendre l'avenir ingérable à nos descendants :mad:

Salut, Il y a eu certainement des demandes anciennes proches de la tienne. A un moment j'avais posté ceci Sur mon disque j'ai retrouvé une même version remaniée qui tends plus vers ta demande. Je te la poste pour inspiration, mais réécrire des modifs ou n versions pour Pierre, Paul, Jacques... Un jour il faut se lancer dans l'écriture pour être bien servi. (defun make_blk_measure ( / all_path n id_path fonts file_shx) (if (not (tblsearch "STYLE" "$BLK_MEAS")) (progn (setq all_path (getenv "ACAD") n 0 ) (while (setq end_pos (vl-string-position (ascii ";") all_path)) (setq id_path (substr all_path 1 end_pos)) (if (wcmatch (strcase id_path) "*FONTS*") (setq fonts_path (strcat id_path "\\")) ) (setq all_path (substr all_path (+ 2 end_pos))) ) (setq file_shx (getfiled "Selectionnez un fichier de police" fonts_path "shx" 8 ) ) (if (not file_shx) (setq file_shx "txt.shx") ) (entmake (append '((0 . "STYLE") (5 . "40") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "$BLK_MEAS") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 0.1) (4 . "") ) (list (cons 3 file_shx)) ) ) ) ) (if (not (tblsearch "BLOCK" "BLK_MEASURE_CURVE")) (progn (entmake '((0 . "BLOCK") (8 . "0") (2 . "BLK_MEASURE_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0)) ) (entmake '((0 . "POINT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbPoint") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (50 . 0.0)) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbText") (10 0.05 0.1 0.0) (40 . 0.1) (1 . "0.0") (50 . 1.570796326794896) (41 . 1.0) (51 . 0.0) (7 . "$BLK_MEAS") (71 . 0) (72 . 0) (11 0.0 0.1 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (3 . "measure") (2 . "VALUE_MEASURE") (70 . 0) (73 . 2) (74 . 2) ) ) (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2))) ) ) ) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (defun inc_txt (Txt / Boucle Decalage Val_Txt) (setq Boucle 1 Val_txt "") (while (<= Boucle (strlen Txt)) (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Boucle))) (if (not Decalage) (setq Ascii_Txt (1+ Ascii_Txt)) ) (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123)) (setq Ascii_Txt (cond ((= Ascii_Txt 58) 48) ((= Ascii_Txt 91) 65) ((= Ascii_Txt 123) 97) ) Decalage nil ) (setq Decalage T) ) (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt)) (setq Boucle (1+ Boucle)) ) (if (not Decalage) (setq Val_Txt (strcat (cond ((< Ascii_Txt 58) "0") ((< Ascii_Txt 91) "A") ((< Ascii_Txt 123) "a")) Val_Txt)) ) Val_Txt ) (defun transpts (apt matrix / ) (list (+ (* (car (nth 0 matrix)) (car apt)) (* (car (nth 1 matrix)) (cadr apt)) (* (car (nth 2 matrix)) (caddr apt)) (cadddr (nth 0 matrix)) ) (+ (* (cadr (nth 0 matrix)) (car apt)) (* (cadr (nth 1 matrix)) (cadr apt)) (* (cadr (nth 2 matrix)) (caddr apt)) (cadddr (nth 1 matrix)) ) (+ (* (caddr (nth 0 matrix)) (car apt)) (* (caddr (nth 1 matrix)) (cadr apt)) (* (caddr (nth 2 matrix)) (caddr apt)) (cadddr (nth 2 matrix)) ) ) ) (defun v_matr (dpt alphax alphay alphaz echx echy echz / ) (list (list (* echx (cos alphaz) (cos alphay)) (- (sin alphaz)) (sin alphay) (car dpt) ) (list (sin alphaz) (* echy (cos alphaz) (cos alphax)) (- (sin alphax)) (cadr dpt) ) (list (- (sin alphay)) (sin alphax) (* echz (cos alphax) (cos alphay)) (caddr dpt) ) (list 0.0 0.0 0.0 1.0) ) ) (defun c:blk-att_measure ( / js dxf_obj obj_vlax pt_start pt_end total_dist partial_dist lst_pt flag n_ini increment_dist sv_luprec sv_dzin d_post prfx sffx a ang dxf_210 nb nb_dec inc) (princ "\nSélectionner un objet curviligne à mesurer/diviser: ") (while (not (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons -4 " (cons -4 "&") (cons 70 112) (cons -4 "NOT>") ) ) ) ) (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!") ) (vl-load-com) (setq dxf_obj (entget (ssname js 0)) obj_vlax (vlax-ename->vla-object (ssname js 0)) pt_start (vlax-curve-getStartPoint obj_vlax) pt_end (vlax-curve-getEndPoint obj_vlax) total_dist (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax)) ) (initget "Mesurer Diviser _Measure Divide") (if (eq (getkword (strcat "\n[Mesurer/Diviser] l'objet d'une longueur de " (rtos total_dist) "? : ")) "Divide") (progn (initget 7) (setq partial_dist (getint "\nEntrez le nombre de segments: ") partial_dist (/ total_dist partial_dist) ) ) (progn (initget 7) (setq partial_dist (getdist "\nSpécifiez la longueur du segment: ")) ) ) (cond ((> total_dist partial_dist) (make_blk_measure) (setq lst_pt (list pt_start) increment_dist partial_dist sv_luprec (getvar "LUPREC") sv_dzin (getvar "DIMZIN") ) (setvar "CMDECHO" 1) (setvar "DIMZIN" 3) (setq d_post (getvar "DIMPOST") prfx "" sffx "") (while (and (/= (setq a (substr d_post 1 1)) "") (/= a "<")) (setq prfx (strcat prfx a) d_post (substr d_post 2)) ) (if (/= d_post "") (setq sffx (substr d_post 3))) (command "_.luprec" pause) (while (< increment_dist total_dist) (setq lst_pt (cons (vlax-curve-getPointAtDist obj_vlax increment_dist) lst_pt) increment_dist (+ increment_dist partial_dist) ) ) (setq lst_pt (reverse (cons pt_end lst_pt))) (initget "Mesurée Incrémentée _Measured Incremented") (if (eq (getkword "\nExécuter avec valeur [Mesurée/Incrémentée] ?: ") "Incremented") (progn (setq flag T) (if (not n_next) (setq n_ini (getstring "\nEntrer une valeur (chiffre, lettre ou alphanumérique)pour débuter l'incrémentation: ") n_next n_ini ) (progn (initget "Oui Non _Yes No") (if (eq (getkword "\nRéinitialiser l'incrémentation [Oui/Non] : ") "Yes") (setq n_ini (getstring T "\nEntrer une valeur (chiffre, lettre ou alphanumérique)pour débuter l'incrémentation: ") n_next n_ini ) (setq n_ini n_next) ) ) ) (if (or (eq (type (read n_ini)) 'INT) (eq (type (read n_ini)) 'REAL)) (setq inc (getint "\nValeur d'incrémentation <1>?: ")) ) (if (not inc) (setq inc 1)) ) (setq flag nil) ) (foreach n lst_pt (setq ang (angle (vlax-curve-getFirstDeriv obj_vlax (vlax-curve-getParamAtPoint obj_vlax n)) '(0.0 0.0 0.0)) dxf_210 (z_dir n (polar n ang (* 0.1 partial_dist))) ) (entmake (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (cons 8 (getvar "CLAYER")) (cons 100 "AcDbBlockReference") (cons 66 1) (cons 2 "BLK_MEASURE_CURVE") (cons 10 (trans n 0 dxf_210)) (cons 41 (* 0.1 partial_dist)) (cons 42 (* 0.1 partial_dist)) (cons 43 (* 0.1 partial_dist)) (cons 50 ang) (cons 210 dxf_210) ) ) (entmake (list (cons 0 "ATTRIB") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (cons 8 (getvar "CLAYER")) (cons 100 "AcDbText") (cons 10 (polar (polar (trans n 0 dxf_210) (+ (/ pi 2) ang) (* 0.1 partial_dist)) ang (* 0.05 partial_dist) ) ) (cons 40 (* 0.1 partial_dist)) (cons 1 (if flag (strcat prfx n_next sffx) (strcat prfx (rtos (vlax-curve-getDistAtPoint obj_vlax n)) sffx))) (cons 50 (+ (/ pi 2) ang)) (cons 41 1.0) (cons 51 0.0) (cons 7 "$BLK_MEAS") (cons 71 0) (cons 72 0) (cons 11 (polar (trans n 0 dxf_210) (+ (/ pi 2) ang) (* 0.1 partial_dist))) (cons 210 dxf_210) (cons 100 "AcDbAttribute") (cons 2 "VALUE_MEASURE") (cons 70 0) (cons 73 2) (cons 74 2) ) ) (entmake (list (cons 0 "SEQEND") (cons 8 (getvar "CLAYER")) (cons 62 0) (cons 6 "ByBlock") (cons 370 -2))) (setq diag_box (textbox (setq dxf_ent (entget (entnext (entlast))))) ins_point (cdr (assoc 10 dxf_ent)) ht_txt (/ (cdr (assoc 40 dxf_ent)) 5.0) ang_box (cdr (assoc 50 dxf_ent)) ) (setq lst_box (list (list (- (caar diag_box) ht_txt) (- (cadar diag_box) ht_txt) 0.0) (list (+ (caadr diag_box) ht_txt) (- (cadar diag_box) ht_txt) 0.0) (list (+ (caadr diag_box) ht_txt) (+ (cadadr diag_box) ht_txt) 0.0) (list (- (caar diag_box) ht_txt) (+ (cadadr diag_box) ht_txt) 0.0) ) ) (setq transform (v_matr ins_point 0.0 0.0 (- ang_box) 1.0 1.0 1.0)) (setq lst_box (mapcar '(lambda (x) (transpts x transform)) lst_box)) (setq lst_box (mapcar '(lambda (x) (trans x 0 1)) lst_box)) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (cons 8 (getvar "CLAYER")) (cons 100 "AcDbPolyline") (cons 90 4) (cons 70 1) (cons 43 (/ (getvar "PLINEWID") (* 0.1 partial_dist ))) (cons 38 (caddr (trans n 0 dxf_210))) (cons 39 (getvar "THICKNESS")) (cons 10 (car lst_box)) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 (cadr lst_box)) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 (caddr lst_box)) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 10 (cadddr lst_box)) (cons 40 0.0) (cons 41 0.0) (cons 42 0.0) (cons 210 dxf_210) ) ) (if flag (progn (setq n_ini n_next) (cond ((eq (type (read n_ini)) 'INT) (setq n_next (itoa (+ inc (atoi n_ini)))) ) ((eq (type (read n_ini)) 'REAL) (setq nb 0) (repeat (strlen n_ini) (if (eq (substr n_ini (setq nb (1+ nb)) 1) ".") (setq nb_dec (1- (strlen (substr n_ini nb)))) ) ) (repeat nb_dec (setq inc (/ inc 10))) (setq n_next (rtos (+ inc (atof n_ini)) 2 nb_dec)) ) ((eq (type n_ini) 'STR) (setq n_next (inc_txt n_ini)) ) ) ) ) ) (setvar "LUPREC" sv_luprec) (setvar "DIMZIN" sv_dzin) ) (T (princ "\nLa longueur est trop grande pour l'objet!")) ) (prin1) )

Un autre blog de Science & Avenir qui tente de récupérer et donner des informations.

Bonjour, Comme vous avez certainement pu le constater, plus aucune info de la part de notre presse écrite, radiophonique ou télévisé. L'actualité est sans doute bien bridée par notre gouvernement: On nous impose le didact de l'autruche. Même la Criirad ne donne plus d'infos récentes. (la dernière recommandation de celle-ci était pour les femmes enceinte: ne plus consommer de légumes frais à feuille, et de ne pas utiliser l'eau de pluie de récupération) Il faut s'informer sur des sites complétement indépendants qui se donne la peine d'analyser la presse ou des blogs mondiaux. En France LE BLOG DE L'ASSOCIATION KOKOPELLI s'emploie à cette tache. Les nouvelles ne sont vraiment pas bonnes :( Niveau 7 ne veut plus rien dire, il faudrait créer une nouvelle échelle de 10 pour Fukushima car Tchernobyl à coté c'était du pipi de chat.

Bonjour, C'est peut être tout simplement que pour une polyligne close (cela fonctionne alors correctement), alors que pour une polyligne non fermée mais dont les points de départ et de fin sont superposés (une fermeture forcée en somme), tu peut avoir ce genre de résultat. Essayes avec pedit d'ouvrir la polyligne qui pose problème, si tu ne peux pas le faire, c'est que la fermeture a été forcée.

Hum ! Déjà, si tu veux pouvoir déboguer un programme en lisp il te faut l'INDENTER correctement pour pouvoir le lire/l'interpréter plus facilement, et cela éviterait que quand tu mets en remarque une variable ou une fonction cela est une incidence sur l’appariement des parenthèses. J'ai pas bien compris la démarche de ton code, néanmoins le voici bien présenté et non bogué, par contre je ne sais pas s'il est fonctionnel par rapport à ton souhait obscur. (defun translate (ptins coordinate / ) ; translate from WSC to OCS (mapcar'+ ptins coordinate) ) (defun c:smff( / ins len i j insname ptins center ent n cor allc lcord lins sname1 sname2 sname3 sname4 sname5 distinter1 distinter2 k s q x d5 d7 d10 d11 ddd lc) (setq ins (ssget) len (sslength ins) i 0 j 0 insname(list) ptins (list) ) (while (< i len) (setq insname (append insname (list(ssname ins i))) i (1+ i) ) ) (while (< j len) (setq ptins (append ptins (list(cdr (assoc 10 (entget (nth j insname )))))) j (1+ j) ) ) (setq center (list)) (setq ent(tblobjname "BLOCK" "Ms") n -1 ) (while (< (setq n (1+ n)) len) (setq center nil) (while (setq ent (entnext ent)) (if (eq "CIRCLE" (cdr (assoc 0 (entget ent)))) (progn (setq cor (cdr (assoc 10 (entget ent)))) ;(translate (cor ptins)) (setq center (append center (list cor))) ) ) ) ;(setq cordi(cdr (nth n ptins))) (setq allc (append allc (list center)) ent(tblobjname "BLOCK" "Ms") ) ) ;=============================================================================================================== ;(setq n (1+ n)) (setq lcord (length center) lins (length ptins) sname1 (list) sname2 (list) sname3 (list) sname5 (list) distinter1 (list) distinter2 (list) k -1 ) (while (< (setq k (1+ k)) Lins) (setq s -1 sname2 nil ) (while (< (setq s (1+ s)) Lcord) (setq sname1 (translate (nth k ptins)(nth s center)) sname2 (append sname2 (list sname1)) ) ) (setq sname3 (append sname3 (list sname2))) ) ;(princ sname3) (setq sname4 (list) q 0 Lcor(1- Lcord) ) (while (< q Lcor) (setq sname4 (distance (nth q (car allc)) (nth (setq q (1+ q)) (car allc))) distinter1 (append distinter1 (list sname4)) ) ) (princ distinter1) (setq x 0 d5 500.0 d7 707.107 d10 1000.0 d11 1118.03 ) ;(princ d5) (while (< x lcor) (setq ddd (nth x distinter1)) (cond ((and(/= ddd d5)(/= ddd d7)(/= ddd d10)(/= ddd d11)) ;(if (/= ddd d5) ;(progn (alert "une des bolle n'est pas a sa place") ;(command "cercle" (nth x (car sname3)) "280" 0.8) ???? (command "_.circle" "_none" (nth x (car sname3)) 280.0) (setq x (1+ x)) ;) (setq lc (1+ lcor)) ;) ) (T (setq x (1+ x))) ) ) (princ) ) Je te laisse trouvé ce que j'ai pu ajusté dans ton code, j'ai déjà fais l'effort de le lire. Va pas tout faire... :exclam: [Edité le 12/5/2011 par bonuscad]

J'ai bien peur que de fournir le lisp ne soit pas suffisant pour qu'il fonctionne. Il fait certainement appel à des fonctions contenu dans la bibliothèque des ExpressTools. Donc si ceux-ci ne sont pas installé, retour au point de départ...

Pourtant la réponse n°1 de Dinosor me semble adaptée !?!? Le motif AR-SAND, pour peu que tu le répète avec une échelle différente et une rotation donne bien un aspect aléatoire. Si tu décompose (_.EXPLODE) ce motif, tu obtiens des lignes de longueur nulle. En adaptant rapidement un lisp publié ici, voilà ce que ça pourrait donner. La ligne en rouge est à adapter à tes soins, nom du bloc, échelle d'insertion et rotation. (defun c:del_line_by_dist ( / dis_ref js nb_ent n key ent dxf_ent lst dxf_10 dxf_11 dis_ent) (initget 69) (setq dis_ref (getdist "\nSaisir la distance de référence des lignes à supprimer: ")) (initget "Tout Selection _All Select") (if (eq (getkword "\nAppliquer à [Tout/Selection] : ") "Select") (setq js (ssget '((0 . "LINE,LWPOLYLINE")))) (setq js (ssget "_X" '((0 . "LINE,LWPOLYLINE")))) ) (cond (js (setq nb_ent 0 n -1) (initget "< <= = >= >") (setq key (getkword "\nChoix du test à appliquer '<' '<=' '=' '>=' '>'? défaut '<=': ")) (if (not key) (setq key "<=")) (repeat (sslength js) (setq ent (ssname js (setq n (1+ n))) dxf_ent (entget ent) ) (cond ((eq (cdr (assoc 0 dxf_ent)) "LINE") (setq dxf_10 (cdr (assoc 10 dxf_ent)) dxf_11 (cdr (assoc 11 dxf_ent)) ) ) ((and (eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE") (eq (cdr (assoc 90 dxf_ent)) 2) ) (setq lst (mapcar '(lambda (x) (trans x ent 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) dxf_10 (car lst) dxf_11 (cadr lst) ) ) (T (setq dxf_10 nil dxf_11 nil)) ) (if (and dxf_10 dxf_11) (progn (setq dis_ent (distance (list (car dxf_10) (cadr dxf_10)) (list (car dxf_11) (cadr dxf_11)))) (if ((eval (read key)) dis_ent dis_ref) (progn (entdel ent) [color=red](command "_.insert" "rond" "_none" (trans dxf_10 0 1) 1 1 0.0)[/color] (setq nb_ent (1+ nb_ent)) ) ) ) ) ) (print nb_ent) (princ " Ligne(s) ont été effacées!.") ) (T (princ "\nAucune ligne trouvée!")) ) (prin1) ) Exemple d'exécution du lisp: Commande: DEL_LINE_BY_DIST Saisir la distance de référence des lignes à supprimer: 0 Appliquer à [Tout/Selection] :Validez l'option "Tout" par défaut Choix du test à appliquer '<' '<=' '=' '>=' '>'? défaut '<=': =

Réessayes, j'ai éditer mon message entre temps.

Bonjour, Un départ avec ce type de code ? ((lambda ( / def_lay x_ori pt_ref nw_pt nam_lay js) (setq def_lay (tblnext "LAYER" T) x_ori 440.0 pt_ref '(0.0 0.0 0.0) nw_pt '(0.0 0.0 0.0)) (while def_lay (setq nam_lay (cdr (assoc 2 def_lay)) js (ssget "_X" (list (cons 8 nam_lay) (cons 410 (getvar "CTAB")))) nw_pt (list (+ (car nw_pt) X_ori) 0.0 0.0) ) (cond (js (command "_.move" js "" "_none" (trans pt_ref 0 1) "_none" (trans nw_pt 0 1)))) (setq def_lay (tblnext "LAYER")) ) (prin1) )) [Edité le 10/5/2011 par bonuscad]

Enfin une explication... Ce serait du à l'exploitation du gaz de schiste dixit André Picot (chimiste et toxicologue reconnu) Comme dit dans l'article: Que va répondre Nathalie Kosciusko-Morizet ?

Bonjour, Essayes cette version (vl-load-com) (defun inc_txt (Txt / Boucle Decalage Val_Txt) (setq Boucle 1 Val_txt "" ) (while (<= Boucle (strlen Txt)) (setq Ascii_Txt (vl-string-elt Txt (- (strlen Txt) Boucle))) (if (not Decalage) (setq Ascii_Txt (1+ Ascii_Txt)) ) (if (or (= Ascii_Txt 58) (= Ascii_Txt 91) (= Ascii_Txt 123)) (setq Ascii_Txt (cond ((= Ascii_Txt 58) 48) ((= Ascii_Txt 91) 65) ((= Ascii_Txt 123) 97) ) Decalage nil ) (setq Decalage T) ) (setq Val_Txt (strcat (chr Ascii_Txt) Val_Txt)) (setq Boucle (1+ Boucle)) ) (if (not Decalage) (setq Val_Txt (strcat (cond ((< Ascii_Txt 58) "0") ((< Ascii_Txt 91) "A") ((< Ascii_Txt 123) "a") ) Val_Txt ) ) ) Val_Txt ) (defun c:Surf ( / js obj AcDoc Space nw_style pt htx rtx unit_key unit_draw dxf_cod n ename ll ur nw_obj lremov) (if (eq (getvar "USERS3") "") (setvar "USERS3" "ID000")) (princ "\nSélectionnez un objet curviligne.") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*POLYLINE,ARC,CIRCLE,ELLIPSE,HATCH") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . " '(-4 . "&") '(70 . 120) '(-4 . "NOT>") ) ) ) ) (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Id-Surfaces")) (vlax-put (vla-add (vla-get-layers AcDoc) "Id-Surfaces") 'color 96) ) ) (cond ((null (tblsearch "STYLE" "Romand-Field")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Romand-Field")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list "romand.shx" 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) ) ) (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz"))) (progn (initget "KM ME CM MM") (if (not (setq unit_key (getkword "\nDessin réalisé en [KM/ME/CM/MM] : "))) (setq unit_key "ME") ) (cond ((eq unit_key "KM") (setq unit_draw 1000000) ) ((eq unit_key "ME") (setq unit_draw 1000 unit_key "M") ) ((eq unit_key "CM") (setq unit_draw 10) ) ((eq unit_key "MM") (setq unit_draw 1) ) ) (setvar "USERS5" (strcat "qz" (itoa unit_draw))) ) (progn (setq unit_draw (atoi (substr (getvar "USERS5") 3))) (cond ((eq unit_draw 1000000) (setq unit_key "KM") ) ((eq unit_draw 1000) (setq unit_key "M") ) ((eq unit_draw 10) (setq unit_key "CM") ) ((eq unit_draw 1) (setq unit_key "MM") ) ) ) ) (initget "Unique Multiple _Single Multiple") (if (eq (getkword "\nSélection filtrée [unique/Multiple]: ") "Single") (setq n -1) (setq dxf_cod (entget (ssname js 0)) js (ssget "_X" (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) ) n -1 ) ) (repeat (sslength js) (setq obj (ssname js (setq n (1+ n))) ename (vlax-ename->vla-object obj) ) (vla-GetBoundingBox ename 'll 'ur) (setq ll (safearray-value ll) ur (safearray-value ur) pt (mapcar '* (mapcar '+ ll ur) '(0.5 0.5 0.5)) nw_obj (vla-addMtext Space (vlax-3d-point pt) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr2%ps[" (strcat (setvar "USERS3" (inc_txt (getvar "USERS3"))) "-," (strcase unit_key T)) "²]\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Romand-Field" "Id-Surfaces" rtx) ) ) (prin1) ) puis pour exporter le texte en CSV, ce qui suit (defun c:text_value2csv ( / js dxf_cod mod_sel n lremov file_name cle f_open ename l_pt l_pr nbs) (princ "\nChoix d'un objet modèle pour le filtrage: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*TEXT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nCe n'est pas un objet valable pour cette fonction!") ) (vl-load-com) (setq dxf_cod (entget (ssname js 0))) (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) (initget "Unique Tout Manuel _Single All Manual") (if (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [unique/Tout/Manuel]: ")) "Single") (setq n -1) (if (eq mod_sel "All") (setq js (ssget "_X" dxf_cod) n -1) (setq js (ssget dxf_cod) n -1) ) ) (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "csv") "csv" 37)) (if (null file_name) (exit)) (if (findfile file_name) (progn (prompt "\nFichier éxiste déjà!") (initget "Ajoute Remplace annUler _Add Replace Undo") (setq cle (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] : ") ) (cond ((eq cle "Add") (setq cle "a") ) ((or (eq cle "Replace") (eq cle ())) (setq cle "w") ) (T (exit)) ) (setq f_open (open file_name cle)) ) (setq f_open (open file_name "w")) ) (repeat (sslength js) (setq ename (vlax-ename->vla-object (ssname js (setq n (1+ n)))) l_pt nil) (setq l_pr (list 'TextString) nbs 0) (foreach n l_pr (if (vlax-property-available-p ename n) (setq l_pt (cons (vlax-get ename n) l_pt) ) ) ) (foreach n l_pt (write-line n f_open) ) (write-line "" f_open) ) (close f_open) (prin1) )

Comme le code n'est pas très long, j'édite mon code pour le commenter. Ainsi j'espère que cela t'éclairera les zones obscures et te sera d'une bonne aide pour t'y plonger

Quand je veux obtenir le dessin d'une version supérieure que je ne peux pas lire, j'utilise DWGTrueView disponible gratuitement sur le site d'AutoDesk. Bien que ce soit un visualiseur de fichiers, il permet de convertir les dessins pour des versions antérieures. Il le fait très efficacement, avec une possibilité de traitement par lot et s'occupe aussi des éventuels Xrefs attachés à la manière de eTransmit. C'est un outil à posséder dès que l'on a une version non actuelle.

Dans le code ? lay_ori (cdr (assoc 8 dxf_ent)) : le calque de/des entités sélectionnées éviter le doublon dans le calque d'origine :(not (eq lay_ori nam_lay)) Il m'arrive de prendre des chemins plus tortueux, ça dépends de l'inspiration ;) Moi aussi, à part créer une multiplicité d'objet..... c'est un peu pour ça que j'ai fait une fonction anonyme unique (ça évite de relancer la commande par accident, car bonjour les effacements ultérieurs). Mais peut être veut-il par exemple dupliquer les murs du rez-chaussée sur les étages...) Tout les calques me surprend un peu quand même ! (faudrait rester en début de conception où il y a peu de calques)

Bonjour, Fais un copier-coller en ligne de commande de ce qui suit [color=green];Définition d'une fonction anonyme et temporaire en mémoire. ; Une fonction (defun C:Dupli2AllLayer ( / ....) aurait pu la remplacer[/color] ((lambda ( / js def_lay nam_lay n dxf_ent lay_ori dxf_nent) (princ "\nChoisir les objets à dupliquer sur tout les calques") [color=green];Une boucle (While) qui m'assure qui il aura bien une sélection non vide (not) ; pour pouvoir être sur que l'entrée utilisateur sera bien faite et que la routine pourra continuer sans erreur[/color] (while (not (setq js (ssget)))) [color=green];Avec (tblnext) j'explore la table des calque en commençant par le 1er avec l'option T[/color] (setq def_lay (tblnext "LAYER" T)) [color=green];J'entame une boucle (while) tant que la définition du calque existe (def_lay) ; La défintion suivante étant cherchée à la fin de la boucle (sans l'option T)[/color] (while def_lay [color=green];J'extrais le nom de du calque de la définition de la table[/color] (setq nam_lay (cdr (assoc 2 def_lay))) [color=green];Je fais une répétion de boucle en corélation avec le nombre d'entités contenu dans le jeu de sélection ; J'en profite pour indexer avec la variable n ce nombre d'éléments[/color] (repeat (setq n (sslength js)) [color=green];J'extrais le nom de l'entité indexée (qui est décrémentée), puis sa définition DXF dans laquelle je récupère le calque de celle-ci[/color] (setq dxf_ent (entget (ssname js (setq n (1- n)))) lay_ori (cdr (assoc 8 dxf_ent)) ) [color=green];Une condition vérifie que le calque de l'entité n'est pas la même que celui de l'élément de la table des calques en cours de traitement[/color] (cond ((not (eq lay_ori nam_lay)) [color=green];Si la condition est vérifiée ; Je récupère le calque de l'entité traitée auquel je lui substitue le nom du calque extrait de la table des calque en cours[/color] (setq dxf_ent (subst (cons 8 nam_lay) (assoc 8 dxf_ent) dxf_ent)) [color=green];Avec cette liste de code DXF à jour je crée la même entité sur le calque concerné[/color] (entmake dxf_ent) [color=green];Si j'ai affaire à une entité complexe. Bloc, Polyligne ancienne ou polyligne 3D[/color] (if (member (cdr (assoc 0 dxf_ent)) '("INSERT" "POLYLINE")) (progn [color=green];Alors j'explore les entités suivantes...[/color] (setq dxf_nent (entget (entnext (cdar dxf_ent)))) [color=green];... jusqu'à rencontrer la fin par l'entité spéciale SEQEND.[/color] (while (/= (cdr (assoc 0 dxf_nent)) "SEQEND") [color=green];Comme précédemment substitution[/color] (setq dxf_nent (subst (cons 8 nam_lay) (assoc 8 dxf_nent) dxf_nent)) [color=green];Puis création[/color] (entmake dxf_nent) [color=green];Affectation de dxf_nent à l'entité suivante (dans la boucle pour pouvoir en sortir)[/color] (setq dxf_nent (entget (entnext (cdar dxf_nent)))) ) [color=green];Puis création de l'entité SEQEND de fin de boucle qui n'a pas été évalué dans la boucle (condition de sortie)[/color] (entmake dxf_nent) ) ) ) ) ) [color=green];Définition suivante de la table des calques[/color] (setq def_lay (tblnext "LAYER")) ) )) [Edité le 21/4/2011 par bonuscad]

Bonjour, Loin de moi de mettre tes capacités en doute, mais ta proposition soulève des interrogations! Tu débarques sur ce site (2 messages seulement et simplement sur ce sujet particulier), et tu te propose la refonte gratuite de ce site. Fais tu parti au moins du monde de la CAO? Qu'elle est ta motivation pour faire cette proposition à brule pour point? Pourquoi un tel investissement sur un site que tu n'as jamais fréquenté avant? Est ce la fréquentation de celui ci qui t'attire afin d'en retirer un certain bénéfice? En sommes bien des questions, sur des intentions que tu n'as guère exposé... Saches de toute façon que je n'ai aucun lien avec l'administrateur de ce site, et que lui seul donnera une suite à ta demande. D'ailleurs une proposition en privé avec lui m'aurait semblé plus adéquate. Dans l'état actuel, je vois pas pourquoi je soutiendrais la proposition d'un kiki fusse t-il de France.

Ou que tu veuilles que ça fasse partie d'une procédure de nettoyage. Le code de Serge (et je pense celui livré par Fraid) bien que ne supprimant par les filtres fonctionne, il n'y a pas de bogue. J'ai fais un pas à pas et les filtres sont bien enlevé du dictionnaire. Mais comme le dit l'aide (traduite en français) Ce n'était pas le cas dans les versions 2000-2002 Donc il y a peu de chose à faire pour rendre à nouveau le code fonctionnel. Pour ma part je ne vois pas quoi soumettre à (entdel), j'ai bien essayé (entdel (dictremove lay_entity filter_name)), mais à priori ce n'est pas la solution.

Un film de Akira Kurosawa de 1990 que je ne connaissais pas! J'avoue qu'il m'a déstabilisé... Dreams [Edité le 15/4/2011 par bonuscad]

Bon, Comme cela faisait un bout de temps que je n'avais pas utilisé cette routine (version 2002 d'autocad), j'ai voulu testé à nouveau. Et bien cela ne fonctionne plus, les filtres sont toujours présent :mad: Idem avec la version proposé par Fraid. L'explication vient sans doute de là, mais je n'ai pas creusé Extrait de l'aide En même temps, je ne sais pas si c'est utile d'avoir une routine fonctionnelle. En effet dans le gestionnaire de calque, un click sur 1er filtre puis maintient de la touche SHIFT et click sur le dernier filtre (mise en évidence de la sélection), click-droit et choisir supprimer et hop tout les filtres sont effacés. La sélection peut aussi se faire avec CTRL pour enlever certain et conserver d'autres.

Bonsoir, J'ai eu testé cette routine de Serge, elle ne m'avait pas posé de problème. Mais tu fais peu être une erreur de jugement sur ce que fait ce lisp. Il nettoie les FILTRES de calques que tu aurais pu établir, ou qui seraient présent dans le dessin. En aucun cas il ne supprime des calques existants !... C'est peut être ta confusion? Si pas de filtre correspondant à ta requête, pas de nettoyage, ça ne fait rien du tout. [Edité le 14/4/2011 par bonuscad]

Je penche pour une pollution par la bannière éducative dans une bibliothèque de dessin. Donc son script serait pour nettoyer celle-ci en passant par le format DXF. J'ai vendu la mèche :calim:

Le seul truc que je remarques en ayant la photo originale et qu'il n'y a pas le même nombre de rangées de pierres de taille entre les fenêtres du dernier étage (dans le sens vertical) photo originale: 2 en dessous et 2 en dessus photo rendu: 3 en dessous et 1 en dessus. Autrement j'ai essayé de convertir (avec trueview) pour ma version. Il y a des erreurs dans les fichiers B0131-F B0131-H et B0131-I Même qu'il propose la récupération de ceux-ci, cela fini par une erreur fatale. Fait bizarre, j'arrive à ouvrir le fichier principal avec les Xref, mais cela fini par planter après quelque manips. Par contre je n'arrive pas à ouvrir les fichiers cités individuellement, ça plante systématiquement. Seul DraftSight a pu les ouvrir, mais la correction apporté par celui-ci les laisse toujours invalide par Autocad et continu à planter. J'ai même essayé de descendre jusqu'en version R14 avec trueview, mais le problème persiste.

Salut, Quand est-il de la configuration de Windows ? La barre de langue est-elle en Anglais ou en Français ! (Voir la barre de tache de Windows, un clic-droit sur elle pour accéder au menu de la barre d'outil, puis barre de langue si elle n'est pas apparente) Car si les pages de codes ne sont pas chargées pour le clavier adéquate !...

Tout était faisable en macro diesel avec LT, à l'exception que la fonction $(sqrt,"nombre") n'existe pas ! donc cela fout en l'air la possibilité d'appliquer la formule. Est-ce que la commande CALC est disponible sous LT? Il y aurais peut être possibilité de faire quelque chose avec dans une macro. Je n'ai pas de LT pour tester ces possibilités que j’énonce. Autrement revoir ta façon de faire des rectangles. Plutôt faire un bloc de 1 unité X 1 unité (un carré en somme), est lors de l'insertion du donnes les facteurs d'échelle en X et Y qui représenteraient tes longueur de côtés. De ce fait, tu pourrais avoir l'information des longueurs des côtés dans la palette des propriétés (qui correspondrait à l'échelle X et Y, ne pas tenir compte de l'échelle Z). Tu pourrais aussi modifier facilement ces longueurs (toujours dans la palette). Le seul hic, est que si tu doit faire des ajustements ou coupure de ceux-ci, tu devras les décomposer et ainsi perdre ces informations.