Jump to content

Area calculation for region...


Hunter

Recommended Posts

Hi all:

 

Can someone give me a lisp which can:

1.calculate each area of region or polyline seleled by user and write the area in text .

 

2.calculate the sum of all areas and write in text.

 

3.export each to Excel.

 

Actually I found the function 「Area Calcutaion」of CadTools almost met my need, but it only works for polylines not for regions...

 

Much appreciate~

 

Li

Link to comment
Share on other sites

here's an update, works now for region, circle,ellipse and and closed spline

 

;;; CADALYST 07/08  www.cadalyst.com/code 
;;; Tip 2292: AreaRon.lsp	Area of Closed Polylines	(c) 2008 Ronald Maneja (Wizman)

;;; PRODUCES TEXT CONTAINING AREA OF  SELECTED CLOSED POLYLINES
;;; AND PUTS THEM IN AREARON LAYER
;;; CREATED BY RON MANEJA 31JAN08
;;; USER INPUTS: SCALE, POLYLINE SELECTION
;;;

;;; VERSION 1.1 (09FEB09): ADDED AREA FOR REGIONS, SPLINE, CIRCLE & ELLIPSE
;;; 

(defun C:AREARON (/
	  allx
	  ally
	  areaobj
	  counter
	  ctr
	  el
	  entity-name
	  entnamevla
	  mysset
	  prec_temp
	  pt
	  reg_centroid
	  temp
	  tst
	  vertex
	  x
	  y
	  oldlayer
	  oldsnap
	  temperr
	  traperror
	  blpt
	  cir_center
	  el_center
	  maxpt
	  minpt
	  spl_center
	  trpt
	 )

(defun set_var ()
 (setvar 'cmdecho 0)
 (setq oldlayer (getvar "clayer"))
 (setq oldsnap (getvar "osmode"))
 (setq temperr *error*)
 (setq *error* traperror)
 (setvar "osmode" 0)
)


(defun traperror (errmsg)
 (command nil nil nil)
 (if (not (member errmsg '("console break" "Function Cancelled"))
     )
   (princ (strcat "\nError: " errmsg))
 )
 (command "_.undo" "end")
 (setvar "clayer" oldlayer)
 (setvar "osmode" oldsnap)
 (setvar "cmdecho" 1)
 (princ "\nError Resetting Enviroment ")
 (setq *error* temperr)
)



(defun reset_var ()
 (setq *error* temperr)
 (setvar "clayer" oldlayer)
 (setvar "osmode" oldsnap)
 (command "_.undo" "end")
 (setvar "cmdecho" 1)
)

 (vl-load-com)
 (set_var)
 (command "_.undo" "be")
 (if (tblsearch "Layer" "AREARON")
   (command "._layer" "_thaw" "AREARON" "_on" "AREARON" "_unlock" "AREARON" "_set" "AREARON" "") ;_ closes command
   (command "._layer" "_make" "AREARON" "_color" 1 "AREARON" "") ;_ closes command
 )
 (if (null sch)
   (setq sch 1.0)
 )
 (initget 6)
 (setq	temp (getreal (strcat "\nENTER SCALE <"
		      (rtos sch 2 2)
		      ">: "
	      )
     )
 )
 (if temp
   (setq sch temp)
   (setq temp sch)
 )

 (if (null precision)
   (setq precision 1)
 )
 (initget 6)
 (setq	prec_temp
 (getint
   (strcat "\nHOW MANY DECIMAL PLACES?: <"
	   (rtos precision 2 2)
	   ">: "
   )
 )
 )
 (if prec_temp
   (setq precision prec_temp)
   (setq prec_temp precision)
 )



 (prompt "\nSELECT CLOSED POLYLINES/SPLINES, REGION, CIRCLE & ELLIPSE:> ")
 (setq
   mysset  (ssget '((-4 . "<or")
	     (-4 . "<and")
	     (0 . "LWPOLYLINE")
	     (70 . 1)
	     (-4 . "and>")
	     (-4 . "<and")
	     (0 . "SPLINE")
	     (70 . 11)
	     (-4 . "and>")
	     (0 . "REGION")
	     (0 . "CIRCLE")
	     (0 . "ELLIPSE")
	     (-4 . "or>")
	    )
    )
   counter 0
 )
 (if mysset
   (progn
     (while (< counter (sslength mysset))
(setq entity-name (ssname mysset counter)
      EL	  (entget entity-name)
      entnamevla  (vlax-ename->vla-object entity-name)
      areaobj	  (vla-get-area entnamevla)
)
(cond
  ((eq (cdr (assoc 0 el)) "LWPOLYLINE")
   (progn
     (setq allx	0
	   ally	0
	   ctr 0
	   tst 1
     )
     (while (assoc 10 el)
       (setq vertex (cdr (assoc 10 el))
	     ctr    (+ ctr 1)
	     x	    (car vertex)
	     y	    (cadr vertex)
	     allx   (+ allx x)
	     ally   (+ ally y)
	     EL	    (cdr (member (assoc 10 el) el))
       )
     )
     (setq x  (/ allx ctr)
	   y  (/ ally ctr)
	   pt (list x y)
     )
     (command "text"
	      "j"
	      "mc"
	      pt
	      (* sch 2.5)
	      "0"
	      (rtos areaobj 2 precision)
     )
   )
  )
  ((eq (cdr (assoc 0 el)) "REGION")
   (setq reg_centroid
	  (vlax-safearray->list
	    (vlax-variant-value
	      (vla-get-centroid entnamevla)
	    )
	  )
   )
   (command "text"
	    "j"
	    "mc"
	    reg_centroid
	    (* sch 2.5)
	    "0"
	    (rtos areaobj 2 precision)
   )
  )

  ((eq (cdr (assoc 0 el)) "CIRCLE")
   (setq cir_center
	  (vlax-safearray->list
	    (vlax-variant-value
	      (vla-get-center entnamevla)
	    )
	  )
   )
   (command "text"
	    "j"
	    "mc"
	    cir_center
	    (* sch 2.5)
	    "0"
	    (rtos areaobj 2 precision)
   )
  )

  ((eq (cdr (assoc 0 el)) "ELLIPSE")
   (setq el_center
	  (vlax-safearray->list
	    (vlax-variant-value
	      (vla-get-center entnamevla)
	    )
	  )
   )
   (command "text"
	    "j"
	    "mc"
	    el_center
	    (* sch 2.5)
	    "0"
	    (rtos areaobj 2 precision)
   )
  )

  ((eq (cdr (assoc 0 el)) "SPLINE")
   (vla-GetBoundingBox entnamevla 'minPt 'maxPt)
   (setq blPt (vlax-safearray->list minPt)
	 trPt (vlax-safearray->list maxPt)
   )
   (setq spl_center
	  (mapcar '* '(0.5 0.5 0.5) (mapcar '+ blPt trPt))
   )
   (command "text"
	    "j"
	    "mc"
	    spl_center
	    (* sch 2.5)
	    "0"
	    (rtos areaobj 2 precision)
   )
  )
)
(setq counter (+ counter 1))
     )
   )
   (alert "\nNO CLOSED POLYLINES/LWPOLYLINES/SPLINES IN YOUR SELECTION"
   )
 )
 (reset_var)
 (princ)

)
(prompt "'\n>>>...AreaRon.Lsp is now Loaded, Type 'Arearon' to start command...<<<")
(princ)

 

 

it does not yet exports to excel, i'll try to add it when i have a free time.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...