Jump to content
  • 10

Create new class with attributes of selected object


michaelk

Question

Recommended Posts

  • 0

Michael, I thought this would be one you would do for yourself.

 

Run as a script or make a Menu Item PIO out of the script and add to the right click menu.

 

Procedure MakeClassWithObjAttribs;

{© 2016, Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}
{No warranty or guarantee, expressed or implied. Use at your own risk.}
{Test for suitability for your use before using on live data.}
{Immediately discontinue use if hair loss occurs.}

{December 2, 2016}
{This script creates a new class and sets the class attributes to those of the selected}
{object. The only parameter that is not set is TextStyle}
{Based on a request on the tech board by michaelk, September 21, 2016.}

Var	FPat:							LongInt;
	FillBackR,FillBackG,FillBackB:	LongInt;
	FillForeR,FillForeG,FillForeB:	LongInt;	
	LineS:							LongInt;  {Name List Index}
	LineW:							Integer;
	ObjBMarkStyl:					LongInt;
	ObjBMarkAngle:					Integer;
	ObjBMarkSize:					Real;
	ObjBMarkWidth:					Real;
	ObjBMarkThickB:					Integer;
	ObjBMarkThick:					Real;
	ObjBMarkVis:					Boolean;
	ObjEMarkStyl:					LongInt;
	ObjEMarkAngle:					Integer;
	ObjEMarkSize:					Real;
	ObjEMarkWidth:					Real;
	ObjEMarkThickB:					Integer;
	ObjEMarkThick:					Real;
	ObjEMarkVis:					Boolean;
	POpacity:						Integer;
	FOpacity:						Integer;
	PenBackR,PenBackG,PenBackB:		LongInt;
	PenForeR,PenForeG,PenForeB:		LongInt;
	DSEnabled:						Boolean;
	DSnUnits:						Integer;
	DSdOffset:						Real;
	DSdBlurRadius:					Real;
	DSdAngle:						Real;
	DSOpacity:						Integer;
	DSRed:							Integer;
	DSGreen:						Integer;
	DSBlue:							Integer;
	ThisObject:						Handle;
	SelectedCount:					LongInt;
	ReturnBool:						Boolean;
	NewClassName:					String;
	SetExistingClass:				Boolean;
	
	Function ClassExists(ClsName:String):Boolean;
		var	ThisClass:LongInt;
			ChkClsName:String;
		Begin
			ClassExists:=False;
			For ThisClass := 1 to ClassNum do
				If ClassList(ThisClass)=ClsName then ClassExists:=True;
		End;
		
		
		
