Topic: AREACALC.VLX

[vinnypoon]

I found a nice area calculation tool last week called areacalc.vlx. The area text info is a reactor object so it update dynamically as the associated polyline changes. The only problem is that the area is in square inches not sq.ft.. Does anyone use a similar function but in sq.ft.? Thanks

[Mark]

No, I don't. Did you try contacting the author? Maybe they can change the code and give you a new version bsaed on sq.ft.

[CADaver]

Code: [Select]


(defun CalcAREA ()
  (setq a 0
        ss (ssget '((-4 . "<OR")(0 . "CIRCLE")(0 . "region")(0 . "*polyline")(-4 . "OR>"));;;'((0 . "*POLYLINE"))
            )
   )
  (if ss
    (progn
      (setq n (1- (sslength ss)))
      (while (>= n 0)
        (command "_.area" "_o" (ssname ss n))
        (setq a (+ a (getvar "area"))
              n (1- n))
      ) ;;close while
     );;close progn
    (alert "\nNo Polylines selected!")
) ;;close if
  (princ)
) ;;close defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:ListAREA ()
(calcarea)
(if (/= a 0)
(progn
     (alert
        (strcat "The total area of the selected object(s) is\n\n     "
        (strcat
             (rtos a 2 2) " Sq In,\nor\n        "
             (rtos (/ a 144.0) 2 2) " Sq Ft, \nor\n             "
             (rtos (cvunit a "sq in" "Acres") 2 3) " Acres")
         ))
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:TAGAREA ()
(calcarea)
(if (/= a 0)
(progn
(setq str3
        (strcat            
             (rtos (/ a 144.0) 2 2) " Sq Ft\\P"
             (rtos (cvunit a "sq in" "acres") 2 3) " Acres"
         )
)
(txstla)
(setq at2  (getpoint "\nLocation for text... "))
(command "Mtext" at2 "R" "0" "J" "MC" "W" "0" str3 "")
)
)
(princ)
)


[vinnypoon]

Yes I have contacted the author, and he is working on it. I was just wondering if anyone else already have a solution for this.

No, I don't. Did you try contacting the author? Maybe they can change the code and give you a new version bsaed on sq.ft.

[vinnypoon]

Thanks! However upon entering the command Calcarea, autocad returned the following msg.

Unknown command "CALCAREA".  Press F1 for help.

Code: [Select]


(defun CalcAREA ()
  (setq a 0
        ss (ssget '((-4 . "<OR")(0 . "CIRCLE")(0 . "region")(0 . "*polyline")(-4 . "OR>"));;;'((0 . "*POLYLINE"))
            )
   )
  (if ss
    (progn
      (setq n (1- (sslength ss)))
      (while (>= n 0)
        (command "_.area" "_o" (ssname ss n))
        (setq a (+ a (getvar "area"))
              n (1- n))
      ) ;;close while
     );;close progn
    (alert "\nNo Polylines selected!")
) ;;close if
  (princ)
) ;;close defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:ListAREA ()
(calcarea)
(if (/= a 0)
(progn
     (alert
        (strcat "The total area of the selected object(s) is\n\n     "
        (strcat
             (rtos a 2 2) " Sq In,\nor\n        "
             (rtos (/ a 144.0) 2 2) " Sq Ft, \nor\n             "
             (rtos (cvunit a "sq in" "Acres") 2 3) " Acres")
         ))
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:TAGAREA ()
(calcarea)
(if (/= a 0)
(progn
(setq str3
        (strcat            
             (rtos (/ a 144.0) 2 2) " Sq Ft\\P"
             (rtos (cvunit a "sq in" "acres") 2 3) " Acres"
         )
)
(txstla)
(setq at2  (getpoint "\nLocation for text... "))
(command "Mtext" at2 "R" "0" "J" "MC" "W" "0" str3 "")
)
)
(princ)
)


[CADaver]

Sorry, CALCAREA is a subroutine enter the command LISTAREA or TAGAREA.

LISTAREA will pop the area up in an alert box in Sq. In., Sq.Ft., or Acres

TAGAREA will place mtext on the drawing containing the Sq.ft. and Acres.

Notice, too, that it only works for circles regions and plines.

[danny]

CADaver,
I got this error message.  Seems like the code is missing the subroutine (TXSTLA)

Command: tagarea

Select objects: 1 found

Select objects:
_.area
Specify first corner point or [Object/Add/Subtract]: _o
Select objects:
Area = 3228.8444, Perimeter = 217.1356

Command:

 no function definition: TXSTLA
; error: An error has occurred inside the *error* functionAutoCAD variable
setting rejected: "blipmode" nil

[CADaver]

CADaver,
I got this error message.  Seems like the code is missing the subroutine (TXSTLA)

AACKK ,sorry again, I missed it when I scanned for it earlier.  that's another subroutine for setting layers and styles for text.  Find the

Code: [Select]

(TXSTLA) and delete that entire line.  Today just isn't my day.
~~~~~~~
Or here's the whole dang thang agin, minus the troublesome bit.

Code: [Select]

(defun CalcAREA ()
  (setq a 0
        ss (ssget '((-4 . "<OR")(0 . "CIRCLE")(0 . "region")(0 . "*polyline")(-4 . "OR>"));;;'((0 . "*POLYLINE"))
            )
   )
  (if ss
    (progn
      (setq n (1- (sslength ss)))
      (while (>= n 0)
        (command "_.area" "_o" (ssname ss n))
        (setq a (+ a (getvar "area"))
              n (1- n))
      ) ;;close while
     );;close progn
    (alert "\nNo Polylines selected!")
) ;;close if
  (princ)
) ;;close defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:ListAREA ()
(calcarea)
(if (/= a 0)
(progn
     (alert
        (strcat "The total area of the selected object(s) is\n\n     "
        (strcat
             (rtos a 2 2) " Sq In,\nor\n        "
             (rtos (/ a 144.0) 2 2) " Sq Ft, \nor\n             "
             (rtos (cvunit a "sq in" "Acres") 2 3) " Acres")
         ))
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:TAGAREA ()
(calcarea)
(if (/= a 0)
(progn
(setq str3
        (strcat            
             (rtos (/ a 144.0) 2 2) " Sq Ft\\P"
             (rtos (cvunit a "sq in" "acres") 2 3) " Acres"
         )
)
(setq at2  (getpoint "\nLocation for text... "))
(command "Mtext" at2 "R" "0" "J" "MC" "W" "0" str3 "")
)
)
(princ)
)


[danny]

Mondays...

[Scott]

Not sure where I got this, but it works well.

AAREA.LSP
(DEFUN c:aarea ()
  (SETQ    oc (GETVAR "cmdecho")
    nc (SETVAR "cmdecho" 0)
  )
  (SETQ getobj (ENTSEL "Select object to get area of:"))
  (COMMAND "AREA" "o" getobj)
  (SETQ    sqft  (/ (GETVAR "AREA") )
    sqyds (/ sqft 9)
    acres (/ sqft 43560)
  )
  (ALERT
    (STRCAT "\nSquare Feet = "
        (RTOS sqft 2 3)
        "\nSquare Yards = "
        (RTOS sqyds 2 3)
        "\nAcres = "
        (RTOS acres 2 3)
    )
  )
  (SETVAR "cmdecho" oc)
)
(PROMPT "To use, enter aarea at the command line.")
(PRINC)

[Scott]

Sorry about not knowing who wrote the above code.  It is most likely someone on this forum since pretty much everone here inhabited the other forum before they desided it was better to make money instead of better the education of CAD users.  Anyway, if you recognize the code, and it belongs to you, please take your credit, as credit is deserved.

[vinnypoon]

Thanks, I have this one. The one I'm looking for uses reactor base text for the area label. The area text updates automatically as the associate pline changes.

Not sure where I got this, but it works well.

AAREA.LSP
(DEFUN c:aarea ()
  (SETQ    oc (GETVAR "cmdecho")
    nc (SETVAR "cmdecho" 0)
  )
  (SETQ getobj (ENTSEL "Select object to get area of:"))
  (COMMAND "AREA" "o" getobj)
  (SETQ    sqft  (/ (GETVAR "AREA") )
    sqyds (/ sqft 9)
    acres (/ sqft 43560)
  )
  (ALERT
    (STRCAT "\nSquare Feet = "
        (RTOS sqft 2 3)
        "\nSquare Yards = "
        (RTOS sqyds 2 3)
        "\nAcres = "
        (RTOS acres 2 3)
    )
  )
  (SETVAR "cmdecho" oc)
)
(PROMPT "To use, enter aarea at the command line.")
(PRINC)

[Andrea]

I have this....is simple...but can help.



;;command                                     ;;
;;                         PLINE AREA         ;;
;;By: AndreaLISP     sept. 2002        ;;

(defun pline_area ()
 
  (setvar "CMDECHO" 0 )
  (setvar "PEDITACCEPT" 1)
  (setq HVpick1 (getpoint "superficie :"))
  (setq HVpick2 (getpoint HVpick1 "\\n To..:"))
  (command "_line" HVpick1 HVpick2 "")
  (setq line1 (ssget "l"))
 
  (while HVpick2
    (setq HVpick1 HVpick2)
    (setq HVpick2 (getpoint HVpick1 "\\n To..:"))
    (if (= HVpick2 nil)
      (progn
   (command "_pedit" line1 "_c" "")
   (COMMAND "_AREA" "_o" "_l")
        (setq areazone (/ (GETVAR "AREA") 144))
   )
    (progn
    (command "_line" HVpick1 HVpick2 "")
    (setq line2 (entlast))
    (command "_pedit" line1 "_j" line2 "" "")
    (setq line1 (entlast))))
))

[danny]

have you tried using the ADT tags.  They not only are associated to the pline, but they can be exported to a schedule.

[Andrea]

I've also found this one..in my library...




(Defun C:DAREA ()
(setvar "CMDECHO" 0 )
(SETQ SS (entsel "Select Object To Get Area of:"))
(PROGN (COMMAND "_AREA" "o" SS))
(setq SqMeters (/ (SETQ Sqmm (/ (GETVAR "AREA") 1)) 1000000)) ;Change 1 to 1000 for Arch. Scale
(alert (strcat "\n Polyline Area" "\n\nSq mm's = " (rtos Sqmm 2 2) "\n Sq m's = " (rtos SqMeters 2 2))) ;put up alert box
(PRINC)
)


;  Print the Area of a closed polyline

(defun C:AREAPRT ()
; error function
  (defun *error* (msg)
    (if
      (not
   (member
     msg
     '("console break" "Function cancelled" "quit / exit abort")
   )
      )
       (princ (strcat "\nError: " msg))
    ) ; if
; reset variables below
    (princ)
  ) ;
;end error function
  (setq   A1 0
   A_Old 0
  )
  (while (/= A1 nil)
    (prompt "Pick Area...")
    (command "area" "o" pause)
    (setq A1 (/ (getvar "AREA") 144)) ;convert inches to feet
    (if   (= A_Old A1)
      (EXIT)
      (Progn
   (prompt "/nPick Text Location...")
   (setq TXT (strcat (rtos A1 2 2) " Sq. Ft."))
;             Check if the drawing height is set to 0:
   (setq dwg_style (getvar "textstyle"))
   (setq styledata (tblsearch "style" dwg_style))
   (setq dwg_ht (cdr (assoc 40 styledata)))

   (if (= dwg_ht 0)
     
     (command "text" pause "" "0" TXT "")
;        ELSE do this
       
     (command "text" pause "0" TXT "")
   ) ; endif
   (setq A_Old A1)
      )
    )
    (princ)
  )
)

;;;;;
;;;;;
;;;;;

(DEFUN c:aarea ()
(SETQ oc (GETVAR "cmdecho")
nc (SETVAR "cmdecho" 0)
)
(SETQ getobj (ENTSEL "Select object to get area of:"))
(COMMAND "AREA" "o" getobj)
(SETQ sqft (/ (GETVAR "AREA") )
sqyds (/ sqft 9)
acres (/ sqft 43560)
)
(ALERT
(STRCAT "\nSquare Feet = "
(RTOS sqft 2 3)
"\nSquare Yards = "
(RTOS sqyds 2 3)
"\nAcres = "
(RTOS acres 2 3)
)
)
(SETVAR "cmdecho" oc)
)
(PROMPT "To use, enter aarea at the command line.")
(PRINC)

[fred_bock]

this print area is a good start... but is any way that can change it to m²
i'm rearching for a way to calculate areas into a xls table .. or even into a cad table.... the only way i found by now is using the ADT tools...

there is a way to write at one cell to get the value of a polyline ??

[Scott]

fred_bock

I have a routine that will extract the areas of polylines to a text file.  I use it to calculate pond volumes.  Let me know if your intested.  It was written by John Kaul.  It is pretty useful to me.

Scott

[CADwoman]

Thanks, how can I edit this so that it displays SqFt when MEASUREMENT=0 and SqMeters when MEASUREMENT=1

CADaver,
I got this error message.  Seems like the code is missing the subroutine (TXSTLA)

AACKK ,sorry again, I missed it when I scanned for it earlier.  that's another subroutine for setting layers and styles for text.  Find the

Code: [Select]

(TXSTLA) and delete that entire line.  Today just isn't my day.
~~~~~~~
Or here's the whole dang thang agin, minus the troublesome bit.

Code: [Select]

(defun CalcAREA ()
  (setq a 0
        ss (ssget '((-4 . "<OR")(0 . "CIRCLE")(0 . "region")(0 . "*polyline")(-4 . "OR>"));;;'((0 . "*POLYLINE"))
            )
   )
  (if ss
    (progn
      (setq n (1- (sslength ss)))
      (while (>= n 0)
        (command "_.area" "_o" (ssname ss n))
        (setq a (+ a (getvar "area"))
              n (1- n))
      ) ;;close while
     );;close progn
    (alert "\nNo Polylines selected!")
) ;;close if
  (princ)
) ;;close defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:ListAREA ()
(calcarea)
(if (/= a 0)
(progn
     (alert
        (strcat "The total area of the selected object(s) is\n\n     "
        (strcat
             (rtos a 2 2) " Sq In,\nor\n        "
             (rtos (/ a 144.0) 2 2) " Sq Ft, \nor\n             "
             (rtos (cvunit a "sq in" "Acres") 2 3) " Acres")
         ))
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:TAGAREA ()
(calcarea)
(if (/= a 0)
(progn
(setq str3
        (strcat            
             (rtos (/ a 144.0) 2 2) " Sq Ft\\P"
             (rtos (cvunit a "sq in" "acres") 2 3) " Acres"
         )
)
(setq at2  (getpoint "\nLocation for text... "))
(command "Mtext" at2 "R" "0" "J" "MC" "W" "0" str3 "")
)
)
(princ)
)


[CAB]

I updated my area print to display meters, perhaps it will work for you.
http://www.theswamp.org/phpBB2/viewtopic.php?p=16451#16451