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)

[dlanorh]

A small sample drawing would help

[braudpat]

Hello

But I have attached a DWG !

Please draw a regular Polygon based on the circle ! I don t need circular Room !

Regards, Patrice

[braudpat]

Hello Mr Dlanorh

I have re-attached the same DWG without the Circle !

So maybe the routine will be less complex to select inside ?

Thanks in advance for your help !

Regards, Patrice

[doaiena]

I started writing a function, but for some reason i can't select the text inside the large polyline in your drawing /ssget "WP" isn't working in that case/. Is there an obvious error that i am missing? Here is the code so far:

(defun c:test ( / _dec dec _numLay numLay _typeLay typeLay _areaLay areaLay _polyLay polyLay
	       ss ssText ctr obj coords pts ss2)

(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

(command "view" "s" "tmp")
(setq ssText (ssadd))

(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)
(repeat (sslength ss2)

(ssadd (ssname ss2 ctr2) ssText)

(setq ctr2 (1+ ctr2))
);repeat

));if ss2

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

(command "view" "r" "tmp")
(command "view" "d" "tmp")
(sssetfirst nil ssText)
));if ss

(princ)
);defun

[devitg]

To get a ssget "WP" or "CP" all such points shall be inside the graphic screen , or just do a zoom to extend

[doaiena]

@devitg Yes i know. That's why i even added a "zoom" command just before the "ssget WP", but still no results. I even tried executing code manually /line by line/ in order to debug on the spot. My point list for the "WP" is correct, i checked that with an entmake LWPOLY.

[braudpat]

Hello

Maybe to select all inside a LWPLINE (in WP or CP Mode)

you can use a beautiful select routine from (gile) ??

;;; BEAUTIFUL Selection Routines by (gile)
;;; SSOC : _CP on A Pline or Circle or Ellipse
;;; SSOF : _WP on A Pline or Circle or Ellipse

I hope these 2 routines   ( SSOC / SSOF )  will help you !?

And the Polygone, Circle, Ellipse has not be completey at screen !!

Thanks for your effort, Regards, Patrice

[doaiena]

I found the problem why i couldn't select inside the largest polyline. Vertices 27 and 28 occupy almost the exact spot. That was throwing off the "ssget WP". Once i edited those verts, the selection worked as expected.

[braudpat]

Hello

OOPS SORRY for this BAD Pline, it's real data !

But I can have "perfect" PLines ... If necessary !?

SSOC & SSOF from (gile) has the same problem on this bad PLine !!

Thanks for your effort, Regards, Patrice

[doaiena]

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.

(defun c:test ( / _dec dec _numLay numLay _typeLay typeLay _areaLay areaLay _polyLay polyLay
	       ss ctr obj coords pts ss2 lay num typ area data 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

(command "view" "s" "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 "0")
(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 (cdr (assoc 1 (entget (ssname ss2 ctr2))))))
)
(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" "d" "tmp")

(if (> (length data) 0)
(progn
(setq data (vl-sort data '(lambda (x y) (< (atoi (car x)) (atoi (car y))))))
(setq table (vla-Addtable acadmodel (vlax-3d-point 0 0 0) (+ (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

[braudpat]

Hello

I am running on French ACAD, so I add an "_" before your commands
but something seems wrong !?

Commande: NUMBER_TYPE_AREA_2_TABLE
How many decimals for the AREA [0/1/2/3] <2>:
Enter layer for text number <TEXT_NUMBER>:
Enter layer for text number <TEXT_TYPE>:
Enter layer for text number <TEXT_AREA>:
Enter layer for text number <ROOM_POLYGON>:

Sélectionner des objets: Spécifiez le coin opposé: 6 trouvé(s)

Sélectionner des objets:

OK ... then ... The problem is at the end of the routine !
Maybe after : (if (> (length data) 0)

Commande: _zoom
Spécifiez le coin d'une fenêtre, entrez un facteur d'échelle (nX ou nXP) ou
[Tout/Centre/DYnamique/ETendu/Précédent/Echelle/Fenêtre/Objet] <temps réel>: _o
Sélectionner des objets: 1 trouvé(s)

Sélectionner des objets:
Commande: _view Entrez une option [?/SUpprimer/orthoGonal/Rappel/SAuver/Paramètres/Fenêtre]: _r Entrez le nom de la vue à restaurer: tmp
Commande: _view Entrez une option [?/SUpprimer/orthoGonal/Rappel/SAuver/Paramètres/Fenêtre]: _de
Entrez le(s) nom(s) de vue à supprimer: tmp
Commande: ; erreur: type d'argument incorrect: VLA-OBJECT nil

So I joined to my Msg my Lisp from your Lisp ... I added only UNDERSCORE ? ... I hope so !!

SORRY for my very poor Lisp !

Regards, Patrice

[doaiena]

Probably it has something to do with the french version of acad. Try commenting out these lines and see if it works:
(command "_view" "_sa" "tmp")
(command "_view" "_r" "tmp")
(command "_view" "_de" "tmp")

The idea behind those commands is to save your view when you start the function and then restore it at the end. If you comment them out, at the end of the function the view will be zoomed in on the last polyline of the selection set.

[braudpat]

Hello

I have commented the 3 VIEW Commands :

Commande: _zoom
Spécifiez le coin d'une fenêtre, entrez un facteur d'échelle (nX ou nXP) ou
[Tout/Centre/DYnamique/ETendu/Précédent/Echelle/Fenêtre/Objet] <temps réel>: _o
Sélectionner des objets: 1 trouvé(s)

Sélectionner des objets:
Commande: ; erreur: type d'argument incorrect: VLA-OBJECT nil

The bug is just AFTER the latest ZOOM !

My Routine works on my OLD Test DWG on your PC ??

Same bug even with ONE Polygone !

Regards, Patrice

[braudpat]

Hello

My latest Test DWG ... The Table on Right is NOK !! ... It's an old version !

Regards, Patrice

[doaiena · Accepted solution]

Pfff.... I am so dumb... In my acad i have a global variable "acadmodel", that i used in this function, but forgot to add it in the lisp. That's why it's working in my acad but not yours.

Change this line:
(setq table (vla-Addtable acadmodel (vlax-3d-point 0 0 0) (+ (length data) 2) 3 10 30))

to:
(setq table (vla-Addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point 0 0 0) (+ (length data) 2) 3 10 30))

[braudpat]

Hello

1) BRAVO & THANKS !!

2) Please may I ask a minor update :

At the end of the routine : Ask for a XY Point which is the Top / Left Corner of the Table !

So the table will be drawn at the right XY ...

3) ME TOO, I am a STUPID / DUMB Boy ... I run many times your latest correct version !

So I generate many Tables at 0,0 BUT I was FAR from 0,0 !!!

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

[braudpat]

Hello

SORRY a very minor Bug : I ask for any decimal, and I always GET ONE Decimal ! ... WHY ??

Is it related to DIMZIN ??

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

[hak_vz]

I have started to code on this problem but in a silence not to interrupt this conversation flow. I see you are on a good way (actually you solved this as I write this post) so I won't mix my code in.  It was asked to:

IF a TEXT is not found :

TEXT_NUMBER then generate a ZERO

TEXT_TYPE then generate a ZERO

TEXT_AREA then generate a ZERO

[braudpat]

Hello

The ZERO TEXT generation (Into the Table) when the right TEXT is not found on the right Layer
would be nice !!

Regards, Patrice