Object Area Field Lisp Routine

March 10, 2010

Hi, I am after a lisp routine that will enter the area of a selected closed polyline, with the area being a field so if the polyline is altered, so is the area text.

So far so easy I'm sure you guys are thinking but I would like a few more bells and whistles:shock:! I would like the area to be shown in m² and to the nearest whole number if it is less than 1 hectare. Once it is greater than or equal to 1ha I would like the number to be shown as X.xxha (eg divide the area by 10,000 and show to 2 decimal places).

Thats the bells taken care of, now the whistle! I would like also to be prompted for the Lot number, which once I enter it, it adds that into the multiline text. If I enter nothing I would like it to just display the area.

So, for example, if I have an object which is 10,357m². I run the lisp, click on the object, it prompts for a Lot number, I enter in 2 say and then the lisp prompts me where to place the text. I select the spot and the centered multiline text entered is Lot 2 1.36ha (with Lot 2 being on one line and 1.36ha on the line below).

What a mouthful! and thanks in advance for your help. It never ceases to amaze me that people are willing to do this just for the craic.

March 10, 2010

Post the code that you're working on and maybe some one here can offer some advice.

March 10, 2010

I saw this that was posted by Fixo, in cadtutor thread 23057

(defun C:FA  (/ acsp adoc cpt elist en ent fld lead_obj lpt mtx oid osm)
 (vl-load-com)
 (or adoc
     (setq adoc
     (vla-get-activedocument
       (vlax-get-acad-object)
       )
    )
     )
 (if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
   (setq acsp (vla-get-paperspace adoc))
   (setq acsp (vla-get-modelspace adoc))
   )
(setq osm (getvar "osmode"))
 (setvar "osmode" 0)

 (while
   (setq ent (entsel "\nSelect pline or hit Enter to exit"))
    (setq en (car ent))
    (if (wcmatch (cdr (assoc 0 (setq elist (entget en)))) "*POLYLINE")
      (progn
 (setq cpt (trans (cadr ent)1 0)
       lpt (trans (getpoint cpt "\nPick the ending point of leader:") 1 0)
       )

 (setq oID (vla-get-objectid (vlax-ename->vla-object en)))
 (setq fld
	(strcat
	  (strcat "Area = " "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa oID)
		  ">%).Area \\f \"%lu2%pr2\">%"
		  "\\P")
	  (strcat "Perimeter = " "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa oID)
		  ">%).Length \\f \"%lu2%pr2\">%"))
       )
 (setq mtx (vlax-invoke
	     acsp 'AddMText lpt 0.0 fld)
       )
 (vlax-put mtx
	   'AttachmentPoint
	   (cond ((> (car cpt) (car lpt))
		  6
		  )
		 ((< (car cpt) (car lpt))
		  4
		  )
		 (T 4)
		 )
	   )
 (vlax-put mtx 'Height (getvar "textsize"))
 (setq lead_obj	(vlax-invoke
		  acsp
		  'Addleader
		  (apply 'append (list cpt lpt))
		  mtx
		  acLineWithArrow
		  )
       )
 (vlax-put lead_obj 'VerticalTextPosition 0);1
 )
      )
    )
 (setvar "osmode" osm)
 (princ)
 )
(princ "\n Start command with FA ...")
(princ)

and also this from wizman (cadtutor thread 32396) who altered a lisp called AreaRon (tip 2292 from cadtips) but I couldn't get this to work in 2010

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

Unfortunately for myself, I can't understand lisp scripting at all , macro's are as far as i can extend to!

Cheers for your help

March 10, 2010

Creating a field is extremely easy.

The easiest thing to do is create the desired field in a piece of MText then use

(vla-fieldcode (vlax-ename->vla-object (car (entsel))))

This will give you the desired coding, all you have to do then is remove the the object id number string and strcat the remaining together with the

(itoa (vla-get-objectid (vlax-ename->vla-object (car (entsel)))))

of the desired LWPolyline (in this case).

This is a fairly simple routine to write. You should give it a shot.

June 6

On 3/10/2010 at 9:53 AM, jimwithaj said:

I saw this that was posted by Fixo, in cadtutor thread 23057

(defun C:FA  (/ acsp adoc cpt elist en ent fld lead_obj lpt mtx oid osm)
 (vl-load-com)
 (or adoc
     (setq adoc
     (vla-get-activedocument
       (vlax-get-acad-object)
       )
    )
     )
 (if (and
(= (getvar "tilemode") 0)
(= (getvar "cvport") 1)
)
   (setq acsp (vla-get-paperspace adoc))
   (setq acsp (vla-get-modelspace adoc))
   )
(setq osm (getvar "osmode"))
 (setvar "osmode" 0)

 (while
   (setq ent (entsel "\nSelect pline or hit Enter to exit"))
    (setq en (car ent))
    (if (wcmatch (cdr (assoc 0 (setq elist (entget en)))) "*POLYLINE")
      (progn
 (setq cpt (trans (cadr ent)1 0)
       lpt (trans (getpoint cpt "\nPick the ending point of leader:") 1 0)
       )

 (setq oID (vla-get-objectid (vlax-ename->vla-object en)))
 (setq fld
	(strcat
	  (strcat "Area = " "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa oID)
		  ">%).Area \\f \"%lu2%pr2\">%"
		  "\\P")
	  (strcat "Perimeter = " "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa oID)
		  ">%).Length \\f \"%lu2%pr2\">%"))
       )
 (setq mtx (vlax-invoke
	     acsp 'AddMText lpt 0.0 fld)
       )
 (vlax-put mtx
	   'AttachmentPoint
	   (cond ((> (car cpt) (car lpt))
		  6
		  )
		 ((< (car cpt) (car lpt))
		  4
		  )
		 (T 4)
		 )
	   )
 (vlax-put mtx 'Height (getvar "textsize"))
 (setq lead_obj	(vlax-invoke
		  acsp
		  'Addleader
		  (apply 'append (list cpt lpt))
		  mtx
		  acLineWithArrow
		  )
       )
 (vlax-put lead_obj 'VerticalTextPosition 0);1
 )
      )
    )
 (setvar "osmode" osm)
 (princ)
 )
(princ "\n Start command with FA ...")
(princ)

and also this from wizman (cadtutor thread 32396) who altered a lisp called AreaRon (tip 2292 from cadtips) but I couldn't get this to work in 2010

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

Unfortunately for myself, I can't understand lisp scripting at all , macro's are as far as i can extend to!

Cheers for your help

Bro can help me change unit mm2 to m2 (second code). Please help me. Thank so much

Edited June 6 by vanhuyou

June 6

On 3/10/2010 at 10:13 AM, alanjt said:
Creating a field is extremely easy.

The easiest thing to do is create the desired field in a piece of MText then use
(vla-fieldcode (vlax-ename->vla-object (car (entsel))))
This will give you the desired coding, all you have to do then is remove the the object id number string and strcat the remaining together with the
(itoa (vla-get-objectid (vlax-ename->vla-object (car (entsel)))))
of the desired LWPolyline (in this case).

This is a fairly simple routine to write. You should give it a shot.

Bro how edit code to creat field in mtext.

Sign In

Object Area Field Lisp Routine

Recommended Posts

jimwithaj

lpseifert

jimwithaj

alanjt

vanhuyou

vanhuyou

Join the conversation

Tutorials

Forums

Activity