Lisp to Get Table with Room : Number + Type + Area

[braudpat]

Hello Lisp/VLisp Friends

I looked for the right Lisp routine but I don't find it !?

They are many nice routines based on Blocks with an outside Polygon to get nice tables ...

But my problem is a little bit different ? Because I have TEXTs already written ...

So please look at my Test DWG ...

I have many Polygones or Circles with NO Overlap !

Inside each one (In Theory), I have 3 TEXTs inside on different layers : TEXT_AREA , TEXT_NUMBER , TEXT_TYPE

So the routine must do :

- Ask a question : How many decimals for the AREA (0/1/2/3) - Default = 2

- Ask for the 3 TEXTs Layer Name ?

- Ask for the Polygon / Circle Layer Name ?

- Ask for a selection of 2D Plines AND Circles ...

Then

- For each Polygon / Circle on the right Layer , find the 3 TEXTs which are on a different layers ...

- Generate automatically the Table sorted by NUMBER

If SAME NUMBER, go on ... I can have many NUMBER 1/2/3/etc ...

- Generate the last ROW with the AREA / SURFACE Total ...

IF a TEXT is not found :

TEXT_NUMBER then generate a ZERO

TEXT_TYPE then generate a ZERO

TEXT_AREA then generate a ZERO

I hope this routine is not a BIG work  !?

Thanks in advance ...

THE HEALTH, Regards, Patrice (The Old French EE Froggy)

[doaiena · Accepted solution]

This should be the last edit...

;; 
;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-get-table-with-room-number-type-area/td-p/9186720
;; 
;; Routine: NUMBER_TYPE_AREA_2_Table by doaiena
;; 
;; ---- Re: Lisp to Get Table with Room : Number + Type + Area ----
;; 
;; Here is a quick draft. I didn't have time to test it a lot, 
;; so try it and tell me if it's working as expected.
;; 

(vl-load-com) 

(defun c:NUMBER_TYPE_AREA_2_Table ( / _dec dec _numLay numLay _typeLay typeLay _areaLay areaLay _polyLay polyLay
	       ss ctr obj coords pts ss2 lay num typ area data tablePt table row col)

(setq _dec "2") 

(setq _numLay "TEXT_NUMBER") 

(setq _typeLay "TEXT_TYPE") 

(setq _areaLay "TEXT_AREA") 

(setq _polyLay "ROOM_POLYGON")

(initget "0 1 2 3")
(setq dec (cond ((getkword (strcat "How many decimals for the AREA [0/1/2/3] <" _dec ">: "))) (_dec)))

(setq numLay (getstring (strcat "Enter layer for text number <" _numLay ">: ")))
(if (= numLay "") (setq numLay _numLay))

(setq typeLay (getstring (strcat "Enter layer for text number <" _typeLay ">: ")))
(if (= typeLay "") (setq typeLay _typeLay))

(setq areaLay (getstring (strcat "Enter layer for text number <" _areaLay ">: ")))
(if (= areaLay "") (setq areaLay _areaLay))

(setq polyLay (getstring (strcat "Enter layer for text number <" _polyLay ">: ")))
(if (= polyLay "") (setq polyLay _polyLay))


(if (setq ss (ssget (list (cons 0 "LWPOLYLINE") (cons 8 polyLay) (cons 70 1)))) 
(progn

(while (not tablePt) (setq tablePt (getpoint "\nPick top left corner for the table: ")))

(command "_view" "_sa" "tmp")
(setq ctr 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss ctr)))
(setq coords (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj))))
(setq pts nil)
(while (> (length coords) 0)
(setq pts (cons (list (car coords) (cadr coords)) pts))
(setq coords (cdr (cdr coords)))
)

(command "_zoom" "_o" (ssname ss ctr) "")
(if (setq ss2 (ssget "_WP" pts (list (cons 0 "Text") (cons 8 (strcat numLay "," typeLay "," areaLay)))))
(progn

(setq ctr2 0 num "0" typ "0" area (rtos 0 2 (atoi dec)))
(repeat (sslength ss2)
(setq lay (cdr (assoc 8 (entget (ssname ss2 ctr2)))))
(cond
((= lay numLay) (setq num (cdr (assoc 1 (entget (ssname ss2 ctr2))))))
((= lay typeLay) (setq typ (cdr (assoc 1 (entget (ssname ss2 ctr2))))))
((= lay areaLay) (setq area (rtos (atof (cdr (assoc 1 (entget (ssname ss2 ctr2))))) 2 (atoi dec))))
)
(setq ctr2 (1+ ctr2))
);repeat

(setq data (cons (list num typ area) data))

));if ss2

(setq ctr (1+ ctr))
);repeat

(command "_view" "_r"  "tmp")
(command "_view" "_de" "tmp")

(if (> (length data) 0)
(progn
(setq data (vl-sort data '(lambda (x y) (< (atoi (car x)) (atoi (car y))))))
(setq table (vla-Addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point tablePt) (+ (length data) 2) 3 10 30))

(setq row 0)
(repeat (length data)
(setq col 0)
(repeat 3
(vla-settext table (+ row 1) col (nth col (nth row data)))
(setq col (1+ col))
)
(setq row (1+ row))
);rows

(vla-settext table (+ row 1) 2 (rtos (apply '+ (mapcar 'atof (mapcar 'caddr data))) 2 (atoi dec)))
))

));if ss

(princ)
);defun

[hak_vz]

SO some polygons are supposed to be empty. If not, creating those three texts in a temp layer with expressed area of the polygon is not a bad idea.

[braudpat]

Hello

THANKS for your latest version !

I will manage the DIMZIN problem related to decimals ...

If you have yet a few minutes for me, I will appreciate that if no TEXT is found on the right Layer,

you will generate "0" (Zero) into your List and into the Table ...

Happy End of Year, Happy Christmas, THE HEALTH, Regards, Patrice

[doaiena]

---

If you have yet a few minutes for me, I will appreciate that if no TEXT is found on the right Layer,

you will generate "0" (Zero) into your List and into the Table ...

---

But that is already in the code from the first version. If you follow the code, you will see that all 3 columns start as "0", then they change to the appropriate value only if a text from the corresponding layer is found.

Or maybe i don't understand you correctly. Do you want a text entity to be created inside the polyline, or just a zero in the table?

[braudpat]

Hello

Just a ZERO into the Table ...

Thanks, Regards, Patrice

[doaiena]

But as i've said, that is already working. Did you test the code?

[braudpat]

Hello

SORRY it s OK !!

I always have TEXTs ... Stupid Boy !!

THANKS, THANKS, Regards, Patrice