Surface closed LWPOLYLINES

[GLAVCVS]

Hi @PGia
Can you attach a larger drawing?
I need to run some tests.

[Saxlle]

@PGia, I'v been updated my last code to get a total value of Area for the largest closed polyline.

 

@LanloyLisp, you'r lisp also works great.

 

But I'm afraid there is going to be complicated situation if @PGia going to have something like from this picture (I added this as possible situation):

 

[Saxlle]

  On 3/21/2025 at 9:24 AM, GLAVCVS said:

Can you attach a larger drawing?

Expand  

I agree with @GLAVCVS.

[PGia]

Hi guys 

This is great. @Saxlle's Lisp is very close to working (it just needs to adjust for differences in the surfaces of the containing polylines). And @LanloyLisp's Lisp now works very well. Regarding Saxlle's last comment: yes, there are some cases (not many) where this happens. It involves some type of land that needs to be delimited and that contains some infrastructure. I'll include any parcel where this happens in the drawing you requested.

Edited March 21 by PGia

[Saxlle]

Hey @PGia,

 

Try the modified code from last post. I updated code about an 1 hour ago. Maybe you tried unupdated version.

[SLW210]

  On 3/19/2025 at 2:13 PM, LanloyLisp said:

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

 

Expand  

 

You need to use Code Tags (<> in the editor toolbar) for your Code, not Quote Tags!

[PGia]

I hope this is enough

Example3.dwgFetching info...

[PGia]

  On 3/21/2025 at 10:20 AM, Saxlle said:

Hey @PGia,

 

Try the modified code from last post. I updated code about an 1 hour ago. Maybe you tried unupdated version.

Expand  

Yes. That's right.

Now it calculates all the surfaces correctly.

Thanks, Saxlle.

[PGia]

The real test I'm facing now is:  How do I apply these lisps to a drawing like the one I've attached? Is it feasible to try selecting 9,000 polylines, 1x1?

Edited March 21 by PGia

[Saxlle]

Hey @PGia, 

 

I think the better way is to select segments by segments. If somewhere fail, it will be much easier to locate problem, inspite of selecting everything in drawing and do a calculations of an Area. I notice there is overlapping segments on the polylines (using overkill command), be aware of that. I will try to fix the code according to an Example3 file which are you uploaded and see what is going to happen. 

Edited March 21 by Saxlle

[GLAVCVS]

I think it's very slow to do it polyline by polyline. Especially since, when selecting them with the cursor, you often select the wrong polyline and have to start over.

The challenge is making the code capable of saving the user that work.

[Saxlle]

 

  On 3/21/2025 at 3:53 PM, GLAVCVS said:

The challenge is making the code capable of saving the user that work.

Expand  

 

I Agree with that, until we find a right solution (one of us/all of us), just not to waste the time @PGia. I would start with segments by segments.

 

I hope this isn't a just once using lisp for only for that purpose. So, maybe to find a good organization in file (for e.g. layers names, closed polygons of polyline, TEXT /MTEXT formatting, entities in right layers, etc.). If everything well organazied, coding is just a pleasure. 

 

 

[BIGAL]

 I think the 9000 objects is ok, once code woks,  have played with 2000 objects, the client would take 3 hours to edit a dwg to what they wanted, 1st go was 34 minutes its now 2 minutes. So if 9000 take 10 minutes so be it just compare to how long to do manually, at some stage need to go and get a coffee.

[PGia]

Thank you for your interest, Mr. Bigal. 
It's an honor for me. 

I'm trying to document a bid (with my own statistical data) for a public tender, and I still have seven weeks to do so. It's highly unlikely that I'll be awarded this contract because it's happened several times in other similar tenders. For this reason, I want to try to ensure that, when that happens, the only thing I've lost is my time. In any case, I'd like that to change and have reasons, in the future, to come here and have a coffee with some of you. 
Thank you very much.

[GLAVCVS]

Hi @PGia
I think this should meet your needs.
I could say I wrote it from scratch just for you, but really, I also did it for myself. I had a good time revisiting old concepts.
As I said, this is much easier to do with Map or Civil3D, creating topologies and manipulating them with the 'mnt*' functions. But writing this code has helped me prove that these tools can also be done in Lisp, with reasonably good results.

The expressions are in my language. You'll have to translate them into yours.

;******************* G L A V C V S *******************
;********************* F E C I T *********************
(defun c:spf>PGia (/ conj cj cjP ent n lstent en ex d pt i l lC lCs cE ltS ltV ltds s lSV actEtqs selR)
  (defun lSV (l / p r)
    (setq ltS (cons (list (setq s (vlax-ename->vla-object (car l))) (cadr l)) ltS) lCs (cons (list s (last l)) lCs))
    (foreach x (reverse (cdr l))
      (if p
        (if (not (member x ltds));ltds es la lista de los ya tocados
   	  (if (setq r (assoc p ltV))
     	    (setq ltV (subst (list (car r) (+ (cadr r) (vla-get-area x))) r ltV) ltds (cons x ltds));ltV es una lista en que se asocia el identificador de las lineas contenedoras con la suma de la áreas de las contenidas
      	    (setq ltV (cons (list p (vla-get-area x)) ltV) ltds (cons x ltds))
   	  )
        )
      )
      (setq p x)
    )
  )
  (defun actEtqs (/ a b c e p pc l et tx)
    (foreach v (reverse ltS)
      (setq e (car v) p (cadr v) pc (last v))
      (if (= (vla-get-layer e) "US")
	(setq l (cadr (assoc e lCs)) tx (vl-some '(lambda (x) (if (equal (cadr x) l) (vla-get-textstring (car x)))) ltS))
	(setq tx nil)
      )
      (if (/= (vla-get-layer e) "GEN") (vla-put-color p 6))
      (vla-put-textstring
	e
	(strcat (if tx (strcat tx "-") "") (vla-get-textstring e) ":" (rtos (- (vla-get-area p) (if (setq a (assoc p ltV)) (cadr a) 0)) 2 2))
      )
    )
  )
  (defun selR (p / r s l lt en ex cj n o r4 f)
    (defun r2+ (p l r / i b)
      (vl-some
        '(lambda(g) (= 2 (setq r (if (foreach a (cons (last l) l) (if b (if (inters p (polar p g d) b (setq b a)) (setq i (not i))) (setq b a)) i) (+ r 1) r))))
        '(0 1.5708 3.141592 4.71239)
      )
    )
    (if (setq cj
	       (ssget "_F"
		(list p (list (car p) (+ (cadr p) (getvar "viewsize"))))
		(list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1))
	       )
	)
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
	(if (r2+ p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e))) 0)
	  (progn (setq l (cons (vlax-ename->vla-object e) l)) (if (ssmemb e cjP) (ssdel e cjP)))
	)
      )
    )
    (if l (vl-sort l '(lambda (a b) (< (vla-get-Area a) (vla-get-Area b)))))
  )
  (setq en (getvar "extmin") ex (getvar "extmax") n -1
        d (max (- (car ex) (car en)) (- (cadr ex) (cadr en)))
  )
  (vla-zoomExtents (vlax-get-acad-object))
  (setq cjP (ssget "x" (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1))))
  (if (setq conj (ssget "_X" '((0 . "TEXT") (8 . "GEN,US"))))
    (while (setq ent (ssname conj (setq n (1+ n))))
      (setq lstent (entget ent) pt (cdr (assoc 10 lstent)))
      (if (setq l (selR pt)) (lSV (cons ent l))	(princ (strcat "\n*** Etiqueta " (cdr (assoc 1 lstent)) " huerfana")))
    )
  )
  (if (> (sslength cjP) 0) (alert "ATENCION: Hay polilíneas sin asignar"))
  (alert (strcat "Numero de perímetros procesados: " (itoa (length ltS))))
  (actEtqs)
  (princ)
)

 

Edited Monday at 12:04 PM by GLAVCVS

[GLAVCVS]

How does it work?

Although it may seem like there's little code, it does a lot more than meets the eye:
- associates each polyline with the text inside it
- calculates the area of each perimeter and associates it with the text inside, taking into account the secondary perimeters
- changes the color of the secondary perimeters and adds a reference to the main perimeter to their labels
- checks whether all perimeters and labels have been found and leaves a warning if this hasn't happened

There are a few more details I've left unresolved so as not to go on about this any longer (because it probably doesn't matter) but that you should keep in mind:
- If there is more than one label inside a perimeter, it will associate the same information with both and won't give you any warning
- If there is an unlabeled perimeter, it will leave a warning but won't tell you where it is.

[GLAVCVS]

Finally, the code assumes that the perimeters in the drawing will be closed LWpolylines, the labels will be text, and the layers will be the same as in the example you attached. If any of these conditions are not met, it won't work.

[GLAVCVS]

PS: Someday you'll win one of those public tenders, and when that happens, I hope you'll come over here and have a coffee with one of us

 

 Good luck!

[Saxlle]

@GLAVCVS, just test it your code and it also works great . I started something new to writte and didn't have time to finish it, when everything is going to be done and tested, I will also post it. Just a little notice @GLAVCVS (picture 1 and 2):

 

- picture 1: the  total  area need to be substracted from areas 1, 2, 3 and 4.

 

 

- picture 2: the  total2  area need to be substracted from areas 1 and 2, and the total1 area need to be substracted from areas 1, 2 and total2 (at this part I stopped writting the code).

 

 

  On 3/24/2025 at 10:40 AM, GLAVCVS said:

closed LWpolylines, the labels will be text, and the layers will be the same as in the example you attached

Expand  

 

Agree with this part. From last post when I said "So, maybe to find a good organization in file (for e.g. layers names, closed polygons of polyline, TEXT /MTEXT formatting, entities in right layers, etc.)", I meant on that.

[GLAVCVS]

Thank you very much, @Saxlle.
Actually, getting that to work was the first thing I did.
But at the last minute, I made a change so the M tags would include a reference to the main polyline, and I didn't check it properly.
It's simply a matter of changing 'e' to 'p', as shown in the attached image.

 

I've already updated that in the code. Check if everything is correct now.