Jump to content

LISP table with polyline areas by layer name


beyveye98

Recommended Posts

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!

Link to comment
Share on other sites

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

 

 

  • Like 1
Link to comment
Share on other sites

@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. 

Link to comment
Share on other sites

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 by Steven P
Link to comment
Share on other sites

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. 

  • Like 1
Link to comment
Share on other sites

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 by Steven P
  • Like 1
Link to comment
Share on other sites

and did you do this to get squared?

 

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

 

  • Like 1
Link to comment
Share on other sites

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 "²")

 

  • Like 1
Link to comment
Share on other sites

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

 

  • Like 2
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...