Jump to content

Write text area when click polygon

tuantrinhdp

By tuantrinhdp
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

tuantrinhdp Contributor

tuantrinhdp

Posted
Posted

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

12.png

 

test.dwg

mhupp Grand Master

mhupp

Posted
Posted (edited)

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 by mhupp
updated code from: devitg, BIGAL
  • Like 1
tuantrinhdp Contributor

tuantrinhdp

Posted
  • Author
Posted (edited)
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 by tuantrinhdp
  • Like 1
mhupp Grand Master

mhupp

Posted
Posted

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

you can put 1 - 15

mhupp Grand Master

mhupp

Posted
Posted

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 Experienced

devitg

Posted
Posted

@ 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

  • Like 1
  • Thanks 1
mhupp Grand Master

mhupp

Posted
Posted (edited)

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 by mhupp
updated code
  • Like 2
tuantrinhdp Contributor

tuantrinhdp

Posted
  • Author
Posted
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 Grand Master

BIGAL

Posted
Posted

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

 

  • Like 1
  • Thanks 1
  • 4 weeks later...
BIGAL Grand Master

BIGAL

Posted
Posted

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)

  • Like 1
  • 4 weeks later...
karsen Rookie

karsen

Posted
Posted (edited)
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 by karsen
Steven P Grand Master

Steven P

Posted
Posted

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)

  • Thanks 1

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.

×
 Share
Go to topic listing
×
×
  • Create New...