Automatically edit text to reflect boundary areas from entire layer

[mpa-la]

Hi all, I am looking for a lisp routine to help with a repetitive, multi step task.  Basically, I have layers that have a bunch of closed boundaries in them.  I need the area of all the boundaries on one layer converted to text with a comma in the right spot.  What I do now is as follows:  We have a layer highlight command, so I do that and exit it, then an area multiple command, issue that and use previous as the selection set (from the layer highlight command), that shows the number to me (no decimal points needed) on the command line, then I have to type it manually into my waiting text object, and put the comma in manually. 

The point of doing it this way is that I can have a hatches in my legend that are on the same layers with the boundaries.  Next to it is the text the quantity goes into, so I can just go down the legend, click the hatch to get the layer, then click the text to automatically input the quantity.  This saves me from doing a lot of layer isolation, and moving around in the drawing.

Btw, I don't want to insert a new text object, I want to edit an existing one that's already in my legend template.

 I've tried to do this myself by kind of combining the lisp routines, but I can't get it to work.  I hope somebody would enjoy taking on this challenge, or knows of something out there that already does this.

Thanks!!  Allison

[maratovich]

It's very hard to understand.
Please attach an example of your DWG file and indicate what and where to do.

[mpa-la]

Ok, here is a link to a screencast of me doing it, and the file too.  https://autode.sk/2QHnBJK

[ronjonp · Accepted solution]

Try this .. if your legends are consistent you should not have to pick the text.

