Display hatch area as a label

Say I have 100 irregular hatches. I want to somehow display the area of each of these hatches on the screen (i.e. area labelled over top of the hatch). I know I can check the properties of each hatch individually to find the area but was wondering if anyone knows of a better way?

Finding the area is one thing (easily solvable with a custom lisp routine). Actually displaying the area atop the hatch is another.

Can you give us an idea of what you want that to look like?

I've found a few area/polyline labeling lisps and been trying them although the ones I have found all require you to pick the insertion point for each piece of text label, which doesn't really help much.

I don't really care how the text/label looks so long as it is over the hatch and you can recognise it as being for that area.

So you don't want to indicate where to place the text. You want the lisp routine to just "do it". That about sum it up?

So you don't want to indicate where to place the text. You want the lisp routine to just "do it". That about sum it up?

Basically, yes. The area labels are not for presentation but for working purposes.

Can you provide us with a sample drawing file? I want to test something I just found.

You got Civ3D, use the Map3D query , but if Mark finds a lisp that might be easier than doing the map attach and query funtions.

Can you provide us with a sample drawing file? I want to test something I just found.

They're just normal polylines.

One of the problems with autoplacing is it can on a shape say like a U put text outside of the area, Remark with your code maybe need a is this ok else move it.

I tested three different lisp routines but didn't like any of them.

What units are you using?

