Lisp to add area of polyline to existing text or mtext object

[nbawden]

I am looking for a lisp routine that determines the area of a closed polyline and then overwrites a selected pre-existing text or mtext object with this area and suffixes it with "m2". This routine keeps running through until user clicks Esc

There appears to be lisp routines around that determines the area and then creates a new text object - but none that I could find that allows you to select & overwite an existing text or mtext object.

In other words I am looking for a routine that:

1) Prompts you to select an existing polyline

2) Prompts you to select an existing text or mtext object

3) Overwrites selected text or mtext object with area of polyline suffixed with "m2"

4) Routine starts over and keeps repeating steps 1 -3 until user hits Esc

Could anyone help me with this?

[paullimapa]

You can try a modified version of my AOL.lsp routine from the Exchange store.

Just open the AOL.lsp file and change this line of code from:

(if(= "ATTRIB" (cdr(assoc 0 ed)))

To this line of code:

(if(or(= "ATTRIB" (cdr(assoc 0 ed)))(= "TEXT" (cdr(assoc 0 ed))))

Then it'll support Linking of TEXT objects to Plines/Hatches Area value.

Area Object Link | Dwg Setup | Feet-Inch Calculator | List on Steroids
Exchange App Store

[nbawden]

Thanks Paul,

Very much appreciate your reply and this lsp is very impressive but way more invovled than what we are looking for.

I was hoping to find a lsp that operates as simply as described in the steps in my first post. Your lsp is a lot more powerful but as a result has a lot more steps that unfortunately won't save us time in our particular case.

[m_badran]

Try the following.

(defun c:test (/ OBJ STR STR1)
  ;; mostafa baran 
  (vl-load-com)
  (while
    (setq obj (vla-get-area (vlax-ename->vla-object (car (entsel)))))
     (setq str (rtos obj))
     (setq str1 (strcat str "m2"))
     (vla-put-TextString
       (vlax-ename->vla-object (car (entsel)))
       str1
     )
  )
  (princ)
)

[nbawden]

Mostafa - thanks heaps! - this lisp is verging on perfect for us.

Two quick questions.

1) How do I restrict the areas applied to the text objects to be correctly rounded up or down to have no decimal places?

2) Instead of the default "Select Object" - How do I display the following prompts instead "Select Closed Polyline" & Select Target Text Object"?

Thanks again!

[m_badran · Accepted solution]

ok try this lisp is writing by hmsilva .

(vl-load-com);; this lisp is writing by hmsilva
(defun c:test (/ flag poly poly-obj str txt txt-obj)
  ;; mostafa baran 
  (setq txt T)
  (while (and txt
              (setq poly (car (entsel "\nSelect Closed Polyline <exit>: ")))
         )
    (if (and (setq poly-obj (vlax-ename->vla-object poly))
             (wcmatch (vla-get-objectname poly-obj) "AcDbPolyline,AcDb2Polyline")
        )
      (if (and (= (vla-get-Closed poly-obj) :vlax-true)
               (setq str (strcat (rtos (vla-get-area poly-obj) 2 0) "m2"))
               (setq flag T)
          )
        (while flag
          (if (setq txt (car (entsel "\nSelect Target Text Object <exit>: ")))
            (if (and (setq txt-obj (vlax-ename->vla-object txt))
                     (wcmatch (vla-get-objectname txt-obj) "AcDbText,AcDbMText")
                )
              (if (vlax-write-enabled-p txt-obj)
                (progn
                  (vla-put-TextString txt-obj str)
                  (setq flag nil)
                )
                (prompt "\nText/Mtext object's layer is locked...")
              )
              (prompt "\nDidn't select a Text/Mtext object...")
            )
            (setq flag nil)
          )
        )
        (prompt "\nSelected Polyline isn't closed!!!")
      )
      (prompt "\nDidn't select a Polyline!!!")
    )
  )
  (princ)
)

[nbawden]

Mostafa,

Absolutely perfect thank you so much!!

[m_badran]

you're welcome .

[thinker1]

I just change m2 to m² and from zero to three decimal digits.

