Surface closed LWPOLYLINES

March 19

Hello everyone, and thank you in advance.

I have over 900 parcels made up of closed polylines and some with other closed polylines inside. Each parcel contains a text label. My version of AutoCAD is standard. I've seen several threads on this forum address this issue recently, and I'm wondering if it's possible to adapt some of that code for what I want to do: calculate the area of each perimeter and somehow associate the area information with its label. I've attached an example image.

I appreciate any help in advance and wish you a nice day.

March 19

Hi @PGia,

Try this code (I put some comments into the each line of code, just to show you what where is happening inside the each line of code):

(prompt "\nTo run a LISP type: UMTXT")
(princ)

(defun c:UMTXT ( / old_nomutt ss len i area ptlist select_text data_text new_txt)
  (setq old_nomutt (getvar 'nomutt)) ;; Get a value from 'nomutt
  (setvar 'nomutt 1) ;; Set a value to be "1" to "supress" the default "Select objects:" from ssget
  (princ "\nSelect closed POLYLINES:")
  (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))) ;; Select ONLY POLYLINES which are closed! "1" means "1 = Closed"
	len (sslength ss) ;; Length of selection set
	i 0 ;; iterator
	)
  (while (< i len)
    (setq area (vlax-get-property (vlax-ename->vla-object (ssname ss i)) 'Area) ;; Get an Area from closed POYLINE
	  ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ss i)))) ;; Get a vertices from closed POLYLINE
	  select_text (ssget "_WP" ptlist '((0 . "*TEXT,MTEXT"))) ;; Select ONLY TEXT or MTEXT entities
	  data_text (cdr (assoc 1 (entget (ssname select_text 0)))) ;; Get a data from TEXT or MTEXT
	  new_txt (subst (cons 1 (strcat data_text "=" (rtos area 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text 0))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value
	  )
    (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value
    (setq i (1+ i)) ;; Adding 1+ to iterator "i" to repeat iterating through selection set "ss"
    )
  (setvar 'nomutt old_nomutt) ;; Restore old value to 'nomutt
  (prompt "\nAdding area to the labels has been done!")
  (princ)
  )

Notice: It will ONLY select POLYLINES which are CLOSED. If you have OPEN POLYLINES, than will nothing is going to happen. Also, the TEXT or MTEXT values may bee larger and they are will be the outside from POLYLINES (see attached picture as an example).

Best regards.

March 19

Thank you very much for your help, Saxlle. I just tried it and it works very well. But I just noticed that polylines that include other polylines often assign the wrong labels to the surface. How can this be fixed?

March 19

Can you please upload an example .dwg, without ortophoto, just a polylines and text inside them? Maybe need to change "_WP" to "_F" inside the:

......
	  select_text (ssget "_WP" ptlist '((0 . "*TEXT,MTEXT"))) ;; Select ONLY TEXT or MTEXT entities. Replace "_WP" with "_F"
......

Edited March 19 by Saxlle

March 19

Hi
It's possible that when you run a ssget from the largest polylines, it selects several labels and keeps the first one, discarding the others. Sometimes the first one is the correct one, but other times it isn't.
If no one has found a solution before, I'll try to find one myself when I get home.

March 19

I'v think you're right @GLAVCVS. Maybe need to modify the code:

- select all closed polylines where it includes others closed polylines inside;

- rearange closed polylines in that way what to go the first, the second, .... based on Area (from min to max) and make a substitution (e.g. M1=212.50 m2);

- and the last one is to select Area with max value and exclude the rest which already have substitued value of Area (e.g. M1=212.50 m2).

Edited March 19 by Saxlle

March 19

On 3/19/2025 at 11:51 AM, Saxlle said:

I'v think you're right @GLAVCVS. Maybe need to modify the code:

- select all closed polylines where it includes others closed polylines inside;

- rearange closed polylines in that way what to go the first, the second, .... based on Area (from min to max) and make a substitution (e.g. M1=212.50 m2);

- and the last one is to select Area with max value and exclude the rest which already have substitued value of Area (e.g. M1=212.50 m2).

Expand

It should also be noted that in a drawing containing multiple of these polylines, the order of the objects returned by ssget will vary. Sometimes the containing polylines will be analyzed first before the contained ones, and other times it will be the other way around.
The algorithm must be protected against these contingencies.

Edited March 19 by GLAVCVS

March 19

Example.dwgFetching info...

March 19

Here's a quick one guys. You can update it according to your preferences.

(defun c:pl_area (/ bb e eng h l ll lst lst2 pt pts n nv ss sst ur v
          raycast)

  ;;LeeMac
  (defun raycast ( p l )
    (= 1
        (logand 1
            (length
                (vl-remove 'nil
                    (mapcar
                       '(lambda ( a b ) (inters p (mapcar '+ p '(1e8 0.0)) a b))
                        (cons (last l) l)
                        l
                    )
                )
            )
        )
    )
  )
  
  (if (setq ss (ssget '((0 . "LWPOLYLINE")(-4 . "&")(70 . 1))))
    (progn
      (repeat (setq n (sslength ss))
    (setq n (1- n)
          e      (ssname ss n)
          v      (vlax-ename->vla-object e)
          a      (vla-get-area v)
          lst (cons (cons a e) lst)
          )
    )
      (setq lst (vl-sort lst '(lambda (x y)(< (car x)(car y))))
        l (cdr (last lst))
        )
      (vla-getboundingbox (vlax-ename->vla-object l) 'll 'ur)
      (setq bb (mapcar 'vlax-safearray->list (list ll ur))
        sst (ssget "C" (car bb)(cadr bb) '((0 . "MTEXT,TEXT")))
        )
      (repeat (setq n (sslength sst))
    (setq n    (1- n)
          e    (ssname sst n)
          v (vlax-ename->vla-object e)
          lst2 (cons (cons v (vlax-get v 'insertionpoint)) lst2)
          )
    )
  
      (foreach a lst
    (setq eng (entget (cdr a))
          pts (mapcar 'cdr (vl-remove-if-not '(lambda (x)(eq (car x) 10)) eng))
          )
    (foreach pt  lst2
      (if (raycast (cdr pt) pts)
        (progn (if (eq (vla-get-objectname (car pt)) "AcDbMText")
             (vlax-put (car pt)
              'textstring
              (strcat (vlax-get (car pt) 'textstring)
                  "\\P= "
                  (rtos (car a) 2 4))
              )
             (progn (setq nv (vla-copy (car pt)) h (* 1.3333 (vla-get-height nv)))
               (vlax-put nv 'textstring (rtos (car a) 2 4))
               (vlax-put nv 'insertionpoint (list (car (cdr pt))(- (cadr (cdr pt)) h)(caddr (cdr pt))))
               )
             )
          (setq lst2 (vl-remove pt lst2))
          )
        )
      )
    )
      )
    )
  (princ)
  )

Edited March 21 by SLW210
Added Code Tags!!

March 19

@LanloyLisp Thank you very much for your help.

But unfortunately, it doesn't calculate any of the areas correctly. Not even the largest polyline, because its area must be the difference between its area and the interior perimeters. And the areas of the interior polylines aren't correct either.

Any idea what's going on?

March 19

hmmm. strange. by the way, M4 is not a closed polyline, so it was excluded from the iteration, resulting in the same area as the largest one. I'll try to fix it this evening

March 19

Just a maybe rather than use the text associated with each pline you can use the geometric center GC to add the area label. You will get some labelled wrong but it should be easy to see which one to move.

(setq cpt (osnap (vlax-curve-getStartPoint obj) "gcen"))

March 20

On 3/19/2025 at 3:46 PM, PGia said:

@LanloyLisp Thank you very much for your help.

But unfortunately, it doesn't calculate any of the areas correctly. Not even the largest polyline, because its area must be the difference between its area and the interior perimeters. And the areas of the interior polylines aren't correct either.

Any idea what's going on?

Expand

Now I see what you did here, you should have to select all the polylines. I've restructured the routine to notify user to select the largest polyline.

(defun c:pl_area (/ bb e eng h ll lst lst2 pt pts n nv ss sst str ur v
          raycast)

  ;;LeeMac
  (defun raycast ( p l )
    (= 1
        (logand 1
            (length
                (vl-remove 'nil
                    (mapcar
                       '(lambda ( a b ) (inters p (mapcar '+ p '(1e8 0.0)) a b))
                        (cons (last l) l)
                        l
                    )
                )
            )
        )
    )
  )
  
  (if (setq e (car (entsel "\nSelect largest polyline: ")))
    (progn
      (setq eng (entget e)
	    bb (mapcar '(lambda (x)(trans (cdr x) e 1))(vl-remove-if-not '(lambda (x)(eq (car x) 10)) eng))
	    ss (ssget "wp" bb '((0 . "LWPOLYLINE")))
	    sst (ssget "cp" bb '((0 . "MTEXT,TEXT")))
        )
      (cond ((null ss)(setq ss (ssadd))(ssadd e ss))
	     ((not (ssmemb e ss))(ssadd e ss))
	     )
      (if (eq (sslength ss)(sslength sst))
	(progn
      (repeat (setq n (sslength ss))
	(setq n	  (1- n)
	      e	  (ssname ss n)
	      v	  (vlax-ename->vla-object e)
	      a	  (vla-get-area v)
	      lst (cons (cons a e) lst)
	      )
	)
      (setq lst	(vl-sort lst '(lambda (x y) (< (car x) (car y)))))
      (repeat (setq n (sslength sst))
	(setq n	   (1- n)
	      e	   (ssname sst n)
	      v	   (vlax-ename->vla-object e)
	      lst2 (cons (cons v (vlax-get v 'insertionpoint)) lst2)
	      )
	)
      (foreach a lst
	(setq eng (entget (cdr a))
	      pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) eng))
	      str (rtos (car a) 2 4)
	      )
	(foreach pt  lst2
	  (if (raycast (cdr pt) pts)
	    (progn
	      (if (eq (vla-get-objectname (car pt)) "AcDbMText")
		(vlax-put (car pt)
			  'textstring
			  (strcat (vlax-get (car pt) 'textstring)
				  "\\P= "
				  str)
			  )
		(progn (setq nv	(vla-copy (car pt))
			     h	(* 1.3333 (vla-get-height nv)))
		       (vlax-put nv 'textstring str)
		       (vlax-put nv
				 'insertionpoint
				 (list (car (cdr pt)) (- (cadr (cdr pt)) h) (caddr (cdr pt))))
		       )
		)
	      (setq lst2 (vl-remove pt lst2))
	      )
	    )
	  )
	)
      )
	(prompt "\nPolyline and text counts do not match. Check selection.")
	)
      )
    )
  (princ)
  )

March 20

On 3/20/2025 at 8:17 AM, LanloyLisp said:

Now I see what you did here, you should have to select all the polylines. I've restructured the routine to notify user to select the largest polyline.

(defun c:pl_area (/ bb e eng h ll lst lst2 pt pts n nv ss sst str ur v
          raycast)

  ;;LeeMac
  (defun raycast ( p l )
    (= 1
        (logand 1
            (length
                (vl-remove 'nil
                    (mapcar
                       '(lambda ( a b ) (inters p (mapcar '+ p '(1e8 0.0)) a b))
                        (cons (last l) l)
                        l
                    )
                )
            )
        )
    )
  )
  
  (if (setq e (car (entsel "\nSelect largest polyline: ")))
    (progn
      (setq eng (entget e)
	    bb (mapcar '(lambda (x)(trans (cdr x) e 1))(vl-remove-if-not '(lambda (x)(eq (car x) 10)) eng))
	    ss (ssget "wp" bb '((0 . "LWPOLYLINE")))
	    sst (ssget "cp" bb '((0 . "MTEXT,TEXT")))
        )
      (cond ((null ss)(setq ss (ssadd))(ssadd e ss))
	     ((not (ssmemb e ss))(ssadd e ss))
	     )
      (if (eq (sslength ss)(sslength sst))
	(progn
      (repeat (setq n (sslength ss))
	(setq n	  (1- n)
	      e	  (ssname ss n)
	      v	  (vlax-ename->vla-object e)
	      a	  (vla-get-area v)
	      lst (cons (cons a e) lst)
	      )
	)
      (setq lst	(vl-sort lst '(lambda (x y) (< (car x) (car y)))))
      (repeat (setq n (sslength sst))
	(setq n	   (1- n)
	      e	   (ssname sst n)
	      v	   (vlax-ename->vla-object e)
	      lst2 (cons (cons v (vlax-get v 'insertionpoint)) lst2)
	      )
	)
      (foreach a lst
	(setq eng (entget (cdr a))
	      pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) eng))
	      str (rtos (car a) 2 4)
	      )
	(foreach pt  lst2
	  (if (raycast (cdr pt) pts)
	    (progn
	      (if (eq (vla-get-objectname (car pt)) "AcDbMText")
		(vlax-put (car pt)
			  'textstring
			  (strcat (vlax-get (car pt) 'textstring)
				  "\\P= "
				  str)
			  )
		(progn (setq nv	(vla-copy (car pt))
			     h	(* 1.3333 (vla-get-height nv)))
		       (vlax-put nv 'textstring str)
		       (vlax-put nv
				 'insertionpoint
				 (list (car (cdr pt)) (- (cadr (cdr pt)) h) (caddr (cdr pt))))
		       )
		)
	      (setq lst2 (vl-remove pt lst2))
	      )
	    )
	  )
	)
      )
	(prompt "\nPolyline and text counts do not match. Check selection.")
	)
      )
    )
  (princ)
  )

Expand

@LanloyLisp Thank you very much for your effort. I really appreciate it. Yes: There is indeed some polyline that isn't closed. That's how the drawings were delivered to us. But this has an easy solution.

I've been testing your Lisp. Now the small polylines do calculate their area correctly in the example I attached. But you don't subtract the area of the small polylines from the large polyline. I've attached an image below that explains this.

March 20

However, there are other cases where the code doesn't work at all. I've attached annother example below.

Example2.dwgFetching info...

March 20

There's another problem: in a drawing where closed polylines overlap their neighbors, selecting the polyline you want to calculate is often difficult because the wrong polyline is often selected. Isn't it possible for the command to do the work on the entire drawing without having to select them one by one?

March 20

It's really hard to consider all possible situations in code. I spent a while working on it yesterday afternoon, but I didn't have time to finish.

I enjoyed doing it because it's helping me remember some things I'd forgotten.

I'll post the result as soon as I can.

March 20

Anyway: all of this is easier with Map or Civil3D.

But anything that's too easy kills brain cells

Edited March 20 by GLAVCVS

March 20

Hey @PGia,

Try this new one:

; ****************************************************************************************
; Functions     :  UMTXT
; Description   :  Adding an Area value to the label/text of each closed polyline
; Author        :  SAXLLE
; Date          :  March 20, 2025
; Update 1.0    :  Added a substraction to get a total value of largest closed polyline
; Update date   :  March 21, 2025
; ****************************************************************************************

(prompt "\nTo run a LISP type: UMTXT")
(princ)

(defun c:UMTXT ( / old_nomutt ss len i area_with_entity_list area area_with_entity len_area_with_entity_list j max_val substracted_area total_area ptlist select_text data_text new_txt k)
  (setq old_nomutt (getvar 'nomutt)) ;; Get a value from 'nomutt
  (setvar 'nomutt 1) ;; Set a value to be "1" to "supress" the default "Select objects:" from ssget
  (princ "\nSelect closed POLYLINES:")
  (setq ss (ssget '((0 . "LWPOLYLINE") (70 . 1))) ;; Select ONLY POLYLINES which are closed! "1" means "1 = Closed"
	len (sslength ss) ;; Length of selection set
	i 0 ;; 1. iterator
	area_with_entity_list (list) ;; In this list will be stored joined value of an Area and entity (e.g. (500 . <Entity name: 2ed1289fd60>))
	)
  
  (while (< i len)
    (setq area (vlax-get-property (vlax-ename->vla-object (ssname ss i)) 'Area) ;; Get an Area from closed POYLINE
	  area_with_entity (cons area (ssname ss i)) ;; Join the value of Area with entity name
	  area_with_entity_list (cons area_with_entity area_with_entity_list) ;; Create a list of value with Area and entity name
	  )
    (setq i (1+ i)) ;; Adding 1+ to iterator "i" to repeat iterating through selection set "ss"
    )
  
  (setq area_with_entity_list (vl-sort area_with_entity_list (function (lambda (x1 x2) (< (car x1) (car x2))))) ;; Sorting list from MIN to MAX area with entity
	len_area_with_entity_list (length area_with_entity_list) ;; Length of elements in the variable "area_with_entity_list"
	j 0 ;; 2. iterator with FIX value "0"
	)
  
  (setq max_val (car (nth 0 area_with_entity_list))) ;; Get the first value as MAX value of an Area
  
  (repeat (setq len_max (length area_with_entity_list)) ;; Finding a MAX value of an Area from variable "area_with_entity_list"
    (if (<= max_val (car (nth (1- len_max) area_with_entity_list)))
      (setq max_val (car (nth (1- len_max) area_with_entity_list))
	    len_max (1- len_max)
	    )
      (setq max_val max_val)
      )
    )
  
  (setq substracted_area 0) ;; Set "substracted_area" to 0
  
  (repeat (setq len_max (length area_with_entity_list)) ;; Finding a "substracted_area" from variable "area_with_entity_list" which are going to be substracted from variable "max_val"
    (if (> max_val (car (nth (1- len_max) area_with_entity_list)))
      (setq result (+ substracted_area (car (nth (1- len_max) area_with_entity_list)))
	    substracted_area result
	    len_max (1- len_max)
	    )
      (setq len_max (1- len_max))
      )
    )
  
  (setq total_area (- max_val substracted_area)) ;; This is a total area for the largest closed polyline, where the rest Area from closed poylines substracted from variable "max_val"
  
  (repeat len_area_with_entity_list
    (setq ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (cdr (nth j area_with_entity_list))))) ;; Get a vertices from closed POLYLINE
	  select_text (ssget "_WP" ptlist '((0 . "*TEXT,MTEXT"))) ;; Select ONLY TEXT or MTEXT entities
	  )
    
    (if (/= select_text nil)
      
      ;; 1. progn with WINDOW POLYGON "_WP"
      (progn
	
	;; start cond
	(cond
	  ;;1. cond
	  ((= (sslength select_text) 1) ;; If the length of selected TEXT or MTEXT equal to 1
	   (setq data_text (cdr (assoc 1 (entget (ssname select_text 0))))) ;; Get a data from TEXT or MTEXT entity
	   (if (wcmatch data_text "*=*") ;; Check if text contain "="
	     (nil)
	     (progn
	       (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos (car (nth j area_with_entity_list)) 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text 0)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value
	       (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value
	       (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued
	       )
	     )
	   ) ;; end 1. cond
	  
	  ;;2. cond
	  ((>= (sslength select_text) 2) ;; If the length of selected TEXT or MTEXT are greater or equal to 2
	   (setq k (- (sslength select_text) 1)) ;; 3. iterator
	   (repeat (sslength select_text)
	     (if (/= k -1)
	       (progn
		 (setq data_text (cdr (assoc 1 (entget (ssname select_text k))))) ;; Get a data from TEXT or MTEXT entity
		 (if (wcmatch data_text "*=*") ;; Check if text contain "="
		   (setq k (1- k))
		   (progn
		     (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos total_area 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text k)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value
		     (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value
		     (setq k (1- k)) ;; Reduce 1- to iterator "k" to repeat iterating through selection set "select_text"
		     )
		   )
		 )
	       )
	     )
	   (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued
	   ) ;; end 2. cond
	  ) ;; end cond
	) ;; end 1. progn
      
      ;; 2. progn with FENCE "_F"
      (progn
	(setq select_text (ssget "_F" ptlist '((0 . "*TEXT,MTEXT")))) ;; Select ONLY TEXT or MTEXT entities
	
	;; start cond
	(cond
	  ;;1. cond
	  ((= (sslength select_text) 1) ;; If the length of selected TEXT or MTEXT equal to 1
	   (setq data_text (cdr (assoc 1 (entget (ssname select_text 0))))) ;; Get a data from TEXT or MTEXT entity
	   (if (wcmatch data_text "*=*") ;; Check if text contain "="
	     (nil)
	     (progn
	       (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos (car (nth j area_with_entity_list)) 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text 0)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value
	       (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value
	       (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued
	       )
	     )
	   ) ;; end 1. cond
	  
	  ;;2. cond
	  ((>= (sslength select_text) 2) ;; If the length of selected TEXT or MTEXT are greater or equal to 2
	   (setq k (- (sslength select_text) 1)) ;; 3. iterator
	   (repeat (sslength select_text)
	     (if (/= k -1)
	       (progn
		 (setq data_text (cdr (assoc 1 (entget (ssname select_text k))))) ;; Get a data from TEXT or MTEXT entity
		 (if (wcmatch data_text "*=*") ;; Check if text contain "="
		   (setq k (1- k))
		   (progn
		     (setq new_txt (subst (cons 1 (strcat data_text "=" (rtos total_area 2 2) " m2")) (cons 1 data_text) (entget (ssname select_text k)))) ;; Substitue old TEXT or MTEXT value with a new value and adding an Area of closed POLYLINE to the new value
		     (entmod new_txt) ;; Modifies the definition data of an entity with TEXT or MTEXT value
		     (setq k (1- k)) ;; Reduce 1- to iterator "k" to repeat iterating through selection set "select_text"
		     )
		   )
		 )
	       )
	     )
	   (setq area_with_entity_list (vl-remove (nth j area_with_entity_list) area_with_entity_list)) ;; Remove the element from list which are substitued
	   ) ;; end 2. cond
	  ) ;; end cond
	) ;; end 2. progn
      ) ;; end if
    ) ;; end repeat
  
  (setvar 'nomutt old_nomutt) ;; Restore old value to 'nomutt
  (prompt "\nAdding area to the labels has been done!")
  (princ)
  )

I'v been tested this new one lisp on the both drawing which are you uploaded, and get great result (picture 1 and picture 2).

Picture 1.

Picture 2.

I hope you will get satisfied.

Notice: It will only concate the label/text value of closed polyline with an Area of that closed polyline, for opened polylines, nothing is going to happen.

Best regards.

Edited March 21 by Saxlle
Added a Notice. Updated code to get a total value of largest closed polyline.

March 20

(defun c:pl_area (/ bb e h ll lst lst2 pt pts n nv q r ss sst str ta ur v
          raycast plineoff)

  ;;LeeMac
  (defun raycast ( p l )
    (= 1
        (logand 1
            (length
                (vl-remove 'nil
                    (mapcar
                       '(lambda ( a b ) (inters p (mapcar '+ p '(1e8 0.0)) a b))
                        (cons (last l) l)
                        l
                    )
                )
            )
        )
    )
  )

  (defun plineoff	 (v off Out / e eng pts vs)
  (setq	e (vlax-vla-object->ename v)
	eng  (entget
	       (vlax-vla-object->ename
		 (car
		   (vl-sort (setq vs (mapcar 'car
					     (list (vlax-invoke v 'offset off)
						   (vlax-invoke v 'offset (- off)))))
			    '(lambda (x y)
			       ((if out > <) (vla-get-area x) (vla-get-area y))
			       )
			    )
		   )
		 )
	       )
	pts  (mapcar '(lambda (x)(trans (cdr x) e 1)) (vl-remove-if-not '(lambda (x) (eq (car x) 10)) eng))
	)
  (mapcar 'vla-delete vs)
  pts
  )
  
  (if (setq e (car (entsel "\nSelect largest polyline: ")))
    (progn
      (setq v (vlax-ename->vla-object e)
	    ta (vla-get-area v)
	    bb (plineoff v 1.0 T)
	    ss (ssget "wp" bb '((0 . "LWPOLYLINE")))
	    sst (ssget "cp" bb '((0 . "MTEXT,TEXT")))
        )
      (if (eq (sslength ss)(sslength sst))
	(progn
      (repeat (setq n (sslength ss))
	(setq n	  (1- n)
	      e	  (ssname ss n)
	      v	  (vlax-ename->vla-object e)
	      a	  (vla-get-area v)
	      lst (cons (cons a e) lst)
	      )
	)
      (setq lst	(vl-sort lst '(lambda (x y) (< (car x) (car y)))) q 0 r (length lst))
      (repeat (setq n (sslength sst))
	(setq n	   (1- n)
	      e	   (ssname sst n)
	      v	   (vlax-ename->vla-object e)
	      lst2 (cons (cons v (vlax-get v 'insertionpoint)) lst2)
	      )
	)
      (foreach a lst
	(setq q (1+ q)
	      eng (entget (cdr a))
	      pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) eng))
	      str (rtos (if (not (eq q r)) (car a) ta) 2 4)
	      ta (- ta (car a))
	      )
	(foreach pt  lst2
	  (if (raycast (cdr pt) pts)
	    (progn
	      (if (eq (vla-get-objectname (car pt)) "AcDbMText")
		(vlax-put (car pt)
			  'textstring
			  (strcat (vlax-get (car pt) 'textstring)
				  "\\P= "
				  str)
			  )
		(progn (setq nv	(vla-copy (car pt))
			     h	(* 1.3333 (vla-get-height nv)))
		       (vlax-put nv 'textstring str)
		       (vlax-put nv
				 'insertionpoint
				 (list (car (cdr pt)) (- (cadr (cdr pt)) h) (caddr (cdr pt))))
		       )
		)
	      (setq lst2 (vl-remove pt lst2))
	      )
	    )
	  )
	)
      )
	(prompt "\nPolyline and text counts do not match. Check selection.")
	)
      )
    )
  (princ)
  )

here's my latest revision as well.

Sign In

Surface closed LWPOLYLINES

Recommended Posts

PGia

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

GLAVCVS

GLAVCVS

LanloyLisp

Posted Images

Saxlle

PGia

Saxlle

GLAVCVS

Saxlle

GLAVCVS

PGia

LanloyLisp

PGia

LanloyLisp

BIGAL

LanloyLisp

PGia

PGia

PGia

GLAVCVS

GLAVCVS

Saxlle

LanloyLisp

Join the conversation

GLAVCVS

GLAVCVS

LanloyLisp

Tutorials

Forums

Activity