If i understand well you mean area for polylines. If we are talking about "normal" shapes you can try this one i found and using a long time ago (can't remember where i found it)

 ;Produces text of area of the selected polyline 
(defun C:TTA (/
   allx
   ally
   areaobj
   counter
   ctr
   el
   entity-name
   entnamevla
   mysset
   pt
   tst
   vertex
   x
   y
  )
 (vl-load-com)
 (COMMAND "_.UNDO" "BE")
 (set_var)
 (if (null sch)
   (setq sch 1.0)
 )
 (initget 6)
 (setq temp (getreal (strcat "\nENTER TEXT HEIGHT <"
        (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:> ")
 (setq
   mysset  (ssget '((0 . "POLYLINE,LWPOLYLINE") (-4 . "&") (70 . 1)))
   counter 0
 )
 (if mysset
   (progn
     (while (< counter (sslength mysset))
(setq allx   0
      ally   0
      ctr   0
      tst   1
      entity-name (ssname mysset counter)
      EL   (entget entity-name)
      entnamevla  (vlax-ename->vla-object entity-name)
      areaobj   (vla-get-area entnamevla)
)
(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 1.0)
  "0"
  (rtos areaobj 2 precision)
)
(setq counter (+ counter 1))
     )
   )
   (alert "\nNO CLOSED POLYLINES/LWPOLYLINES IN YOUR SELECTION"
   )
 )
 (reset_var)
 (princ)
(COMMAND "_.UNDO" "END")
)
(princ)

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

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

(defun reset_var ()
 (setq *error* temperr)
 (setvar "clayer" oldlayer)
 (setvar "osmode" oldsnap)
 (princ)
)

Btw i've made some additions/changes to that. Tried to submit it as an attatchment but that didn't worked out. Sorry for posting is as code instead of attatchment!

Maybe this text part needs a bit of work started with lee's http://www.cadtutor.net/forum/showthread.php?31653-Lisp-coordinates-of-points-to-excel-sheet-(-point-number)/page3 so I would add back in the error checking etc.

(vl-load-com)
(while
 
 (setq ent (car (entsel "\nSelect Polyline: ")))
      
(if (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
   (progn
     (setq objAREA (vla-get-AREA (vlax-ename->vla-object ent)))
     
     (setq pts (mapcar 'cdr
     (vl-remove-if-not
     (function (lambda (pt) (= (car pt) 10)))
     (entget ent)
     )
     )
     )
   ) ; progn
(princ "\npick again or ESC")
) ; if
(setq i 0
      x 0
      y 0)  
(foreach pt pts
(setq i (+ i 1))
 (setq X (+ x (car pt)))
 (setq y (+ y (cadr pt)))
)
(setq x (/ x i))
(setq y (/ y i))
(command "text" (list x y) 250 0 (rtos objarea 2 2 ))
 
); while

I've replied to this thread last night ... im not sure if there was something wrong with my post. maybe a moderator can answer me?? Thank you

Try this quickly written program, based on my Area Label program:

([color=BLUE]defun[/color] c:quickarea ( [color=BLUE]/[/color] *error* c e l p v x )

   ([color=BLUE]defun[/color] *error* ( msg )
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] v))
           ([color=BLUE]setvar[/color] 'cmdecho v)
       )
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
           ([color=BLUE]entdel[/color] e)
       )
       ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg) [color=MAROON]"*BREAK,*CANCEL*,*EXIT*"[/color]))
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
       )
       ([color=BLUE]princ[/color])
   )
   ([color=BLUE]setq[/color] v ([color=BLUE]getvar[/color] 'cmdecho))
   ([color=BLUE]setvar[/color] 'cmdecho 0)
   
   ([color=BLUE]while[/color] ([color=BLUE]setq[/color] p ([color=BLUE]getpoint[/color] [color=MAROON]"\nPick Area <Exit>: "[/color]))
       ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
           ([color=BLUE]progn[/color]
               ([color=BLUE]entdel[/color] e)
               ([color=BLUE]setq[/color] e [color=BLUE]nil[/color])
           )
       )
       ([color=BLUE]setq[/color] x ([color=BLUE]entlast[/color]))
       ([color=BLUE]command[/color] [color=MAROON]"_.-boundary"[/color] [color=MAROON]"_A"[/color] [color=MAROON]"_B"[/color] [color=MAROON]"_E"[/color] [color=MAROON]"_I"[/color] [color=MAROON]"_N"[/color] [color=MAROON]""[/color] [color=MAROON]"_O"[/color] [color=MAROON]"_P"[/color] [color=MAROON]""[/color] [color=MAROON]"_non"[/color] p [color=MAROON]""[/color])
       ([color=BLUE]if[/color]
           ([color=BLUE]and[/color]
               ([color=BLUE]not[/color] ([color=BLUE]eq[/color] x ([color=BLUE]setq[/color] e ([color=BLUE]entlast[/color]))))
               ([color=BLUE]=[/color] [color=MAROON]"LWPOLYLINE"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ([color=BLUE]entget[/color] e))))
           )
           ([color=BLUE]progn[/color]
               ([color=BLUE]foreach[/color] x ([color=BLUE]entget[/color] e)
                   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))
                       ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] x) l))
                   )
               )
               ([color=BLUE]setq[/color] c ([color=BLUE]mapcar[/color] '[color=BLUE]/[/color] ([color=BLUE]apply[/color] '[color=BLUE]mapcar[/color] ([color=BLUE]cons[/color] '[color=BLUE]+[/color] l)) ([color=BLUE]list[/color] ([color=BLUE]length[/color] l) ([color=BLUE]length[/color] l))))
               ([color=BLUE]entmake[/color]
                   ([color=BLUE]list[/color]
                      '(0 . [color=MAROON]"TEXT"[/color])
                       ([color=BLUE]cons[/color] 40 ([color=BLUE]getvar[/color] 'textsize))
                       ([color=BLUE]cons[/color] 07 ([color=BLUE]getvar[/color] 'textstyle))
                       ([color=BLUE]cons[/color] 01 ([color=BLUE]rtos[/color] ([color=BLUE]vla-get-area[/color] ([color=BLUE]vlax-ename->vla-object[/color] e))))
                       ([color=BLUE]cons[/color] 10 c)
                       ([color=BLUE]cons[/color] 11 c)
                      '(72 . 1)
                      '(73 . 2)
                   )
               )
               ([color=BLUE]redraw[/color] e 3)
               ([color=BLUE]setq[/color] l [color=BLUE]nil[/color])
           )
           ([color=BLUE]setq[/color] e [color=BLUE]nil[/color])
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] e))
       ([color=BLUE]entdel[/color] e)
   )
   ([color=BLUE]setvar[/color] 'cmdecho v)
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

Adapted my code here + Lee's routine.

;;   Write the area of the selected polylines in the position of   ;;
;;   maximum inscribed circle.                                     ;;
;;                                                                 ;;
;;   19.01.2013 - Gian Paolo Cattaneo                              ;;

(defun c:arpoly (/ sel poly POLY_vl Dx Dy Lp List_vert_poly list_p_int P_center dist step1 step2)
   (prompt "\nSelect Polyline: ")
   (setq sel (ssget '((0 . "LWPOLYLINE"))))
   (if sel
       (progn
           (repeat (setq :n (sslength sel))
               (setq poly (ssname sel (setq :n (1- :n))))
               (setq jjj 0)
               (setq step1 30) ;--> grid_1 density
               (setq step2 10) ;--> grid_2 density
               (setq POLY_vl (vlax-ename->vla-object POLY))
               (setq list_vert_poly (LM:LWPoly->List POLY))
               (grid_1)   
               (Point_int)
               ;(grid+) ;increase accuracy
               (Point_center)
               (if (= jjj 1) (setq p_prov P_center))
              ;(repeat 2 ;increase accuracy
                   (grid_2) 
                   (Point_center)
              
               (entmake
                   (list
                       (cons 0 "TEXT")
                       (cons 8 (getvar "clayer"))
                       (cons 7 (getvar "textstyle"))
                       (cons 10 P_center)
                       (cons 11 P_center)
                       (cons 40 (getvar "textsize"))
                       (cons 72 1)
                       (cons 73 2)
                       (cons 1 (rtos (vlax-curve-getArea poly) 2 2))
                   )
               )
           )
           (princ)
       )
       (alert "No selected lwpolyline")
   )
)        

;; LWPolyline to Point List  -  Lee Mac
;; Returns a list of points describing the supplied LWPolyline
(defun LM:LWPoly->List ( ent / der di1 di2 inc lst par rad )
   (setq par 0)
   (repeat (cdr (assoc 90 (entget ent)))
       (if (setq der (vlax-curve-getsecondderiv ent par))
           (if (equal der '(0.0 0.0 0.0) 1e-
               (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
               (if
                   (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
                         di1 (vlax-curve-getdistatparam ent par)
                         di2 (vlax-curve-getdistatparam ent (1+ par))
                   )
                   (progn
                       (setq inc (/ (- di2 di1) (1+ (fix (* 10 (/ (- di2 di1) rad (+ pi pi)))))))
                       (while (< di1 di2)
                           (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                                 di1 (+ di1 inc)
                           )
                       )
                   )
               )
           )
       )
       (setq par (1+ par))
   )
   (setq x lst)
   lst
)

; Restituisce una griglia di punti all'interno del getboundingbox della poly selezionata
; Returns a grid of points within the BoundingBox of the selected poly
(defun grid_1 (/ P1_ P2_ n P> )
   (vla-getboundingbox POLY_vl 'p1 'p2)
   (setq P1_ (vlax-safearray->list p1))
   (setq P2_ (vlax-safearray->list p2))
   (setq P1_ (list (car P1_) (cadr P1_)))
   (setq P2_ (list (car P2_) (cadr P2_)))
   (setq Dx (/ (- (car P2_) (car P1_)) step1))
   (setq Dy (/ (- (cadr P2_) (cadr P1_)) step1))
   (setq n 0)
   (setq P> P1_)
   (setq Lp (list P1_))
   (repeat (* (1+ step1) step1)
       (setq P> (list (+ (car P>) Dx) (cadr P>)))
       (setq Lp (cons P> Lp))
       (setq n (1+ n))
       (if (= n step1)
           (progn
               (setq n 0)
               (setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
               (setq P> P1_)
               (setq Lp (cons P> Lp))
           )
       )
   )
   (setq Lp (cdr Lp))
   (setq a Lp)
)
  
; Restituisce una griglia di punti intorno al punto centrale (provvisorio)
; Returns a grid of points around the center point (provisional)
(defun grid_2 (/ P1_  P> n)
   (setq list_p_int nil)
   (setq P1_ (list (- (car P_center) (* Dx 2)) (- (cadr P_center) (* Dy 2))))
   (setq Dx (/ (* 4 Dx) step2))
   (setq Dy (/ (* 4 Dy) step2))
   (setq n 0)
   (setq P> P1_)
   (setq list_p_int (list P1_))
   (repeat (* (1+ step2) step2)
       (setq P> (list (+ (car P>) Dx) (cadr P>)))
       (setq list_p_int (cons P> list_p_int))
       (setq n (1+ n))
       (if (= n step2)
           (progn
               (setq n 0)
               (setq P1_ (list (car P1_) (+ (cadr P1_) Dy)))
               (setq P> P1_)
               (setq list_p_int (cons P> list_p_int))
           )
       )
   )
   (setq d  list_p_int)
)
   
; restituisce la lista dei punti interni ad un poligono
; dati:  - lista coordinate dei punti -> Lp
;        - lista coordinate vertici poligono -> list_vert_poly
; Returns the list of inside points 
(defun Point_int (/ P_distant n Pr cont attr p# Pa Pa_ Pb )
   (setq P_distant (list (car (getvar "extmax")) (* 2 (cadr (getvar "extmax")))))    
   (setq list_p_int nil)
   (foreach Pr Lp 
       (setq cont -1)
       (setq attr 0)
       (setq p# nil) 
       (setq Pa (nth (setq cont (1+ cont)) list_vert_poly))
       (setq Pa_ Pa)
       (repeat (length list_vert_poly)
           (setq Pb (nth (setq cont (1+ cont)) list_vert_poly))
           (if (= cont (length list_vert_poly)) (setq Pb Pa_))
           (setq P# (inters Pa Pb Pr P_distant))
           (if (/= P# nil) (setq attr (1+ attr)))
           (setq Pa Pb)
       )
       (if (> (rem attr 2) 0) (setq list_p_int (cons Pr list_p_int)))      
   )
   (setq b list_p_int)
)

; Infittisce la griglia inserendo altri punti
; nel centro delle diagonali tra i punti interni
; Increases the grid density
(defun grid+ (/ G+)
   (setq G+
       (mapcar '(lambda ( x ) (list (+ (car x) (/ Dx 2)) (+ (cadr x) (/ Dy 2)))) list_p_int)
   )
   (setq list_p_int (append G+ list_p_int))
   (setq c list_p_int)
)

; Da una lista di punti restituisce quello più lontano da un oggetto
; dati:  - lista dei punti -> list_p_int
;        - oggetto -> POLY_vl
; Returns the farthest point from the polyline
(defun Point_center (/ Pa n Pvic)
   (setq Dist 0.0000001)
   (setq P_center nil)
   (foreach Pa list_p_int
(setq Pvic (vlax-curve-getClosestPointTo POLY_vl Pa))
       (if (> (distance Pa Pvic) Dist)
           (progn
               (setq P_center Pa)
               (setq Dist (distance Pa Pvic))
           )
       )
   )
   (setq jjj (1+ jjj))
   (setq pc P_center)
)

(vl-load-com)
(prompt "\n ") (prompt "\n ") (prompt "\n ")
(princ "\nType \"ARPOLY\" to invoke")
(princ)

You guys are so talented. Thanks for your efforts.

Hmm too many letters, here is mine

 
(defun C:LHAT(/ ar cp en hobj lp num rp sset)
 (if (and
(setq lp (getpoint "\nFirst Corner point of selection window >> ")
     rp (getcorner lp "\nOpposite Corner >> "))
(setq sset (ssget "_W" lp rp (list
         (cons 0 "hatch")
         ;; hatch patterns separated by comma
         (cons 2 "ANGLE,DOLMIT,ANSI37,AR-BRELM,AR-RSHKE"); you may exclude this one to grab all hatches
         ))))
 (progn
(setq num (sslength sset))
 (while (> num 0)
   (setq en (ssname sset (setq num (1- num))))
   ;
   (setq hobj (vlax-ename->vla-object en)
  ar (vla-get-area hobj))
(setq cp (trans (cdr (last (entget en))) en 0))
   (command "._mtext"  cp "_h" 2.5 "_j" "_mc" "_w" 0 (rtos ar 2 0) "")
   )
)
   )
 (princ)
 )
(or (vl-load-com)(princ))

Thanks for the help, all of those do exactly what I wanted to achieve. How do I divide the area by a factor? E.g. if I wanted to divide it by a factor 10 I tried the following on one of the lisps above without much success. Apologies, my lisp knowledge is very basic to non existent

Tried changing

(cons 1 (rtos (vlax-curve-getArea poly) 2 2))

to

(cons 1 (rtos ((/ (vlax-curve-getArea poly) 2) ) 2 2))

which gave me the error msg

Select objects:  ; error: bad argument type: numberp: nil

Expression

(vlax-curve-getArea poly) is double.

then you have use it like, check right parenthesis

 
(cons 1 (rtos (/ (vlax-curve-getArea poly) 10.)) 2 2)))