(vl-load-com);; this lisp is writing by hmsilva
(defun c:AT (/ flag poly poly-obj str txt txt-obj)
  ;; mostafa baran 
  (setq txt T)
  (while (and txt
              (setq poly (car (entsel "\nSelect Closed Polyline <exit>: ")))
         )
    (if (and (setq poly-obj (vlax-ename->vla-object poly))
             (wcmatch (vla-get-objectname poly-obj) "AcDbPolyline,AcDb2Polyline")
        )
      (if (and (= (vla-get-Closed poly-obj) :vlax-true)
               (setq str (strcat (rtos (vla-get-area poly-obj) 2 3) "m²"))
               (setq flag T)
          )
        (while flag
          (if (setq txt (car (entsel "\nSelect Target Text Object <exit>: ")))
            (if (and (setq txt-obj (vlax-ename->vla-object txt))
                     (wcmatch (vla-get-objectname txt-obj) "AcDbText,AcDbMText")
                )
              (if (vlax-write-enabled-p txt-obj)
                (progn
                  (vla-put-TextString txt-obj str)
                  (setq flag nil)
                )
                (prompt "\nText/Mtext object's layer is locked...")
              )
              (prompt "\nDidn't select a Text/Mtext object...")
            )
            (setq flag nil)
          )
        )
        (prompt "\nSelected Polyline isn't closed!!!")
      )
      (prompt "\nDidn't select a Polyline!!!")
    )
  )
  (princ)
)

[thinker1]

Now I note that it calculate only one PL area, not multiple objects, this lisp will be smarter if it calculte multiple objects area at a time

I don't have this much knowledge to do this.

Thanks,

[Anonymous]

Hi

That lisp is almost what iam looking for except,

- Is it possible to divide the measured are with 5 and then write to the existing text?

- 2 decimal digits after comma?

Thank you very much

[CADaSchtroumpf]

Hi,

No change existing text, but make a field with the value that you want.

Accept polyline,ellipse, spline closed and circle

(vl-load-com)
(defun c:surf_curve-closed ( / AcDoc Space js nw_obj ename ent_text dxf_ent key)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (princ "\nSelect one closed objet")
  (while
    (setq js
      (ssget "_+.:E:S"
        '(
          (-4 . "<OR")
            (-4 . "<AND")
              (0 . "*POLYLINE")
              (-4 . "<AND")
                (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>")
                (-4 . "&") (70 . 1)
              (-4 . "AND>")
            (-4 . "AND>")
            (0 . "CIRCLE")
            (-4 . "<AND")
              (0 . "SPLINE")
              (-4 . "&") (70 . 1)
            (-4 . "AND>")
            (-4 . "<AND")
              (0 . "ELLIPSE")
              (41 . 0.0)
              (42 . 6.283185307179586)
            (-4 . "AND>")
          (-4 . "OR>")
        )
      )
    )
    (if (zerop (getvar "USERR1")) (setvar "USERR1" (/ (getvar "VIEWSIZE") 75.0)))
    (setq nw_obj
      (vla-addMtext Space
        (vlax-3d-point (trans (getvar "VIEWCTR") 1 0))
        0.0
        (strcat "S="(rtos (* 0.2 (vlax-get-property (setq ename (vlax-ename->vla-object (ssname js 0))) "Area")) 2 2) "m²")
      )
    )
    (mapcar
      '(lambda (pr val)
        (vlax-put nw_obj pr val)
      )
      (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color)
      (list 1 (getvar "USERR1") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 250)
    )
    (setq
      ent_text (entlast)
      dxf_ent (entget ent_text)
      dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent)
      dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent)
    )
    (entmod dxf_ent)
    (while (and (setq key (grread T 4 0)) (/= (car key) 3))
      (cond
        ((eq (car key) 5)
          (setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent))
          (entmod dxf_ent)
        )
      )
    )
    (vlax-put
      (vlax-ename->vla-object (entlast))
      'TextString
      (strcat
        "{\\fArial|b0|i0|c0|p34;"
        "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
        (itoa (vla-get-ObjectID ename))
        ">%).Area \\f \"%lu2%pr2%ps[S=,"
        "m²]%ct8[0.2]\">%"
      )
    )
  )
  (prin1)
)