Author Topic: help with area lisp  (Read 6511 times)

0 Members and 1 Guest are viewing this topic.

pedroantonio

  • Guest
help with area lisp
« on: October 23, 2019, 05:54:45 AM »
Hi i use thi lisp to calculate area of a polyline and insert area text in the drawing. This code allow me to select multyple polylines and calculate the area. I want to add an option

for example

1. Select one polyline only
2. Select multyple polylines

or if i pick twice the same polyline gines me an alert window  to select (yes or no if i accept to continue)

I want this option because is easy to do a mistake and pick two times the same polyline and take the double area .

Code - Auto/Visual Lisp: [Select]
  1. (defun C:GetArea (/ ent myArea pt1 ht scl )
  2. (COMMAND "_layer" "_m" "Area" "_c" "6""" "")
  3. (command "-style" "Area" "arial.ttf" "" "" "" "" "")
  4. (setq scl (getvar "useri1"))
  5.  (setq ht(* 0.003 scl))
  6.   ;turn off the system echo
  7.   (setvar "cmdecho" 0)
  8.   ;set up a variable to hold the accumulated areas
  9.   (setq myArea 0)
  10.   ;while the user keeps making a selection
  11.   (while(setq ent(entsel))
  12.     ;if an entity was selected and not a point in space    
  13.     (if(car ent)
  14.        (progn
  15.           ;let AutoCAD get the area of the object...cheap yet effective way out...
  16.           ;Note: AutoCAD stores the area in the system variable "Area"
  17.           (command "area" "Object" (car ent))
  18.           ;print the area to the command line
  19.           (princ (strcat "\n E = " (rtos (getvar "Area") 2 2)" sq.m"))
  20.           ;accumulate the area if it exist
  21.           (if (getvar "Area")(setq myArea(+ myArea (getvar "Area"))))
  22.        )
  23.     )
  24.   )
  25.   ;ask for a text insertion point
  26.   (setq pt1 (getpoint "\n Insert text:"))
  27.   ;print the area in the drawing
  28.   (command "text" pt1 ht 100 (strcat "E = "(rtos myArea 2 2)" τ.μ"))
  29.  
  30.   ;suppress the last echo
  31.  (command "setvar" "clayer" "0")
  32.   (princ)
  33. )
  34.  
  35.  

Thanks

tombu

  • Bull Frog
  • Posts: 288
  • ByLayer=>Not0
Re: help with area lisp
« Reply #1 on: October 23, 2019, 07:41:20 AM »
I prefer using the fields approach since objects whose areas have been modified would reflect the updated area in the field.
Lee Mac has several that are close to what you're describing.  I like the idea of preventing an object from being selected more than once.  Being able to subtract areas would be nice as well. http://lee-mac.com/areastofield.html
His Field Arithmetic lisp could help with that.

Irné Barnard has another: https://forums.augi.com/showthread.php?98524-Area-of-Hatched-Objects&p=967005&viewfull=1#post967005
« Last Edit: October 23, 2019, 07:49:37 AM by tombu »
Tom Beauford P.S.M.
Leon County FL Public Works - Windows 7 64 bit AutoCAD Civil 3D

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: help with area lisp
« Reply #2 on: October 23, 2019, 10:01:56 AM »
I've pulled out this one from my library for quick area placements directly inside enclosed boundary of ACAD curve entities...
Maybe someone can improve it further more...

