Merci Gile! ça marche pour pline_block! J'ai trouvé un autre Lisp et DCL (DDAREA)pour la surface aussi. C'est très intéressant aussi, et je trouve pas la ou les lignes pour diviser par 1000000. Le deuxième problème lorsque j'écris un nom de pièce dans la boîte de dialogue, il me donne tjs un chiffre derrière. Par exemple: bureau0 ou bureau1 ....Pour écrire simplement le nom des pièces, comment faire? Ci-joint le fichier DCL et LISP ddarea : dialog { value = "Configuartion DDarea"; key = "title"; :row { : boxed_column { label="Configuration du texte: "; : edit_box { label = "Nom de la surface: "; key = "obj"; fixed_width = true; } : edit_box { label = "N° de départ: "; fixed_width = true; key = "num"; } : toggle { label = "Ecrire les valeurs"; key = "lbl"; } : edit_box { label = "Hauteur du texte: "; fixed_width = true; key = "thei"; } : edit_box { label = "Angle du texte: "; fixed_width = true; key = "trot"; } : toggle { label = " 2 chiffres après la virgule "; fixed_width = true; key = "decim"; } }//fin box column :spacer{ width=0; } : column{ : boxed_column{ label = "Label"; key = "bc"; : toggle { label = "Numérotation "; key = "ID"; } : toggle { label = "Aire en m2"; key = "area"; } : toggle { label = "Périmètre "; key = "peri"; } }// fin box column label : boxed_column{ label = "Fichier"; key = "Fichbc"; :button { label = "Fichier de sortie"; key = "out"; width=10; } : toggle { label = "Création du fichier de sortie "; key = "sof"; } }//fin box column fichier }} : boxed_row{ label = "Options de Contour"; :column { : toggle { label = "Conserver les contours "; key="rbl"; } } } :spacer{ height=1; } :row{ :spacer{ width=3; } :button{ label="Choix des objets"; key="accept"; } :button{ label="Contour"; key="acceptb"; } :button{ label="Digitalisation"; key="acceptd"; } cancel_button; :spacer{ width=3; } }//fin row du bas } RESULTAT_calcul : dialog { label = "RESULTAT"; : edit_box { key = "SOMME"; edit_width = 70; } ok_button; } Fichier LISP ;source originale de Brian Strandberg ;modifié par PIerre Louiset ; Global Variables (setq BW_AREA_OBJ "Surface : ") (setq ADDT 0) (setq BW_AREA_THEI (* 1 (getvar "dimscale"))) (setq BW_AREA_TROT 0) (setq BW_AREA_AREA 1) (setq BW_AREA_PERI 0) (setq BW_AREA_ID 1) (setq BW_AREA_LBL 1) (setq BW_AREA_AREAC 0) (setq BW_AREA_RBL 0) (setq BW_AREA_SOF 0) (setq decimal 0) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (setq BW_AREA_FD "e:/ddarea.txt") ;;; edit this to change the default location of the output file (defun BW_AREA (/ A TEXT NUM LEN C D E F H TOTAL TOTALP) (setvar "hpbound" 1) (setvar "cmdecho" 0) (if (= 1 BW_AREA_SOF) (setq FD (open BW_AREA_FD "a")) () ) ;_ end of if (setq TOTAL 0) (setq TOTALP 0) ; Select objects or boundary ******************* ;;; (if (/= RET 2) (if (= RET 1) (setq A (ssget)) ) ;_ end of if (if (= ret 2) (progn (BW_BOUND) (setq A BW_BOUND_SET)) ) (if (= RET 3) (progn (ere) (setq A (ssget))) ) (setq TSH (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) (if (= TSH 0) (princ) (command "_style" "" "" "0" "" "" "" "" "") ) ;_ end of if (setq NUM 0) (setq LEN (sslength A)) (if (= 1 BW_AREA_SOF) (progn (princ "\n\n\n" FD) (if (= 1 BW_AREA_ID) (princ BW_AREA_OBJ FD) () ) ;_ end of if (if (= 1 BW_AREA_AREA) (princ ",m2" FD) () ) ;_ end of if (if (= 1 BW_AREA_PERI) (princ ",Périmetre" FD) () ) ;_ end of if ) ;_ end of progn () ) ;_ end of if (repeat LEN (setq C (ssname A NUM)) (setq D (entget C)) (setq E (cdr (assoc -1 D))) (command "_area" "_O" E) (princ "\n") (if (= 1 BW_AREA_SOF) (progn (princ "\n " FD) (if (= 1 BW_AREA_ID) (if (not BW_AREA_SOF) (princ BW_AREA_OBJ FD) () ) ;_ end of if () ) ;_ end of if (setq QQ (+ ADDT NUM)) (if (= 1 BW_AREA_ID) (princ (strcat "" (itoa QQ)) FD) () ) ;_ end of if (if (= 1 BW_AREA_AREA) (if (= 1 decimal) (progn (princ (strcat "," (rtos (getvar "area") 2 2)) FD)) (progn (princ (strcat "," (rtos (getvar "area") 2 0)) FD)) ) ;;; (progn (princ (strcat "," (rtos (getvar "area"))) FD)) () ) ;_ end of if (if (= 1 BW_AREA_PERI) (if (= 1 decimal) (progn (princ (strcat "," (rtos (getvar "Perimeter") 2 2)) FD)) (progn (princ (strcat "," (rtos (getvar "Perimeter") 2 0)) FD)) ) ;;; (progn (princ (strcat "," (rtos (getvar "Perimeter"))) FD)) () ) ;_ end of if (setq TOTALP (+ TOTALP (getvar "perimeter"))) (setq TOTAL (+ TOTAL (getvar "AREA"))) ) ;_ end of progn () ) ;_ end of if (if (= 1 BW_AREA_LBL) (BW-LABEL) () ) ;_ end of if (setq NUM (+ 1 NUM)) ) ;_ end of repeat (if (and (= RET 2) (= BW_AREA_RBL 0)) (command "_erase" A "") () ) ;_ end of if (if (= 1 BW_AREA_SOF) (progn (if (= 1 BW_AREA_AREA) (progn (princ "\nTotal des surfaces sélectionnées : " FD) (princ TOTAL FD) ) () ) ;_ end of IF (if (= 1 BW_AREA_PERI) (progn (princ "\nTotal des périmètres des surfaces sélectionnées : " FD ) (princ TOTALP FD) ) () ) ;_ end of IF ) ;_ end of progn () ) ;_ end of if (if (/= TSH 0.0) (command "_style" "" "" TSH "" "" "" "" "") () ) ;_ end of if (setq ADDT (+ ADDT NUM)) ; prevent repeating numbers (if (= 0 BW_AREA_SOF) () (close FD) ) ;_ end of if (princ) ) ;_ end of defun (defun BW-LABEL (/ TINS) (redraw E 3) (setq TINS (getpoint "\nPoint d'insertion du Texte : ")) (if (= 1 BW_AREA_ID) (progn (command "_text" "_m" TINS BW_AREA_THEI BW_AREA_TROT (strcat BW_AREA_OBJ (itoa (+ ADDT NUM))) ) ;_ end of command ) ;_ end of progn (command "_text" "_m" TINS BW_AREA_THEI BW_AREA_TROT "") ) ;_ end of if (if (= 1 BW_AREA_AREA) (if (= 1 decimal) (command "_text" "" (strcat (rtos (getvar "area")2 2) " m2")) (command "_text" "" (strcat (rtos (getvar "area")2 0) " m2")) ) () ) ;_ end of if (if (= 1 BW_AREA_PERI) (if (= 1 decimal) (command "_text" "" (strcat (rtos (getvar "Perimeter")2 2) " m")) (command "_text" "" (strcat (rtos (getvar "Perimeter")2 0) " m")) ) () ) ;_ end of if (setq BW_TEMP (cdr (assoc -1 (entget (entlast))))) (redraw E 4) ) ;close routine (defun BW_GF (/) (setq BW_FD (getfiled "Fichier de sortie " BW_AREA_FD "TXT" (+ 1 2 4)) ) ) ;_ end of defun (defun BW_AREA_SETUP (/) (set_tile "obj" BW_AREA_OBJ) (set_tile "num" (itoa ADDT)) (set_tile "thei" (rtos BW_AREA_THEI)) (set_tile "trot" (rtos BW_AREA_TROT)) (set_tile "ID" (itoa BW_AREA_ID)) (set_tile "area" (itoa BW_AREA_AREA)) (set_tile "peri" (itoa BW_AREA_PERI)) (set_tile "lbl" (itoa BW_AREA_LBL)) (set_tile "rbl" (itoa BW_AREA_RBL)) (set_tile "sof" (itoa BW_AREA_SOF)) (set_tile "decim" (itoa decimal)) (if (= BW_AREA_LBL 0) (progn (mode_tile "thei" 1) (mode_tile "trot" 1)) () ) ;_ end of if ) ;_ end of defun (defun BW_LBL1 ($VAL /) (if (= $VAL "0") (progn (mode_tile "thei" 1) (mode_tile "trot" 1)) (progn (mode_tile "thei" 0) (mode_tile "trot" 0)) ) ;_ end of if (setq BW_AREA_LBL (atoi $VAL)) ) ;_ end of defun (defun C:DDAREA (/) (setq DH (load_dialog "ddarea")) (if (not (new_dialog "ddarea" DH)) (exit) ) (BW_AREA_SETUP) (action_tile "accept" "(done_dialog 1)") (action_tile "acceptb" "(done_dialog 2)") (action_tile "acceptd" "(done_dialog 3)") (action_tile "cancel" "(exit)(exit)") (action_tile "obj" "(progn (setq bw_area_obj $value)(bw_area_setup))" ) (action_tile "num" "(progn (setq addt (atoi $value))(bw_area_setup))" ) (action_tile "thei" "(progn (setq bw_area_thei (atof $value))(bw_area_setup))" ) (action_tile "decim" "(progn (setq decimal (atoi $value))(bw_area_setup))" ) (action_tile "trot" "(progn (setq bw_area_trot (atof $value))(bw_area_setup))" ) (action_tile "ID" "(progn (setq bw_area_id (atoi $value))(bw_area_setup))" ) (action_tile "area" "(progn (setq bw_area_area (atoi $value))(bw_area_setup))" ) (action_tile "areac" "(progn (setq bw_area_areac (atoi $value))(bw_area_setup))" ) (action_tile "peri" "(progn (setq bw_area_peri (atoi $value))(bw_area_setup))" ) (action_tile "lbl" "(bw_lbl1 $value)") (action_tile "out" "(bw_gf)") (action_tile "rbl" "(progn (setq bw_area_rbl (atoi $value))(bw_area_setup))" ) (action_tile "sof" "(progn (setq bw_area_sof (atoi $value))(bw_area_setup))" ) (setq RET (start_dialog)) (BW_AREA) ) ;_ end of defun (defun BW_BOUND (/ A C DQ B1) (setq B1 1) (setq BW_BOUND_SET NIL) (setq DQ NIL) (setq A (entlast)) ;Selecting Entities Start********%%%%%%%% (princ "\nPoints dans les surfaces fermées à mesurer, ENTREE pour sortir: " ) (while (/= NIL B1) (setq B1 (getpoint)) (if (/= NIL B1) (command "_boundary" B1 "") () ) ;_ end of if (if (= BW_AREA_BV 1) (progn (setq KB (entlast)) (princ "\n") (initget "Yes No") (setq KBL (getkword "Conserver le contour? (Yes or No) ")) (if (= KBL "N") (command "_erase" KB "") () ) ;_ end of if ) ;close progn () ) ;close if ) ; end while (setq D (ssget "L")) (setq C (entnext A)) (while (/= NIL C) (setq DQ (ssadd C D)) (setq C (entnext C)) ) ;Selecting Entities End*********%%%%%%%%% (setq BW_BOUND_SET DQ) (if (= NIL BW_BOUND_SET) (progn (alert "Un contour n'est pas fermé\n\n FIN du Programme") (exit) ) ;_ end of progn () ) ;_ end of if ) ;_ end of defun ;;;------------------------------------------------------------ (princ ".") (defun deferr (s) (setq ere2 nil) (setvar "OSMODE" svosmode) ;;; (setvar "CLAYER" svclayer) (command "_UNDO" "_E") (if (/= s "Fonction annulee") (princ (strcat "\nErreur detectee: " s)) ) ;;; (setvar "CMDECHO" scmde) (setq *error* olderr) (princ) ) ;-------------------------------------------------------------------- (princ ".") (defun getval (code desent) (cdr (assoc code desent)) ) ;-------------------------------------------------------------------- (princ ".") (defun ere_pl1 (ere1 / ere2) (setq ere2 (list ere1)) (setq ere5 1) (command "_PLINE" ere1) (while (progn (initget 0 "U Recommencer Arc 1 2") (setq ere1 (getpoint ere1 "\n1/2/Arc/annUler/Recommencer/: " ) ) (cond ((null ere1) (if (> ere5 2) (command "_C") (prompt "\nPas assez de segments pour clore !!!") ) ) ((eq ere1 "U") (cond ((> (length ere2) 1) (command "_U") (setq ere2 (cdr ere2)) (If T_arc (progn (setq T_arc nil) (command "_LINE") ) ) ) (T (prompt "\nPas de segments a annuler !!!")) ) (setq ere1 (car ere2)) ) ((eq ere1 "Recommencer") (repeat (1- (length ere2)) (command "_U") ) (command "") (setq ere2 nil) ) ((eq ere1 "Arc") (setvar "OSMODE" 1536) (setq pa1 (getpoint "\n: ")) (initget 0 "1") (setq pa2 (getpoint "\n1/: ")) (if (= pa2 "1") (progn (setvar "OSMODE" 1057) (setq p1 (getpoint "\n: ")) (setq p2 (getpoint "\n: ")) (setvar "OSMODE" 0) (setq pix (/ (+ (nth 0 p1) (nth 0 p2)) 2)) (setq piy (/ (+ (nth 1 p1) (nth 1 p2)) 2)) (setq pa2 (list pix piy 0.0)) ) ) (command "_ARC" "_S" pa1 pa2 "_LINE") (setvar "OSMODE" svosmode) (setq T_arc T) (setq ere1 pa2) (setq ere2 (cons ere1 ere2)) (setq ere5 (1+ ere5)) ) ((eq ere1 "1") (setvar "OSMODE" 1057) (setq p1 (getpoint "\n: ")) (setq p2 (getpoint "\n: ")) (setvar "OSMODE" 0) (setq pix (/ (+ (nth 0 p1) (nth 0 p2)) 2)) (setq piy (/ (+ (nth 1 p1) (nth 1 p2)) 2)) (setq ere1 (list pix piy 0.0)) (command ere1) (setq ere2 (cons ere1 ere2)) (setq ere5 (1+ ere5)) (setvar "OSMODE" svosmode) ) ((eq ere1 "2") (setvar "OSMODE" 1057) (setq p1 (getpoint "\n: ")) (setq p2 (getpoint "\n: ")) (setvar "OSMODE" 1057) (setq p3 (getpoint "\n: ")) (setq p4 (getpoint "\n: ")) (setvar "OSMODE" 0) (setq pix (/ (+ (nth 0 p1) (nth 0 p2)) 2)) (setq piy (/ (+ (nth 1 p1) (nth 1 p2)) 2)) (setq pint (list pix piy 0.0)) (setq pax (/ (+ (nth 0 p2) (nth 0 p3)) 2)) (setq pay (/ (+ (nth 1 p2) (nth 1 p3)) 2)) (setq pa (list pax pay 0.0)) (setq pbx (/ (+ (nth 0 p1) (nth 0 p4)) 2)) (setq pby (/ (+ (nth 1 p1) (nth 1 p4)) 2)) (setq pb (list pbx pby 0.0)) (setq alpha (angle p1 p2)) (setq alpha (+ (/ pi 2) alpha)) (setq pint1 (polar pint alpha 10)) (setq ere1 (inters pa pb pint pint1 nil)) (command ere1) (setq ere2 (cons ere1 ere2)) (setq ere5 (1+ ere5)) (setvar "OSMODE" svosmode) ) (T (command ere1) (setq ere2 (cons ere1 ere2)) (setq ere5 (1+ ere5)) ) ) ) ) ere2 ) ;;;-------------------------------------------------------------------- ;;; Command ERE ;;; (princ ".") (defun ere () (setq olderr *error* *error* deferr ) (command "_UNDO" "_G") (command "_UCS" "") (setq svosmode (getvar "OSMODE")) (setvar "OSMODE" 1057) (prompt "\nDigitalisation de surfaces") (while (progn (setq ere3 (entlast) ere4 (getpoint "\n: ") ) ) (cond (T (setq ere5 (ere_pl1 ere4)) ) ) ) (command "_UCS" "_P") (command "_UNDO" "_E") (setq *error* olderr) (princ) ) ;;;-------------------------------------------------------------------- ;;; Routine SOM pour le calcul des surfaces. ;;; (princ ".") (defun c:som() (setq olderr *error* *error* deferr) (setq scmde (getvar "CMDECHO")) (setvar "CMDECHO" 0) (command "_UNDO" "_G") (command "_UCS" "") (setq svosmode (getvar "OSMODE")) (setvar "OSMODE" 0) (setq svclayer (getvar "CLAYER")) (setq val_dcl (load_dialog "SURFACE")) (setq llist (list "0")) (tblnext "LAYER" T) (setq lay (tblnext "LAYER")) (while (/= lay nil) (if (/= lay nil) (progn (setq nompln (cdr (assoc 2 lay))) (setq llist (cons nompln llist)) ) ) (setq lay (tblnext "LAYER")) ) (setq llist (cons "-Tous les plans" llist)) (setq llist (reverse llist)) (if (>= (getvar "maxsort") (length llist)) (setq llist (acad_strlsort llist)) ) (if (not (new_dialog "DDLAYER" val_dcl)) (exit)) (start_list "list_layer") (mapcar 'add_list llist) (end_list) (set_tile "list_layer" "0") (action_tile "cancel" "(done_dialog) (setq deferr \"\") (exit)") (action_tile "accept" (strcat "(progn (setq chx_lay (get_tile \"list_layer\"))" "(done_dialog))" ) ) (start_dialog) (if chx_lay (progn (setq cchx_lay (nth (atoi chx_lay) llist)) (if (= cchx_lay "-Tous les plans") (setq js (ssget)) (setq js (ssget "X" (list (cons 8 cchx_lay)))) ) ) ) (if js (progn (setq i 0) (setq surft 0.0) (setq nb (sslength js)) (while (< i nb) (progn (setq ent (ssname js i)) (setq ent (entget ent)) (setq tent (cdr (assoc 0 ent))) (if (= tent "TEXT") (progn (setq surfac (cdr (assoc 1 ent))) (setq surfac (substr surfac 1 (- (strlen surfac) 3))) (setq surfac (atof surfac)) (setq surft (+ surfac surft)) ) ) (setq i (1+ i)) ) ) (if (not (new_dialog "RESULTAT" val_dcl)) (exit)) (if (= cchx_lay "-Tous les plans") (set_tile "SOMME" (strcat "La somme des surfaces de tous les calques est de "(rtos surft 2 (getvar "LUPREC")) " m2.")) (set_tile "SOMME" (strcat "La somme des surfaces du claque " cchx_lay " est de "(rtos surft 2 (getvar "LUPREC")) " m2.")) ) (action_tile "accept" "(done_dialog)") (start_dialog) ) ) (command "_UCS" "_P") (setvar "OSMODE" svosmode) (setvar "CLAYER" svclayer) (command "_UNDO" "_E") (setq *error* olderr) (setvar "CMDECHO" scmde) (princ) ) ;-------------------------------------------------------------------- (princ ".") Merci par avance!