LISp for area and length

[Steve_-B]

First post so please go easy if I'm posting in wrong forum.

Basically, I'm trying to find a way to write a script to state the length against all open polyines and state the area inside all closed polylines in one macro.  I've found a macro for each task but have no idea how to combine them.  I also need the length/area tex to be on the same layer as the line they reference.

Something like the below as I need to take of lots of information from plans and constantly clicking a line and then looking at the properties and copying to Excel is very time consuming.

Any assistance would be much appreciated.  Thanks.

[Kent1Cooper]

---

@Steve_-B wrote:

....  I've found a macro for each task but have no idea how to combine them.  ....

---

Post them.  Someone could much more easily show you how to combine them than come up with an approach from scratch [or find things to combine in this Forum].

[ВeekeeCZ · Accepted solution]

Try this one.

(vl-load-com)

(defun c:PLenarea  (/ spc doc s i l e o vrs pts oid pnt fld txt)
  
  (setq spc (vla-get-modelspace (setq doc (vla-get-activedocument (vlax-get-acad-object)))))
  (vla-startundomark doc)
  
  (if (setq s (ssget '((0 . "CIRCLE,LWPOLYLINE,LINE,ARC"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    o (vlax-ename->vla-object e)
	    l (cdr (assoc 8 (entget e))))
      (if (or (= "CIRCLE" (cdr (assoc 0 (entget e))))
	      (and (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
		   (= 1 (getpropertyvalue e "Closed"))))
	(setq vrs (cond ((cdr (assoc 90 (entget e)))) (1))
	      pts (apply 'mapcar (cons '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e)))))
	      pnt (mapcar '/ pts (list vrs vrs))		 
	      oid (itoa (vla-get-objectid o))
	      fld (strcat "%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Area \\f \"%lu2%ps[, m2]%ct8[1.0E-006]\">%"))
	(setq pnt (vlax-curve-getpointatdist e (/ (vlax-curve-getdistatparam e (vlax-curve-getendparam e)) 2))
	      oid (itoa (vla-get-objectid o))
	      fld (strcat "%<\\AcObjProp Object(%<\\_ObjId " oid ">%).Length \\f \"%lu2%ps[, m]%ct8[1.0E-003]\">%")))
      (setq txt (vla-addMText spc (setq pnt (vlax-3d-point pnt)) 0 fld))
      (vla-put-layer txt l)
      (vla-put-AttachmentPoint txt acAttachmentPointMiddleCenter)
      (vla-put-InsertionPoint txt pnt)
      ))
  (vla-endundomark doc)
  (princ)
  )

[Steve_-B]

Wow, that is really good and just what I need.  I appreciate your help and don't want to abuse it but is there a way to get the text to adopt the layer of the line it's referencing? 

I also need to change the units (my drawings are in mm and mm2 but I want the text to be m2 as you've put in your code), also decimal points and rounding up to the nearest single decimal point.  However I want to try and work this out myself as don't want to take liberties.

thanks again

[ВeekeeCZ]

Ok, code updated.

[Steve_-B]

thank you so much

[calderg1000]

Regards @Steve_-B 

Here I show you my simple proposal, using only Vanilla autolisp.
For open polylines it calculates only length, for closed polylines it calculates length and area.
Important note: Works with any text style similar to Standard (height=0)

(defun c:apl (/ s a p h pt l)
  (setq s (entsel "\nSelect Lwpolyline: "))
  (command "_area" "_o" (car s))
  (setq a  (getvar 'area)
        p  (getvar 'perimeter)
        h  (getreal "\nEnter Height Text: ")
        pt (cadr s)
        l  (cdr (assoc 8 (entget (car s))))
        tl (strcat "\nL= " (rtos (* p 1e+3) 2 2) " mm")
        ta (strcat "\nL= " (rtos (* p 1e+3) 2 2) " mm" "; " "A= " (rtos a 2 2) " m2")
  )
  (if (= (cdr (assoc 70 (entget (car s)))) 128)
    (command "_text" "_near" pt h 0.0 tl)
    (command "_text" "_near" pt h 0.0 ta)
  )
  (command "_chprop" (entlast) "" "la" l "")
)

[Steve_-B]

thank you