Calculate Area by picking internal point

May 1, 2008

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.

May 4, 2008

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)
)

May 4, 2008

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))

May 6, 2008

Thank you both. I solved the problem.

May 6, 2008

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))

May 8, 2008

how i great in macro files from autocad

December 19, 2009

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 !

December 19, 2009

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

December 20, 2009

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))

December 20, 2009

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 .

December 20, 2009

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?

December 20, 2009

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.

December 20, 2009

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))

December 20, 2009

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.

December 20, 2009

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 .

December 20, 2009

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.

December 20, 2009

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

December 20, 2009

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 .

December 20, 2009

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

December 20, 2009

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

Sign In

Calculate Area by picking internal point

Recommended Posts

Bane

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

3dwannab

Posted Images

Arch_Eric

alanjt

Bane

filan1a

venkateshans

bbb120

Lee Mac

alanjt

bbb120

Lee Mac

bbb120

Lee Mac

bbb120

bbb120

Lee Mac

bbb120

bbb120

bbb120

bbb120

Join the conversation

3dwannab

Tutorials

Forums

Activity