Leaderboard

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!

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

If values for 72 and 74 dxf codes supplied, you will get this (link): If group 72 and/or 74 values are nonzero, then the text insertion point values are ignored and new values are calculated by AutoCAD based on the text alignment point and the length of the text string itself (after applying the text style). If you want to avoid this, than you can for the second attribut making according to insertation point (pt) do this "(cons 10 (cons 10 (list (car pt) (- (cadr pt) 0.3) (caddr pt)))" (where 0.3 is the text height), and you will get something like this and need to put (cons 74 0) in all attribut definition: If (cons 74 0) are non-zero value, I get this: Also, you can change (cons 70 0) to be visible, otherwise the values are not appears to be visible in drawing.

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

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.

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.

After that, all that's left is to identify which of the objects created by 'boundary' matches the rectangle. '(ssadd (entlast) dm)' is useless because it might select the wrong polyline. I would use, for example: (setq f (ssget "_X" (list '(0 . "LWP*") '(-4 . "=,=,*") (list 10 (car p1) (cadr p1) 0.0))))

I think you misunderstood me. You should write: (setq m (polar p1 (angle p1 p2) (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))))

You can calculate this using: (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE")))

Another thing to keep in mind is that calculating a point just 1 drawing unit from the bottom corner of the rectangle may cause "boundary" to not work correctly. You may want to calculate that point by applying the drawing distance equivalent to one pixel.

Here is a similar code: Block name in text. EFF_NAME.lsp