TheSwamp

CAD Forums => CAD General => Topic started by: vinnypoon on January 31, 2005, 01:25:41 PM

Title: AREACALC.VLX
Post by: vinnypoon on January 31, 2005, 01:25:41 PM
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
Title: AREACALC.VLX
Post by: Mark on January 31, 2005, 01:33:07 PM
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.
Title: AREACALC.VLX
Post by: CADaver on January 31, 2005, 03:03:27 PM
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)
)
Title: AREACALC.VLX
Post by: vinnypoon on January 31, 2005, 04:05:23 PM
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.

Quote from: Mark Thomas
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.
Title: AREACALC.VLX
Post by: vinnypoon on January 31, 2005, 04:08:10 PM
Thanks! However upon entering the command Calcarea, autocad returned the following msg.

Unknown command "CALCAREA".  Press F1 for help.


Quote from: 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)
)
Title: AREACALC.VLX
Post by: CADaver on January 31, 2005, 05:38:40 PM
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.
Title: AREACALC.VLX
Post by: danny on January 31, 2005, 05:55:03 PM
CADaver,
I got this error message.  Seems like the code is missing the subroutine (TXSTLA)
Quote
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
Title: AREACALC.VLX
Post by: CADaver on January 31, 2005, 06:01:48 PM
Quote from: danny
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)
)
Title: AREACALC.VLX
Post by: danny on January 31, 2005, 06:12:31 PM
Mondays...
Title: AREACALC.VLX
Post by: Scott on January 31, 2005, 06:51:13 PM
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)
Title: AREACALC.VLX
Post by: Scott on February 01, 2005, 10:27:19 AM
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.
Title: AREACALC.VLX
Post by: vinnypoon on February 01, 2005, 11:59:25 AM
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.

Quote from: 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)
Title: AREACALC.VLX
Post by: Andrea on February 01, 2005, 02:21:57 PM
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))))
))
Title: AREACALC.VLX
Post by: danny on February 01, 2005, 02:25:39 PM
have you tried using the ADT tags.  They not only are associated to the pline, but they can be exported to a schedule.
Title: AREACALC.VLX
Post by: Andrea on February 01, 2005, 05:23:35 PM
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)
Title: AREACALC.VLX
Post by: fred_bock on February 02, 2005, 06:03:49 AM
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 ??
Title: AREACALC.VLX
Post by: Scott on February 02, 2005, 09:20:16 AM
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
Title: AREACALC.VLX
Post by: CADwoman on April 04, 2005, 12:53:08 PM
Thanks, how can I edit this so that it displays SqFt when MEASUREMENT=0 and SqMeters when MEASUREMENT=1

Quote from: CADaver
Quote from: danny
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)
)
Title: AREACALC.VLX
Post by: CAB on April 04, 2005, 01:34:24 PM
I updated my area print to display meters, perhaps it will work for you.
http://www.theswamp.org/phpBB2/viewtopic.php?p=16451#16451