Jump to content
Pat Stanford

Rotate objects by individual centers

Recommended Posts

If you hace multiple objects selected and use the scale tools, they all scale around a single point and the group gets bigger. Often, you want each object to scale around its own center. That is what this script does.

Use as you see fit, but at your own risk. Please credit me if you use this.

Pat

============

Procedure ScaleEachObject;

{Scales each selected object in the active layer around the obejct center}

{? 2007, Coviana, Inc - Pat Stanford pat@coviana.com}

{Licensed unde the GNU Lesser General Public License}

Var H1,H2:Handle;

N1,N2:Integer;

A1:Dynarray[ ] of handle;

R1:Real;

Begin

N1:=Count(Sel);

If N1>0 then

Begin

Allocate A1[1..N1];

N2:=1;

While N2<=N1 do

Begin

A1[N2]:=FSActLayer;

SetDSelect(FSActLayer);

N2:=N2+1;

End;

R1:=RealDialog('Enter the amount to scale each object by','2.0');

N2:=1;

While N2<=N1 do

Begin

SetSelect(A1[N2]);

Scale(R1,R1);

DSelectAll;

N2:=N2+1;

End;

End

else AlrtDialog('At least one object must be selected');

End;

Run(ScaleEachObject);

============

  • Like 1

Share this post


Link to post

Thought I'd add a comment for those learning vScript:

Pat's script demonstrates how to overcome a common problem that we all run up against at some point, and that is how do we apply a function that operates on selection status to individual objects in a selection set:

Load the selected object's handles into an array (A1). This serves as the list of objects that the user wants to work on.

De-select the objects.

Step thru the array, getting each individual object handle, selecting, applying the function (scale) and deselecting before moving on to the next handle in the array.

Sometimes it's useful to go thru the array one more time at the end to re-select the objects in the list. This allows the user to "try again" on the same set of objects without having to select those objects again.

This technique is also useful when using some MenuText calls that can only operate on one object at a time. Edit Group/Exit Group come to mind.

Keep on Scripting!

Charles Croft

Share this post


Link to post

I didn't have a rotate, but I do now.

This will rotate each object individually. Symbols and PIOs are rotated around the insertion point, Other objects around their geometric center.

Regards,

Pat

==============

Procedure RotateEachObject;

{Rotates each selected object in the active layer}

{Symbols and PIOs are rotates around the insertion point}

{Other Objects are rotated around their center point}

{? 2007,2008, Coviana, Inc - Pat Stanford pat@coviana.com}

{Licensed unde the GNU Lesser General Public License}

Var H1,H2:Handle;

N1,N2:Integer;

A1:Dynarray[ ] of handle;

R1,X1,Y1 :Real;

Begin

N1:=Count(Sel);

If N1>0 then

Begin

Allocate A1[1..N1];

N2:=1;

While N2<=N1 do

Begin

A1[N2]:=FSActLayer;

SetDSelect(FSActLayer);

N2:=N2+1;

End;

R1:=RealDialog('Enter the amount to rotate each object by','90.0');

N2:=1;

While N2<=N1 do

Begin

If ((GetType(A1[N2]) = 15) or (GetType(A1[N2])=86)) then

GetSymLoc(A1[N2],X1,Y1)

else

HCenter(A1[N2],X1,Y1);

HRotate(A1[N2],X1,Y1,R1);

N2:=N2+1;

End;

End

else AlrtDialog('At least one object must be selected');

End;

Run(RotateEachObject);

==============

Share this post


Link to post

Good work. Now this corresponds with the thread title.

I've added these scripts to my workspace as menu commands.

Share this post


Link to post

Here is an updated version of the Rotate Each Object Script. It has been modified to work around a bug that was found in the Scale Each Object script.

Procedure RotateEachObject;
{Rotates each selected object in the active layer}


{Symbols and PIOs are rotated around the insertion point}
{Other Objects are rotated around their center point}
{? 2007,2008,2010 Coviana, Inc - Pat Stanford pat@coviana.com}
{Licensed unde the GNU Lesser General Public License}

Var	 H1,H2:Handle;
N1,N2:Integer;
A1:Dynarray[ ] of handle;
R1,X1,Y1	 :Real;

Begin
N1:=Count(Sel);
If N1>0 then
	Begin
		Allocate A1[1..N1];
		N2:=1;
		While N2<=N1 do
			Begin
				A1[N2]:=FSActLayer;
				SetDSelect(FSActLayer);
				N2:=N2+1;
			End;

		R1:=RealDialog('Enter the amount to rotate each object by','90.0');

		N2:=1;
		While N2<=N1 do
			Begin
				If ((GetType(A1[N2]) = 15) or (GetType(A1[N2])=86)) then GetSymLoc(A1[N2],X1,Y1)
				else
					HCenter(A1[N2],X1,Y1);

				HRotate(A1[N2],X1,Y1,R1);

				N2:=N2+1;
			End;
	End
