Jump to content
Developer Wiki and Function Reference Links ×

Script : Search duplicate walls or/and hidden walls


Recommended Posts

Hi all,

 

I made a script to find and remove duplicate and/or hidden walls in the background but I would like your opinion on the way it's written and on possible improvements.

 

Compared to Vector's function which is in File/File Contents/Show/Duplicate Objects:

- I wanted to be able to locate the object before deleting it

- also select the hidden walls in the background which are at the same position but which can have another wall style

- select the walls in the back plan which are hidden and shifted.

 

Small explanations: The goal is to avoid costing errors, we use pieces of walls to make wall panel then we recover them in a worksheet, we use different models that we move or copy so these errors can happen.

In the script there are 2 loops While (Hd1<>NIL) DO to separate the 2 dialog boxes between the superimposed walls and those which are shifted.

Is it possible to add a function that should escape and stop the running script?

With the IF NOT DidCancel function, you have to add a dialog in addition to YNDialog but is it possible without this dialog?

 

I hope my explanations are clear enough and I would appreciate your remarks to improve this script.

 

Below is the script and an attached file for tester.

 

Thanks,

 

PROCEDURE SearchDuplicateWall;
{Utiliser ce script dans la vue en plan 2d}
{ce script va chercher des murs qui ne seraient pas visibles en 2d et qui seraient cachés en étant sur des couches inférieures}


CONST
	kIndex=68; {type objet mur}

VAR 
	Hd1, Hd2 :HANDLE;
	A1x,A1y,A2x,A2y :REAL; {Coordonnée en haut à gauche et en bas à droite de la boîte englobante A}
	CAx,CAy : REAL;	{Centre de la boîte englobante A}
	B1x,B1y,B2x,B2y :REAL; {idem pour B}
	CBx,CBy :REAL; {idem pour B}
	SNameTemp, SWallStyleName : STRING;
	
	
PROCEDURE CompareNextObjectWall(Hd2 :HANDLE); {recherche un mur avec la même boite englobante et le même centre}
BEGIN
		GetBBox(Hd2,B1x,B1y,B2x,B2y);
		HCenter(Hd2,CBx,CBy);
		IF(((A1x=B1x) AND (A1y=B1y) AND (A2x=B2x) AND (A2y=B2y)) AND ((CAx=CBx) AND (CAy=CBy))) THEN 
			BEGIN 
				SetSelect(Hd2);
				DoMenuTextByName('Fit To Objects',0);
				SetZoom(100);
				SWallStyleName := GetWallStyle(Hd2);
				IF YNDialog(Concat('Voulez-vous supprimer ce Doublon dont le style de mur est :',CHR(13),SWallStyleName))=TRUE THEN
					BEGIN
					DelObject(Hd2);
					END
				ELSE
				SetDSelect(Hd2);
			END;
END;
		
PROCEDURE CompareHiddenWall(Hd2 :HANDLE); {recherche un mur qui serait caché dans l'alignement d'un autre mur sans avoir forcément la même taille}
BEGIN
		GetBBox(Hd2,B1x,B1y,B2x,B2y);
		HCenter(Hd2,CBx,CBy);
		IF (((CBx=CAx) AND (CBy<=A1y) AND (CBy>=A2y)) OR ((CBy=CAy) AND (CBx>=A1x) AND (CBx<=A2x))) THEN
			BEGIN 
				SetSelect(Hd2);
				DoMenuTextByName('Fit To Objects',0);
				SetZoom(100);
				SWallStyleName := GetWallStyle(Hd2);
				IF YNDialog(Concat('Voulez-vous supprimer ce Mur Caché dont le style de mur est :',CHR(13),SWallStyleName))=TRUE THEN
					BEGIN
					DelObject(Hd2);
					END
				ELSE
				SetDSelect(Hd2);
			END;
END;

BEGIN
	DSelectAll;
	Hd1:=LActLayer;
	SNameTemp := 'Tmp';
	WHILE (Hd1<>NIL) DO
		BEGIN
						IF (GetTypeN(Hd1)=kIndex) THEN
							BEGIN
							GetBBox(Hd1,A1x,A1y,A2x,A2y);
							HCenter(Hd1,CAx,CAy);
							DelName('Tmp');
							SetName(Hd1, 'Tmp');
							ForEachObject(CompareNextObjectWall, (NOTINDLVP & NOTINREFDLVP & ((L='Dessin') & (T=WALL) & (N<>'Tmp'))));
							DelName('Tmp');
							Hd1:=PrevObj(Hd1);
							END
						ELSE
						Hd1:=PrevObj(Hd1);
		END;
	AlrtDialog('Il n''y a pas ou plus de "Doublon" de mur en arrière plan');
	
	Hd1:=LActLayer;
	WHILE (Hd1<>NIL) DO
		BEGIN
						IF (GetTypeN(Hd1)=kIndex) THEN
							BEGIN
							GetBBox(Hd1,A1x,A1y,A2x,A2y);
							HCenter(Hd1,CAx,CAy);
							DelName('Tmp');
							SetName(Hd1, 'Tmp');
							ForEachObject(CompareHiddenWall, (NOTINDLVP & NOTINREFDLVP & ((L='Dessin') & (T=WALL) & (N<>'Tmp'))));
							DelName('Tmp');
							Hd1:=PrevObj(Hd1);
							END
						ELSE
						Hd1:=PrevObj(Hd1);
		END;
	AlrtDialog('Il n''y a pas ou plus de Murs cachés en arrière plan');