Begin
	ThisObject:=Nil;
	If NumSObj(ActLayer) =1 then 
		Begin
			ThisObject:=FSActLayer;
			FPat := GetFPat(ThisObject);
			GetFillBack(ThisObject,FillBackR,FillBackG,FillBackB);
			GetFillFore(ThisObject,FillForeR,FillForeG,FillForeB);
			LineS:=GetLSN(ThisObject);
			LineW:=GetLW(ThisObject);
			ReturnBool:=GetObjBeginningMarker(ThisObject,ObjBMarkStyl,ObjBMarkAngle,ObjBMarkSize,
								ObjBMarkWidth,ObjBMarkThickB,ObjBMarkThick,
								ObjBMarkVis);
			ReturnBool:=GetObjEndMarker(ThisObject,ObjEMarkStyl,ObjEMarkAngle,ObjEMarksize,ObjEMarkWidth,
									ObjEMarkThickB,ObjEMarkThick,ObjEMarkVis);
			ReturnBool:=GetOpacityN(ThisObject,POpacity,FOpacity);
			GetPenBack(ThisObject,PenBackR,PenBackG,PenBackB);
			GetPenFore(ThisObject,PenForeR,PenForeG,PenForeB);
			DSEnabled:=IsDropShadowEnabled(ThisObject);
			ReturnBool:=GetDropShadowData(ThisObject,DSnUnits,DSdOffset,
									DSdBlurRadius,DSdAngle,DSOpacity,
									DSRed,DSGreen,DSBlue);
									
			NewClassName:=StrDialog('Enter the name for the new class',
					Concat('NewClass_',Date(2,2)));
					
			SetExistingClass:=False;
					
			If ClassExists(NewClassName) then
				SetExistingClass:=YNDialog('Class already exists. Set attributes to match object?');
				
			If SetExistingClass or NOT ClassExists(NewClassName) then
				Begin
					NameClass(NewClassName);
					SetClFPat(NewClassName,FPat);
					SetClFillBack(NewClassName,FillBackR,FillBackG,FillBackB);
					SetClFillFore(NewClassName,FillForeR,FillForeG,FillForeB);
					SetClLSN(NewClassName,LineS);
					SetClLW(NewClassName,LineW);
					ReturnBool:=SetClassBeginningMarker(NewClassName,
									ObjBMarkStyl,ObjBMarkAngle,ObjBMarkSize,
									ObjBMarkWidth,ObjBMarkThickB,ObjBMarkThick);
					ReturnBool:=SetClassEndMarker(NewClassName,
									ObjEMarkStyl,ObjEMarkAngle,ObjEMarksize,
									ObjEMarkWidth,ObjEMarkThickB,ObjEMarkThick);
					SetClOpacityN(NewClassName,FOpacity,POpacity);

					SetClPenBack(NewClassName,PenBackR,PenBackG,PenBackB);
					SetClPenFore(NewClassName,PenForeR,PenForeG,PenForeB);
					EnableCLDropShadow(NewClassName,DSEnabled);
					SetCLDrpShadowData(NewClassName,DSnUnits,DSdOffset,
									DSdBlurRadius,DSdAngle,DSOpacity,
									DSRed,DSGreen,DSBlue);
				End
			Else AlrtDialog('No Changes Made');
		End
	Else
		AlrtDialog('A problem occured. Make sure a single object is selected.');
End;

Run(MakeClassWithObjAttribs);

 

  • Like 3
Link to comment
  • 0
On 09/05/2017 at 7:13 AM, michaelk said:

This has been really helpful, Pat.

 

I'm posting a slight update to it.

This is a really useful script

 

@michaelk could you highlight the changes you made to the script as I would like to try an "in between" version so that the new class is set to the active class and the class attributes are set to "Use at creation". It would be good to understand what you did so that I can make the slight change to the script.

 

Many thanks

Link to comment
  • 0

Mark

 

I added exactly two lines of code.  I actually wrote more comments than code.

 

My two lines of code added to Pat's 100 lines sounds pretty typical.

 

This is what I added:

 

SetClUseGraphic(NewClassName,TRUE);
NameClass(ActiveClassName);

 

If you delete the NameClass function it should do what you want.

 

mk

  • Like 1
Link to comment
  • 0

Here's a newer version.  This one

 

1.  Creates a new class with the attributes of the selected object.

2.  Keeps the active class active.

AND

3.  Puts the selected object in the new class.

 

Procedure MakeClassWithObjAttribs;

{© 2016, Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}
{No warranty or guarantee, expressed or implied. Use at your own risk.}
{Test for suitability for your use before using on live data.}
{Immediately discontinue use if hair loss occurs.}

{December 2, 2016}
{This script creates a new class and sets the class attributes to those of the selected}
{object. The only parameter that is not set is TextStyle}
{Based on a request on the tech board by michaelk, September 21, 2016.}

{Updated by Michael Klaers May 8 2017.}
{Changes:	1)  Newly created class will have "Use At Creation" checked.}
{			2)  Active class will not change to newly created class.}

{Updated by Michael Klaers October 2 2018}
{Changes:	3)  Selected object will be in the new class, not the active class}



