Calculate Area by picking internal point

I need the Lisp code for calculating area by picking internal point, and using only 2 specified layers.

There are many line entities in my drawing. They are connected representing parcels, and all are in one layer "Property lines". When I draw another line on layer "Cutting line" it will cut some of these parcels.

I need to calculate this new parcels' areas by picking an internal point of new parcel. Now, code must work only with Layers "Property lines" and "Cutting line", because I have many lines in other layers crossing over parcels (plumbing, canalization...). After picking the internal point, new area should be temporary coloured (maybe hatch or something) just to have visual proof that the right area is calculated. Than the lisp code should give me the value of area.

It is all about two mentioned layers. All other layers should stay as they are in that moment (on or off), but their content must not affect calculating of area.

I have lisp code for calculating area by picking points, but I want to speed up my work because I have over than 3000 of new parcels. My mouse would not get over it My forefinger too

Thank you.

The hatch is actually the key to this. You hatch the area then use the AREA command to get the area of the last object entered into the database.

(defun c:carea( / cla)
(setvar "cmdecho" 0)
(setq cla (getvar "clayer"))
(command "-layer" "s" "Property Lines" "state" "save" "carea" "" "" "off" "*" "" "on" "Cutting Line" "")
(graphscr)
(command "-hatch" (getpoint "Click internal point: ") "")
(command "area" "o" "L")
(princ (strcat "\n\nArea: " (rtos (/ (getvar "area") 144) 2 2) " sq ft"))
(command "erase" "L" "")
(command "-layer" "state" "restore" "carea" "d" "carea" "" "")
(setvar "clayer" cla)
(setvar "cmdecho" 1)
(princ)
)