Code - Auto/Visual Lisp: [Select]
  1. (defun c:aaa ( / *error* ss-allcurves mk_txt p ar el )
  2.  
  3.  
  4.   (defun *error* ( m / ch )
  5.     (initget "Yes No")
  6.     (setq ch (getkword "\nDo you want to keep *size* variable for text size in memory or not [Yes/No] <Yes> : "))
  7.     (if (null ch)
  8.       (setq ch "Yes")
  9.     )
  10.     (if (= ch "No")
  11.       (setq *size* nil)
  12.     )
  13.     (if m
  14.       (prompt m)
  15.     )
  16.     (princ)
  17.   )
  18.  
  19.   (defun ss-allcurves ( / ss sss ssss i e )
  20.     (if (not (equal '(nil nil) (sssetfirst nil (ssget "_A" (list (cons 0 "*POLYLINE,SPLINE,XLINE,LINE,RAY,ARC,CIRCLE,ELLIPSE,HELIX") (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))))))) (setq ss (ssget "_:L")))
  21.     (setq sss (ssadd))
  22.     (if ss
  23.       (repeat (setq i (sslength ss))
  24.         (setq e (ssname ss (setq i (1- i))))
  25.         (if (not (minusp (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget e))))))))
  26.           (ssadd e sss)
  27.         )
  28.       )
  29.     )
  30.     (setq ssss (ssadd))
  31.     (if sss
  32.       (repeat (setq i (sslength sss))
  33.         (setq e (ssname sss (setq i (1- i))))
  34.         (if (zerop (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget e)))))))
  35.           (ssadd e ssss)
  36.         )
  37.       )
  38.     )
  39.     (if ssss
  40.       (if (/= (sslength ssss) 0)
  41.         ssss
  42.         nil
  43.       )
  44.       nil
  45.     )
  46.   )
  47.  
  48.   (defun mk_txt ( p txt a )
  49.     (or *size* (setq *size* (getvar 'textsize)))
  50.     (entmake
  51.       (list
  52.         '(0 . "TEXT")
  53.         '(100 . "AcDbEntity")
  54.         '(100 . "AcDbText")
  55.         '(7 . "Standard")
  56.         (cons 1 txt)
  57.         (cons 10 p)
  58.         (cons 40 *size*)
  59.         (cons 50 a)
  60.         '(71 . 0)
  61.         '(72 . 1)
  62.         (cons 11 p)
  63.         '(210 0.0 0.0 1.0)
  64.         '(73 . 2)
  65.       )
  66.     )
  67.   )
  68.  
  69.   (setq *size* (if (null *size*) (progn (initget 6) (getdist (strcat "\nPick or specify textsize <" (if (zerop (vla-get-height (vla-get-activetextstyle (vla-get-activedocument (vlax-get-acad-object))))) (rtos (* (/ (getvar 'viewsize) (cadr (getvar 'screensize))) 10) 2 50) (rtos (getvar 'textsize) 2 50)) "> : "))) *size*))
  70.   (if (null *size*)
  71.     (setq *size*
  72.         (* (/ (getvar 'viewsize) (cadr (getvar 'screensize))) 10)
  73.         (getvar 'textsize)
  74.       )
  75.     )
  76.   )
  77.   (while (setq p (getpoint "\nPick or specify point inside boundary : "))
  78.     (setq el (entlast))
  79.     (vl-cmdf "_.-BOUNDARY" "_A" "_O" "_R" "_I" "_N" "_N" "_B" "_N" (ss-allcurves) "" "" "_non" p "")
  80.     (if (not (eq el (entlast)))
  81.       (progn
  82.         (setq ar (vla-get-area (vlax-ename->vla-object (entlast))))
  83.         (entdel (entlast))
  84.         (mk_txt p (rtos ar 2 4) 0.0)
  85.       )
  86.     )
  87.   )
  88.   (*error* nil)
  89. )
  90.  

HTH., M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

pedroantonio

  • Guest
Re: help with area lisp
« Reply #3 on: October 23, 2019, 10:09:37 AM »
Nice code ribam but is not workin for my job. I have polygons with fence inside and buildings and roads. I need to select the close polyline not to pick inside becouse gives me wrong results

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: help with area lisp
« Reply #4 on: October 23, 2019, 10:19:06 AM »
Just a note for my posted code... Area you pick with a point will be calculated for enclosing curves that are only on unlocked layer(s) - those on locked layer(s) will be omitted in boundary calculation...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

pedroantonio

  • Guest
Re: help with area lisp
« Reply #5 on: October 23, 2019, 12:19:22 PM »
any other options?

Thanks

pedroantonio

  • Guest
Re: help with area lisp
« Reply #6 on: October 24, 2019, 04:05:32 AM »
is it possible to add an alert in command line with the number of the select polylines?


Quote
for example i select two polylines

Select objects: 1 found
Select objects: 1 found, 2 total


Thanks

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: help with area lisp
« Reply #7 on: October 24, 2019, 08:31:39 AM »
Have you tried using (entsel) function, or (ssget "_+.:E:S") - or if you want to select on unlocked layer (ssget "_+.:E:S:L")
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

pedroantonio

  • Guest
Re: help with area lisp
« Reply #8 on: October 24, 2019, 10:57:53 AM »
I try this but something is going wrong !!!

Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun c:test (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
  3.  (COMMAND "_layer" "_m" "_Area" "_c" "6""" "")
  4.   (command "_.-style" "_area" "arial.ttf" "_annotative" "_yes" "_no" 3 1.0 0.0 "_no" "_no" "_no")
  5.   (defun errexit (s)
  6.     (restore)
  7.   )
  8.  
  9.   (defun undox ()
  10.     (command "._undo" "_E")
  11.     (setvar "cmdecho" oldcmdecho)
  12.     (setq *error* olderr)
  13.     (princ)
  14.   )
  15.  
  16.   (setq olderr  *error*
  17.         restore undox
  18.         *error* errexit
  19.   )
  20.   (setq oldcmdecho (getvar "cmdecho"))
  21.   (setvar "cmdecho" 0)
  22.   (command "._UNDO" "_BE")
  23.  
  24.   (progn
  25.     (setq nr 0)
  26.     (setq tot_area 0.0)
  27.     (setq en (ssname ss1 nr))
  28.     (while en
  29.       (command "._area" "_O" en)
  30.       (setq tot_area (+ tot_area (getvar "area")))
  31.       (setq nr (1+ nr))
  32.       (setq en (ssname ss1 nr))
  33.     )
  34.   (setq pt(getpoint "\nPick to insert the text:"))
  35.     (command "text" pt 100 (strcat "E = " (rtos tot_area 2 2) " sq.m"))
  36.   )
  37. )
  38. (setq ss1 nil)
  39. (setvar 'cmdecho 1)
  40. (command "setvar" "clayer" "0")
  41. (restore)
  42. )
  43. )
  44.  
« Last Edit: October 24, 2019, 11:08:01 AM by Topographer »

ronjonp

  • Needs a day job
  • Posts: 7526
Re: help with area lisp
« Reply #9 on: October 24, 2019, 11:03:02 AM »
Your post is confusing .. your first code example looks nothing like the last? Look at Ribarm's comments you have an answer.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

pedroantonio

  • Guest
Re: help with area lisp
« Reply #10 on: October 24, 2019, 11:10:33 AM »
Hi ronjonp. I am trying to find a way to count how may polylines i select . So i will be sure if the results are correct. Now i try to change the code  but is not working

ronjonp

  • Needs a day job
  • Posts: 7526
Re: help with area lisp
« Reply #11 on: October 24, 2019, 12:20:02 PM »
Hi ronjonp. I am trying to find a way to count how may polylines i select . So i will be sure if the results are correct. Now i try to change the code  but is not working
Which code are you referring to? Your last post won't work at all as it's missing some subs .. if you're referring to your original post then try this.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:getarea (/ a ent ht myarea pt1 r scl)
  2.   (command "_layer" "_m" "Area" "_c" "6" "" "")
  3.   (command "-style" "Area" "arial.ttf" "" "" "" "" "")
  4.   (setq scl (getvar "useri1"))          ; <- Does this work? returns 0 here
  5.   (setq ht (* 0.003 scl))
  6.   (setvar "cmdecho" 0)
  7.   (setq myarea 0)
  8.   (while (setq ent (car (entsel "\nPick something to get area: ")))
  9.     (setq r (cons ent r))
  10.     (if (= 'real (type (setq a (vl-catch-all-apply 'vlax-curve-getarea (list ent)))))
  11.       (progn (princ (strcat "\n E = " (rtos (getvar "Area") 2 2) " sq.m"))
  12.              (if (getvar "Area")
  13.                (+ myarea a)
  14.              )
  15.              ;; This should ensure you don't pick twice ;)
  16.              (redraw ent 2)
  17.              ;; Print number of items picked.
  18.              (print (length r))
  19.       )
  20.     )
  21.   )
  22.   ;; Show them again
  23.   (foreach e r (redraw e 1))
  24.   (if (setq pt1 (getpoint "\n Insert text:"))
  25.     (command "text" pt1 ht 100 (strcat "E = " (rtos myarea 2 2) " &#38;#964;.&#38;#956;"))
  26.   )
  27.   (command "setvar" "clayer" "0")
  28.   (setvar "cmdecho" 1)
  29.   (princ)
  30. )
  31.  

Why are you picking one at a time .. this is horribly inefficient?
« Last Edit: October 24, 2019, 12:24:20 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

pedroantonio

  • Guest
Re: help with area lisp
« Reply #12 on: October 24, 2019, 01:30:22 PM »
I want something like this code but insert annotative  text in to the drawing with the area

use

Code - Auto/Visual Lisp: [Select]
  1. (COMMAND "_layer" "_m" "_Area" "_c" "6""" "")
  2.   (command "_.-style" "_area" "arial.ttf" "_annotative" "_yes" "_no" 3 1.0 0.0 "_no" "_no" "_no")
  3. (setq pt(getpoint "\nPick to insert the text:"))
  4.     (command "text" pt 100 (strcat "E = " (rtos tot_area 2 2) " sq.m"))
  5. (command "setvar" "clayer" "0")
  6.  


Code - Auto/Visual Lisp: [Select]
  1.  
  2. ;;; AREAM.LSP
  3. ;;; Function: Calculates the total area of selected objects
  4. ;;; By Jimmy Bergmark
  5. ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved
  6. ;;; Website: www.jtbworld.com
  7. ;;; E-mail: info@jtbworld.com
  8. ;;; Tested on AutoCAD 2000
  9.  
  10. (defun c:aream (/ olderr oldcmdecho errexit undox restore ss1 nr en tot_area)
  11.   (defun errexit (s)
  12.     (restore)
  13.   )
  14.  
  15.   (defun undox ()
  16.     (command "._undo" "_E")
  17.     (setvar "cmdecho" oldcmdecho)
  18.     (setq *error* olderr)
  19.     (princ)
  20.   )
  21.  
  22.   (setq olderr  *error*
  23.         restore undox
  24.         *error* errexit
  25.   )
  26.   (setq oldcmdecho (getvar "cmdecho"))
  27.   (setvar "cmdecho" 0)
  28.   (command "._UNDO" "_BE")
  29.   (if (setq ss1 (ssget '((-4 . "<OR")
  30.                          (0 . "POLYLINE")
  31.                          (0 . "LWPOLYLINE")
  32.                          (0 . "CIRCLE")
  33.                          (0 . "ELLIPSE")
  34.                          (0 . "SPLINE")
  35.                          (0 . "REGION")
  36.                          (-4 . "OR>")
  37.                         )
  38.                 )
  39.       )
  40.     (progn
  41.       (setq nr 0)
  42.       (setq tot_area 0.0)
  43.       (setq en (ssname ss1 nr))
  44.       (while en
  45.         (command "._area" "_O" en)
  46.         (setq tot_area (+ tot_area (getvar "area")))
  47.         (setq nr (1+ nr))
  48.         (setq en (ssname ss1 nr))
  49.       )
  50.       (princ "\nTotal Area = ")
  51.       (princ tot_area)
  52.     )
  53.   )
  54.   (setq ss1 nil)
  55.   (restore)
  56. )
  57.  
  58.  

Thanks

ronjonp

  • Needs a day job
  • Posts: 7526
Re: help with area lisp
« Reply #13 on: October 24, 2019, 03:09:32 PM »
 :blink: You are confusing me. Sorry I can't help anymore.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

pedroantonio

  • Guest
Re: help with area lisp
« Reply #14 on: October 25, 2019, 08:12:22 AM »
is it possible to add annotation text in the last code?

thanks