Var	FPat:							LongInt;
	FillBackR,FillBackG,FillBackB:	LongInt;
	FillForeR,FillForeG,FillForeB:	LongInt;	
	LineS:							LongInt;  {Name List Index}
	LineW:							Integer;
	ObjBMarkStyl:					LongInt;
	ObjBMarkAngle:					Integer;
	ObjBMarkSize:					Real;
	ObjBMarkWidth:					Real;
	ObjBMarkThickB:					Integer;
	ObjBMarkThick:					Real;
	ObjBMarkVis:					Boolean;
	ObjEMarkStyl:					LongInt;
	ObjEMarkAngle:					Integer;
	ObjEMarkSize:					Real;
	ObjEMarkWidth:					Real;
	ObjEMarkThickB:					Integer;
	ObjEMarkThick:					Real;
	ObjEMarkVis:					Boolean;
	POpacity:						Integer;
	FOpacity:						Integer;
	PenBackR,PenBackG,PenBackB:		LongInt;
	PenForeR,PenForeG,PenForeB:		LongInt;
	DSEnabled:						Boolean;
	DSnUnits:						Integer;
	DSdOffset:						Real;
	DSdBlurRadius:					Real;
	DSdAngle:						Real;
	DSOpacity:						Integer;
	DSRed:							Integer;
	DSGreen:						Integer;
	DSBlue:							Integer;
	ThisObject:						Handle;
	SelectedCount:					LongInt;
	ReturnBool:						Boolean;
	NewClassName:					String;
	SetExistingClass:				Boolean;
	ActiveClassName:				STRING;
	
	Function ClassExists(ClsName:String):Boolean;
		var	ThisClass:LongInt;
			ChkClsName:String;
		Begin
			ClassExists:=False;
			For ThisClass := 1 to ClassNum do
				If ClassList(ThisClass)=ClsName then ClassExists:=True;
		End;
		
		
		
Begin
	ThisObject:=Nil;
	If NumSObj(ActLayer) =1 then 
		Begin
			ThisObject:=FSActLayer;
			FPat := GetFPat(ThisObject);
			GetFillBack(ThisObject,FillBackR,FillBackG,FillBackB);
			GetFillFore(ThisObject,FillForeR,FillForeG,FillForeB);
			LineS:=GetLSN(ThisObject);
			LineW:=GetLW(ThisObject);
			ReturnBool:=GetObjBeginningMarker(ThisObject,ObjBMarkStyl,ObjBMarkAngle,ObjBMarkSize,
								ObjBMarkWidth,ObjBMarkThickB,ObjBMarkThick,
								ObjBMarkVis);
			ReturnBool:=GetObjEndMarker(ThisObject,ObjEMarkStyl,ObjEMarkAngle,ObjEMarksize,ObjEMarkWidth,
									ObjEMarkThickB,ObjEMarkThick,ObjEMarkVis);
			ReturnBool:=GetOpacityN(ThisObject,POpacity,FOpacity);
			GetPenBack(ThisObject,PenBackR,PenBackG,PenBackB);
			GetPenFore(ThisObject,PenForeR,PenForeG,PenForeB);
			DSEnabled:=IsDropShadowEnabled(ThisObject);
			ReturnBool:=GetDropShadowData(ThisObject,DSnUnits,DSdOffset,
									DSdBlurRadius,DSdAngle,DSOpacity,
									DSRed,DSGreen,DSBlue);
									
			NewClassName:=StrDialog('Enter the name for the new class',
					Concat('NewClass_',Date(2,2)));
					
			SetExistingClass:=False;
					
			If ClassExists(NewClassName) then
				SetExistingClass:=YNDialog('Class already exists. Set attributes to match object?');
				
			If SetExistingClass or NOT ClassExists(NewClassName) then
				Begin
					ActiveClassName := ActiveClass;
					NameClass(NewClassName);
					SetClFPat(NewClassName,FPat);
					SetClFillBack(NewClassName,FillBackR,FillBackG,FillBackB);
					SetClFillFore(NewClassName,FillForeR,FillForeG,FillForeB);
					SetClLSN(NewClassName,LineS);
					SetClLW(NewClassName,LineW);
					ReturnBool:=SetClassBeginningMarker(NewClassName,
									ObjBMarkStyl,ObjBMarkAngle,ObjBMarkSize,
									ObjBMarkWidth,ObjBMarkThickB,ObjBMarkThick);
					ReturnBool:=SetClassEndMarker(NewClassName,
									ObjEMarkStyl,ObjEMarkAngle,ObjEMarksize,
									ObjEMarkWidth,ObjEMarkThickB,ObjEMarkThick);
					SetClOpacityN(NewClassName,FOpacity,POpacity);

					SetClPenBack(NewClassName,PenBackR,PenBackG,PenBackB);
					SetClPenFore(NewClassName,PenForeR,PenForeG,PenForeB);
					EnableCLDropShadow(NewClassName,DSEnabled);
					SetCLDrpShadowData(NewClassName,DSnUnits,DSdOffset,
									DSdBlurRadius,DSdAngle,DSOpacity,
									DSRed,DSGreen,DSBlue);
					SetClUseGraphic(NewClassName,TRUE);
					NameClass(ActiveClassName);			
					SetClass(ThisObject,NewClassName);															
				End
			Else AlrtDialog('No Changes Made');
		End
	Else
		AlrtDialog('A problem occured. Make sure a single object is selected.');
End;

Run(MakeClassWithObjAttribs);

 

  • Like 3
Link to comment
  • 0

I'd love to be able to use this script however when I copy it, and paste it into a new script in VW, then try to run it on an object I get an error message.

I've tried multiple times and am being very careful to copy the whole script. I tried this same method on another (simpler) script posted in the forum and the copy & paste worked the first time but thereafter, trying the same thing with the same script, again I kept getting error messages.

 

This has happened to me before and last time a helpful user posted the script as a vw file for me. I assumed I had missed some text in the copy.

Frustrating! Here is a short video of what I'm doing. Am I missing something?

 

 

 

Link to comment
  • 0

The error message you are getting says there is an error on line 2.

 

But line 2 is blank.

 

I just did exactly what you did in your screen capture movie.  (Thanks for that.  It was very clear.)  Copied the above script and pasted it into a script palette.  It worked.

 

I'm very interested to know if the script in the attached file runs for you.

Link to comment
  • 0

I always try to past scripts into a "code" block  (click on the <> icon above the edit window). That will ensure that everything is truly text and not some extended unicode text like object. It also keeps tab formatting correct rather than compressing everything to the left margin.

 

My question would be what browser you are each using and what operating system. I know Michael is on Mac and it looks like Boh is on Windows.

 

My guess is that whatever browser Boh is using is sticking some invisible characters into the text when copied that are then confusing the VS compiler.

Link to comment
  • 0

You are right Pat. I'm using chrome with windows. When I tried copying and pasting from Firefox it worked! Thanks again for your advice.

 

I didn't understand this though:

55 minutes ago, Pat Stanford said:

I always try to past scripts into a "code" block  (click on the <> icon above the edit window). That will ensure that everything is truly text and not some extended unicode text like object. It also keeps tab formatting correct rather than compressing everything to the left margin.

 

Which "edit" window? Is there another coding app I should paste into? (Sorry for ignorance).

 

Michael, thanks for the VW file. Yes it works on my machine on your file as well as when I export to my test file.

 

This is a very useful script. Thanks!

Capture.JPG

Link to comment
  • 0

When you're composing a forum post there is a button between the quote and emoji buttons that looks like <>

 

This will give you a window to paste code that keeps formatting.

 

Everything you type into the regular window is probably converted to something else to be formatted for the web.  One of the things you loose is blank space in front of the line, so indentations get lost.

 

Especially bad since indentations have actual meaning in Python!

Link to comment
  • 0
2 minutes ago, Boh said:

Loving this script! One "little" improvement could be if the selected object then takes on it's new class attributes. ATM it retains it's object attributes not the class attributes of it's newly created class. 🙂

 

 

Ha!  I never noticed before.

 

Let me see if I can fix that.  (Pat may beat me to it!)

 

Link to comment
  • 0
7 minutes ago, michaelk said:

When you're composing a forum post there is a button between the quote and emoji buttons that looks like <>

 

This will give you a window to paste code that keeps formatting.

Ok so that's just for people posting scripts. For copying scripts then it seems to ensure it formats correctly for me best to just use Firefox (at least not chrome).

Link to comment
  • 0

Great work everyone!!! This is a gem!

Now all we need is a second contextual click / menu command to put below this one that updates the designated class of the selected object with the overwritten graphic attributes of said object! Think of it as the all too often needed "option B" workflow scenario.

 

On 9/21/2016 at 10:53 AM, michaelk said:

I'd like a new contextual click  / menu command to create a new class with the graphic attributes of the selected object.

 

  • Like 1
Link to comment
  • 0

Try this:

Procedure MakeClassWithObjAttribs;

{*************************************************

This is a fork of the original script described in the comments below.

*************************************************}

{Unceremoniously an inelegantly forked by Michael Klaers October 19, 2018}

{This script will update the class of the selected object 
to have the attributes that the object currently has.

It will force that class to be Use at Creation and 
the object will be forced to have all attribues by class}

{*********************************************************}

{© 2016, Pat Stanford pat@coviana.com}
{Licensed under the GNU Lesser General Public License}
{No warranty or guarantee, expressed or implied. Use at your own risk.}
{Test for suitability for your use before using on live data.}
{Immediately discontinue use if hair loss occurs.}

{December 2, 2016}
{This script creates a new class and sets the class attributes to those of the selected}
{object. The only parameter that is not set is TextStyle}
{Based on a request on the tech board by michaelk, September 21, 2016.}

{Updated by Michael Klaers May 8 2017.}
{Changes:	1)  Newly created class will have "Use At Creation" checked.}
{			2)  Active class will not change to newly created class.}

{Updated by Michael Klaers October 2 2018}
{Changes:	3)  Selected object will be in the new class, not the active class}

{Updated by Michael Klaers October 4 2018}
{Changes:  	4) Selected object attributes will all be by class}


Var	FPat:							LongInt;
	FillBackR,FillBackG,FillBackB:	LongInt;
	FillForeR,FillForeG,FillForeB:	LongInt;	
	LineS:							LongInt;  {Name List Index}
	LineW:							Integer;
	ObjBMarkStyl:					LongInt;
	ObjBMarkAngle:					Integer;
	ObjBMarkSize:					Real;
	ObjBMarkWidth:					Real;
	ObjBMarkThickB:					Integer;
	ObjBMarkThick:					Real;
	ObjBMarkVis:					Boolean;
	ObjEMarkStyl:					LongInt;
	ObjEMarkAngle:					Integer;
	ObjEMarkSize:					Real;
	ObjEMarkWidth:					Real;
	ObjEMarkThickB:					Integer;
	ObjEMarkThick:					Real;
	ObjEMarkVis:					Boolean;
	POpacity:						Integer;
	FOpacity:						Integer;
	PenBackR,PenBackG,PenBackB:		LongInt;
	PenForeR,PenForeG,PenForeB:		LongInt;
	DSEnabled:						Boolean;
	DSnUnits:						Integer;
	DSdOffset:						Real;
	DSdBlurRadius:					Real;
	DSdAngle:						Real;
	DSOpacity:						Integer;
	DSRed:							Integer;
	DSGreen:						Integer;
	DSBlue:							Integer;
	ThisObject:						Handle;
	SelectedCount:					LongInt;
	ReturnBool:						Boolean;
	NewClassName:					String;
	SetExistingClass:				Boolean;
	ActiveClassName:				STRING;
	
	Function ClassExists(ClsName:String):Boolean;
		var	ThisClass:LongInt;
			ChkClsName:String;
		Begin
			ClassExists:=False;
			For ThisClass := 1 to ClassNum do
				If ClassList(ThisClass)=ClsName then ClassExists:=True;
		End;
		
		
		
