Lisp to calculate Multiple Area by Layer

[3arizona]

Hi can someone help me add this lisp?  At the moment lisp can calculate 1 area at a time and only in sq inches.  

This is what i want it do:

Extract layer and total area, from multiple areas.

Output to be in SQ FT. round up if possible

Close PLine if not closed (so that i wont have problems calculating). Do this matter?

Thanks

(defun c:AREAtotal() 
(COMMAND "TEXTSIZE" "10" "")
          (setq OldVars (mapcar 'getvar (setq VarList '(cmdecho clayer))))
          (setvar 'cmdecho 0)
          (command "_.layer" "_make" "AREA" "color" "MAGENTA" "" "PLOT" "NO" "" "")
	  (COMMAND "AREA" "O" PAUSE "" "TEXT" "J" "R" PAUSE "" "" (strcat(rtos (GETVAR "AREA") 2 0)" SQ. IN.")
          (mapcar 'setvar VarList OldVars)
        ); progn
      ); if
 (PRINC) 

[ВeekeeCZ]

Did you search?

I am using THIS one.

[Kent1Cooper]

Search for terms like "area by layer", for example >this< and >here<.  If you find something that does most of what you want in the way that suits your needs best, other elements such as in-square-feet can be added.

No, Polylines don't need to be closed -- the Area will be the same either way unless  the closing of them would be with an arc  segment.

[3arizona]

BeekeeCZ

I can't open the link. i created an account and still wont let me in.  I did search but most lisps only give you a total at the command prompt or extract data (sq. ft. only) to an XL sheet.  Can you post lisp to this forum?

Thanks

[3arizona]

Kent,

Here is a lisp i found and modified with help. I cant get the total Sq Foot to calculate correctly.

i'm on an area of 10'x10'. instead of 100'-0" sq ft i'm getting 1200'-0". Also, i don't know how to suppress the "0" at the end. 

Hope that someone can help, I've been on this for a while now.

Thanks  

(defun C:LAYtest ( / *error* acdoc ss p i e a d l) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar 'undoctl) 8))
      (vla-endundomark acdoc)
    )
    (princ)
    )
  
  (if
    (and
      (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
      (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
      )
    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))
              d (vlax-curve-getarea e)
        )
        (if
          (setq o (assoc a l))
          (setq l (subst (list a (+ (cadr o) d)) o l))
          (setq l (cons (list a d) l))
        )
      )
      (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))

          (setq OldVars (mapcar 'getvar (setq VarList '(cmdecho clayer))))
          (setvar 'cmdecho 0)
      (command "_.layer" "_thaw" "x LF Total" "_make" "x SQ.F. Total" "_Color" "red" "" "_Plot" "_No" "" ""   

	(insert_table l p)
	)
      )
    )
  (*error* nil)
  (princ)
  )