(defun c:foo (/ rtoc a e p s)
  ;; RJP » 2021-04-20
  (defun rtoc (n p / foo d l)
    ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/1-000-comma-separator/m-p/5015892#M322341
    (defun foo (l n)
      (if (or (not (cadr l)) (= 46 (cadr l)))
	l
	(if (zerop (rem n 3))
	  (vl-list* (car l) 44 (foo (cdr l) (1+ n)))
	  (cons (car l) (foo (cdr l) (1+ n)))
	)
      )
    )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (vl-string->list (rtos (abs n) 2 p)))
    (setvar 'dimzin d)
    (vl-list->string
      (append (if (minusp n)
		'(45)
	      )
	      (foo l (- 3 (rem (fix (/ (log (abs n)) (log 10))) 3)))
      )
    )
  )
  (while (and (setq e (entsel "\nPick legend hatch: "))
	      (setq s (ssget "_X" (list '(0 . "LWPOLYLINE") (assoc 8 (entget (car e))))))
	      (not (ssdel (car e) s))
	      (setq p (cadr e))
	      (or (and (setq e (ssget "_C" p (mapcar '- p '(50 12 0)) '((0 . "*TEXT"))))
		       (setq e (ssname e 0))
		  )
		  (setq e (car (entsel "\nPick text to update: ")))
	      )
	      (wcmatch (cdr (assoc 0 (entget e))) "*TEXT")
	      (setq a (apply '+ (mapcar 'vlax-curve-getarea (mapcar 'cadr (ssnamex s)))))
	      (entmod (append (entget e) (list (cons 1 (rtoc a 0)))))
	 )
  )
  (princ)
)

[mpa-la]

I haven't tried it yet, but the legends are not consistent.  We have about 20 different things that could be in the legend, but there are usually only 5 or so of them at a time.  I will give it a try and see how it works though.  I love a new lisp routine!

[mpa-la]

RonJonP, you are my new best friend.  That is a miraculous lisp routine.  That you don't even have to pick the text if it's in the right position, miraculous.  Chef's kiss.  You officially made my day!!  Thank you!!  Allison

[ronjonp]

Glad you're enjoying it ! 🍻

[mpa-la]

Hey RonJon, the sample drawing I posted was not in our final format, the text is to the right of the of the hatch now.  How do I change where it looks for the text?

[ronjonp]

---

@mpa-la wrote:

Hey RonJon, the sample drawing I posted was not in our final format, the text is to the right of the of the hatch now.  How do I change where it looks for the text?

---

;; Change this
(mapcar '- p '(50 12 0))
;; To this
(mapcar '+ p '(50 12 0))

Or if you want the option of left or right:

(defun c:foo (/ rtoc a e k p s)
  ;; RJP » 2021-04-20
  (defun rtoc (n p / foo d l)
    ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/1-000-comma-separator/m-p/5015892#M322341
    (defun foo (l n)
      (if (or (not (cadr l)) (= 46 (cadr l)))
	l
	(if (zerop (rem n 3))
	  (vl-list* (car l) 44 (foo (cdr l) (1+ n)))
	  (cons (car l) (foo (cdr l) (1+ n)))
	)
      )
    )
    (setq d (getvar 'dimzin))
    (setvar 'dimzin 0)
    (setq l (vl-string->list (rtos (abs n) 2 p)))
    (setvar 'dimzin d)
    (vl-list->string
      (append (if (minusp n)
		'(45)
	      )
	      (foo l (- 3 (rem (fix (/ (log (abs n)) (log 10))) 3)))
      )
    )
  )
  (initget "L R")
  (setq	k (if (= "R" (getkword (strcat "\nText direction [Left/Right] <Right>: ")))
	    '+
	    '-
	  )
  )
  (while
    (and (setq e (entsel "\nPick legend hatch: "))
	 (setq s (ssget "_X" (list '(0 . "LWPOLYLINE") (assoc 8 (entget (car e))))))
	 (not (ssdel (car e) s))
	 (or (and (setq e (ssget "_C" (setq p (cadr e)) (mapcar k p '(50 12 0)) '((0 . "*TEXT"))))
		  (setq e (ssname e 0))
	     )
	     (setq e (car (entsel "\nPick text to update: ")))
	 )
	 (wcmatch (cdr (assoc 0 (entget e))) "*TEXT")
	 (setq a (apply '+ (mapcar 'vlax-curve-getarea (mapcar 'cadr (ssnamex s)))))
	 (entmod (append (entget e) (list (cons 1 (rtoc a 0)))))
    )
  )
  (princ)
)

[mpa-la]

Cool, thanks again!!

[k_ngo-quoc]

Hi Ronjonp,

Your lisp is work great! I work in mm and i would like the result is in m² and not include the area of the legend.

Thank for your help!

[ronjonp]

---

@k_ngo-quoc wrote:

Hi Ronjonp,

Your lisp is work great! I work in mm and i would like the result is in m² and not include the area of the legend.

Thank for your help!

---

@k_ngo-quoc 

Post a sample drawing to show what your result looks like. 

Or try this:

(defun c:foo (/ a e s)
  ;; RJP » 2021-04-23
  (while (and (setq e (entsel "\nPick something to set layer filter: "))
	      (setq s (ssget "_X" (list '(0 . "LWPOLYLINE") (assoc 8 (entget (car e))))))
	      (setq a (apply '+ (mapcar 'vlax-curve-getarea (mapcar 'cadr (ssnamex s)))))
	      (alert (strcat (vl-princ-to-string (* a 0.000001)) " m2"))
	 )
  )
  (princ)
)

[k_ngo-quoc]

Sorry, this file can help you understand better.

Thank for your help!

[ronjonp]

@k_ngo-quoc 

Try this:

(defun c:foo (/ a e p s)
  ;; RJP » 2021-04-23
  (while
    (if	(and (setq e (entsel "\nPick legend hatch: "))
	     (setq s (ssget "_X" (list '(0 . "LWPOLYLINE") (assoc 8 (entget (car e))))))
	)
      (progn
	;; This relies on associative hatch to remove the area of the legend item
	;; or don't include a polyline boundary
	(ssdel (cdr (assoc 330 (reverse (entget (car e))))) s)
	(or (and (setq e (ssget "_C" (setq p (cadr e)) (mapcar '- p '(2500 500 0)) '((0 . "*TEXT"))))
		 (setq e (ssname e 0))
	    )
	    (setq e (car (entsel "\nPick text to update: ")))
	)
	(wcmatch (cdr (assoc 0 (entget e))) "*TEXT")
	(setq a (apply '+ (mapcar 'vlax-curve-getarea (mapcar 'cadr (ssnamex s)))))
	(entmod (append (entget e) (list (cons 1 (strcat (rtos (* a 0.000001) 2 0) "m2")))))
      )
    )
  )
  (princ)
)

[mpa-la]

Hey RonJon, I have one more question if you don't mind.  I realized that your routine works on objects in model space while you're in paperspace.  My layer highlight hack did not, that's why my legend was in modelspace.  It would be awesome to just do the whole task while in paperspace instead of having to move and scale it at the end.  Right now the routine gets confused about where the text to change is when it's scaled down by 50, and I cannot figure out for the life of me how that mapchar command works as far as telling it where the text is.  I have attached my final legend scaled for paperspace, could you tell me what line to edit to work for the text in these sizes and positions. 

Secondly, you need a patreon page so us grateful non-programmers can send you gifts. 🙂

[ronjonp]

You need to make the offsets smaller.  🙂

;; Picked point (X+1.8 Y+0.27 Z+0)
(mapcar k p '(1.8 0.27 0))

[mpa-la]

Yay, thanks!!

[ronjonp]

Actually the X offset should be 1.2

;; Picked point (X+1.2 Y+0.27 Z+0)
(mapcar k p '(1.2 0.27 0))

[mpa-la]

So I changed (mapcar '+ p '(50 12 0)) to (mapcar k p '(1.2 .27 0)).  When I load it, it says misplaced dot on input, Function cancelled, then doesn't work.

[mpa-la]

 Is there a ' missing in the new one?