Surface closed LWPOLYLINES

[Saxlle]

You're welcome @GLAVCVS, I'm here to help .

[PGia]

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

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

 

Expand  

 

Wow!

It's incredible!

It works perfectly!

It did the whole job in less than 4 minutes!

Edited March 24 by PGia

[PGia]

Thank you very much @GLAVCVS

Adding a reference to the main tag in the secondary tags is very helpful.

[PGia]

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

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!

Expand  

It will be a pleasure to come here for coffee.