Multiple polyline area sum

February 5, 2019

I need a lisp command, to calculate area sum of already selected multiple closed polylines ...

Thanks

February 5, 2019

(vl-load-com)
;; Get Selected Areas
(defun c:gsa ( / ss1 obj i sum)
  ;; SSGET polylines already selected
  (setq ss1  (ssget "I" '( (0 . "POLYLINE,LWPOLYLINE") (70 . 1) )))  ;; 70=1 means closed
 
  (setq
    i 0
    sum 0.0
  )
  (repeat (sslength ss1)
    (setq obj (vlax-ename->vla-object (ssname ss1 i)))
    (setq ar (vlax-curve-getarea obj))  ;; get area
    (setq sum (+ sum ar))
    (setq i (+ i 1))
  )
 
  (princ sum)
  (princ)
)

Edited February 5, 2019 by Emmanuel Delay

February 5, 2019

Thank you!!
It works fine, but I have two more questions, and asking you, if you can help me.
Using this lisp, i found out two strange things.
1. example: My units are set to 4 decimal numbers. in one case result shows 5 decimal numbers.
2. example: I choose few really big objects and result is 9.36016e+06. But I want to see whole real number (so I can use copy-paste option), not to calculate result ...is it possible at all?
How to fix this. Do I have to change something in my program settings or any of System Variables?

kind regards!

February 5, 2019

You may want to consider my Total Length & Area programs.

To modify the precision of the output, change:

(princ (rtos a 2))

To:

(princ (rtos a 2 15))

Alternatively, retain the existing code and increase the value of your LUPREC system variable.

Edited February 5, 2019 by Lee Mac

February 5, 2019

Thanks....exactly what I need.

By the way, an option (princ (rtos a 2 1 5 )) doesnt work...but never mind, original version works fine.

Now I am just wondering, if there is an option, to display thousands separated with comma...or space..?

February 5, 2019

7 minutes ago, Jest said:

Thanks....exactly what I need.

By the way, an option (princ (rtos a 2 1 5 )) doesnt work...but never mind, original version works fine.

Now I am just wondering, if there is an option, to display thousands separated with comma...or space..?

It should be:

(rtos a 2 15)

Per my post, not:

(rtos a 2 1 5)

The rtos function accepts a maximum of three arguments.

Edited February 5, 2019 by Lee Mac

February 5, 2019

9 minutes ago, Jest said:

Now I am just wondering, if there is an option, to display thousands separated with comma...or space..?

For this you can make use of the function I posted here.

Copy the code for that function to the end of your .lsp file, and then change the output expression to:

(princ (rtoc a 15))

Edited February 5, 2019 by Lee Mac

February 5, 2019

It works, but now i got 6 decimal numbers, not 4, as before..

Did I wrote down correctly?:

;;---------------------=={ Total Area }==---------------------;;
;;                                                            ;;
;; Displays the total area of selected objects at the        ;;
;; command line. The precision of the printed result is      ;;
;; dependent on the setting of the LUPREC system variable.   ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:tarea ( / a i s )
    (if (setq s
            (ssget
               '(   (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")
                    (-4 . "<NOT")
                        (-4 . "<AND")
                            (0 . "POLYLINE") (-4 . "&") (70 . 80)
                        (-4 . "AND>")
                    (-4 . "NOT>")
                )
            )
        )
        (progn
            (setq a 0.0)
            (repeat (setq i (sslength s))
                (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i))))))
            )
            (princ "\nTotal Area: ")
            (princ (rtoc a 15))
        )
    )
    (princ)
)
(vl-load-com) (princ)
(defun rtoc ( n p / d i l x )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (vl-string->list (rtos (abs n) 2 p))
          x (cond ((cdr (member 46 (reverse l)))) ((reverse l)))
          i 0
    )
    (setvar 'dimzin d)
    (vl-list->string
        (append (if (minusp n) '(45))
            (reverse
                (apply 'append
                    (mapcar
                       '(lambda ( a b )
                            (if (and (zerop (rem (setq i (1+ i)) 3)) b)
                                (list a 44)
                                (list a)
                            )
                        )
                        x (append (cdr x) '(nil))
                    )
                )
            )
            (member 46 l)
        )
    )
)

February 5, 2019

10 minutes ago, Jest said:

It works, but now i got 6 decimal numbers, not 4, as before..

Note that the precision is limited to approximately 15 significant figures, hence for larger numbers, you'll lose precision in the number of decimal places - observe:

_$ (rtos 1.123456789012345 2 15)
"1.123456789012345"
_$ (rtos 10.123456789012345 2 15)
"10.12345678901234"
_$ (rtos 100.123456789012345 2 15)
"100.1234567890123"
_$ (rtos 1000.123456789012345 2 15)
"1000.123456789012"
_$ (rtos 10000.123456789012345 2 15)
"10000.12345678901"
_$ (rtos 100000.123456789012345 2 15)
"100000.123456789"
_$ (rtos 1000000.123456789012345 2 15)
"1000000.123456789"
_$ (rtos 10000000.123456789012345 2 15)
"10000000.12345679"
_$ (rtos 100000000.123456789012345 2 15)
"100000000.1234568"
_$ (rtos 1000000000.123456789012345 2 15)
"1000000000.123457"
_$ (rtos 10000000000.123456789012345 2 15)
"10000000000.12345"
_$ (rtos 100000000000.123456789012345 2 15)
"100000000000.1235"
_$ (rtos 1000000000000.123456789012345 2 15)
"1000000000000.123"
_$ (rtos 10000000000000.123456789012345 2 15)
"10000000000000.12"
_$ (rtos 100000000000000.123456789012345 2 15)
"100000000000000.1"
_$ (rtos 1000000000000000.123456789012345 2 15)
"1000000000000000"

February 6, 2019

I see...thanks

Can you just tell me, ho toadd thousand comma separation to TotaL Lenght lisp?

February 6, 2019

6 hours ago, Jest said:

I see...thanks

Can you just tell me, ho toadd thousand comma separation to TotaL Lenght lisp?

In the same way, changing:

(princ (rtos l))

to:

(princ (rtoc l 15))

December 10, 2021

On 2/5/2019 at 3:51 PM, Emmanuel Delay said:




(vl-load-com)
;; Get Selected Areas
(defun c:gsa ( / ss1 obj i sum)
  ;; SSGET polylines already selected
  (setq ss1  (ssget "I" '( (0 . "POLYLINE,LWPOLYLINE") (70 . 1) )))  ;; 70=1 means closed
 
  (setq
    i 0
    sum 0.0
  )
  (repeat (sslength ss1)
    (setq obj (vlax-ename->vla-object (ssname ss1 i)))
    (setq ar (vlax-curve-getarea obj))  ;; get area
    (setq sum (+ sum ar))
    (setq i (+ i 1))
  )
 
  (princ sum)
  (princ)
)

This is nearly perfect for me however I would like to have the sum of the areas of the polylines written in an MText in this format:

"%lu2%pr2%ps[,]%ct8[0.0001]"

(I draw in cm and want the sum in m2)

Cheers!

December 10, 2021

This will create an mtext object, just replace the "princ sum" text in the above with this

  (setq pt (getpoint "Select Insertion Point")) 
  (entmakex (list (cons 0 "MTEXT")         
                  (cons 100 "AcDbEntity")
                  (cons 100 "AcDbMText")
                  (cons 10 pt) ;Insertion Point
                  (cons 1 sum) ;Sum text from above
                  (cons 40 2.5)
  ))

and you can have a look on google how to format this as you want

December 10, 2021

Wouldn't you need to divide by 10000 to get m² or is that taken care of with that formatting?

Punched up the code a bit. After making mtext its copied to clipboard.

;; Get Selected Areas
(defun c:gsa (/ sum SS1 ent poly area pt str)
  (vl-load-com)
  (setq sum 0)
  (if (ssget "I") ;allows user to have polylines already selected or select them while code is running.
    (setq SS1 (ssget "_P" '((0 . "*POLYLINE") (70 . 1))))
    (setq SS1 (ssget '((0 . "*POLYLINE") (70 . 1))))
  )
  (if SS1
    (progn
      (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS1)))
        (setq poly (vlax-ename->vla-object ent)
              sum (+ sum (vlax-curve-getarea poly))
        )
      )
      (setq pt (getpoint "Select Insertion Point"))
      (entmake (list '(0 . "MTEXT")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbMText")
                     (cons 10 pt)  ;Insertion Point
                     (cons 1 (setq str (strcat (rtos (/ sum 10000) 2 3) " m²")))  ;cm to m convert
                     (cons 40 (getvar "TextSize"))
               )
      )
      (vlax-invoke (vlax-get (vlax-get (setq html (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "TEXT" str)
      ;copies output to clipboard
      (vlax-release-object html)
    )
    (prompt "/nNo Polylines Selected")
  )
  (princ)
)

Edited December 11, 2021 by mhupp

October 4, 2022

On 2/6/2019 at 1:53 AM, Jest said:

It works, but now i got 6 decimal numbers, not 4, as before..

Did I wrote down correctly?:

;;---------------------=={ Total Area }==---------------------;;
;;                                                            ;;
;; Displays the total area of selected objects at the        ;;
;; command line. The precision of the printed result is      ;;
;; dependent on the setting of the LUPREC system variable.   ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:tarea ( / a i s )
    (if (setq s
            (ssget
               '(   (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")
                    (-4 . "<NOT")
                        (-4 . "<AND")
                            (0 . "POLYLINE") (-4 . "&") (70 . 80)
                        (-4 . "AND>")
                    (-4 . "NOT>")
                )
            )
        )
        (progn
            (setq a 0.0)
            (repeat (setq i (sslength s))
                (setq a (+ a (vlax-curve-getarea (ssname s (setq i (1- i))))))
            )
            (princ "\nTotal Area: ")
            (princ (rtoc a 15))
        )
    )
    (princ)
)
(vl-load-com) (princ)
(defun rtoc ( n p / d i l x )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (vl-string->list (rtos (abs n) 2 p))
          x (cond ((cdr (member 46 (reverse l)))) ((reverse l)))
          i 0
    )
    (setvar 'dimzin d)
    (vl-list->string
        (append (if (minusp n) '(45))
            (reverse
                (apply 'append
                    (mapcar
                       '(lambda ( a b )
                            (if (and (zerop (rem (setq i (1+ i)) 3)) b)
                                (list a 44)
                                (list a)
                            )
                        )
                        x (append (cdr x) '(nil))
                    )
                )
            )
            (member 46 l)
        )
    )
)

It's works perfectly

Sign In

Multiple polyline area sum

Recommended Posts

Jest

Emmanuel Delay

Jest

Lee Mac

Jest

Lee Mac

Lee Mac

Jest

Lee Mac

Jest

Lee Mac

JFZ

Steven P

mhupp

faizur

Join the conversation

Tutorials

Forums

Activity