(defun c:surfcoulcalk (/ inc x y xt yt obj)

 (command "_undo" "_begin")
  (setvar "cmdecho" 0)
  (defun erreur	(msg)
		(if	(= msg "Fonction annulée")
		  (princ)
		  (princ (strcat "\nErreur: " msg))
		)
		(setvar "OSMODE" os)
		(setq *error* m:err
		  m:err	nil
		)
	)
  (setq	m:err	*error*
	*error*	erreur
	os	(getvar "OSMODE")
  )
  
  (setq coulini (getvar 'cecolor))
  (setq accroini (getvar 'osmode))
  (setq calkini (getvar 'clayer))
  (setq inserUini (getvar 'insunits))
  (setq inserUDefSini (getvar 'insunitsdefsource))
  (setq inserUDefTini (getvar 'insunitsdeftarget))
  (command "scu" "")
  (setvar "cmddia" 0)
  (setvar 'osmode 16416)
  (setvar 'cecolor "BYLAYER")
  (setvar 'insunits 6)
  (setvar 'insunitsdefsource 6)
  (setvar 'insunitsdeftarget 6)
    
  (setvar 'angbase 0)
  (if (= preci nil)			; donc 1ere utilisation du lisp
    (progn
      (initget 1 "O o N n")
      (if
	(/=
	  "O"
	  (strcase
	    (getkword
	      "Modifier les options par défaut (2 décimales, pas de pochages, pas de calques pour les textes): O/N ?"
	    )
	  )
	)
	 (progn
	   (setq preci 2)
	   (setq pochactif "N")
	   (setq pochcalk "N")
	   (setq txtcalk "N")
	 )
	 (progn
	   (setq preci (getint "Nombre de décimales :? "))
	   (initget 1 "O o N n")
	   (setq
	     pochactif (strcase
			 (getkword "Activer les pochages :? (Oui/Non)")
		       )
	   )
	   (initget 1 "O o N n")
	   (setq pochcalk
		  (strcase
		    (getkword
		      "Créer des calques -HACH pour les pochages :? (Oui/Non)"
		    )
		  )
	   )
	   (initget 1 "O o N n")
	   (setq txtcalk
		  (strcase
		    (getkword
		      "Créer des calques -TXT pour les textes de surfaces :? (Oui/Non)"
		    )
		  )
	   )
	 )
      )
    )
  )

  (setvar 'osmode 0)
   (if (= (getvar 'aunits) 2)
    (setq koef 200) 	;en grades
    (setq koef 180)	;en degrés
  )
  (if ( = (getvar 'angdir) 1)
	  (setq
		rot	(+ 
				(/ (* koef (getvar 'viewtwist)) pi) ; rotation de la vue exprimée dans l'unité d'angle du dessin
				(* 4 koef)
			)
	  )
	 (setq
		rot	(+ 
				(/ (* koef (- 0.0 (getvar 'viewtwist))) pi) ; rotation de la vue exprimée dans l'unité d'angle du dessin
				(* 4 koef)
			)
	  )
	)
  (while (> rot (* 2 koef))
    (setq rot (- rot (* 2 koef)))
  )
  (if (/= (getvar "textstyle") "surface")
    (command "_style" "surface" "simplex.shx" 0.2 1 0 "" "" "")
  )


  (setq add 0)
  (princ "\nSélectionnez les polylignes à mesurer")
  (princ "\n")
  (setq	ssel (ssget '((-4 . "<or")
		      (0 . "LWPOLYLINE")
		      (0 . "POLYLINE")
		      (-4 . "or>")
		     )
	     )
  )
  (repeat (sslength ssel)		;sslength = nbre d'objet dans la sélection ssel
    (setq ename (ssname ssel add))	;ename = nom de l'objet n°add de la sélection
    (setq elist (entget ename))		;elist = objet
    (command "_area" "ob" ename)
    (setq air (strcat (rtos (getvar "area") 2 preci) " m2"))
    (setq x 0)
    (setq y 0)
    (setq xt 0)
    (setq yt 0)
    (setq inc 0)
    (setq obj ename)
    (setq obja (entget obj))
    (setq calk (cdr (assoc 8 obja)))
    (if	(= txtcalk "O")
      (command "._layer" "e" (strcat calk "-TXT") "")
      (setvar "CLAYER" calk)
    )
    (if	(= (cdr (assoc 0 elist)) "POLYLINE")
      (progn
	(setq obj (entnext obj))
	(setq att (entget obj))
	(while (= (cdr (assoc 0 att)) "VERTEX")
	  (setq x (car (cdr (assoc 10 att))))
	  (setq xt (+ xt x))
	  (setq y (cadr (cdr (assoc 10 att))))
	  (setq yt (+ yt y))
	  (setq inc (1+ inc))
	  (setq obj (entnext obj))
	  (setq att (entget obj))
	  (redraw obj 3)
	)
	(setq yt (/ (- yt y) (- inc 1)))
      )
    )
    (if	(= (cdr (assoc 0 elist)) "LWPOLYLINE")
      (progn
	(setq incatt 0)
	(setq att (entget obj))
	(repeat	(length att)
	  (if (= (car (nth incatt att)) 10)
	    (progn
	      (setq x (cadr (nth incatt att)))
	      (setq xt (+ xt x))
	      (setq y (caddr (nth incatt att)))
	      (setq yt (+ yt y))
	      (setq inc (1+ inc))
	    )				;progn
	  )				;if
	  (setq incatt (+ incatt 1))
	)
	(setq yt (- (/ (- yt y) (- inc 1)) 0.3))
      )
    )
    (setq xt (/ (- xt x) (- inc 1)))
    (setq pt (list xt yt 0))
    (setq coul (cdr (assoc 62 att)))
    (if	(= coul nil)
      (setq coul "DUCALQUE")
      (setq coul (rtos coul 2 0))
    )
    (setvar 'cecolor coul)
    (command "_text" "_s" "surface" "_j" "_m" pt rot air)
    (setq add (+ add 1))




					;(if	(= (cdr (assoc 0 elist)) "LWPOLYLINE") ; pourquoi que pour les LW?
					;(progn




    (if	(/= pochactif "N")
      (progn
	(if (= pochcalk "O") (command "._layer" "e" (strcat calk "-HACH") "") (command "._layer" "e" "SURFCOUL" ""))
	(setq coul (cond
		     ((= coul "1") "11")
		     ((= coul "2") "51")
		     ((= coul "3") "71")
		     ((= coul "4") "131")
		     ((= coul "5") "151")
		     ((= coul "6") "211")
		     ((= coul "7") "254")
		     ((= coul "256") "11")
		     ((= coul "DUCALQUE") "DUCALQUE")
		   )
	)
	(if coul
	  (setvar 'cecolor coul)
	  (setvar 'cecolor (rtos (1+ (cdr (assoc 62 att))) 2 0))
	)

	(setq version (atoi (getvar "acadver")))
	(cond
	  ((<= version 16) (command "hachures" "ansi31" ename ""))
	  ((> version 16)
	   (command "-hachures" "p" "s" "s" ename "" "")
	  )
	)
      )
    )

					; )					;progn
					;)				;if

    (princ add)
    (princ "\n")
  )
  (redraw obj 4)

  
  (setq msg "Vous pouvez utiliser la commande SURFNEG pour passer des surfaces en négatif")
  
  (setvar 'cecolor coulini)
  (setvar 'osmode accroini)
  (setvar 'clayer calkini)
  (setvar 'cmddia 1)
  (setvar 'filedia 1)
  (setvar 'insunitsdefsource inserUDefSini)
  (setvar 'insunitsdeftarget inserUDefTini)
  (setvar 'insunits inserUini)
  (if (< (atoi (getvar "acadver")) 20)
    (command "scu" "p")
    (command-s "scu" "p")
  )
  (command "_undo" "_end")
)

(defun c:surfneg ()
  (princ "\n")    
  (princ "\n Choix des nombres à passer en négatif")
  (princ "\n")        
  (setq ss2 (ssget '((0 . "TEXT" ))))
  (setq ct (sslength ss2))
  (setq ct (1- ct))
  (while (/= ct -1)
       (setq nom_ent1 (ssname ss2 ct))
       (setq ent1 (entget nom_ent1))
       (if (/= "-" (substr (cdr (assoc 1 ent1)) 1 1))
	 (progn
	   	(setq chaine (strcat "- " (cdr (assoc 1 ent1))))
       		(setq ent1(subst (cons 1 chaine )(assoc 1 ent1)ent1))
       		(entmod ent1)
	 )
       )
	(setq ct (1- ct))
  )
)