Multiple polyline area sum

[Jest]

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

Thanks

[Emmanuel Delay]

(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

[Jest]

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!

[Lee Mac]

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

[Jest]

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

[Lee Mac]

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

[Lee Mac]

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

[Jest]

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

 

[Lee Mac]

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"

 

[Jest]

I see...thanks

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

[Lee Mac]

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

 

[JFZ]

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!

 

[Steven P]

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

[mhupp]

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

[faizur]

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