how to Count layer name and its Area in table format

[jaimuthu]

above code is lee mac code i download this code is count all text objcet in table format if its possible 

layer count on  Example layer name "A1"  layer name "A2"  layer name "A3"  layer name "A4" 

i used this layers in closed polyline  i want count layer name and its Area in table format

[Sea-Haven]

Post a sample dwg may explain better what you want. Not sure what objects for area.

[jaimuthu]

here sample drawing

[paullimapa]

POLYAREA is taken from POLYLENGTH from here:

https://www.cadtutor.net/forum/topic/77121-lisp-table-with-polyline-areas-by-layer-name/

The area read out is as is in square unit setting.

The unit is defined by the user ie: 1 unit = 1 Meter or 1mm for Metric or 1 Ft or 1 inch for Imperial

;; 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
;;;
(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)
)

[jaimuthu]

 error: Automation Error. Invalid input   ITS SHOW ONLY TABLE NOT VALUE

[paullimapa · Accepted solution]

that's odd...when I (load"POLYAREA") & run POLYAREA on your drawing selecting the rectangles you show this is the table I get:

[rohit_poojari]

Can you create a lisp without the total area and just the layer name and its color.

[paullimapa]

So you want a table object that shows all the layer names in first cell with corresponding color filled in the second cell  and this has nothing to do with layers with plines?

[rohit_poojari]

Yes, please. Is it possible to replace the hatch that displays the layer name's color with the matching layer name's linetype with color instead?

[rohit_poojari]

Yes, please. Is it possible to replace the hatch that displays the layer name's color with the matching layer name's line type with color instead?

[paullimapa]

When you label the color hatch column with the linetype and the color is the same as the text then you won't see it any more but give LyrTbl.lsp a try:

;; LyrTbl creates a Table listing Layer names, color & linetype
;; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-to-count-layer-name-and-its-area-in-table-format/m-p/12440430#M458944
(defun c:LyrTbl ( / AllData Layer_table cellht cellwd clr crow fname get_laylst lyr_v15_sort str txtht)
 (vl-load-com)
  (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
; lyr_v15_sort list
 (defun lyr_v15_sort (lst-arg / tmp)
    (setq tmp (vl-sort lst-arg '(lambda (a b) (< (strcase a) (strcase b)))))
    tmp
 ) ; defun lyr_v15_sort list
; get_laylst build layer list 
 (defun get_laylst (/ lyr tmp)
  (while (setq tmp (tblnext "LAYER" (not tmp)))
   (setq lyr (cons (cdr (assoc 2 tmp)) lyr))
  )
  (if lyr (setq lyr (lyr_v15_sort lyr)))
  lyr
 ) ; defun get_laylst
       (setq AllData (get_laylst)) ; create list of all layers in dwg
       (setq Layer_table           ; add a table object with 2 columns
              (vlax-invoke
                (vlax-get (vla-get-ActiveLayout
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          'Block
                )
                'Addtable
                (getpoint "\nPick point for Layer Table:")
                2 2 cellht cellwd
              )
       )
       (setq fname(vl-filename-base (getvar "dwgname")))                     ;get Header name from file name
       (vla-settext Layer_table 0 0 fname)                                   ;set header name
       (vla-setcelltextheight Layer_table 0 0 txtht)                                                
       (mapcar '(lambda (y)
                  (vla-settext Layer_table 1 (car y) (cadr y))
                  (vla-setcelltextheight Layer_table 1 (car y) txtht)        ;second row text height
                )
               (list '(0 "Layer Name") '(1 "Color/LType"))
       )
       (foreach d AllData
        (vla-insertrows
           Layer_table
           (1+ (setq crow (vla-get-rows Layer_table)))
           cellht                                                            ;cell height from 4-th row
           1
        )
        (vla-setcelltextheight Layer_table crow 0 txtht)                     ;fill Layer name 
        (vla-setCellAlignment Layer_table crow 0 5)
        (vla-setCellValue Layer_table crow 0 d)
        (setq x(strcat "AutoCAD.AcCmColor."  (substr (getvar 'Acadver) 1 2))) ;set Color markers
        (setq clr (vlax-create-object x))
        (vla-setCellValue Layer_table crow 1 (cdr (assoc 6 (tblsearch "LAYER" d)))) ; fill Linetype
        (vla-setcelltextheight Layer_table crow 1 txtht)                                        
        (vla-setCellAlignment Layer_table crow 1 5)
        (vla-put-colorindex clr (cdr (assoc 62 (tblsearch "LAYER" d))))       ; fill Color
        (vla-SetCellBackgroundColor Layer_table crow 1 clr)
      ) ; foreach
  (princ) ; clean exit
) ; defun

[rohit_poojari]

Appreciate your help, but I require this output.

[paullimapa]

Unfortunately I don’t know of an option to place a line inside a Tables cell. Perhaps you should start a new thread with this request to let others chime in

[rohit_poojari]

Is this Possible?

[paullimapa]

try this with one modified line:

;; LyrTbl creates a Table listing Layer names, color & linetype
;; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-to-count-layer-name-and-its-area-in-table-format/m-p/12440430#M458944
(defun c:LyrTbl ( / AllData Layer_table cellht cellwd clr crow fname get_laylst lyr_v15_sort str txtht)
 (vl-load-com)
  (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
; lyr_v15_sort list
 (defun lyr_v15_sort (lst-arg / tmp)
    (setq tmp (vl-sort lst-arg '(lambda (a b) (< (strcase a) (strcase b)))))
    tmp
 ) ; defun lyr_v15_sort list
; get_laylst build layer list 
 (defun get_laylst (/ lyr tmp)
  (while (setq tmp (tblnext "LAYER" (not tmp)))
   (setq lyr (cons (cdr (assoc 2 tmp)) lyr))
  )
  (if lyr (setq lyr (lyr_v15_sort lyr)))
  lyr
 ) ; defun get_laylst
       (setq AllData (get_laylst)) ; create list of all layers in dwg
       (setq Layer_table           ; add a table object with 2 columns
              (vlax-invoke
                (vlax-get (vla-get-ActiveLayout
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          'Block
                )
                'Addtable
                (getpoint "\nPick point for Layer Table:")
                2 2 cellht cellwd
              )
       )
       (setq fname(vl-filename-base (getvar "dwgname")))                     ;get Header name from file name
       (vla-settext Layer_table 0 0 fname)                                   ;set header name
       (vla-setcelltextheight Layer_table 0 0 txtht)                                                
       (mapcar '(lambda (y)
                  (vla-settext Layer_table 1 (car y) (cadr y))
                  (vla-setcelltextheight Layer_table 1 (car y) txtht)        ;second row text height
                )
               (list '(0 "Layer Name") '(1 "Linetype/Color"))
       )
       (foreach d AllData
        (vla-insertrows
           Layer_table
           (1+ (setq crow (vla-get-rows Layer_table)))
           cellht                                                            ;cell height from 4-th row
           1
        )
        (vla-setcelltextheight Layer_table crow 0 txtht)                     ;fill Layer name 
        (vla-setCellAlignment Layer_table crow 0 5)
        (vla-setCellValue Layer_table crow 0 d)
        (setq x(strcat "AutoCAD.AcCmColor."  (substr (getvar 'Acadver) 1 2))) ;set Color markers
        (setq clr (vlax-create-object x))
        (vla-setCellValue Layer_table crow 1 (cdr (assoc 6 (tblsearch "LAYER" d)))) ; fill Linetype
        (vla-setcelltextheight Layer_table crow 1 txtht)                                        
        (vla-setCellAlignment Layer_table crow 1 5)
        (vla-put-colorindex clr (cdr (assoc 62 (tblsearch "LAYER" d))))       ; layer Color
;        (vla-SetCellBackgroundColor Layer_table crow 1 clr)                  ; fill color
        (vla-setcellcontentcolor Layer_table crow 1 clr)                      ; text color
      ) ; foreach
  (princ) ; clean exit
) ; defun

[david.waight]

@Anonymous, This is a nice routine, could your last version with the coloured text be tweaked so it only showed the layers with entities on? or have an option to show all or used layers only?

This way it would also be easier to read by laymen.

[rohit_poojari]

Thank You Paul.

[paullimapa]

Glad to have helped…cheers!!!

[paullimapa]

**Objects residing in layers inside blocks are not accounted for**

give this modified version a try:

;; LyrTbl creates a Table listing Layer names, color & linetype
;; OP:
; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-to-count-layer-name-and-its-area-in-table-format/m-p/12440430#M458944
(defun c:LyrTbl ( / AllData Layer_table cellht cellwd choice clr crow fname get_laylst lyr_v15_sort str txtht)
 (vl-load-com)
  (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
; lyr_v15_sort list
 (defun lyr_v15_sort (lst-arg / tmp)
    (setq tmp (vl-sort lst-arg '(lambda (a b) (< (strcase a) (strcase b)))))
    tmp
 ) ; defun lyr_v15_sort list
; get_laylst builds layer list 
; Argument:
; opt = determines what layers to include "In-Use": only layers with objects otherwise all layers
 (defun get_laylst (opt / lyr lyrname tmp)
  (while (setq tmp (tblnext "LAYER" (not tmp)))
   (setq lyrname (cdr (assoc 2 tmp)))
   (if (eq opt "In-Use" )
     (if(ssget"_X" (list (cons 8 lyrname)))
      (setq lyr (cons lyrname lyr))
     ) ; if
     (setq lyr (cons lyrname lyr))
   ) ; if
  ) ; while
  (if lyr (setq lyr (lyr_v15_sort lyr)))
  lyr
 ) ; defun get_laylst
     (if(not **lyrtbl**)(setq **lyrtbl** "All"))
     (initget "All In-Use")
     (setq choice (getkword (strcat "\nCreate Table of Layers [All/In-Use] <" **lyrtbl** ">: ")))
     (if(not choice)(setq choice **lyrtbl**))
     (setq **lyrtbl** choice)
     (if(setq AllData (get_laylst **lyrtbl**)) ; create list of all layers in dwg
      (progn
       (setq Layer_table           ; add a table object with 2 columns
              (vlax-invoke
                (vlax-get (vla-get-ActiveLayout
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          'Block
                )
                'Addtable
                (getpoint "\nPick point for Layer Table:")
                2 2 cellht cellwd
              )
       )
       (setq fname(vl-filename-base (getvar "dwgname")))                     ;get Header name from file name
       (vla-settext Layer_table 0 0 fname)                                   ;set header name
       (vla-setcelltextheight Layer_table 0 0 txtht)                                                
       (mapcar '(lambda (y)
                  (vla-settext Layer_table 1 (car y) (cadr y))
                  (vla-setcelltextheight Layer_table 1 (car y) txtht)        ;second row text height
                )
               (list '(0 "Layer Name") '(1 "Linetype/Color"))
       )
       (foreach d AllData
        (vla-insertrows
           Layer_table
           (1+ (setq crow (vla-get-rows Layer_table)))
           cellht                                                            ;cell height from 4-th row
           1
        )
        (vla-setcelltextheight Layer_table crow 0 txtht)                     ;fill Layer name 
        (vla-setCellAlignment Layer_table crow 0 5)
        (vla-setCellValue Layer_table crow 0 d)
        (setq x(strcat "AutoCAD.AcCmColor."  (substr (getvar 'Acadver) 1 2))) ;set Color markers
        (setq clr (vlax-create-object x))
        (vla-setCellValue Layer_table crow 1 (cdr (assoc 6 (tblsearch "LAYER" d)))) ; fill Linetype
        (vla-setcelltextheight Layer_table crow 1 txtht)                                        
        (vla-setCellAlignment Layer_table crow 1 5)
        (vla-put-colorindex clr (cdr (assoc 62 (tblsearch "LAYER" d))))       ; layer Color
;        (vla-SetCellBackgroundColor Layer_table crow 1 clr)                  ; fill color
        (vla-setcellcontentcolor Layer_table crow 1 clr)                      ; text color
      ) ; foreach
    ) ; progn
    (alert(strcat"There Are No Layers " **lyrtbl**))
   ) ; if
  (princ) ; clean exit
) ; defun

[Sea-Haven]

Draw a line in a table I did it by cheating you can get the row heights so work out a X, same with Y and take into account the cell width.

The hard part where did I put it.  Maybe use Underscore, set text color.

Pulled this out of code, I am sure Paullimapa you will work it out.

(defun ahdodrawline (llayer crow lcol / pt pt1 pt2 vdist acm )
(setq pts (vlax-safearray->list (vlax-variant-value (VLA-GETCELLEXTENTS objtable (+ crow 1) 1 :vlax-false))))
(setq pt1 (list (nth 0 pts)(nth 1 pts) 0.0))
(setq pt2 (list (nth 6 pts)(nth 7 pts) 0.0))
(setq vdist (/ (- (cadr pt1) (cadr pt2)) 2.0))
(setq pt1 (mapcar '+ pt1 (list 10.0 vdist 0.0)))
(setq pt2 (list (nth 3 pts)(nth 4 pts) 0.0))
(setq pt2 (mapcar '+ pt2 (list (- 10.0) vdist 0.0)))
(command "line" pt1 pt2 "")
(command "chprop" (entlast) "" "la" llayer "")
(setq acm (vla-getinterfaceobject (vlax-get-acad-object) (strcat "Autocad.AcCmcolor." (substr (getvar 'acadver) 1 2))))
(vla-put-colorindex acm lcol)
(vla-setcellbackgroundcolor objtable row 2 acm)
(princ)
)