Script sélectionner ce qui est dans un rectangle / Script select what is in a rectangle

[Thomas W]

Bonjour à tous,

 

Je fais mes premiers tests de script et j'espère que mes explications seront assez claires.

 

J'aimerai faire un script qui transforme un rectangle en une sélection, comme on pourrait le faire en utilisant l'outil Sélection, comme ci-dessous :

 

Hi there,

 

I'm doing my first script tests and I hope my explanations will be clear enough. I would like to make a script that transforms a rectangle into a selection, as one could do using the

 

Selection tool, as below:

 

 

Après des recherches sur le forum et dans l'aide je suis arrivé à ce script :

After searching on the forum and in the help I arrived at this script:

 

PROCEDURE selectInRect;

VAR 
    h1 :HANDLE;
    
BEGIN
    h1 :=FSActLayer;
        IF FSActLayer = NIL THEN
        AlrtDialog('Sélectionner un rectangle pour faire une sélection');
        SetName(h1, 'MySelectionPolygon');
        DSelectAll;
        SelectObj((NOTINDLVP & NOTINREFDLVP & (LOC='MySelectionPolygon')));
        END;
Run(selectInRect);

 

 Ce qui me donne ce résultat :

 Which gives me this result:

 

 

Cela fonctionne mais la fonction 'LOC' se base sur le centre des objets et ne réagit donc pas tout à fait comme l'outil Sélection.

It works but the 'LOC' function is based on the center of the objects and therefore does not react quite like the Selection tool.

 

Est ce que quelqu'un sait si on pourrait utiliser les coordonnées du rectangle pour faire une sélection à partir de ces coordonnées en utilisant l'outil sélection?

Does anyone know if we could use the coordinates of the rectangle to make a selection from those coordinates using the selection tool?

 

Ci-dessous les coordonnées du rectangle récupérées par GetBBox :

Below are the coordinates of the rectangle retrieved by GetBBox:

 

 

Je vous joins également le fichier .vwx pour tester.

 

Merci et bonne journée!

 

Thomas

TW_VS créer un rectangle_rectangleN_GetBBox nettoyé pour forum.vwx

[Pat Stanford]

My suggestion would be to start with the script that you already have and then get the bounding box of each selected object. If either point on the bounding box is outside of the bounding box of the rectangle then deselect that object.

 

Something like (untested, so use carefully)

 

{Add this procedure above the Begin and after the variables of your main script}
Procedure Execute(Hd1:Handle);
Var	X1,Y1,X2,Y2:Real;

Begin
	GetBBox(Hd1,X1,Y1,X2,Y2);
	If ((X1<RectX1) or (X2>RectX2) or (Y1>RectY1) or (Y2<RectY2)) Then SetDSelect(Hd1);
End;
                                                                  
{Then in your main script after you make the first selection add}

ForEachObject(Execute, ((VSel)));                                                                  
                                                                  
                                                                 

You may want to tighten up the criteria in the ForEachObject line.

 

HTH.

 

Ask again if you need more help.

 

[Thomas W]

Merci Pat pour votre suggestion!

 

Je vais tester ça demain et je vous tiens au courant, je n'avais pas pensé à cette possibilité de trier après la sélection...

 

Thanks Pat for your suggestion!

 

I'm going to test it tomorrow and I'll let you know, I hadn't thought of this possibility of sorting after the selection...

[Pat Stanford]

There will be edge cases where this will fail, so be careful.  One example could be an odd shaped polygon where the bounding box ends up much bigger than the visible object. These edge cases would be much worse if you were allowing a polygon shaped "frame" instead of just a rectangle. It depends on how perfect you need the result.

 

Glad to help. Ask again if you need more.

[Thomas W]

Bonjour Pat,

 

Je suis entrain de tester votre suggestion, mes différents tests se compilent mais je n'arrive pas au résultat souhaité pour l'instant.

Soit c'est un problème d'ordre dans l'écriture, soit je n'ai pas donné les bonnes informations pour récupérer les coordonnées du Rectangle de sélection.

Ci-dessous les scripts que j'ai essayé et le fichier .vwx est ci-joint.

Si vous avez des pistes pour améliorer ce script je suis preneur!

Merci et bonne journée,

 

I'm testing your suggestion, my various tests are compiling but I can't get the desired result for now.

Either it's a problem with the order in the writing, or I didn't give the right information to retrieve the coordinates of the Selection Rectangle.

Below are the scripts I tried and the .vwx file is attached.

If you have any ideas for improving this script, I'm all ears!

Thank you and good day,

 

Version 7 :

PROCEDURE selectInRect;
VAR 
	Hd1 :HANDLE;
	RX1,RY1,RX2,RY2 :REAL;
	
PROCEDURE Execute(Hd1:HANDLE);
VAR
	X1,Y1,X2,Y2 :REAL;
	RX1,RY1,RX2,RY2 :REAL;
	