END;
Run(SearchDuplicateWall);

 

TW VScript recherche doublon de murs-V4 FINAL - Forum.vwx

Link to comment

Hello @Thomas W,

   Everything you've written is good. It works and the flow is straight forward. I can only offer very minor suggestions, which you can follow or ignore. They may make your future scripts easier to read later, after you've forgotten how you solved a problem.

 

   First, your variable names are nondescript. I changed the variable names to better reflect what they mean. For your BoundingBox vars, you used: A1x,A1y,A2x,A2y, CAx,CAy :REAL; I changed them to: TL_A, BR_A, CenA :POINT; where TL = TopLeft, and BR = BottomRight. Each POINT variable has an X & Y component built in. Where you had 6 variables now there are 3. Consider it a package deal. Type VECTOR gives you a 3-way bundle with XY&Z components. This can reduce clutter for you, and for anyone you are sharing your code with. 

 

   Second, I replaced your boolean operators, AND and OR, with & and |. These are short circuit operators that do the same thing, but evaluation of the boolean expression stops when the outcome is decided. If A is FALSE, you don't need to evaluate B in the expression (A & B), because B cannot affect the outcome. Likewise for the expression (A | B), if A is TRUE, B does not affect the outcome. If you want to know more about this, just ask. There are other subtleties.

 

   I also changed your temp class name, and the CR character (chr(13)), to constants; and I moved your PrefObj() calls outside the IF structures, for style reasons only. 

 

   Lastly, because I spotted it just before I hit submit, I changed the way you coded your active layer name in your search criteria. Currently, your script only works on the hard coded layer 'Dessin'. In another file your layer names will most likely be different, or you may want to run the script on multiple layers in the same file. By assigning the Active Layer name to a string variable, you can use the <criteria> statement in this script pretty much the way you wrote it, but now (L=ActLName) will replace (L='Dessin'), and you won't have to edit your script to run it elsewhere. It will always run on the active design layer.

 

   If you do nothing else, your script looks like this:

PROCEDURE SearchDuplicateWall;
{ Utiliser ce script dans la vue en Plan 2D. }
{ ce script va chercher des murs qui ne seraient pas visibles en 2d et qui seraient cachés en étant sur des couches inférieures. }
{ Use this script in 2D Plan view. }
{ This script will look for walls which would not be visible in 2d and which would be hidden by being on lower layers. }

CONST
	kWallType = 68;		{ type objet mur }
	kCR = chr(13);		{ Carriage Control char }
	kSNameTemp = 'Tmp';

VAR 
	Hd1,  Hd2 :HANDLE;
	TL_A, BR_A, CenA :POINT;	{ BBox et points centraux pour A } { BBox & Center Points for A }
					{ TL = TopLeft, BR = BottomRight, Cen = Center }
	SWallStyleName, ActLName :STRING;
	
	
	PROCEDURE CompareNextObjectWall(Hd2 :HANDLE); 
	{ Recherche un mur avec la même boite englobante et le même centre. }
	{ searches for a wall with the same bounding box and the same center. }
	VAR
		TL_B, BR_B, CenB :POINT;	{ BBox et points centraux pour B } { BBox & Center Points for B }
	BEGIN
		GetBBox(Hd2, TL_B.x, TL_B.y, BR_B.x, BR_B.y);
		HCenter(Hd2, CenB.x, CenB.y);
		IF (TL_A = TL_B) & (BR_A = BR_B) & (CenA = CenB) THEN 
			BEGIN 
				SetSelect(Hd2);
				DoMenuTextByName('Fit To Objects', 0);
				SetZoom(100);
				SWallStyleName := GetWallStyle(Hd2);

				{ Do you want to delete this Duplicate whose wall style is: }
				IF YNDialog(Concat('Voulez-vous supprimer ce Doublon dont le style de mur est :', kCR, SWallStyleName)) THEN
					DelObject(Hd2)
				ELSE
					SetDSelect(Hd2);
			END;		{ if BBx & Cen are equal }
	END;		{ CompareNextObjectWall }


	PROCEDURE CompareHiddenWall(Hd2 :HANDLE); 
	{ Recherche un mur qui serait caché dans l'alignement d'un autre mur sans avoir forcément la même taille. }
	{ searches for a wall that would be hidden in line with another wall without necessarily having the same size. }
	VAR
		CenB :POINT;		{ points centraux pour B } { Center Points for B }
	BEGIN
		HCenter(Hd2, CenB.x, CenB.y);
		IF (((CenB.x = CenA.x) & (CenB.y <= TL_A.y) & (CenB.y >= BR_A.y)) | ((CenB.y = CenA.y) & (CenB.x >= TL_A.x) & (CenB.x <= BR_A.x))) THEN
			BEGIN 
				SetSelect(Hd2);
				DoMenuTextByName('Fit To Objects', 0);
				SetZoom(100);
				SWallStyleName := GetWallStyle(Hd2);
			
				{ Do you want to delete this Hidden Wall whose wall style is: }
				IF YNDialog(Concat('Voulez-vous supprimer ce Mur Caché dont le style de mur est :', kCR, SWallStyleName)) THEN
					DelObject(Hd2)
				ELSE
					SetDSelect(Hd2);
			END;
	END;		{ CompareHiddenWall }


