Jump to content

Get fill color of a class on a worksheet?


Recommended Posts

The following script is a kind of complicated version but I think it does what you want.

 

In addition to setting the cell with the class name to the Class FillFore, FillBack colors and FillPattern, it also has some interesting functionality at the bottom.  If you change any of the yellow cells in Column 1 to be non-blank, then the database at the bottom will open to display a list of all the objects in that class.

 

Ask if you need more help.

 

Procedure Classes_to_Worksheet;
{Make a worksheet listing all of the classes in a VW file}
{Lists both used and unused classes}
{The worksheet is named "Classes:"with and appended date}

{January 26, 2017}
{Added code to display the Class Fill color in the ClassName column for the Class}

{April 10, 2015}
{Updated for formatting and to add database integration}
{Set any of the yellow cells in column 1 to non-blank and the related}
{database row at the bottom of the worksheet will show subrows for each item in that class}
{Set the yellow cell back to blank (select, delete, enter/return, and the database subrows}
{will disapper.  The database rows show the Class, Layer and Object type for the related object}

{October 13, 2010}
{Updated to sort classes in alphabetical order prior to storing in worksheet}
{As of VW2011, there is not way to get the display order of the classes in the Nav Palette}
{October 14, 2008}
{© 2017, 2010, 2008, Coviana, Inc - Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}

var	 H1, H2:	Handle;
N1:	LongInt;
ClassSort : Array[1..1024] of string;
Formula : String;
Result : Boolean;
Font,Size,Style:Integer;
R1,G1,B1,BGColor,FGColor: LongInt;
FillPattern: Integer;

Begin
SetCursor(WatchC);

H1:=CreateWS(Concat('Classes:',date(2,1)),(Classnum+2)*2,4);
SetWSCellAlignment(H1,1,1,ClassNum+2,2,5);
SetWSColumnWidth(H1,1,1,20);
SetWSColumnWidth(H1,2,2,200);
SetWSColumnWidth(H1,3,3,200);
SetWSColumnWidth(H1,4,4,200);

Result := WorksheetMergeCells(H1,1,1,1,3);

GetWSCellTextFormat(H1,1,1,Font,Size,Style);

SetWSCellTextFormat(H1,1,1,(ClassNum+2)*2,4,Font,14,Style);
SetWSCellTextFormat(H1,1,1,1,1,Font,18,1);
SetWSCellTextFormat(H1,2,1,2,4,Font,14,1);
SetWSCellTextFormat(H1,Classnum+4,1,ClassNum+4,4,Font,14,1);

SetWSCellBorders(H1,3,1,ClassNum+2,3,True,True,True,True,7);
SetWSCellOutlineBorder(H1,3,1,ClassNum+2,3,2,25,1);
SetWSCellBorders(H1,Classnum+5,1,(ClassNum+2)*2,4,True,True,True,True,7);
SetWSCellOutlineBorder(H1,Classnum+5,1,(ClassNum+2)*2,4,2,25,1);

SetWSCellFill(H1,3,1,ClassNum+2,1,1,5,0,1);
SetWSCellFill(H1,ClassNum+5,1,(ClassNum+2)*2,1,1,1,0,1);


For N1:= 1 to Classnum do ClassSort[N1]:=ClassList(N1);

SortArray(ClassSort,ClassNum,1);

For N1:= 1 to Classnum do 
	Begin

{*****************************}
{Code in this block is used to set the WS Cell Format to match the Class Fill Color and Pattern}
		GetClFillFore(ClassSort[N1],R1,G1,B1);
		RGBToColorIndex(R1,G1,B1,FGColor);
		GetClFillBack(ClassSort[N1],R1,G1,B1);
		RGBToColorIndex(R1,G1,B1,BGColor);
		FillPattern:=GetClFPat(ClassSort[N1]);
		SetWSCellFill(H1,N1+2,2,N1+2,2,1,BGColor,FGColor,FillPattern);
		
{This code can be deleted or commented out without effecting other script functionality}
{*****************************}	
		
		SetWSCellNumberFormat(H1,N1+2,2,N1+2,2,13,0,'','');
		SetWSCellFormula(H1,N1+2,2,N1+2,2,Concat(ClassSort[N1]));	
	
		Formula:=Concat('=Count(C=',CHR(39),Classsort[N1],CHR(39),')');

		SetWSCellFormula(H1,N1+2,3,N1+2,3,Formula);

		Formula:=Concat('=Database(C=IF(A',Num2Str(0,N1+2),'<>',CHR(39),CHR(39),', B',Num2Str(0,N1+2),',',CHR(39),'PTS!@#$%^&',CHR(39),'))');

		SetWSCellFormula(H1,ClassNum+4,2,ClassNum+4,2,'Class');
		SetWSCellFormula(H1,ClassNum+4,3,ClassNum+4,3,'Layer');
		SetWSCellFormula(H1,ClassNum+4,4,ClassNum+4,4,'Object Type');

		SetWSCellFormula(H1,N1+ClassNum+4,0,N1+ClassNum+4,0,Formula);
		SetWSCellFormula(H1,N1+ClassNum+4,2,N1+ClassNum+4,2,'=C');
		SetWSCellFormula(H1,N1+ClassNum+4,3,N1+ClassNum+4,3,'=L');
		SetWSCellFormula(H1,N1+ClassNum+4,4,N1+ClassNum+4,4,'=T');


	End;

SetWSCellFormula(H1,1,1,1,1,Concat('Classes in File:',date(2,1)));
SetWSCellFormula(H1,2,2,2,2,'Class Name');
SetWSCellFormula(H1,2,3,2,3,'# of Objects in Class');

RecalculateWS(H1);
SetCursor(ArrowC);

ClrMessage;
ShowWS(H1,True);
End;
Run(Classes_to_Worksheet);

 

  • Like 1
Link to comment
  • 2 years later...

Hello

 

I try to use this script. But when I selected the script and click in my drawing, I always get the message "comma expected" 

When there are 2 classes and I click twice on OK I get the sheet with the tings I need. But when there hundred of classes than I have to click as many times as there are

classes. I think I don't use it on the right way. Mayby you can give me a tip how to work with it

 

Thanks

Pascal

Link to comment
  • 4 weeks later...

@tismacfan2

 

I thought I had sen the above reply a month ago.  😞

 

Here is a version of the script that seems to work in VW2019.

 

Other changes are that the toggle cells to select the classes to show objects from are now formatted as Text so any entry will display the details. Also, the Database Headers are now turned off.

 

Procedure Classes_to_Worksheet;
{Make a worksheet listing all of the classes in a VW file}
{Lists both used and unused classes}
{The worksheet is named "Classes:"with and appended date}

{April 12, 2019}
{Modified to work around obsolete VS functions for formatting Worksheets}
{Yellow check mark cells to select classes to detail are now formatted as text so data will execute.}
{Datbase Headers are now turned off this can be changed in the SetObjectVariable Boolean (82) line.}

{January 26, 2017}
{Added code to display the Class Fill color in the ClassName column for the Class}

{April 10, 2015}
{Updated for formatting and to add database integration}
{Set any of the yellow cells in column 1 to non-blank and the related}
{database row at the bottom of the worksheet will show subrows for each item in that class}
{Set the yellow cell back to blank (select, delete, enter/return, and the database subrows}
{will disapper.  The database rows show the Class, Layer and Object type for the related object}

{October 13, 2010}
{Updated to sort classes in alphabetical order prior to storing in worksheet}
{As of VW2011, there is not way to get the display order of the classes in the Nav Palette}
{October 14, 2008}
{© 2019, 2017, 2010, 2008, Coviana, Inc - Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}

var	 H1, H2:	Handle;
N1:	LongInt;
ClassSort : Array[1..1024] of string;
Formula : String;
Result : Boolean;
Font,Size,Style:Integer;
R1,G1,B1,BGColor,FGColor: LongInt;
FillPattern: Integer;

Begin
SetCursor(WatchC);

H1:=CreateWS(Concat('Classes:',date(2,1)),(Classnum+2)*2,4);
SetWSCellAlignment(H1,1,1,ClassNum+2,2,5);
SetWSColumnWidth(H1,1,1,20);
SetWSColumnWidth(H1,2,2,200);
SetWSColumnWidth(H1,3,3,200);
SetWSColumnWidth(H1,4,4,200);

Result := WorksheetMergeCells(H1,1,1,1,3);

GetWSCellTextFormat(H1,1,1,Font,Size,Style);

SetWSCellTextFormat(H1,1,1,(ClassNum+2)*2,4,Font,14,Style);
SetWSCellTextFormat(H1,1,1,1,1,Font,18,1);
SetWSCellTextFormat(H1,2,1,2,4,Font,14,1);
SetWSCellTextFormat(H1,Classnum+4,1,ClassNum+4,4,Font,14,1);

SetWSCellBorders(H1,3,1,ClassNum+2,3,True,True,True,True,7);
{SetWSCellOutlineBorder(H1,3,1,ClassNum+2,3,2,25,1);  (*Commented out 4/12/19 Decprecated*)
}SetWSCellBorders(H1,Classnum+5,1,(ClassNum+2)*2,4,True,True,True,True,7);
{SetWSCellOutlineBorder(H1,Classnum+5,1,(ClassNum+2)*2,4,2,25,1);	(*Commented out 4/12/19 Decprecated*)
}
SetWSCellFill(H1,3,1,ClassNum+2,1,1,5,0,1);
SetWSCellFill(H1,ClassNum+5,1,(ClassNum+2)*2,1,1,1,0,1);


For N1:= 1 to Classnum do ClassSort[N1]:=ClassList(N1);

SortArray(ClassSort,ClassNum,1);

For N1:= 1 to Classnum do 
	Begin

{*****************************}
{Code in this block is used to set the WS Cell Format to match the Class Fill Color and Pattern}
		GetClFillFore(ClassSort[N1],R1,G1,B1);
		RGBToColorIndex(R1,G1,B1,FGColor);
		GetClFillBack(ClassSort[N1],R1,G1,B1);
		RGBToColorIndex(R1,G1,B1,BGColor);
		FillPattern:=GetClFPat(ClassSort[N1]);
		SetWSCellFill(H1,N1+2,2,N1+2,2,1,BGColor,FGColor,FillPattern);
		SetWSCellNumberFormat(H1,N1+2,1,N1+2,1,13,0,'','');  {Added 4/12/2019 Format cells as text}
		
		
{This code can be deleted or commented out without effecting other script functionality}
{*****************************}	
		
		SetWSCellNumberFormat(H1,N1+2,2,N1+2,2,13,0,'','');
		SetWSCellFormula(H1,N1+2,2,N1+2,2,Concat(ClassSort[N1]));	
	
		Formula:=Concat('=Count(C=',CHR(39),Classsort[N1],CHR(39),')');

		SetWSCellFormula(H1,N1+2,3,N1+2,3,Formula);

		Formula:=Concat('=Database(C=(IF(A',Num2Str(0,N1+2),'<>',CHR(39),CHR(39),
				', B',Num2Str(0,N1+2),',',CHR(39),'PTS!@#$%^&',CHR(39),')))');

		SetWSCellFormula(H1,ClassNum+4,2,ClassNum+4,2,'Class');
		SetWSCellFormula(H1,ClassNum+4,3,ClassNum+4,3,'Layer');
		SetWSCellFormula(H1,ClassNum+4,4,ClassNum+4,4,'Object Type');

		SetWSCellFormula(H1,N1+ClassNum+4,0,N1+ClassNum+4,0,Formula);
		SetWSCellFormula(H1,N1+ClassNum+4,2,N1+ClassNum+4,2,'=C');
		SetWSCellFormula(H1,N1+ClassNum+4,3,N1+ClassNum+4,3,'=L');
		SetWSCellFormula(H1,N1+ClassNum+4,4,N1+ClassNum+4,4,'=T');
		SetWSCellNumberFormat(H1,N1+2,2,N1+2,2,13,0,'','');  {Added 4/12/2019 Format cells as text}


	End;

SetWSCellFormula(H1,1,1,1,1,Concat('Classes in File:',date(2,1)));
SetWSCellFormula(H1,2,2,2,2,'Class Name');
SetWSCellFormula(H1,2,3,2,3,'# of Objects in Class');


RecalculateWS(H1);
SetCursor(ArrowC);

ClrMessage;
ShowWS(H1,True);
SetObjectVariableBoolean(H1,82,False);	{Added 4/12/19 to hide database header rows.}
End;

Run(Classes_to_Worksheet);

 

  • Like 1
Link to comment

What version of VW are you using? This script has been tested in VW2019.

 

Did you copy everything in the script block (from the original Procedure to after the final semicolon after the Run(Classes_to_Worksheet);)?

 

I just copied from above and pasted into a new script in a new file created from the Architect Imperial template and it runs fine for me.

 

Let's see if we can figure this out.

Link to comment
2 hours ago, Pat Stanford said:

What version of VW are you using? This script has been tested in VW2019.

 

Did you copy everything in the script block (from the original Procedure to after the final semicolon after the Run(Classes_to_Worksheet);)?

 

I just copied from above and pasted into a new script in a new file created from the Architect Imperial template and it runs fine for me.

 

Let's see if we can figure this out.

 

Sir Stanford,

I´ve sent you an email, please check.

Link to comment

Based on another email, it appears that the code is not being properly copied in some browsers. I have reformatted the code above to manually wrap the longest line. 

 

Open your browser window to a very wide width and copy ALL of the text in the code block above.  Open a VW file. In the Resource Browser select the New Resource button at the bottom left. The Type will be Script.  It will ask for a name for the new Script Pallet and then for the new Script. Once you enter the two named the Script Editor window will open. Make sure the language is set to VectorScript and then click in the text area and Paste the script from above. Clic the Gear icon at the top right of the window to compile the code. You should get a dialog box saying "Script Complied Successfully". If not, you did not properly copy the code. Be very careful with pasting the code into a word processor such as Microsoft Word first. It often adds invisible characters that will prevent the code from compiling.

 

To run the script you double click on it's name in the script pallet.  You could make it into a menu command but that involved learning about the PlugIn Editor and is more complicated.

 

See the following post for the basics of how and why to use scripts.

 

 

Link to comment

Hi Pat Stanford,

 

Is better now. No error messages.

However persists a warning message "Comma expected" for every class I have on my vw file. Then the worksheet opens filled with the classes info on top.

I tested it by pasting on a script via resourse file manager and creating a .vs filetype via notepad (as cited on your previous post). For both the same result.

 

pleased to contribute

 

 

Edited by Picapau Amarelo
Link to comment

OK try the version in this file. I still think something is messing with your copy/paste from the forum into the script editor.

 

This version is just copied and pasted from above into a new VW2019 file.  Open the Resource Browser to see the Script Palette and run the script. If it does not provide the warning, them import the script into your file and see if it works properly there.

 

Let me know.

 

Classes to Worksheet.vwx

  • Like 1
Link to comment
  • 11 months later...

Thanks for this! Just ran it in 2020, and it seems to be working perfectly. I've been trying to purge unused classes, but the purge tool says I don't have any. This script confirms that some of the classes don't have any objects. I knew there had to be a way to find the number of objects in each class. As usual, user forums to the rescue!

Link to comment
  • 2 years later...

Hi, 

 

This script works perfectly, thanks for all your work with it. 

 

I was wondering, is there a way to modify it slightly so that it only displays specific classes?

 

I can get the class names I need from a worksheet/database by setting a layer for the data to come from, but I would really like to be able to add the colours into that worksheet if possible. 

 

If anyone could help with this, it would be much appreciated! 

 

 

image.png.e778e6b809a106e5b2881adbb5bad461.png

Link to comment

@loic.jourdan Based on what you are saying, it sounds like you want to specify a specific layer and only have the classes that exist on that layer show in the worksheet.  Is that correct?  It would be possible, but it would probably be slow as your would need to inspect multiple object for each class to determine if they are on the correct layer.

 

Your screen shot seems to show that you only want the objects with classes that are named starting with UGF in the list. Would a version that allowed you to specify a substring that would have to be part of the class name (either in any location or specifically as a prefix) be helpful?

Link to comment

@Pat Stanford Thanks for your fast reply, having UGF as the prefix for the class would be perfect as the only classes I need to be highlighted all have the prefix UGF (as you spotted). 

 

Essentially, I'm just trying to combine the two tables into one and the colours are just there to help my colleague, who I will be exporting the worksheets to as an excel file, to associate the colours with a key she uses more easily than having to use the names. 

Link to comment

This version should do what you need. It puts up a dialog box and asks for the "class prefix" (any string that begins the classes to display) and then only includes classes that have that beginning are included in the worksheet.

 

Procedure Prefix_Classes_to_Worksheet;

{Make a worksheet listing all of the classes in a VW file}
{Lists both used and unused classes}
{The worksheet is named "Classes:"with and appended date}

{October 14, 2022}
{Modified to allow the user to enter a prefix and only classes having that prefix}
{will be included in the worksheet.}

{April 12, 2019}
{Modified to work around obsolete VS functions for formatting Worksheets}
{Yellow check mark cells to select classes to detail are now formatted as text so data will execute.}
{Datbase Headers are now turned off this can be changed in the SetObjectVariable Boolean (82) line.}

{January 26, 2017}
{Added code to display the Class Fill color in the ClassName column for the Class}

{April 10, 2015}
{Updated for formatting and to add database integration}
{Set any of the yellow cells in column 1 to non-blank and the related}
{database row at the bottom of the worksheet will show subrows for each item in that class}
{Set the yellow cell back to blank (select, delete, enter/return, and the database subrows}
{will disapper.  The database rows show the Class, Layer and Object type for the related object}

{October 13, 2010}
{Updated to sort classes in alphabetical order prior to storing in worksheet}
{As of VW2011, there is not way to get the display order of the classes in the Nav Palette}
{October 14, 2008}
{© 2019, 2017, 2010, 2008, Coviana, Inc - Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}

var	 H1, H2:	Handle;
N1,N2,N3	:	LongInt;
ClassSort : Array[1..1024] of string;
Formula, Prefix, ThisClass, S2 : String;
Result : Boolean;
Font,Size,Style:Integer;
R1,G1,B1,BGColor,FGColor: LongInt;
FillPattern: Integer;

Begin
Prefix:=StrDialog('Enter Prefix for Classes to include in Worksheet', 'UGF');
SetCursor(WatchC);

N2:=1;
For N1:= 1 to Classnum do 
	BEGIN					{This Begin/End pair added to check for Prefix match}
		ThisClass:=ClassList(N1);
		S2:=Copy(ThisClass,1,Len(Prefix));
{		AlrtDialog(Concat(ThisClass,'  ',S2,'  ',Prefix,'  ',Len(Prefix),'  ',N1,'  ',N2));
}		If Copy(ThisClass,1,Len(Prefix))=Prefix then 
			BEGIN
				ClassSort[N2]:=ClassList(N1);
				N2:=N2+1;
			End;
	End;
	
N3:=N2-1;

SortArray(ClassSort,N3,1);

H1:=CreateWS(Concat('Classes:',date(2,1)),((N3)+2)*2,4);
SetWSCellAlignment(H1,1,1,N3+2,2,5);
SetWSColumnWidth(H1,1,1,20);
SetWSColumnWidth(H1,2,2,200);
SetWSColumnWidth(H1,3,3,200);
SetWSColumnWidth(H1,4,4,200);

Result := WorksheetMergeCells(H1,1,1,1,3);

GetWSCellTextFormat(H1,1,1,Font,Size,Style);

SetWSCellTextFormat(H1,1,1,(N3+2)*2,4,Font,14,Style);
SetWSCellTextFormat(H1,1,1,1,1,Font,18,1);
SetWSCellTextFormat(H1,2,1,2,4,Font,14,1);
SetWSCellTextFormat(H1,N3+4,1,N3+4,4,Font,14,1);

SetWSCellBorders(H1,3,1,N3+2,3,True,True,True,True,7);
{SetWSCellOutlineBorder(H1,3,1,ClassNum+2,3,2,25,1);  (*Commented out 4/12/19 Decprecated*)
}SetWSCellBorders(H1,N2+5,1,(N3+2)*2,4,True,True,True,True,7);
{SetWSCellOutlineBorder(H1,Classnum+5,1,(ClassNum+2)*2,4,2,25,1);	(*Commented out 4/12/19 Decprecated*)
}
SetWSCellFill(H1,3,1,N2+2,1,1,5,0,1);
SetWSCellFill(H1,N3+5,1,(N3+2)*2,1,1,1,0,1);



For N1:= 1 to N3 do 
	Begin

{*****************************}
{Code in this block is used to set the WS Cell Format to match the Class Fill Color and Pattern}
		GetClFillFore(ClassSort[N1],R1,G1,B1);
		RGBToColorIndex(R1,G1,B1,FGColor);
		GetClFillBack(ClassSort[N1],R1,G1,B1);
		RGBToColorIndex(R1,G1,B1,BGColor);
		FillPattern:=GetClFPat(ClassSort[N1]);
		SetWSCellFill(H1,N1+2,2,N1+2,2,1,BGColor,FGColor,FillPattern);
		SetWSCellNumberFormat(H1,N1+2,1,N1+2,1,13,0,'','');  {Added 4/12/2019 Format cells as text}
		
		
{This code can be deleted or commented out without effecting other script functionality}
{*****************************}	
		
		SetWSCellNumberFormat(H1,N1+2,2,N1+2,2,13,0,'','');
		SetWSCellFormula(H1,N1+2,2,N1+2,2,Concat(ClassSort[N1]));	
	
		Formula:=Concat('=Count(C=',CHR(39),Classsort[N1],CHR(39),')');

		SetWSCellFormula(H1,N1+2,3,N1+2,3,Formula);

		Formula:=Concat('=Database(C=(IF(A',Num2Str(0,N1+2),'<>',CHR(39),CHR(39),
				', B',Num2Str(0,N1+2),',',CHR(39),'PTS!@#$%^&',CHR(39),')))');

		SetWSCellFormula(H1,N3+4,2,N3+4,2,'Class');
		SetWSCellFormula(H1,N3+4,3,N3+4,3,'Layer');
		SetWSCellFormula(H1,N3+4,4,N3+4,4,'Object Type');

		SetWSCellFormula(H1,N1+N3+4,0,N1+N3+4,0,Formula);
		SetWSCellFormula(H1,N1+N3+4,2,N1+N3+4,2,'=C');
		SetWSCellFormula(H1,N1+N3+4,3,N1+N3+4,3,'=L');
		SetWSCellFormula(H1,N1+N3+4,4,N1+N3+4,4,'=T');
		SetWSCellNumberFormat(H1,N1+2,2,N1+2,2,13,0,'','');  {Added 4/12/2019 Format cells as text}


	End;

SetWSCellFormula(H1,1,1,1,1,Concat('Classes in File:',date(2,1)));
SetWSCellFormula(H1,2,2,2,2,'Class Name');
SetWSCellFormula(H1,2,3,2,3,'# of Objects in Class');


RecalculateWS(H1);
SetCursor(ArrowC);

ClrMessage;
ShowWS(H1,True);
SetObjectVariableBoolean(H1,82,False);	{Added 4/12/19 to hide database header rows.}
End;

Run(Prefix_Classes_to_Worksheet);

 

  • 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...