LISP table with polyline areas by layer name

[beyveye98]

Hello everyone,

Does anyone know a lisp which could calculate polyline areas of selected objects, and sort it in the table by layers? Thanks in advance!

[Steven P]

This was posted earlier, if we change the length to area would that work? Noting that this sums all the line lengths on a layer

 

 

[hosneyalaa]

Hi

Can you attached example drawing 

[marko_ribar]

http://www.lee-mac.com/arealabel.html

 

HTH.

M.R.

[beyveye98]

@Steven P Yes Steven, just like for the length, but I want to calculate areas. I want one column of the table to be layer name, second pline area, and third colour. Can you modify this lisp for me? I dont really know how to do it. 

[Steven P]

13 hours ago, beyveye98 said:

@Steven P Yes Steven, just like for the length, but I want to calculate areas. I want one column of the table to be layer name, second pline area, and third colour. Can you modify this lisp for me? I dont really know how to do it. 

 

Ahh, I told the other poster to have a go - great learning for them and if I just give you the code they might get upset... so have a go and you never know there is a good chance you'll get the right answer.

 

Open the LISP file from the link above and look through it,  I reckon that this is the line you need to change to get area and not length:

 

(setq area_ (vl-catch-all-apply 'vla-get-length (list E)))

 

Take a guess what to change,,, and it might just work

 

 

If it doesn't work, post what you think it should be and we will help you out

Edited March 16, 2023 by Steven P

[beyveye98]

Thank you so much for helping me. I did it, and it works just fine. I even changed "m" to "m^2", but the last thing I would like to know is how to change size of the table, because it so big in the drawing. I changed all the numbers but its only affecting text not the table. 

[Steven P]

34 minutes ago, beyveye98 said:

Thank you so much for helping me. I did it, and it works just fine. I even changed "m" to "m^2", but the last thing I would like to know is how to change size of the table, because it so big in the drawing. I changed all the numbers but its only affecting text not the table. 

 

Perfect... you don't need our help then!

 

EDIT

 

If you make the table with the LISP and measure the distances I reckon within the LISP these numbers will appear somewhere - and they are the ones to change. Do a quick check of course that you aren't changing something odd. Cell heights are 1500? and cell widths are 7000?

 

So if it was me I'd add this to the start of the code, perhaps under the (vl-load-com). and the comments should suggest what to change later in the code:

I just picked a text height of 250 - change it to what you want, cellht and cellwd are keeping the cell sizes in proportion to the text in the original table. Change the 250 to what you want and the rest will follow, you could even go further and ask the user what text height to use

 

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

 

 

Have a go and see what you can do.

Edited March 16, 2023 by Steven P

[Steven P]

and did you do this to get squared?

 

(vla-setcellformat Area_table crow 1 (strcat "%lu2%pr3%ps[, m" (chr 178) "]")) 

 

[beyveye98]

If i change like you did, i get this.

[Steven P]

That's odd. if you create a piece of mtext, make a squared sign ( ² ) in it and then paste that into the command line using (ascii ) that should give you the code to use, for me it is 178, or copy this into the command line:

 

(ascii "²")

 

[beyveye98]

For me its "72", but when I change all things according to your answer I get this error:

 

[Steven P]

OK, This is what I have, should be the same as yours? Try it just to make sure of say typing errors and so on

 

 

;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-polyline-length-total-by-layer-in-table/m-p/11229970#M432527
;; Hatched area Table sorted by Layer with the Color markers
;;;
(Defun c:POLYLENGHT ( / 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 250) ;; 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 "Category") '(1 "Total Length") '(2 "Colour"))
       )
       (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 072) "]"))    
		 
		 (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)
)

 

[beyveye98]

It works perfectly fine now, thanks a lot sir.

[Steven P]

Probably the type of annoying typing error that we all make then?

[beyveye98]

Yes, my mistake.  

[Steven P]

we all do the same