BEGIN
	DSelectAll;
	Hd1 := LActLayer;
	ActLName := GetLName(ActLayer);
	WHILE (Hd1 <> NIL) DO
		BEGIN
			IF (GetTypeN(Hd1) = kWallType) THEN
				BEGIN
					GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
					HCenter(Hd1, CenA.x, CenA.y);
					DelName(kSNameTemp);
					SetName(Hd1, kSNameTemp);
					ForEachObject(CompareNextObjectWall,  (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
					DelName(kSNameTemp);
				END;
			Hd1 := PrevObj(Hd1);
		END;
	AlrtDialog('Il n''y a pas ou plus de "Doublon" de mur en arrière plan');	{ There is no or no more "Duplicate" wall in the background }
	
	Hd1 := LActLayer;
	WHILE (Hd1 <> NIL) DO
		BEGIN
			IF (GetTypeN(Hd1) = kWallType) THEN
				BEGIN
					GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
					HCenter(Hd1, CenA.x, CenA.y);
					DelName(kSNameTemp);
					SetName(Hd1,  kSNameTemp);
					ForEachObject(CompareHiddenWall,  (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
					DelName(kSNameTemp);
				END;
			Hd1 := PrevObj(Hd1);
		END;
	AlrtDialog('Il n''y a pas ou plus de Murs cachés en arrière plan');		{ There are no or no more hidden walls in the background }  
END;
Run(SearchDuplicateWall);

 

 

If you consolidate your two subroutines into one, to remove Duplicate and Hidden walls at the same time, your script could look something like this:

PROCEDURE SearchDuplicateWall;
{ Utiliser ce script dans la vue en Plan 2D. }
{ ce script va chercher des murs qui ne seraient pas visibles en 2D et qui seraient cachés en étant sur des couches inférieures. }
{ Use this script in 2D Plan view. }
{ This script will look for walls which would not be visible in 2D and which would be hidden by being on lower layers. }

CONST
	kWallType = 68;		{ type objet mur } { wall object type }
	kCR = chr(13);		{ Carriage Control char }
	kSNameTemp = 'Tmp';

VAR 
	Hd1, Hd2 :HANDLE;
	SWallStyleName, ActLName :STRING;
	TL_A, BR_A, CenA :POINT;	{ BBox et points centraux pour A } { BBox & Center Points for A }
					{ TL = TopLeft, BR = BottomRight, Cen = Center }
	
	
	PROCEDURE CompareWalls(Hd2 :HANDLE); 
	{ recherche un mur qui serait caché dans l'alignement d'un autre mur sans avoir forcément la même taille }
	{ searches for a wall that would be hidden in line with another wall without necessarily having the same size }
	VAR
		CondA, CondB, CondC :BOOLEAN;	{ conditions booléennes } { boolean conditions }	
		TL_B, BR_B, CenB :POINT;	{ BBox et points centraux pour B } { BBox & Center Points for B }
		Question :String;
	BEGIN
		GetBBox(Hd2, TL_B.x, TL_B.y, BR_B.x, BR_B.y);
		HCenter(Hd2, CenB.x, CenB.y);
	
		CondA := (TL_A = TL_B) & (BR_A = BR_B) & (CenA = CenB);			{ duplicate walls }
		CondB := (CenB.x = CenA.x) & (CenB.y <= TL_A.y) & (CenB.y >= BR_A.y);	{ vertical hidden walls }
		CondC := (CenB.y = CenA.y) & (CenB.x >= TL_A.x) & (CenB.x <= BR_A.x);	{ horizontal hidden walls }
	
		IF CondA | CondB | CondC THEN
			BEGIN
				SetSelect(Hd2);
				DoMenuTextByName('Fit To Objects', 0);
				SetZoom(100);
				SWallStyleName := GetWallStyle(Hd2);
			
							{ Do you want to delete this Duplicate whose wall style is }
				IF CondA THEN Question := 'Voulez-vous supprimer ce Doublon dont le style de mur est: '	
							{ Do you want to delete this Hidden Wall whose wall style is }
				ELSE Question := 'Voulez-vous supprimer ce Mur Caché dont le style de mur est: ';		
				IF YNDialog(Concat(Question, '  —  ', SWallStyleName)) 
					THEN DelObject(Hd2)
					ELSE SetDSelect(Hd2);
			END;
	END;		{ CompareWalls }


BEGIN
	DSelectAll;
	Hd1 := LActLayer;
	ActLName := GetLName(ActLayer);
	WHILE (Hd1 <> NIL) DO
		BEGIN
			IF (GetTypeN(Hd1) = kWallType) THEN
				BEGIN
					GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
					HCenter(Hd1, CenA.x, CenA.y);
					DelName(kSNameTemp);
					SetName(Hd1, kSNameTemp);
					ForEachObject(CompareWalls, (NOTINDLVP & NOTINREFDLVP & (L=ActLName) & (T=WALL) & (N<>kSNameTemp)) );
					DelName(kSNameTemp);
				END;		{ if }
			Hd1 := PrevObj(Hd1);
		END;		{ while }
	{ There is no or no more "Duplicate" wall in the background }
	{ AND }
	{ There are no or no more hidden walls in the background }  
	AlrtDialog(concat('Il n''y a pas ou plus de "Doublon" de mur en arrière plan', kCR, 'ET', kCR,
			'Il n''y a pas ou plus de Murs cachés en arrière plan'));				
END;
Run(SearchDuplicateWall);

 

 

   Honestly, none of these changes are necessary. Everything you've written is fine, and the modified scripts work identically to yours.

 

   The only thing I would recommend you do differently is add more comments as you script. It will help you down the road when you revisit your scripts. Consider if this script was 1000 lines, or lots more, instead of ~100 lines. Comments will save you a lot of confusion and headaches later on.

 

HTH,

Raymond

 

  • Like 1
Link to comment

Hello @MullinRJ,

 

Thank you very much for these remarks and suggestions for improvements, it helps me to see logic and reasoning that I would have had trouble seeing on my own.

I will rewrite these two versions taking into account your remarks (and adding the duplicate symbol search in the background).

I will add more comments which will be useful especially when not writing scripts regularly!

 

Thank you again for taking the time for this answer and have a nice day,

Thomas

 

 

Link to comment
On 4/27/2023 at 3:07 AM, Thomas W said:

Is it possible to add a function that should escape and stop the running script?

 

@Thomas W,

   To answer your last question, YES. There is a 4-Button pre-defined dialog you can use that gives you multiple options – AlertQuestion(). I modified your code (long version) to show how to use it, and am only using 3 of the buttons – for Delete, Skip, and Cancel. For more complicated user interactions you can build a custom dialog, but for what you want, this is quicker.

 

   In the following script, I added a { *** NEW *** } label after each line I added. Some lines were deleted, but I did not mark them. 

 

PROCEDURE SearchDuplicateWall;
{ Utiliser ce script dans la vue en Plan 2D. }
{ ce script va chercher des murs qui ne seraient pas visibles en 2d et qui seraient cachés en étant sur des couches inférieures. }
{ Use this script in 2D Plan view. }
{ This script will look for walls which would not be visible in 2d and which would be hidden by being on lower layers. }

CONST
	kWallType = 68;		{ type objet mur }
	kCR = chr(13);		{ Carriage Control char }
	kSNameTemp = 'Tmp';

VAR 
	Hd1,  Hd2 :HANDLE;
	Done :BOOLEAN;			{ *** NEW *** }
	TL_A, BR_A, CenA :POINT;	{ BBox et points centraux pour A } { BBox & Center Points for A }
					{ TL = TopLeft, BR = BottomRight, Cen = Center }
	SWallStyleName, ActLName :STRING;
	
	
	PROCEDURE CompareNextObjectWall(Hd2 :HANDLE); 
	{ Recherche un mur avec la même boite englobante et le même centre. }
	{ searches for a wall with the same bounding box and the same center. }
	VAR
		Choice :INTEGER;		{ *** NEW *** }
		Question :STRING;
		TL_B, BR_B, CenB :POINT;	{ BBox et points centraux pour B } { BBox & Center Points for B }
	BEGIN
		GetBBox(Hd2, TL_B.x, TL_B.y, BR_B.x, BR_B.y);
		HCenter(Hd2, CenB.x, CenB.y);
		IF (TL_A = TL_B) & (BR_A = BR_B) & (CenA = CenB) THEN 
			BEGIN 
				SetSelect(Hd2);
				DoMenuTextByName('Fit To Objects', 0);
				SetZoom(100);
				SWallStyleName := GetWallStyle(Hd2);

				{ Do you want to delete this Duplicate whose wall style is: }
				Question := Concat('Voulez-vous supprimer ce Doublon dont le style de mur est :  ', SWallStyleName);

				Choice := AlertQuestion(Question, '', 1, 'Delete', 'Cancel', 'Skip', '');	{ *** NEW *** }
				CASE Choice of					{ *** NEW *** }
					1: DelObject(Hd2);	{ Delete }	{ *** NEW *** }
					2: SetDSelect(Hd2);	{ Skip }	{ *** NEW *** }
					0: Done := TRUE;	{ QUIT }	{ *** NEW *** }
				END;		{ CASE }			{ *** NEW *** }

		END;		{ if BBox & Cen are equal }
	END;		{ CompareNextObjectWall }


	PROCEDURE CompareHiddenWall(Hd2 :HANDLE); 
	{ Recherche un mur qui serait caché dans l'alignement d'un autre mur sans avoir forcément la même taille. }
	{ searches for a wall that would be hidden in line with another wall without necessarily having the same size. }
	VAR
		Choice :INTEGER;	{ *** NEW *** }
		Question :STRING;
		CenB :POINT;		{ points centraux pour B } { Center Points for B }
	BEGIN
		HCenter(Hd2, CenB.x, CenB.y);
		IF (((CenB.x = CenA.x) & (CenB.y <= TL_A.y) & (CenB.y >= BR_A.y)) | ((CenB.y = CenA.y) & (CenB.x >= TL_A.x) & (CenB.x <= BR_A.x))) THEN
			BEGIN 
				SetSelect(Hd2);
				DoMenuTextByName('Fit To Objects', 0);
				SetZoom(100);
				SWallStyleName := GetWallStyle(Hd2);
			
				{ Do you want to delete this Hidden Wall whose wall style is: }
				Question := Concat('Voulez-vous supprimer ce Mur Caché dont le style de mur est :  ', SWallStyleName);
				Choice := AlertQuestion(Question, '', 1, 'Delete', 'Cancel', 'Skip', '');	{ *** NEW *** }
				CASE Choice of					{ *** NEW *** }
					1: DelObject(Hd2);	{ Delete }	{ *** NEW *** }
					2: SetDSelect(Hd2);	{ Skip }	{ *** NEW *** }
					0: Done := TRUE;	{ QUIT }	{ *** NEW *** }
				END;		{ CASE }			{ *** NEW *** }
			END;		{ IF }
	END;		{ CompareHiddenWall }


BEGIN
	DSelectAll;
	Hd1 := LActLayer;
	ActLName := GetLName(ActLayer);
	Done := False;				{ *** NEW *** }
	WHILE not Done & (Hd1 <> NIL) DO	{ *** NEW *** }
		BEGIN
			IF (GetTypeN(Hd1) = kWallType) THEN
				BEGIN
					GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
					HCenter(Hd1, CenA.x, CenA.y);
					DelName(kSNameTemp);
					SetName(Hd1, kSNameTemp);
					ForEachObject(CompareNextObjectWall,  (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
					DelName(kSNameTemp);
				END;		{ IF }
			Hd1 := PrevObj(Hd1);
		END;		{ WHILE }
	if not Done then		 { *** NEW *** }
		AlrtDialog('Il n''y a pas ou plus de "Doublon" de mur en arrière plan');	{ There is no or no more "Duplicate" wall in the background }
	
	Hd1 := LActLayer;
	{ Enable next line if you want to be able to cancel each loop separately. }
{	Done := False;	} 		  { *** NEW *** }
	WHILE not Done & (Hd1 <> NIL) DO  { *** NEW *** }
		BEGIN
			IF (GetTypeN(Hd1) = kWallType) THEN
				BEGIN
					GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
					HCenter(Hd1, CenA.x, CenA.y);
					DelName(kSNameTemp);
					SetName(Hd1,  kSNameTemp);
					ForEachObject(CompareHiddenWall,  (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
					DelName(kSNameTemp);
				END;		{ IF }
			Hd1 := PrevObj(Hd1);
		END;		{ WHILE }
	if not Done then		{ *** NEW *** }
		AlrtDialog('Il n''y a pas ou plus de Murs cachés en arrière plan');		{ There are no or no more hidden walls in the background }  
END;
Run(SearchDuplicateWall);

 

   If you have any questions, someone is always here.

 

Raymond

 

 

  • Love 1
Link to comment

@MullinRJ,

Excellent!

That's what I was looking for, I'll test this AlertQuestion function and I'll post the script, but I'll first retest the boolean conditions to consolidate two subroutines into one.

Sorry for the late reply, I was on the weekend!

 

Thank you again for this information and have a nice day,

 

Thomas

Link to comment

Hello @MullinRJ,

 

I took the 1st version of the script taking into account your remarks and adding the search for duplicate symbols in the background, it works well but we will use the version with the AlertQuestion function which will cancel each loop.

 

Below is the 1st version with the YNDialog function:

 

PROCEDURE SearchDuplicateWallAndSymbol;
{$DEBUG}
{ Utiliser ce script dans la vue en plan 2d. }
{ Ce script va chercher des murs et des symboles qui ne seraient pas visibles en 2d et qui seraient cachés en étant sur des couches inférieures. }
{ Use this script in 2D Plan view. }
{ This script will look for walls and symbols which would not be visible in 2D and which would be hidden by being on lower layers. }

CONST
	kWallType = 68; 	{ type objet mur } { wall object type }
	kSymbolType = 15; 	{ type objet symbol placé } { placed symbol object type }
	kCR = Chr(13); 		{ retour à la ligne } { carriage control char }
	kSNameTemp = 'Tmp'; { nom temporaire } { temporary name }	
	
VAR 
	Hd1, Hd2 :HANDLE;
	SWallStyleName, ActLName :STRING;
	SymbolName1, SymbolName2 :STRING;
	TL_A, BR_A, CenA :POINT;			{ BBox et points centraux pour A } { BBox & Center Points for A }
										{ TL = TopLeft, BR = BottomRight, Cen = Center }
	InsPtS1, InsPtS2 :POINT;			{ Point d'insertion symbole 1 et 2 } { Symbol insertion point 1 and 2 }
										{ InsPt = point d'insertion du Symbole } { InsPt = Symbol insertion point }
										 
	
	PROCEDURE CompareNextObjectWall(Hd2:HANDLE); 
	{ recherche un mur avec la même boite englobante et le même centre. }
	{ searches for a wall with the same bounding box and the same center. }
	VAR
			TL_B, BR_B, CenB :POINT;			{ BBox et points centraux pour B } { BBox & Center Points for B }
												{ TL = TopLeft, BR = BottomRight, Cen = Center }
	BEGIN
			GetBBox(Hd2, TL_B.x, TL_B.y, BR_B.x, BR_B.y);
			HCenter(Hd2, CenB.x, CenB.y);
			IF (TL_B = TL_A) & (BR_B = BR_A) & (CenB = CenA) THEN
				BEGIN 
						SetSelect(Hd2);
						DoMenuTextByName('Fit To Objects', 0);
						SetZoom(100);
						SWallStyleName := GetWallStyle(Hd2);
						
						{ Do you want to delete this Duplicate whose wall style is: }
						IF YNDialog(Concat('Voulez-vous supprimer ce Doublon dont le style de mur est :', kCR, SWallStyleName)) THEN
							DelObject(Hd2)
						ELSE
							SetDSelect(Hd2);
				END;		{ if BBox et points centraux de B = BBox et points centraux de A } { if BBox & Cen are equal }
	END;		{ CompareNextObjectWall }
	
	
	PROCEDURE CompareHiddenWall(Hd2:HANDLE); 
	{ recherche un mur qui serait caché dans l'alignement d'un autre mur sans avoir forcément la même taille. }
	{ searches for a wall that would be hidden in line with another wall without necessarily having the same size. }
	VAR
			CenB :POINT; 	{ points centraux pour B } { Center Points for B }
	BEGIN
			HCenter(Hd2, CenB.x, CenB.y);
			IF (((CenB.x = CenA.x) & (CenB.y <= TL_A.y) & (CenB.y >= BR_A.y)) | ((CenB.y = CenA.y) & (CenB.x >= TL_A.x) & (CenB.x <= BR_A.x))) THEN
				BEGIN 
						SetSelect(Hd2);
						DoMenuTextByName('Fit To Objects',0);
						SetZoom(100);
						SWallStyleName := GetWallStyle(Hd2);
						
						{ Do you want to delete this Hidden Wall whose wall style is: }
						IF YNDialog(Concat('Voulez-vous supprimer ce Mur Caché dont le style de mur est :', kCR, SWallStyleName)) THEN
							DelObject(Hd2)
						ELSE
							SetDSelect(Hd2);
				END; 		{ if mur caché dans l'alignement } { if wall hidden in line with another wall }
	END;		{ CompareHiddenWall }

	PROCEDURE CompareDuplicateSymbol(Hd2:HANDLE); 
	{ recherche un symbole qui aurait le même point d'insertion et qui serait à l'arrière plan }
	{ searches for a symbol that would have the same insertion point and that would be in the background }
	BEGIN
			GetSymLoc(Hd2, InsPtS2.x, InsPtS2.y);
			SymbolName2 := GetSymName(Hd2);
			IF (SymbolName2 = SymbolName1) & (InsPtS2 = InsPtS1) THEN
				BEGIN
						SetSelect(Hd2);
						DoMenuTextByName('Fit To Objects',0);
						SetZoom(100);
						
						{ Do you want to delete this Duplicate Symbol whose name is: }
						IF YNDialog(Concat('Voulez-vous supprimer ce Doublon de Symbole dont le nom est: ', kCR, SymbolName2)) THEN
							DelObject(Hd2)
						ELSE
							SetDSelect(Hd2);
				END;		{ if symbole qui aurait le même point d'insertion }
	END;		{ CompareDuplicateSymbol }
	

BEGIN
	DSelectAll;
	Hd1 := LActLayer;
	ActLName := GetLName(ActLayer);
	WHILE (Hd1 <> NIL) DO
		BEGIN
						IF (GetTypeN(Hd1) = kWallType) THEN
							BEGIN
									GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
									HCenter(Hd1, CenA.x, CenA.y);
									DelName(kSNameTemp);
									SetName(Hd1, kSNameTemp);
									ForEachObject(CompareNextObjectWall, (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
									DelName(kSNameTemp);
							END;	{ if }
						Hd1 := PrevObj(Hd1);
		END;			{ while }
	AlrtDialog('Il n''y a pas ou plus de "Doublon" de mur en arrière plan');		{ There is no or no more "Duplicate" wall in the background }
	
	Hd1 := LActLayer;
	WHILE (Hd1 <> NIL) DO
		BEGIN
						IF (GetTypeN(Hd1) = kWallType) THEN
							BEGIN
									GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
									HCenter(Hd1, CenA.x, CenA.y);
									DelName(kSNameTemp);
									SetName(Hd1, kSNameTemp);
									ForEachObject(CompareHiddenWall, (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
									DelName(kSNameTemp);
							END;	{ if }
						Hd1 := PrevObj(Hd1);
		END;			{ while }
	AlrtDialog('Il n''y a pas ou plus de Murs cachés en arrière plan');				{ There are no or no more hidden walls in the background }	
	
	Hd1 := LActLayer;
	WHILE (Hd1 <> NIL) DO
		BEGIN
						IF (GetTypeN(Hd1) = kSymbolType) THEN
							BEGIN
									GetSymLoc(Hd1, InsPtS1.x, InsPtS1.y);
									SymbolName1 := GetSymName(Hd1);
									DelName(kSNameTemp);
									SetName(Hd1,kSNameTemp);
									ForEachObject(CompareDuplicateSymbol, (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=SYMBOL) & (N<>kSNameTemp))));
									DelName(kSNameTemp);
							END;	{ if }
						Hd1 := PrevObj(Hd1);
		END;			{ while }
	AlrtDialog('Il n''y a pas ou plus de Symboles dupliqués en arrière plan');		{ There are no or no more duplicate Symbols in the background }
	
END;
Run(SearchDuplicateWallAndSymbol);

 

And the version with the AlertQuestion function:

 

PROCEDURE SearchDuplicateWallAndSymbol;
{$DEBUG}
{ Utiliser ce script dans la vue en plan 2d. }
{ Ce script va chercher des murs et des symboles qui ne seraient pas visibles en 2d et qui seraient cachés en étant sur des couches inférieures. }
{ Use this script in 2D Plan view. }
{ This script will look for walls and symbols which would not be visible in 2D and which would be hidden by being on lower layers. }

CONST
	kWallType = 68; 	{ type objet mur } { wall object type }
	kSymbolType = 15; 	{ type objet symbol placé } { placed symbol object type }
	kCR = Chr(13); 		{ retour à la ligne } { carriage control char }
	kSNameTemp = 'Tmp'; { nom temporaire } { temporary name }	
	
VAR 
	Hd1, Hd2 :HANDLE;
	Done :BOOLEAN;						{ utilisé dans le choix de AlertQuestion et dans les boucle While } { used in AlertQuestion choice and while loops }
	SWallStyleName, ActLName :STRING;
	SymbolName1, SymbolName2 :STRING;
	TL_A, BR_A, CenA :POINT;			{ BBox et points centraux pour A } { BBox & Center Points for A }
										{ TL = TopLeft, BR = BottomRight, Cen = Center }
	InsPtS1, InsPtS2 :POINT;			{ Point d'insertion symbole 1 et 2 } { Symbol insertion point 1 and 2 }
										{ InsPt = point d'insertion du Symbole } { InsPt = Symbol insertion point }
										 
	
	PROCEDURE CompareNextObjectWall(Hd2:HANDLE); 
	{ recherche un mur avec la même boite englobante et le même centre. }
	{ searches for a wall with the same bounding box and the same center. }
	VAR
			Choice :INTEGER;					{ choix pour la fonction AlertQuestion } { choice for the AlertQuestion function }
			Question :STRING;					{ Question utilisée dans la fonction AlertQuestion } { Question used in the AlertQuestion function }
			TL_B, BR_B, CenB :POINT;			{ BBox et points centraux pour B } { BBox & Center Points for B }
												{ TL = TopLeft, BR = BottomRight, Cen = Center }
	BEGIN
			GetBBox(Hd2, TL_B.x, TL_B.y, BR_B.x, BR_B.y);
			HCenter(Hd2, CenB.x, CenB.y);
			IF (TL_B = TL_A) & (BR_B = BR_A) & (CenB = CenA) THEN
				BEGIN 
						SetSelect(Hd2);
						DoMenuTextByName('Fit To Objects', 0);
						SetZoom(100);
						SWallStyleName := GetWallStyle(Hd2);
						
						{ Do you want to delete this Duplicate whose wall style is: }
						Question := Concat('Voulez-vous supprimer ce Doublon dont le style de mur est :', kCR, SWallStyleName);
						
						Choice := AlertQuestion(Question, '', 1, 'Delete', 'Cancel', 'Skip', '');
						{ AlertQuestion(question, advice, defaultButton, OKOverrideText, CancelOverrideText, customButtonAText, customButtonBText) }
						CASE Choice OF
								1: DelObject(Hd2);		{ Delete : 	1: the positive button was hit }
								2: SetDSelect(Hd2);		{ Skip : 	2: custom button A was hit }
								0: Done := TRUE;		{ Quit : 	0: the negative button was hit }
						END;
				END;	{ if (BBox et points centraux de B) = (BBox et points centraux de A) } { if BBox & Cen are equal }
	END;		{ CompareNextObjectWall }
	
	
	PROCEDURE CompareHiddenWall(Hd2:HANDLE); 
	{ recherche un mur qui serait caché dans l'alignement d'un autre mur sans avoir forcément la même taille. }
	{ searches for a wall that would be hidden in line with another wall without necessarily having the same size. }
	VAR
			Choice :INTEGER;					{ choix pour la fonction AlertQuestion } { choice for the AlertQuestion function }
			Question :STRING;					{ Question utilisée dans la fonction AlertQuestion } { Question used in the AlertQuestion function }			
			CenB :POINT; 	{ points centraux pour B } { Center Points for B }
	BEGIN
			HCenter(Hd2, CenB.x, CenB.y);
			IF (((CenB.x = CenA.x) & (CenB.y <= TL_A.y) & (CenB.y >= BR_A.y)) | ((CenB.y = CenA.y) & (CenB.x >= TL_A.x) & (CenB.x <= BR_A.x))) THEN
				BEGIN 
						SetSelect(Hd2);
						DoMenuTextByName('Fit To Objects',0);
						SetZoom(100);
						SWallStyleName := GetWallStyle(Hd2);
						
						{ Do you want to delete this Hidden Wall whose wall style is: }
						Question := Concat('Voulez-vous supprimer ce Mur Caché dont le style de mur est :', kCR, SWallStyleName);
						
						Choice := AlertQuestion(Question, '', 1, 'Delete', 'Cancel', 'Skip', '');
						{ AlertQuestion(question, advice, defaultButton, OKOverrideText, CancelOverrideText, customButtonAText, customButtonBText) }
						CASE Choice OF
								1: DelObject(Hd2);		{ Delete : 	1: the positive button was hit }
								2: SetDSelect(Hd2);		{ Skip : 	2: custom button A was hit }
								0: Done := TRUE;		{ Quit : 	0: the negative button was hit }
						END;
				END; 	{ if mur caché dans l'alignement } { if wall hidden in line with another wall }
	END;		{ CompareHiddenWall }

	PROCEDURE CompareDuplicateSymbol(Hd2:HANDLE); 
	{ recherche un symbole qui aurait le même point d'insertion et qui serait à l'arrière plan }
	{ searches for a symbol that would have the same insertion point and that would be in the background }
	VAR
			Choice :INTEGER;					{ choix pour la fonction AlertQuestion } { choice for the AlertQuestion function }
			Question :STRING;					{ Question utilisée dans la fonction AlertQuestion } { Question used in the AlertQuestion function }
	BEGIN
			GetSymLoc(Hd2, InsPtS2.x, InsPtS2.y);
			SymbolName2 := GetSymName(Hd2);
			IF (SymbolName2 = SymbolName1) & (InsPtS2 = InsPtS1) THEN
				BEGIN
						SetSelect(Hd2);
						DoMenuTextByName('Fit To Objects',0);
						SetZoom(100);
						
						{ Do you want to delete this Duplicate Symbol whose name is: }
						Question := Concat('Voulez-vous supprimer ce Doublon de Symbole dont le nom est: ', kCR, SymbolName2);
						
						Choice := AlertQuestion(Question, '', 1, 'Delete', 'Cancel', 'Skip', '');
						{ AlertQuestion(question, advice, defaultButton, OKOverrideText, CancelOverrideText, customButtonAText, customButtonBText) }
						CASE Choice OF
								1: DelObject(Hd2);		{ Delete : 	1: the positive button was hit }
								2: SetDSelect(Hd2);		{ Skip : 	2: custom button A was hit }
								0: Done := TRUE;		{ Quit : 	0: the negative button was hit }
						END;
				END;	{ if symbole qui aurait le même point d'insertion } { symbol that would have the same insertion point }
	END;		{ CompareDuplicateSymbol }
	

BEGIN
	DSelectAll;
	Hd1 := LActLayer;
	ActLName := GetLName(ActLayer);
	Done := FALSE;
	WHILE NOT Done & (Hd1 <> NIL) DO
		BEGIN
						IF (GetTypeN(Hd1) = kWallType) THEN
							BEGIN
									GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
									HCenter(Hd1, CenA.x, CenA.y);
									DelName(kSNameTemp);
									SetName(Hd1, kSNameTemp);
									ForEachObject(CompareNextObjectWall, (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
									DelName(kSNameTemp);
							END;	{ if }
						Hd1 := PrevObj(Hd1);
		END;			{ while }
	IF NOT Done THEN
		AlrtDialog('Il n''y a pas ou plus de "Doublon" de mur en arrière plan');		{ There is no or no more "Duplicate" wall in the background }
	
	Hd1 := LActLayer;
	Done := FALSE;
	WHILE NOT Done & (Hd1 <> NIL) DO
		BEGIN
						IF (GetTypeN(Hd1) = kWallType) THEN
							BEGIN
									GetBBox(Hd1, TL_A.x, TL_A.y, BR_A.x, BR_A.y);
									HCenter(Hd1, CenA.x, CenA.y);
									DelName(kSNameTemp);
									SetName(Hd1, kSNameTemp);
									ForEachObject(CompareHiddenWall, (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=WALL) & (N<>kSNameTemp))));
									DelName(kSNameTemp);
							END;	{ if }
						Hd1 := PrevObj(Hd1);
		END;			{ while }
	IF NOT Done THEN	
		AlrtDialog('Il n''y a pas ou plus de Murs cachés en arrière plan');				{ There are no or no more hidden walls in the background }	
	
	Hd1 := LActLayer;
	Done := FALSE;
	WHILE NOT Done & (Hd1 <> NIL) DO
		BEGIN
						IF (GetTypeN(Hd1) = kSymbolType) THEN
							BEGIN
									GetSymLoc(Hd1, InsPtS1.x, InsPtS1.y);
									SymbolName1 := GetSymName(Hd1);
									DelName(kSNameTemp);
									SetName(Hd1,kSNameTemp);
									ForEachObject(CompareDuplicateSymbol, (NOTINDLVP & NOTINREFDLVP & ((L=ActLName) & (T=SYMBOL) & (N<>kSNameTemp))));
									DelName(kSNameTemp);
							END;	{ if }
						Hd1 := PrevObj(Hd1);
		END;			{ while }
	IF NOT Done THEN
		AlrtDialog('Il n''y a pas ou plus de Symboles dupliqués en arrière plan');		{ There are no or no more duplicate Symbols in the background }
	
END;
Run(SearchDuplicateWallAndSymbol);

 

Thank you again for the advice and help that allowed me to move forward on this script!

 

Thanks!

Thomas

  • Like 1
Link to comment

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...