(defun insert_table (lst pct / tab row col ht i n space)
  (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
        ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
        )
  (vlax-put tab 'direction n)
  
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
  
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))

  (setq lst (cons '("Layer" "Total SQ.FT") lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list lst))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
  
  (setq lst (cons '("Linear Foot") lst))
  
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col (if (numberp c) (rtos c) (vl-princ-to-string c)))
      (setq col (1+ col))
      )
    (setq row (1+ row))
(mapcar 'setvar VarList OldVars)
    )
  )

[Kent1Cooper]

---

@3arizona wrote:

.... I cant get the total Sq Foot to calculate correctly.

i'm on an area of 10'x10'. instead of 100'-0" sq ft i'm getting 1200'-0". Also, i don't know how to suppress the "0" at the end. 

....

The (vlax-curve-get-area) should be returning in square drawing units, whatever those are.  I assume from the fact that you're getting feet-and-inches returns that your drawing unit is an inch, not a foot.  In that case, I would expect 10'x10' to be 14400 square units.  1200 is like it's multiplying the size in one direction in feet  by the size in the other direction in inches.  But I would have expected, if your drawing unit is an inch, a division of area values by 144 to get square feet.  I don't see anything like that, so I'm not sure what is causing that 1200 value.

For suppressing the feet-and-inches part, change

(rtos c)

near the end [which will return a string in current drawing-units format] to

(rtos c 2 0)

The 2 is to get decimal units regardless of the current units setting, and the 0 for the number of decimal places [whole-number return with 0 -- change that to whatever you need].

[3arizona]

My drawing was set to ARCH, that's why i was getting the 1200'. Changed units to Decimal and got 14400 sq in. 

Changing (rtos c 2 0) gives me SQ. IN. no mattered if i'm Decimal or Arch.  But I still would like an output of Sq Ft., if possible.

Thanks

[Kent1Cooper]

---

@3arizona wrote:

.... 

Changing (rtos c 2 0) gives me SQ. IN. no mattered if i'm Decimal or Arch.  But I still would like an output of Sq Ft., if possible.

....

---

For that, change it to:

(rtos (/ c 144) 2 0)

[3arizona]

Works perfect.  How can i to insert a foot ' symbol?   Only other problem that i saw is than when i close the following:

(command "_.layer" "_thaw" "x LF Total" "_make" "x SQ.F. Total" "_Color" "red" "" "_Plot" "_No" "" "")

I get this error, but still works fine both ways.

Command: ; error: extra right paren on input

[Kent1Cooper]

---

@3arizona wrote:

....  How can i to insert a foot ' symbol?   ....

---

(strcat (rtos (/ c 144) 2 0) "'")

But they're not  feet, they're square  feet -- linear and area values are really quite different things.  I would be inclined to do this instead:

(strcat (rtos (/ c 144) 2 0) " sf")

or upper-case SF if you prefer.  There's probably a way to do '2 with the 2 as superscript, but it might depend on the font you're using.

On the extra right parenthesis, I suspect that's coming from somewhere else other than that Layer command, but I haven't dug into the full routine.  Maybe later....

[3arizona]

Kent,

Thanks for your help. I hope this error doesn't create problems down the road.  

thanks, for your time  

[ВeekeeCZ · Accepted solution]

Anyone who added the (insert_table l p) line did id at wrong spot. It should be one closing-parenthesis behind.

(defun C:LAYtest ( / *error* acdoc ss p i e a d l) (vl-load-com)
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark acdoc)

  (defun *error* (msg)
    (and
      msg
      (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*,*EXIT*"))
      (princ (strcat "\nError: " msg))
    )
    (if
      (= 8 (logand (getvar 'undoctl) 8))
      (vla-endundomark acdoc)
    )
    (princ)
    )
  
  (if
    (and
      (setq ss (ssget ":L" '((0 . "LINE,POLYLINE,LWPOLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE"))))
      (setq p (getpoint "\nTable scale depend on annotation scale.\nSpecify table insert point: "))
      )
    (progn
      (repeat
        (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i)))
              a (cdr (assoc 8 (entget e)))
              d (vlax-curve-getarea e)
        )
        (if
          (setq o (assoc a l))
          (setq l (subst (list a (+ (cadr o) d)) o l))
          (setq l (cons (list a d) l))
        )
      )
      (setq l (vl-sort l '(lambda (a b) (< (car a) (car b)))))

          (setq OldVars (mapcar 'getvar (setq VarList '(cmdecho clayer))))
          (setvar 'cmdecho 0)
      (command "_.layer" "_thaw" "x LF Total" "_make" "x SQ.F. Total" "_Color" "red" "" "_Plot" "_No" "" "")
      (insert_table l p)
      )
    )
  (*error* nil)
  (princ)
  )

(defun insert_table (lst pct / tab row col ht i n space)
  (setq space (vlax-get acDoc (if (= 1 (getvar 'cvport)) 'PaperSpace 'ModelSpace))
        ht  (/ 2.5 (cond ((getvar 'cannoscalevalue)) (1.0)))
        pct (trans pct 1 0)
        n   (trans '(1 0 0) 1 0 T)
        tab (setq tab (vla-addtable space (vlax-3d-point pct) (+ 2 (length lst)) (length (car lst)) (* 2.5 ht) ht))
        )
  (vlax-put tab 'direction n)
  
  (mapcar
    (function
      (lambda (rowType)
        (vla-SetTextStyle  tab rowType (getvar 'textstyle))
        (vla-SetTextHeight tab rowType ht)
      )
    )
   '(2 4 1)
  )
  
  (vla-put-HorzCellMargin tab (* 0.14 ht))
  (vla-put-VertCellMargin tab (* 0.14 ht))

  (setq lst (cons '("Layer" "Total SQ.FT") lst))

  (setq i 0)
  (foreach col (apply 'mapcar (cons 'list lst))
    (vla-SetColumnWidth tab i
      (apply
        'max
        (mapcar
          '(lambda (x)
             ((lambda (txb) (+ (abs (- (caadr txb) (caar txb))) (* 2.0 ht)))
              (textbox (list (cons 1 (vl-princ-to-string x)) (cons 7 (getvar 'textstyle)) (cons 40 ht)))
              )
             )
          col
          )
        )
      )
    (setq i (1+ i))
    )
  
  (setq lst (cons '("Linear Foot") lst))
  
  (setq row 0)
  (foreach r lst
    (setq col 0)
    (vla-SetRowHeight tab row (* 1.5 ht))
    (foreach c r
      (vla-SetText tab row col (if (numberp c) (strcat (rtos (/ c 144) 2 0) "'") (vl-princ-to-string c)))
      (setq col (1+ col))
      )
    (setq row (1+ row))
(mapcar 'setvar VarList OldVars)
    )
  )

(just added what Kent suggested before.)

BTW that thing with your wrong units is really weird - would you post same sample drawing to take a look?

[3arizona]

Kent, BeekeeCZ

No errors!  Thank you both for help me out with this.   

[Anonymous]

How to do it so the area is in sq. meter? Please help me.. Thank you!

[Anonymous]

Got it. I just changed the 144 to 1 and sq. Ft. To sq. M..  Thank you anyway. 

[3arizona]

 BeekeeCZ,

Never noticed this error, maybe because its been working. I'll appreciate it if you can help me out

The following errors occurs when loading lisp and using command.

Error when loading:

Command: APPLOAD
; error: no function definition: STARTCOMMAND
Square Foot AREA.LSP successfully loaded.
; error: no function definition: ENDCOMMAND

Error after using command:

Error: no function definition: STARTCOMMAND
Error: no function definition: ENDCOMMAND