else 
	Begin
		N1:=0;
		AlrtDialog('At least one object must be selected');
	End;
End;

Run(RotateEachObject);

  • Like 1

Share this post


Link to post

Here is an update to the Scale Each Object script. It fixes a bug (that was either never found or introduced in a later version of VW where the script would incorrectly hang at the "At least one object must be selected" error message if only groups were selected.

Procedure ScaleEachObject;
{Scales each selected object in the active layer around the obejct center}
{? 2007, 2010, Coviana, Inc - Pat Stanford pat@coviana.com}
{Licensed unde the GNU Lesser General Public License}

Var	H1,H2:Handle;
N1,N2:Integer;
A1:Dynarray[ ] of handle;
R1:Real;
Begin
N1:=Count(Sel);
If N1>0 then
Begin
	Allocate A1[1..N1];
	N2:=1;
	While N2<=N1 do
		Begin
			A1[N2]:=FSActLayer;
			SetDSelect(FSActLayer);
			N2:=N2+1;
		End;

	R1:=RealDialog('Enter the amount to scale each object by','2.0');

	N2:=1;
	While N2<=N1 do
		Begin
			SetSelect(A1[N2]);
			Scale(R1,R1);
			DSelectAll;
			N2:=N2+1;
		End;
End
else 
Begin
	N1:=0;
	AlrtDialog('At least one object must be selected');
End;
End;

Run(ScaleEachObject);

Share this post


Link to post

Hi Pat

thanks alot for this great script. It would be very helpful to me to have a version which works with symbols as well (and in second priority with groups). This version here only seems to work with simple objects like rectangles, circles, polys...

Which code would I have to add for symbols? I couldn't find anything in the VS function reference.

My goal is to write a script combined of your scale individual objects script and the rotate individual objects script including a randomizing function. I'm in landscaping. I want to be able to place tree symbols (of same size) on site plans and quickly make them look more natural by rescaling and rotating them randomly within a certain range. Maybe it would be easyer to keep scripts separated: one for simple objects and one for symbols.

Next step maybe would be a "forest-script" to create randomly scattered trees within an area defined by a polyline.

Thanks in advance for any tip.

Markus

Below my first (working) attempt to add a randomizing function to your scale individual objects script (not working with symbols):

Procedure ScaleEachObjectRandom;
{Scales each selected object in the active layer around the obejct center}
{? original Script ScaleEachObject by 2007, 2010, by Coviana, Inc - Pat Stanford pat@coviana.com}
{added randomizing function by Markus Urbscheit mu@u-plan.ch}
{Licensed under the GNU Lesser General Public License}

Var	H1,H2:Handle;
N1,N2:Integer;
A1:Dynarray[ ] of handle;
RX:Real;
R1:Real;
R2:Real;
Begin
N1:=Count(Sel);
If N1>0 then
Begin
	Allocate A1[1..N1];
	N2:=1;
	While N2<=N1 do
		Begin
			A1[N2]:=FSActLayer;
			SetDSelect(FSActLayer);
			N2:=N2+1;
		End;

	R1:=RealDialog('min scaling factor','1.0');
	R2:=RealDialog('max scaling factor,'2.0');

	N2:=1;
	While N2<=N1 do
		Begin
			SetSelect(A1[N2]);
			RX:=(R2-R1)*random+R1;
			Scale(RX,RX);
			DSelectAll;
			N2:=N2+1;
		End;
End
else 
Begin
	N1:=0;
	AlrtDialog('mindestens ein Objekt muss ausgewählt sein!');
End;
End;

Run(ScaleEachObjectRandom);

Share this post


Link to post

sorry guys, in my last post of the ScaleEachObjectRandom script there was a ' missing after max scaling factor.

here the correct version:

Procedure ScaleEachObjectRandom;
{Scales each selected object in the active layer around the obejct center}
{? original Script ScaleEachObject by 2007, 2010, by Coviana, Inc - Pat Stanford pat@coviana.com}
{added randomizing function by Markus Urbscheit mu@u-plan.ch}
{Licensed under the GNU Lesser General Public License}

Var	H1,H2:Handle;
N1,N2:Integer;
A1:Dynarray[ ] of handle;
RX:Real;
R1:Real;
R2:Real;
Begin
N1:=Count(Sel);
If N1>0 then
Begin
	Allocate A1[1..N1];
	N2:=1;
	While N2<=N1 do
		Begin
			A1[N2]:=FSActLayer;
			SetDSelect(FSActLayer);
			N2:=N2+1;
		End;

	R1:=RealDialog('min scaling factor','1.0');
	R2:=RealDialog('max scaling factor','2.0');

	N2:=1;
	While N2<=N1 do
		Begin
			SetSelect(A1[N2]);
			RX:=(R2-R1)*random+R1;
			Scale(RX,RX);
			DSelectAll;
			N2:=N2+1;
		End;
End
else 
Begin
	N1:=0;
	AlrtDialog('mindestens ein Objekt muss ausgewählt sein!');
End;
End;

Run(ScaleEachObjectRandom);

Share this post


Link to post

Hi guys - I found out how to manipulate the symbols scale in this thread and modified Pats script to randomize the individual scale of symbols.

here you go - ScaleEachSymbolRandom:

Procedure ScaleEachSymbolRandom;
{Scales each selected symbol in the active layer around the symbol center}
{? original Script ScaleEachObject, 2007, 2010, by Coviana, Inc - Pat Stanford pat@coviana.com}
{modified for symbols and added randomizing function 2015 by Markus Urbscheit mu@u-plan.ch}
{Licensed under the GNU Lesser General Public License}

Var	H1,H2:Handle;
N1,N2:Integer;
A1:Dynarray[ ] of handle;
RX:Real;
R1:Real;
R2:Real;
Begin
N1:=Count(Sel);
If N1>0 then
Begin
	Allocate A1[1..N1];
	N2:=1;
	While N2<=N1 do
		Begin
			A1[N2]:=FSActLayer;
			SetDSelect(FSActLayer);
			N2:=N2+1;
		End;

	R1:=RealDialog('min scaling factor','1.0');
	R2:=RealDialog('max scaling factor','2.0');

	N2:=1;
	While N2<=N1 do
		Begin
			SetSelect(A1[N2]);
			RX:=(R2-R1)*random+R1;
			SetObjectVariableReal(A1[N2], 102, RX);
			SetObjectVariableInt(A1[N2], 101, 2);
			DSelectAll;
			N2:=N2+1;
		End;
End
else 
Begin
	N1:=0;
	AlrtDialog('mindestens ein Objekt muss ausgewählt sein!');
End;
End;

Run(ScaleEachSymbolRandom);

Share this post


Link to post

And here I modified Pats rotate each object adding randomizing functionality. Try it out. Pat - tell me if the author info in the header is ok like this for you.

So Pat, I actually answered all my questions myself :) and now have my randomizing scripts. Great! This is fun!

Cheers, Markus

Procedure RotateEachObjectRandom;
{Rotates each selected object including symbols in the active layer randomly in a range between two input values of rotation angles}


{Symbols and PIOs are rotated around the insertion point}
{Other Objects are rotated around their center point}
{original script: RotateEachObject ? 2007,2008,2010 Coviana, Inc - Pat Stanford pat@coviana.com}
{2015 modified by Markus Urbscheit - mu@u-plan.ch added randomizing functionality}
{Licensed under the GNU Lesser General Public License}

Var	 H1,H2:Handle;
N1,N2:Integer;
A1:Dynarray[ ] of handle;
R1,R2,RX,X1,Y1	 :Real;

Begin
N1:=Count(Sel);
If N1>0 then
	Begin
		Allocate A1[1..N1];
		N2:=1;
		While N2<=N1 do
			Begin
				A1[N2]:=FSActLayer;
				SetDSelect(FSActLayer);
				N2:=N2+1;
			End;

		R1:=RealDialog('Enter the min amount to rotate each object by','90.0');
		R2:=RealDialog('Enter the max amount to rotate each object by','180.0');
		N2:=1;
		While N2<=N1 do
			Begin
				If ((GetType(A1[N2]) = 15) or (GetType(A1[N2])=86)) then GetSymLoc(A1[N2],X1,Y1)
				else
					HCenter(A1[N2],X1,Y1);

				RX:=R1+(R2-R1)*random;
				HRotate(A1[N2],X1,Y1,RX);

				N2:=N2+1;
			End;
	End
else 
	Begin
		N1:=0;
		AlrtDialog('at least one object must be selected!');
	End;
End;

Run(RotateEachObjectRandom);

Share this post


Link to post

Looks good.

The attribution is fine.

Glad you were able to work it out for yourself. That is the best way to learn.

Share this post


Link to post

For those interested, I needed Pat's script to do the exact same thing, except also rotate symbols and PIOs around their geometric centers.  I merely removed this snippet of code, and it works like a charm!

 

				If ((GetType(A1[N2]) = 15) or (GetType(A1[N2])=86)) then GetSymLoc(A1[N2],X1,Y1)
				else

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.

×