Display hatch area as a label

January 17, 2013

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?

January 17, 2013

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?

January 17, 2013

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.

January 17, 2013

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?

January 17, 2013

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.

January 17, 2013

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

January 17, 2013

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.

January 17, 2013

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

They're just normal polylines.

January 18, 2013

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.

January 18, 2013

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

What units are you using?

January 18, 2013

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

January 18, 2013

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!

January 19, 2013

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

January 19, 2013

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

January 19, 2013

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

January 19, 2013

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)

January 19, 2013

You guys are so talented. Thanks for your efforts.

January 19, 2013

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

January 20, 2013

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

January 20, 2013

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

Edited January 20, 2013 by fixo
not tested just from the memory

Sign In

Display hatch area as a label

Recommended Posts

Organic

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

ReMark

Organic

ReMark

Organic

ReMark

Murph_map

Organic

BIGAL

ReMark

meracl

meracl

BIGAL

meracl

Lee Mac

GP_

ReMark

fixo

Organic

fixo

Join the conversation

Tutorials

Forums

Activity