;;;用法：先在程序命令行中输入此句：;
;;;(setenv "AutoAreaReader" "1")
;;;再加载本程序，注意，需要这样的步骤才能起作用;
;;;然后，每次点击（单击）封闭多义线，就会在命令行中得到选取多义线的面积，;
;;;一次选择多个封闭多义线的话，会得到面积总和。;
;;;如果发现给出的面积是英制的话，输入如下语句：(setq def_show_area "Decimal")

;; by LE

;; To turn this ability ON-OFF use:
;; For ON:
;; (setenv "AutoAreaReader" "1")
;; For OFF:
;; (setenv "AutoAreaReader" "0")
;;
;;
;; To change the print output use:
;; Variable name: def_show_area
;; Options:
;; 1. "Decimal"
;; 2. "Squarefeet"
;; 3. "Acres"
;; 4. "SquareMeters"
;; 5. "Hectares"
;; In example:
;; Command: (setq def_show_area "Acres")
;; Command: (setq def_show_area "Decimal")

;;--------------------------------------------------------------

(if (not (getenv "AutoAreaReader"))
  (setenv "AutoAreaReader" "0"))

;;--------------------------------------------------------------

(defun dtt-ssget->vla-list  (ss / index vlaList)
  (setq    index (if ss
        (1- (ssLength ss))
        -1))
  (while (>= index 0)
    (setq vlaList (cons
            (vlax-ename->vla-object
              (ssname ss index))
            vlaList)
      index      (1- index)))
  vlaList)

;;--------------------------------------------------------------

(defun dtt-addcomma  (txt / strl cont1 lth cont txt1)
  (setq    strl  (strlen txt)
    cont1 1
    txt1  "")
  (while (and (/= (substr txt cont1 1) ".") (<= cont1 strl))
    (setq cont1 (1+ cont1)))
  (setq    lth   (1- cont1)
    cont1 1
    cont  (1- lth))
  (if (> lth 3)
    (progn
      (while (< cont1 lth)
    (setq let  (substr txt cont1 1)
          txt1 (strcat txt1 let))
    (if (and (zerop (rem cont 3)) (eq (type (read let)) 'INT))
      (setq txt1 (strcat txt1 ",")))
    (setq cont  (1- cont)
          cont1 (1+ cont1)))
      (while (<= cont1 strl)
    (setq txt1  (strcat txt1 (substr txt cont1 1))
          cont1 (1+ cont1)))
      txt1)
    txt))

;;--------------------------------------------------------------

(defun dtt-print-area  (ar / string)
  (setq    string
       "\nChange variable LUPREC to a higher precision value - try again.")
  (if (not def_show_area)
    (setq def_show_area "Decimal"))
  (cond
    ((= def_show_area "Decimal")
     (if (zerop (atof (rtos ar 2 (getvar "luprec"))))
       (prompt string)
       (princ
     (dtt-addcomma
       (rtos ar 2 (getvar "luprec"))))))
    ((= def_show_area "Squarefeet")
     (if (zerop (atof (rtos (/ ar 144.0) 2 (getvar "luprec"))))
       (prompt string)
       (progn
     (princ
       (dtt-addcomma (rtos (/ ar 144.0) 2 (getvar "luprec"))))
     (princ " square feet"))))
    ((= def_show_area "Acres")
     (if
       (zerop
     (atof (rtos (/ (/ ar 144.0) 43560.0) 2 (getvar "luprec"))))
    (prompt string)
    (progn
      (princ
        (dtt-addcomma
          (rtos (/ (/ ar 144.0) 43560.0) 2 (getvar "luprec"))))
      (princ " acres"))))
    ((= def_show_area "SquareMeters")
     (if (zerop (atof (rtos ar 2 (getvar "luprec"))))
       (prompt string)
       (progn
     (princ
       (dtt-addcomma
         (rtos ar 2 (getvar "luprec"))))
     (princ " m2"))))
    ((= def_show_area "Hectares")
     (if
       (zerop
     (atof (rtos (/ ar 10000.0) 2 (getvar "luprec"))))
    (prompt string)
    (progn
      (princ
        (dtt-addcomma
          (rtos (/ ar 10000.0) 2 (getvar "luprec"))))
      (princ " hectares"))))))

;;--------------------------------------------------------------

(defun areareader-pickfirst
       (reactor params / ss ent obj ar pol_data lst_dat)
  (if (eq (getenv "AutoAreaReader") "1")
    (cond
      ((and (eq 1 (logand 1 (getvar "pickfirst")))
        (setq ss (ssget "_i" '((0 . "LWPOLYLINE"))))
        (eq 1 (sslength ss))
        (setq ent (ssname ss 0))
        (setq obj (vlax-ename->vla-object ent))
        (eq (vla-get-closed obj) :vlax-true))
       (setq ar (vla-get-area obj))
       (princ "\nArea of single polyline= ")
       (dtt-print-area ar)
       (princ))
      ((and
     (eq 1 (logand 1 (getvar "pickfirst")))
     (setq ss (ssget "_i" '((0 . "LWPOLYLINE"))))
     (> (sslength ss) 1)
     (vl-every
       (function
         (lambda (obj) (eq (vla-get-closed obj) :vlax-true)))
       (setq objs (dtt-ssget->vla-list ss))))
       (princ "\nTotal area of multiple polylines= ")
       (setq ar (apply '+ (mapcar 'vla-get-area objs)))
       (dtt-print-area ar)
       (princ)))))

;;--------------------------------------------------------------

(if (not areareader_pickfirst_reactor)
  (setq    areareader_pickfirst_reactor
     (vlr-set-notification
       (vlr-miscellaneous-reactor
         "AutoAreaReader"
         '((:vlr-pickfirstmodified . areareader-pickfirst)))
       'active-document-only)))

;;--------------------------------------------------------------

(defun dtt-removeall  (reactor params)
  (vlr-remove-all))

;;--------------------------------------------------------------

(if (not dtt_reactor_dwg)
  (setq    dtt_reactor_dwg
     (vlr-set-notification
       (vlr-editor-reactor
         "removeallreactors"
         '((:vlr-beginclose . dtt-removeall)))
       'active-document-only)))

;;--------------------------------------------------------------

(cond
  ;; ON
  ((and    (eq (getenv "AutoAreaReader") "1")
    areareader_pickfirst_reactor
    (not (vlr-added-p areareader_pickfirst_reactor)))
   (vlr-add areareader_pickfirst_reactor))
  ;; OFF
  ((and    (eq (getenv "AutoAreaReader") "0")
    areareader_pickfirst_reactor
    (vlr-added-p areareader_pickfirst_reactor))
   (vlr-remove areareader_pickfirst_reactor)))
(princ)