Lisp area and/or length of polyline, as a leader

I'm looking for a lisp rutine, to put the area or the perimeter of a polyline, as a leader, but i want it to be dynamic (field) as the polyline changes, the value inside the leader should change.

thank you for being interesed.

Give this a try

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

Give this a try

 

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

testing it, till now looks fine.

Many thanks

Glad I have helped

Cheers

~'J'~

How does the text for the area change when the polyline changes? How can I change the text format? I'm new to the lisp routines

Thanks

Welcome on board, temo!

Not clearly enough what the format you need

Guess you want to add text with particular precision

and units

What the units you use -metric or imperical?

Better yet attach the small screenshot as .jpg file here

Use 'Manage attachment' button below

After you've changed polyline the text should changes

automatically, just use View->Regen in main menu

Hth

~'J'~

The regen command worked...I want to add text in Square Feet instead of Square inches. The numerical value is highlighted, and i want to take that away. How do I do that?

Thanks

Try this expression instead:

(setq fld
	(strcat
	  (strcat "Area = " "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa oID)
		  ">%).Area \\f \"%pr1%lu2%ct4%qf1 SQ. FT.\">%"
		  "\\P")
	  (strcat "Perimeter = " "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa oID)
		  ">%).Length \\f \"%lu3%pr1\">%"))
       )

To unhighlight the polyline after regen just hit ESC key

~'J'~

That worked. Instead of the Perimeter displayed can I get the "Handle Id" to show up? Where do you learn this stuff? How do i post an image so I can show what is highlighted?

Try another one:

(setq fld
	(strcat
	  (strcat "Area = " "%<\\AcObjProp Object(%<\\_ObjId "
		  (itoa oID)
		  ">%).Area \\f \"%lu2%pr2\">%"
		  "\\P")
	  (strcat "Handle ID = " (vla-get-handle (vlax-ename->vla-object en))
))
       )

To upload something here scroll down this page

and use "Manage Attachments" button

~'J'~

I dont have a "manage attachments" button but I found out that the text will print without the highlighted box around it so i guess it works out. Thanks

Sorry for the bad explanation

After you will press 'Post reply' button, the message window

will be appears and at the bottom of this window you will see

'Additional Options' tab where you can find 'Manage Attachments'

button and other options

Sorry again for my poor english

~'J'~

Its ok. I got it to work, but this is what shows on my screen. The white rectangles where the area is at is the highlighting that I was talking about. It shows up only on the area text. Is there a way to get rid of it?

By any chance do you know how to export the handle id to an access database or excel spreadsheet? I have been trying to figure out a way to do that but no luck so far.

Thanks

To avoid to "highlight" this field just

set FIELDDISPLAY system variable to 0

Accordingly to export data into Access or Excel

I recommend you to start the new thread with this

question

~'J'~

When I use this script, my text comes in way to small. Is there any where in the script to adjust the text size/height?

Thanks

When I use this script, my text comes in way to small. Is there any where in the script to adjust the text size/height?

 

Thanks

Just change this line:

(vlax-put mtx 'Height (getvar "textsize"))

on this one (e.g. set text height to 250.):

(vlax-put mtx 'Height 250.0); -->change text size to suit here

~'J'~

I knew it was something easy ....Thanks!

Give this a try

 

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

hi..it is very interesting..thanks...any solution to remove the perimeter the "TXT"

Area = 244.86
Perimeter = 62.89

Area = 244.86 sq.m

thank you..

oliver

I would have said this - but untested:

(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 "%<\\AcObjProp Object(%<\\_ObjId "
             (itoa oid)
             ">%).Area \\f \"%lu2%pr2\">%"
             "\\P")
         (strcat "%<\\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)

Fixo, is there a certain version requirement for this LISP?

I just seem to get this return: