Jump to content
  • 7
michaelk

Create new class with attributes of selected object

Question

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

 

mk

  • Like 2

Share this post


Link to post

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 2

Share this post


Link to post
  • 0

Pat

 

I never even thought of  writing a script to do that!

 

And I wouldn't have thought that a script to do this would use so many variables!

 

 

Thanks, Pat.  I'm adding this to my workspace!

 

 

mk

Share this post


Link to post
  • 0

This has been really helpful, Pat.

 

I'm posting a slight update to it.

 

This script is the exactly the same as the above except:

 

1.  The newly created script will have "Use At Creation" checked.

2.  The active class will not change from the currently active class to the newly created 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.}



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);													
				End
			Else AlrtDialog('No Changes Made');
		End
	Else
		AlrtDialog('A problem occured. Make sure a single object is selected.');
End;

Run(MakeClassWithObjAttribs);

 

  • Like 3

Share this post


Link to post
  • 0

Thank you !

 

I was able to add as a menu item - now I need to hunt down how to add as a right click item :)

 

Thank you!
Ethan

Share this post


Link to post
  • 0

In the Workspace Editor, you should be able to add any menu command to right-click by adding the menu command under Object Context:

59131b85d0dfd_ScreenShot2017-05-10at9_53_24AM.png.c1834899c0939d882e24e9f186bbb379.png

 

(Document Context is when you right click in a blank area of your drawing.)

Share this post


Link to post
  • 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

Share this post


Link to post
  • 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

Share this post


Link to post
  • 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);

 

Share this post


Link to post
  • 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?

 

 

 

Share this post


Link to post
  • 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.

Share this post


Link to post
  • 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.

Share this post


Link to post
  • 0

Pat, I was thinking the same thing.  Maybe the browser saw the line 2 carriage return -- CHR(13) -- as something else?

Share this post


Link to post
  • 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

Share this post


Link to post
  • 0

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

 

Share this post


Link to post
  • 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!

Share this post


Link to post
  • 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!)

 

Share this post


Link to post
  • 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).

Share this post


Link to post
  • 0

This rarely happens.  I usually can't look up all the functions, make 5 syntax errors, correct them and test a script in the time it takes Pat to just type it out.

 

I'm assuming Mr. Stanford isn't at his computer at the moment 🙂

 

Here's the new script:

 

New Class From Object Script II.vwx

  • Like 1

Share this post


Link to post
  • 0

Very fast - wasn't expecting that! Thanks Michael. 🙂

 

Share this post


Link to post
  • 0

I was near the computer, but I have been on 7 conference calls and a lunch meeting today. Hard to script with all that background rigmarole going on 😉

 

Michaels explanation of the code block being in the forum was exactly what I meant.

Share this post


Link to post
  • 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

Share this post


Link to post
  • 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

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

 

7150 Riverwood Drive, Columbia, Maryland 21046, USA   |   Contact Us:   410-290-5114

 

© 2018 Vectorworks, Inc. All Rights Reserved. Vectorworks, Inc. is part of the Nemetschek Group.

×