in addition to calculating the acreage based on a picked point (doesn't have to be a polyline) and placing mtext at your picked point, you can increment your labels (ie: Lot 1, and then it will just increase by 1. i wrote this for when i design subdivisions and when i've laid my lots out i can just quickly pick and label them.

;CREATED BY: alan thompson 11.28.07
;MODIFIED BY: alan thompson 12.19.07 (mtext instead of dtext, lot numbering works better, etc.)
(defun c:GA()
(setq DZIN (getvar "dimzin"))
(setq des (getstring "\Enter Number Prefix (Lot, Parcel, etc.): "))
(setq ins 1)
(setq n (getint "\Enter First Lot Number: "))
(while
(setq ins (getpoint "\nPick Number Location: "))
(command "dimzin" "0")
(command "-boundary" ins "")
(command "area" "o" "l")
(command "erase" "l" "")
(setq AR (getvar "area"))
(setq ACRE (strcat (rtos (/ (getvar "area") 43560) 2 2) " AC.±"))
(setq txt (strcat des " " (rtos n 2 0)))
(command "mtext" ins "j" "mc" ins txt ACRE "")
(setq n (1+ n))
(command "dimzin" DZIN)
(princ "\n")(princ ACRE)(princ " & ")(princ (getvar "area"))(princ" SQ. FT.")
);WHILE
(princ))

Thank you both. I solved the problem.

can you make one for the metric mesaurement? it gives me the area in imperial.

thanks

in addition to calculating the acreage based on a picked point (doesn't have to be a polyline) and placing mtext at your picked point, you can increment your labels (ie: Lot 1, and then it will just increase by 1. i wrote this for when i design subdivisions and when i've laid my lots out i can just quickly pick and label them.

 

;CREATED BY: alan thompson 11.28.07
;MODIFIED BY: alan thompson 12.19.07 (mtext instead of dtext, lot numbering works better, etc.)
(defun c:GA()
(setq DZIN (getvar "dimzin"))
(setq des (getstring "\Enter Number Prefix (Lot, Parcel, etc.): "))
(setq ins 1)
(setq n (getint "\Enter First Lot Number: "))
(while
(setq ins (getpoint "\nPick Number Location: "))
(command "dimzin" "0")
(command "-boundary" ins "")
(command "area" "o" "l")
(command "erase" "l" "")
(setq AR (getvar "area"))
(setq ACRE (strcat (rtos (/ (getvar "area") 43560) 2 2) " AC.±"))
(setq txt (strcat des " " (rtos n 2 0)))
(command "mtext" ins "j" "mc" ins txt ACRE "")
(setq n (1+ n))
(command "dimzin" DZIN)
(princ "\n")(princ ACRE)(princ " & ")(princ (getvar "area"))(princ" SQ. FT.")
);WHILE
(princ))

how i great in macro files from autocad

in addition to calculating the acreage based on a picked point (doesn't have to be a polyline) and placing mtext at your picked point, you can increment your labels (ie: Lot 1, and then it will just increase by 1. i wrote this for when i design subdivisions and when i've laid my lots out i can just quickly pick and label them.

 

;CREATED BY: alan thompson 11.28.07
;MODIFIED BY: alan thompson 12.19.07 (mtext instead of dtext, lot numbering works better, etc.)
(defun c:GA()
(setq DZIN (getvar "dimzin"))
(setq des (getstring "\Enter Number Prefix (Lot, Parcel, etc.): "))
(setq ins 1)
(setq n (getint "\Enter First Lot Number: "))
(while
(setq ins (getpoint "\nPick Number Location: "))
(command "dimzin" "0")
(command "-boundary" ins "")
(command "area" "o" "l")
(command "erase" "l" "")
(setq AR (getvar "area"))
(setq ACRE (strcat (rtos (/ (getvar "area") 43560) 2 2) " AC.±"))
(setq txt (strcat des " " (rtos n 2 0)))
(command "mtext" ins "j" "mc" ins txt ACRE "")
(setq n (1+ n))
(command "dimzin" DZIN)
(princ "\n")(princ ACRE)(princ " & ")(princ (getvar "area"))(princ" SQ. FT.")
);WHILE
(princ))

but how to send the data to excel ?it will be better if it can send area data to excel !

but how to send the data to excel ?it will be better if it can send area data to excel !

This may help

http://www.cadtutor.net/forum/showthread.php?t=39562

Man, look at this, it's TERRIBLE! I didn't even have my variables localized. I guess it's safe to say I've come a long way since 2007. LoL

in addition to calculating the acreage based on a picked point (doesn't have to be a polyline) and placing mtext at your picked point, you can increment your labels (ie: Lot 1, and then it will just increase by 1. i wrote this for when i design subdivisions and when i've laid my lots out i can just quickly pick and label them.

 

;CREATED BY: alan thompson 11.28.07
;MODIFIED BY: alan thompson 12.19.07 (mtext instead of dtext, lot numbering works better, etc.)
(defun c:GA()
(setq DZIN (getvar "dimzin"))
(setq des (getstring "\Enter Number Prefix (Lot, Parcel, etc.): "))
(setq ins 1)
(setq n (getint "\Enter First Lot Number: "))
(while
(setq ins (getpoint "\nPick Number Location: "))
(command "dimzin" "0")
(command "-boundary" ins "")
(command "area" "o" "l")
(command "erase" "l" "")
(setq AR (getvar "area"))
(setq ACRE (strcat (rtos (/ (getvar "area") 43560) 2 2) " AC.±"))
(setq txt (strcat des " " (rtos n 2 0)))
(command "mtext" ins "j" "mc" ins txt ACRE "")
(setq n (1+ n))
(command "dimzin" DZIN)
(princ "\n")(princ ACRE)(princ " & ")(princ (getvar "area"))(princ" SQ. FT.")
);WHILE
(princ))

Man, look at this, it's TERRIBLE! I didn't even have my variables localized. I guess it's safe to say I've come a long way since 2007. LoL

but how to send your calculated area data to excel ,you can make your code better .

but how to send your calculated area data to excel ,you can make your code better .

Did my link not help you to modify the code?

Did my link not help you to modify the code?

I know only a Little about autolisp,I study it just from today,so it is difficult for me to modify the code ,and I do not know which code that you want me to modify.

From my link, this code should put the area of a polyline into an Excel cell, so, with a combination of this and Alan's LISP, you should get your desired result:

;; Area to Excel Cell  ~  Lee McDonnell (Lee Mac)
;; Copyright © August 2009

(defun c:A2xl (/ *error* xlApp xlCells Row)
 (vl-load-com)

 (defun *error* (msg)
   (ObjRel (list xlApp xlCells))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq xlApp  (vlax-get-or-create-object "Excel.Application")
       xlCells   (vlax-get-property
                   (vlax-get-property
                     (vlax-get-property
                       (vlax-invoke-method
                         (vlax-get-property xlApp 'Workbooks)
                         'Add)
                       'Sheets)
                     'Item 1)
                   'Cells)    Row 1)

 (while
   (and
     (setq ent (car (entsel "\nSelect Object: ")))
       (vlax-property-available-p
         (setq Obj
           (vlax-ename->vla-object ent)) 'Area))

   (vlax-put-property xlCells 'Item row 1
     (rtos
       (vlax-get-property Obj 'Area)))
   
   (setq Row (1+ Row)))

 (ObjRel (list xlApp xlCells))
 (gc) (gc)
 (princ))
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))

From my link, this code should put the area of a polyline into an Excel cell, so, with a combination of this and Alan's LISP, you should get your desired result:

 

;; Area to Excel Cell  ~  Lee McDonnell (Lee Mac)
;; Copyright © August 2009

(defun c:A2xl (/ *error* xlApp xlCells Row)
 (vl-load-com)

 (defun *error* (msg)
   (ObjRel (list xlApp xlCells))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq xlApp  (vlax-get-or-create-object "Excel.Application")
       xlCells   (vlax-get-property
                   (vlax-get-property
                     (vlax-get-property
                       (vlax-invoke-method
                         (vlax-get-property xlApp 'Workbooks)
                         'Add)
                       'Sheets)
                     'Item 1)
                   'Cells)    Row 1)

 (while
   (and
     (setq ent (car (entsel "\nSelect Object: ")))
       (vlax-property-available-p
         (setq Obj
           (vlax-ename->vla-object ent)) 'Area))

   (vlax-put-property xlCells 'Item row 1
     (rtos
       (vlax-get-property Obj 'Area)))
   
   (setq Row (1+ Row)))

 (ObjRel (list xlApp xlCells))
 (gc) (gc)
 (princ))
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))

maybe you can combine the code which was provided by alan thompson(http://www.cadtutor.net/forum/showthread.php?t=22874) and your code into one ,I know only a Little about LISP language ,I just study it from today,it is difficult for me to combine two codes into one ,maybe you can help me.

I think it should be very useful if you can write a code which can send the area data to excel ,I am a very novice about LISP language ,I just learn it from today .

No need to double post, there really isn't much to add to the code:

;; Area to Excel Cell  ~  Lee McDonnell (Lee Mac)
;; Copyright © August 2009

(defun c:A2xl (/ *error* vl ov xlApp xlCells Row pt eLast)
 (vl-load-com)

 (defun *error* (msg)
   (ObjRel (list xlApp xlCells))
   (and ov (mapcar 'setvar vl ov))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl))

 (setq xlApp  (vlax-get-or-create-object "Excel.Application")
       xlCells   (vlax-get-property
                   (vlax-get-property
                     (vlax-get-property
                       (vlax-invoke-method
                         (vlax-get-property xlApp 'Workbooks)
                         'Add)
                       'Sheets)
                     'Item 1)
                   'Cells)    Row 1)

 (while (setq pt (getpoint "\nPick Area: "))

   (mapcar 'setvar vl '(0 0))
   (setq eLast (entlast))
   (vl-cmdf "_.-boundary" "_a" "_i" "_n" "" "" pt "")

   (if (not (eq elast (setq ent (entlast))))
     (progn
       (vlax-put-property xlCells 'Item row 1
         (rtos
           (vlax-get-property (vlax-ename->vla-object ent) 'Area)))
       
       (entdel ent)
       (setq Row (1+ Row))))
   
   (mapcar 'setvar vl ov))

 (vlax-put-property xlApp 'Visible :vlax-true)
 (ObjRel (list xlApp xlCells))
 (gc) (gc)
 
 (mapcar 'setvar vl ov)
 (princ))
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))

Edit: code updated.

No need to double post, there really isn't much to add to the code:

 

;; Area to Excel Cell  ~  Lee McDonnell (Lee Mac)
;; Copyright © August 2009

(defun c:A2xl (/ *error* vl ov xlApp xlCells Row pt eLast)
 (vl-load-com)

 (defun *error* (msg)
   (ObjRel (list xlApp xlCells))
   (and ov (mapcar 'setvar vl ov))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq vl '("CMDECHO" "OSMODE") ov (mapcar 'getvar vl))

 (setq xlApp  (vlax-get-or-create-object "Excel.Application")
       xlCells   (vlax-get-property
                   (vlax-get-property
                     (vlax-get-property
                       (vlax-invoke-method
                         (vlax-get-property xlApp 'Workbooks)
                         'Add)
                       'Sheets)
                     'Item 1)
                   'Cells)    Row 1)

 (while (setq pt (getpoint "\nPick Area: "))

   (mapcar 'setvar vl '(0 0))
   (setq eLast (entlast))
   (vl-cmdf "_.-boundary" "_a" "_i" "_n" "" "" pt "")

   (if (not (eq elast (setq ent (entlast))))
     (progn
       (vlax-put-property xlCells 'Item row 1
         (rtos
           (vlax-get-property (vlax-ename->vla-object ent) 'Area)))
       
       (entdel ent)
       (setq Row (1+ Row))))
   
   (mapcar 'setvar vl ov))

 (vlax-put-property xlApp 'Visible :vlax-true)
 (ObjRel (list xlApp xlCells))
 (gc) (gc)
 
 (mapcar 'setvar vl ov)
 (princ))
           
(defun ObjRel (lst)
 (mapcar
   (function
     (lambda (x)
       (if (and (eq (type x) 'VLA-OBJECT)
                (not (vlax-object-released-p x)))
         (vl-catch-all-apply
           'vlax-release-object (list x))))) lst))

Edit: code updated.

your code works well ,but sometimes threre too many area ,and it is difficult to make a distinction between area which have been measured and which area have not been measured ,so it needs to make a mark on the area which has been measured ,and the area which have been measured should have different marks.the mark should appear immediately after pick the area .I think you can make your code work better .this is just my suggestions

please look the attachment picture ,area which have been measured and area which have not been measured .I think you can make your code work better .

and I want to show the results in one book but in different sheets(excel)

is there anybody who can modify the code which is provided by Lee McDonnell? I cannot understand his code at all.