j'ai trouvé sur le site ce lisp qui permet d'inscrire l'aire d'une surface au milieu de la polyligne. J e ne connais rien au lisp, et je souhaiterai avoir une version de ce lisp avec les "m2" en "m²" et avec un arrondi de un chiffre après la virgule au lieu de deux... Si qqn veut bien jeter un coup d'oeil DD AREA ;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 ".")