BEGIN
		GetBBox(Hd1,X1,Y1,X2,Y2);
		IF((X1<RX1) OR (X2>RX2) OR (Y1>RY1) OR (Y2<RY2)) THEN SetDSelect(Hd1);
		END;
		
BEGIN
	Hd1 :=FSActLayer;
	    IF FSActLayer = NIL THEN
        AlrtDialog('Selectionner un rectangle pour faire une sélection');
		SetName(Hd1, 'MySelectionPolygon');
		GetBBox(Hd1, RX1, RY1, RX2, RY2);
		Message('Coordonnées du rectangle','  RX1=', RX1,'  RY1=', RY1,'  RX2=', RX2,'  RY2=', RY2);
		DSelectAll;
		SelectObj((NOTINDLVP & NOTINREFDLVP & (LOC='MySelectionPolygon')));
		ForEachObject(Execute, ((NOTINDLVP & NOTINREFDLVP & (VSEL=TRUE))));
		END;
Run(selectInRect);

 

Et une autre version :

And another version:

 

Version 8 :

PROCEDURE selectInRect;
VAR 
	Hd1 :HANDLE;
	X1,Y1,X2,Y2 :REAL;
	RX1,RY1,RX2,RY2 :REAL;{Rect Dims}
	
PROCEDURE Execute(Hd1:HANDLE);
VAR
	X1,Y1,X2,Y2 :REAL;
	RX1,RY1,RX2,RY2 :REAL;{Rect Dims}
	
BEGIN
		GetBBox(Hd1,X1,Y1,X2,Y2);
		IF((X1<RX1) OR (X2>RX2) OR (Y1>RY1) OR (Y2<RY2)) THEN SetDSelect(Hd1);
		END;
		
BEGIN
	Hd1 :=FSActLayer;
	    IF FSActLayer = NIL THEN
        AlrtDialog('Selectionner un rectangle pour faire une sélection');
		SetName(Hd1, 'MySelectionPolygon');
		GetBBox(Hd1, X1, Y1, X2, Y2);
		RX1:=X1;
		RY1:=Y1;
		RX2:=X2;
		RY2:=Y2;
		Message('Coordonnées du rectangle','  RX1=', RX1,'  RY1=', RY1,'  RX2=', RX2,'  RY2=', RY2);
		DSelectAll;
		SelectObj((NOTINDLVP & NOTINREFDLVP & (LOC='MySelectionPolygon')));
		ForEachObject(Execute, ((NOTINDLVP & NOTINREFDLVP & (VSEL=TRUE))));
		END;
Run(selectInRect);

 

Merci,

Thomas

TW_VS créer un rectangle_rectangleN_GetBBox_sur bureau_pour forum.vwx

[Thomas W]

Bonjour,

 

C'est ok le script ci-dessous fonctionne mais il y aura certainement des exceptions.

Fonctionnement de base : Dans le dessin je sélectionne un rectangle et on souhaite récupérer tout ce qui est entièrement compris dans ce rectangle.

Cela fonctionne pour l'instant pour des objets comme des lignes, des rectangles....mais ça risque de se compliquer avec les symboles 2d/3d et les symboles dans murs.

 

C'est pour de la construction modulaire et l'objectif est d'attribuer un format de base de données à des modules qui sont rectangulaires et qui peuvent être accolés.

Ci-dessous le script qui fonctionne pour les objets simples comme les lignes, rectangles...

 

Hello, It's ok the script below works but there will definitely be exceptions.

Basic operation: In the drawing I select a rectangle and we want to recover everything that is entirely included in this rectangle.

It works for now for objects like lines, rectangles...but it may get complicated with 2d/3d symbols and wall symbols.

It is for modular construction and the objective is to assign a database format to modules which are rectangular and which can be joined. Below is the script that works for simple objects like lines, rectangles...

 

PROCEDURE selectInRect;
VAR 
	Hd1 :HANDLE;
	X1,Y1,X2,Y2 :REAL;
	RectX1,RectY1,RectX2,RectY2 :REAL;{Rect Dims}
	
PROCEDURE Execute(Hd1:HANDLE);
BEGIN
		GetBBox(Hd1,X1,Y1,X2,Y2);
		IF((X1<RectX1) OR (X2>RectX2) OR (Y1>RectY1) OR (Y2<RectY2)) THEN SetDSelect(Hd1);
		END;
		
BEGIN
	Hd1 :=FSActLayer;
	    IF FSActLayer = NIL THEN
        AlrtDialog('Selectionner un rectangle pour faire une sélection');
		SetName(Hd1, 'MySelectionPolygon');
		GetBBox(Hd1, RectX1, RectY1, RectX2, RectY2);
		Message('Coordonnées du rectangle','  RectX1=', RectX1,'  RectY1=', RectY1,'  RectX2=', RectX2,'  RectY2=', RectY2);
		DSelectAll;
		SelectObj((NOTINDLVP & NOTINREFDLVP & (LOC='MySelectionPolygon')));
		ForEachObject(Execute, ((VSEL=TRUE)));
		END;
Run(selectInRect);

