Write text area when click polygon

[tuantrinhdp]

Hello everyone. 
I have a problem, please help. I want to calculate and write text area (square meter) when i click polygon, with choice: text height and decimal ( ex 0 or 0.0 or 0.00 or 0.000).

 

test.dwg

[mhupp]

Should be what you are looking for. please only click in fully enclosed areas.

Will ask you for text size and precision then ask to pick an area. it will input a text into the center of the area. if your picking inside weird shapes it could be outside.

 

might have to rework the boundary command seems to be a bit different in BricsCAD.

 

;;----------------------------------------------------------------------------;;
;; Adds Area text
(defun C:FOO (/ h x obj area LL UR MPT)
  (vl-load-com)
  (if (not (setq h (getreal (strcat "\nText Height ["(rtos (getvar 'textsize) 2 (getvar 'luprec))"]: "))))
    (setq h (getvar 'textsize))
  )
  (setq x (getint "\n Prescision: "))  
  (while (setq pt (getpoint "\nPick Area: "))
    (vl-cmdf "_.-Boundary" "A" "I" "No" "X" "_non" PT "")
    (setq obj (vlax-ename->vla-object (entlast)))
    (setq area (rtos (vla-get-area obj) 2 x))
    (setq MPT (osnap (vlax-curve-getStartPoint obj) "gcen"))
    (entmake (list (cons 0 "TEXT")
                   (cons 10 MPT)
                   (cons 11 MPT)
                   (cons 40 h)
                   (cons 1 area)
                   (cons 71 0)
                   (cons 72 1)
                   (cons 73 2)
             )
    )
    (vla-delete obj)
  )
  (princ)
)

 

 

Edited February 16, 2022 by mhupp
updated code from: devitg, BIGAL

[tuantrinhdp]

48 minutes ago, mhupp said:

Should be what you are looking for. please only click in fully enclosed areas.

Will ask you for text size and precision then ask to pick an area. it will input a text into the center of the area. if your picking inside weird shapes it could be outside.

 

might have to rework the boundary command seems to be a bit different in BricsCAD.

 

;;----------------------------------------------------------------------------;;
;; Adds Area text
(defun C:FOO (/ h x a b area LL UR MPT)
  (vl-load-com)
  (setq h (getreal "\nText Height: "))
  (setq x (getreal "\nPrecision: "))  
  (while (setq pt (getpoint "\nPick Area: "))
    (vl-cmdf "_.-Boundary" "A" "I" "No" "X" "_non" PT "")
    (setq a  (entlast))
    (setq b (vlax-ename->vla-object a))
    (setq area (rtos (vla-get-area b) 2 x))
    (vla-getboundingbox b 'minpt 'maxpt)
    (setq LL (vlax-safearray->list minpt)
          UR (vlax-safearray->list maxpt)
          MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
    )
    (entmake (list (cons 0 "TEXT")
                   (cons 10 MPT)
                   (cons 11 MPT)
                   (cons 40 h)
                   (cons 1 area)
                   (cons 71 0)
                   (cons 72 1)
                   (cons 73 2)
             )
    )
    (entdel a)
  )
  (princ)
)

 

 

Thank you, but i tried lisp didn't dislay  a text into the center of the area. 
error: "Cannot invoke (command) from *error* without prior call to (*push-error-using-command*)" - with different drawing.
          and "bad argument type: fixnump: 2.0" ( when i input Precision)

Edited February 13, 2022 by tuantrinhdp

[mhupp]

When prompted with Precision input a whole number of how many decimal places you want.

you can put 1 - 15

[mhupp]

Seems the boundray comand in autocad is abit diffrent

 

(vl-cmdf "_.-Boundary" "A" "I" "No" "X" "_non" PT "")
  change to
(vl-cmdf "_.-boundary" "A" "I" "No" "" "" "_non" PT "")

 

[devitg]

@ tuantrinhdp please try this way 

 I dare to modify MHUPP lisp . 

 

 

the text size default to actual TEXTSIZE  

I change GETINT , for precision,  as it shall be an Integer 

and setq osmode to 0 

And use -boundary , with no options  

 

 

;;----------------------------------------------------------------------------;;
;; Adds Area text
(defun C:Adds-Area-text (/
 A AREA B H LL MAXPT MINPT MPT OSMODE PT TEXTSIZE UR X
                         )
  (vl-load-com)
  (setq textsize (getvar 'textsize))
  (if (not(setq h (getreal "\nText Height: ")))
          (setq h textsize)
          )
    (setq x (getint "\n Prescision"))
        (setq osmode (getvar 'osmode))
(setvar 'osmode 0)
  
  (while (setq pt (getpoint "\nPick Area: "))
    ;(vl-cmdf "_.-Boundary" "A" "I" "No" "X" "_non" PT "")
        (vl-cmdf "_.-Boundary"  PT "")

    (setq a  (entlast))
    (setq b (vlax-ename->vla-object a))
    (vla-put-closed b :vlax-true)
    (setq area (rtos (vla-get-area b) 2 x))
    (vla-getboundingbox b 'minpt 'maxpt)
    (setq LL (vlax-safearray->list minpt)
          UR (vlax-safearray->list maxpt)
          MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
    )
    (entmake (list (cons 0 "TEXT")
                   (cons 10 MPT)
                   (cons 11 MPT)
                   (cons 40 h)
                   (cons 1 area)
                   (cons 71 0)
                   (cons 72 1)
                   (cons 73 2)
             )
    )
    (entdel a)
  );end while
  (setvar 'osmode osmode)
  
  (princ)
)
;|«Visual LISP© Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;

 

 

adds-area-text.lsp to put text at center area.dwg

[mhupp]

This goes for anyone. please feel free to edit anything i post.  I often come back and edit things after thinking about it for awhile.

 

Nice to see whats its going to be if you just hit enter.

(if (not(setq h (getreal (strcat "\nText Height ["(rtos (getvar 'textsize) 2 (getvar 'luprec)) "]: "))))
  (setq h textsize)
)

Text Height [0.2000]: 

 

No need to change osmode just put "_non" in front of pt.

(vl-cmdf "_.-Boundary" "_non" PT "")

This could give the wrong area if their is an island tho.

Edited February 19, 2022 by mhupp
updated code

[tuantrinhdp]

5 hours ago, devitg said:

@ tuantrinhdp please try this way 

 I dare to modify MHUPP lisp . 

 

 

the text size default to actual TEXTSIZE  

I change GETINT , for precision,  as it shall be an Integer 

and setq osmode to 0 

And use -boundary , with no options  

 

 

;;----------------------------------------------------------------------------;;
;; Adds Area text
(defun C:Adds-Area-text (/
 A AREA B H LL MAXPT MINPT MPT OSMODE PT TEXTSIZE UR X
                         )
  (vl-load-com)
  (setq textsize (getvar 'textsize))
  (if (not(setq h (getreal "\nText Height: ")))
          (setq h textsize)
          )
    (setq x (getint "\n Prescision"))
        (setq osmode (getvar 'osmode))
(setvar 'osmode 0)
  
  (while (setq pt (getpoint "\nPick Area: "))
    ;(vl-cmdf "_.-Boundary" "A" "I" "No" "X" "_non" PT "")
        (vl-cmdf "_.-Boundary"  PT "")

    (setq a  (entlast))
    (setq b (vlax-ename->vla-object a))
    (vla-put-closed b :vlax-true)
    (setq area (rtos (vla-get-area b) 2 x))
    (vla-getboundingbox b 'minpt 'maxpt)
    (setq LL (vlax-safearray->list minpt)
          UR (vlax-safearray->list maxpt)
          MPT (mapcar '/ (mapcar '+ LL UR) '(2 2 2))
    )
    (entmake (list (cons 0 "TEXT")
                   (cons 10 MPT)
                   (cons 11 MPT)
                   (cons 40 h)
                   (cons 1 area)
                   (cons 71 0)
                   (cons 72 1)
                   (cons 73 2)
             )
    )
    (entdel a)
  );end while
  (setvar 'osmode osmode)
  
  (princ)
)
;|«Visual LISP© Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;

 

 

adds-area-text.lsp 1.4 kB · 0 downloads to put text at center area.dwg 53.35 kB · 0 downloads

thank you so much.

[BIGAL]

Guys check out GCEN this is geometric centre of a pline, Bricscad & Acad.

 

(setq pt (osnap (vlax-curve-getStartPoint (vlax-ename->vla-object   (entlast))) "gcen"))

 

[viviancarvalho]

Check out this link.

 

http://www.lee-mac.com/areastofield.html

 

Thanks to Lee-mac

 

[BIGAL]

mhupp use bpoly rather than boundary 

 

Like you polygon is different in Bricscad, I uses a check for acadver and use wcmatch so basically do like 3 lines instead of 1.

ACADVER = "22.0 BricsCAD" (read only)

[karsen]

On 3/13/2022 at 10:15 AM, viviancarvalho said:

Check out this link.

 

http://www.lee-mac.com/areastofield.html

 

Thanks to Lee-mac

 

 

how can I change unit? and add the text "ha" after the number

I want have hectares --> 0.0001ha

Edited April 5, 2022 by karsen

[devitg]

@karsen, you can use the FIELD command , and arrange to yours need. 

[Steven P]

Adding a suffix I think look for the lines:

                (setq str
                    (strcat
                        "%<\\AcObjProp Object(%<\\_ObjId "
                        (LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
                        ">%).Area \\f \"" fmt "\">%"
                    )
                )

and

                    (setq str
                        (strcat
                            "%<\\AcExpr "
                            (apply 'strcat (reverse (cdr (reverse lst))))
                            " \\f \"" fmt "\">%"
                        )
                    )

 

and before the closing brackets for (strcat.... add your suffix text ("ha"), something like

....
                            " \\f \"" fmt "\">%"
                            " ha"
                        )
                    )

 

That will give you the area as a field and then the ha as text after it.

 

Not sure but the units will depends on the units your drawing is using.

 

Lee Mac has a thing here, format codes http://www.lee-mac.com/fieldformat.html so if you set up the formatting for one of the fields created above as you want and use this, then you can change this line:

    (setq fmt "%lu6%qf1") ;; Field Formatting

and put in the code that fieldformat gives you (I think)