Begin
	ThisObject:=Nil;
	If NumSObj(ActLayer) =1 then 
		Begin
			ThisObject:=FSActLayer;
			FPat := GetFPat(ThisObject);
			GetFillBack(ThisObject,FillBackR,FillBackG,FillBackB);
			GetFillFore(ThisObject,FillForeR,FillForeG,FillForeB);
			LineS:=GetLSN(ThisObject);
			LineW:=GetLW(ThisObject);
			ReturnBool:=GetObjBeginningMarker(ThisObject,ObjBMarkStyl,ObjBMarkAngle,ObjBMarkSize,
								ObjBMarkWidth,ObjBMarkThickB,ObjBMarkThick,
								ObjBMarkVis);
			ReturnBool:=GetObjEndMarker(ThisObject,ObjEMarkStyl,ObjEMarkAngle,ObjEMarksize,ObjEMarkWidth,
									ObjEMarkThickB,ObjEMarkThick,ObjEMarkVis);
			ReturnBool:=GetOpacityN(ThisObject,POpacity,FOpacity);
			GetPenBack(ThisObject,PenBackR,PenBackG,PenBackB);
			GetPenFore(ThisObject,PenForeR,PenForeG,PenForeB);
			DSEnabled:=IsDropShadowEnabled(ThisObject);
			ReturnBool:=GetDropShadowData(ThisObject,DSnUnits,DSdOffset,
									DSdBlurRadius,DSdAngle,DSOpacity,
									DSRed,DSGreen,DSBlue);
									
			NewClassName:=GetClass(ThisObject);
					
			SetExistingClass:=False;
					
		
				
			
					ActiveClassName := ActiveClass;
					NameClass(NewClassName);
					SetClFPat(NewClassName,FPat);
					SetClFillBack(NewClassName,FillBackR,FillBackG,FillBackB);
					SetClFillFore(NewClassName,FillForeR,FillForeG,FillForeB);
					SetClLSN(NewClassName,LineS);
					SetClLW(NewClassName,LineW);
					ReturnBool:=SetClassBeginningMarker(NewClassName,
									ObjBMarkStyl,ObjBMarkAngle,ObjBMarkSize,
									ObjBMarkWidth,ObjBMarkThickB,ObjBMarkThick);
					ReturnBool:=SetClassEndMarker(NewClassName,
									ObjEMarkStyl,ObjEMarkAngle,ObjEMarksize,
									ObjEMarkWidth,ObjEMarkThickB,ObjEMarkThick);
					SetClOpacityN(NewClassName,FOpacity,POpacity);

					SetClPenBack(NewClassName,PenBackR,PenBackG,PenBackB);
					SetClPenFore(NewClassName,PenForeR,PenForeG,PenForeB);
					EnableCLDropShadow(NewClassName,DSEnabled);
					SetCLDrpShadowData(NewClassName,DSnUnits,DSdOffset,
									DSdBlurRadius,DSdAngle,DSOpacity,
									DSRed,DSGreen,DSBlue);
					SetClUseGraphic(NewClassName,TRUE);
					NameClass(ActiveClassName);			
					SetClass(ThisObject,NewClassName);				
					SetFPatByClass(ThisObject);
					SetFillColorByClass(ThisObject);
					SetLSByClass(ThisObject);
					SetLWByClass(ThisObject);
					SetMarkerByClass(ThisObject);
					SetOpacityByClass(ThisObject);
					SetPenColorByClass(ThisObject);
					SetTextStyleByClass(ThisObject);

				
		
		End
	
End;

Run(MakeClassWithObjAttribs);

 

Update Class.vwx

  • Like 2
  • Love 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
Answer this question...

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