;; POLYAREA 
;; Hatched area Table sorted by Layer with the Color markers
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-polyline-length-total-by-layer-in-table/m-p/11229970#M432527
;; OP:
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-to-count-layer-name-and-its-area-in-table-format/m-p/12331947/highlight/false#M456565
;;;
(Defun c:POLYAREA ( / AllData ss e edata Area_table crow bn area_ ssNH fname clr )
(vl-load-com)
;;; 	pBe 23Apr2013 					;;;
;;; Mod for FSJ_Mo : Layer instead of Block swatches 	;;;
;;;	pBe 18Jul2013					;;;
;;; karpki : Header by filename, m2 05/01/2020          ;;;
;;; Moded by hak_vz for karpki: color markers 12/01/2020      ;;;

  (setq txtht 10) ;; Change all '500' to this
  (setq cellht (* 3 txtht)) ;; Change all 1500 to this
  (setq cellwd (* 14 txtht)) ;; Change 7000 to this

  (if
    (setq AllData nil ssNH (ssadd)
          ss      (ssget '((0 . "POLYLINE,LWPOLYLINE")))
    )
     (progn
       (repeat (setq i (sslength ss))
         (setq e (vlax-ename->vla-object (ssname ss (Setq i (1- i)))))
         (setq edata
                (list
                  (vlax-get e 'Layer)
                  (IF
                    (not
                      (vl-catch-all-error-p
                        (setq area_ (vl-catch-all-apply 'vla-get-area (list E)))
                      )
                    )
                     area_
                     (progn (ssadd (ssname ss i) ssNH) 0.0)
                  )
                )
         )
         (setq AllData
                (if (setq f (assoc (car edata) AllData))
                  (subst (list (car f) (+ (cadr f) (cadr edata))) f Alldata)
                  (cons edata AllData)
                )
         )
       )
       (setq AllData (vl-sort AllData '( lambda (m n) (< (Car m) (car n)))))
            (setq Area_table
              (vlax-invoke
                (vlax-get (vla-get-ActiveLayout
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          'Block
                )
                'Addtable
                (getpoint "\nPick point for Table:")
                2 3 cellht cellwd
              )
       )
       (setq fname(substr (setq str (getvar "dwgname")) 1 (- (strlen str) 4)))                     ;get Header name from file name
       (vla-settext Area_table 0 0 fname)                                                          ;set header name
       (vla-setcelltextheight Area_table 0 0 txtht)                                                
       (mapcar '(lambda (y)
                  (vla-settext Area_table 1 (car y) (cadr y))
                  (vla-setcelltextheight Area_table 1 (car y) txtht)                               ;second row text height
                )
               (list '(0 "Layer Name") '(1 "Total Area") '(2 "Color"))
       )
       (foreach d AllData
         (vla-insertrows
           Area_table
           (1+ (setq crow (vla-get-rows Area_table)))
           cellht                                                                                    ;cell height from 4-th row
           1
         )
         (vla-setcelltextheight Area_table crow 0 txtht)                                           ;set Layer name (Category)
         (vla-setCellAlignment Area_table crow 0 5)
	     (vla-setCellValue Area_table crow 0 (car d))

         (vla-setCellValue Area_table crow 1 (cadr d))                                             ;set Area
         (vla-setcelltextheight Area_table crow 1 txtht)                                        
         (vla-setCellAlignment Area_table crow 1 5)
         (vla-setcellformat Area_table crow 1 (strcat "%lu2%pr3%ps[, m" (chr 0178) "]"))    
		 
		 (setq x(strcat "AutoCAD.AcCmColor."  (substr (getvar 'Acadver) 1 2)))             ;set Color markers
		 (setq clr (vlax-create-object x))
         (vla-put-colorindex clr (cdr (assoc 62 (tblsearch "layer" (car d)))))
         (vla-SetCellBackgroundColor Area_table crow 2 clr)
       ) 
     )
  )
  (princ)
)