Je vais tester pour les symboles 2d/3d et les symboles 2d/3d qui contiennent des symboles dans mur vu qu'ils réagissent différemment à la sélection et j'aurai sûrement d'autres questions.

I'm going to test for 2d/3d symbols and 2d/3d symbols that contain wall symbols as they react differently to selection and I'm sure I'll have more questions.

 

le fichier de cet exemple est ci-joint

the file of this example is attached

 

Merci à Pat et bonne journée,

Thank you Pat and have a nice day,

 

Thomas

 

TW_VS créer un rectangle_rectangleN_GetBBox_sur bureau nettoyé pour forum.vwx

[Thomas W]

Bonjour,

 

J'ai complété le script pour réaliser les étapes ci-dessous :

 

- Sélectionner un rectangle qui servira de contour de sélection.

- Nommer le rectangle.

- Sélectionner ce qui est dans le rectangle, LOC recherche le centre des objets.

- ForEachObject chercher les objets (qui ne sont pas des symboles) et qui ont au moins un point en dehors du rectangle, les désélectionner.

- ForEachObject chercher les symboles non sélectionnés qui ont leur point d'insertion dans le rectangle. les sélectionner.

- ForEachObject chercher les symboles sélectionnés qui ont leur point d'insertion en dehors du rectangle parmi ceux sélectionnés, les désélectionner.

 

Il y aura certaines exceptions comme sur la capture ci-dessous mais ce sera acceptable pour notre utilisation.

 

Hello, I completed the script to perform the steps below:

 

- Select a rectangle that will serve as a selection outline.

- Name the rectangle.

- Select what is in the rectangle, LOC searches the center of objects.

- ForEachObject find objects (which are not symbols) and which have at least one point outside the rectangle, deselect them.

- ForEachObject find unselected symbols that have their insertion point in the rectangle. select them.

- ForEachObject find the selected symbols which have their insertion point outside the rectangle among those selected, deselect them.

 

There will be some exceptions as in the screenshot below but it will be acceptable for our use.

 

 

Le script de cette sélection et le fichier en pièce jointe :

 

PROCEDURE selectInRect;
VAR 
	Hd1 :HANDLE;
	X1,Y1,X2,Y2 :REAL;
	RectX1,RectY1,RectX2,RectY2 :REAL;{Rect Dims}
	
PROCEDURE ObjectOutRect(Hd1:HANDLE);{chercher les objets (qui ne sont pas des symboles) et qui ont au moins un point en dehors du rectangle}
BEGIN
		GetBBox(Hd1,X1,Y1,X2,Y2);
		IF((X1<RectX1) OR (X2>RectX2) OR (Y1>RectY1) OR (Y2<RectY2)) THEN SetDSelect(Hd1);
		END;

PROCEDURE SymLocInRect(Hd1:HANDLE);{chercher les symboles non sélectionnés qui ont leur point d'insertion dans le rectangle}
BEGIN
		GetSymLoc(Hd1,X1,Y1);
		IF(((X1>RectX1) AND (X1<RectX2)) AND ((Y1<RectY1) AND (Y1>RectY2))) THEN SetSelect(Hd1);
		END;
		
PROCEDURE SymLocOutRect(Hd1:HANDLE);{chercher les symboles sélectionnés qui ont leur point d'insertion en dehors du rectangle parmi ceux sélectionnés}
BEGIN
		GetSymLoc(Hd1,X1,Y1);
		IF(((X1<RectX1) OR (X1>RectX2)) OR ((Y1>RectY1) OR (Y1<RectY2))) THEN SetDSelect(Hd1);
		END;
		
BEGIN
	Hd1 :=FSActLayer;
	    IF FSActLayer = NIL THEN
        AlrtDialog('Selectionner un rectangle pour faire une sélection');
		SetName(Hd1, 'MySelectionPolygon');
		GetBBox(Hd1, RectX1, RectY1, RectX2, RectY2);
		Message('Coordonnées du rectangle','  RectX1=', RectX1,'  RectY1=', RectY1,'  RectX2=', RectX2,'  RectY2=', RectY2);
		DSelectAll;
		SelectObj((NOTINDLVP & NOTINREFDLVP & (LOC='MySelectionPolygon')));
		DelName('MySelectionPolygon');
		ForEachObject(ObjectOutRect, ((NOTINDLVP & NOTINREFDLVP & ((VSEL=TRUE) & (T<>SYMBOL)))));
		ForEachObject(SymLocInRect,(NOTINDLVP & NOTINREFDLVP & ((VSEL=FALSE) & (T=SYMBOL))));
		ForEachObject(SymLocOutRect,(NOTINDLVP & NOTINREFDLVP & ((VSEL=TRUE) & (T=SYMBOL))));
		END;
Run(selectInRect);

 

Bonne journée et encore merci Pat pour les suggestions,

 

Have a nice day and thanks again Pat for the suggestions,

 

Thomas

TW_VS créer un rectangle_rectangleN_GetBBox_sur bureau pour forum V2.vwx