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

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

Yes, I think I agree.  For most uses VSel (Visible Selected Objects) is better than Sel because it only handles objects you can currently see as selected.

 

Sel may effect objects on layers or classes that are invisible or objects inside of symbols or group.

 

I am relatively certain the VSEL was not an option in 2007 when this script was originally written or I probably would have used it. 😉

 

 

Share this post


Link to post

These 2 scripts are part of the AutoPlot Tools for Spotlight, but I will share them here.

 

First, "Rotate Left 90"

This will rotate each selected object around its insertion point  90 degrees left.  If the object does not have an insertion point it will rotate them around the geographic center.  You can change the "90" in the script to any angle you desire.

 

{Script  starts here}

PROCEDURE RotateEachLeft90;

VAR
    NumberOfObjs : INTEGER;

    PROCEDURE RotateObj(theObj : HANDLE);

    VAR
        locX : REAL;
        locY : REAL;

    BEGIN
        NumberOfObjs := NumberOfObjs + 1;
        IF ((GetType(theObj) = 15) OR (GetType(theObj) = 86)) THEN
            GetSymLoc(theObj,locX,locY)
        ELSE
            HCenter(theObj,locX,locY);
        HRotate(theObj, locX, locY, 90);
    END; {PROCEDURE FillSelectedArray}

{==================================================================}

BEGIN
    NumberOfObjs := 0;
    ForEachObject(RotateObj, ((VSEL=TRUE)));
    ClrMessage;
END;
RUN(RotateEachLeft90);

{Script  ends here}

 

 

Second, "Rotate by Query"

 

This command will ask you what angle you wish to rotate to, whether or not you want to include other layers or enter groups one level.

 

{Script  starts here}

PROCEDURE RotateObjects;
{DEBUG}

CONST
    kGroup = 11;
    kSymInstance = 15;
    {Alignment constants}
    kRight                = 1;
    kBottom               = 2;
    kLeft                 = 3;
    kColumn               = 4;
    kResize               = 0;
    kShift                = 1;

    { Dialog resource ID }
    kOK                   = 1;
    kCancel               = 2;

    { control IDs}
    kRotAngleLbl          = 4;
    kRotAngleEditBx       = 5;
    kRotInGrpObjsChk      = 6;
    kRotOtherLyrsChk      = 7;

VAR
    TheObjArray            :ARRAY[1..200] OF HANDLE;
    NumberOfObjs        :INTEGER;
    TheActiveLayer        :STRING;
    RotAngle            :REAL;
    Index                :INTEGER;
    Dialog                 :INTEGER;
    cnt                    :INTEGER;
    DlgItemNum            :INTEGER;
    RotInsideGrps        :BOOLEAN;
    RotOtherLayers        :BOOLEAN;
    DlgTitle            :STRING;
    RotQuery            :STRING;
    InGrpsQuery            :STRING;
    OtherLyrsQuery        :STRING;
    OKstr                :STRING;
    CancelStr            :STRING;

{==================================================================}    

{==================================================================}    

    PROCEDURE SetUpDialog;

    BEGIN
        OKstr            := 'OK'; {OK}
        CancelStr        := 'Cancel'; {Cancel}
        DlgTitle        := 'Enter Rotation Angle'; {Enter Rotation Angle}
        RotQuery        := 'Enter angle of rotation';
        OtherLyrsQuery    := 'Rotate selected objects on all visible layers';
        InGrpsQuery        := 'Rotate objects inside groups';

        Dialog := CreateLayout(DlgTitle, TRUE, OKstr, CancelStr);

        {create controls}
        CreateStaticText( Dialog, kRotAngleLbl, RotQuery, -1 );
        CreateEditReal(Dialog, kRotAngleEditBx, 2, 0, 10);

        CreateCheckBox( Dialog, kRotInGrpObjsChk, OtherLyrsQuery);
        CreateCheckBox( Dialog, kRotOtherLyrsChk, InGrpsQuery);

        {set relations}
        SetFirstLayoutItem( Dialog, kRotAngleLbl );
        SetBelowItem( Dialog, kRotAngleLbl, kRotAngleEditBx, 0, 0 );
        SetBelowItem( Dialog, kRotAngleEditBx, kRotInGrpObjsChk, 0, 4 );
        SetBelowItem( Dialog, kRotInGrpObjsChk, kRotOtherLyrsChk, 0, 1 );
    END;

{==================================================================}    

    PROCEDURE HandleDialog(var dlgItem :LONGINT; data :LONGINT);
    
    VAR
        angValue : REAL;
        ok : BOOLEAN;
    
    BEGIN
        CASE dlgItem OF
            SetupDialogC:
                BEGIN
                    RotInsideGrps := FALSE;
                    SetBooleanItem(Dialog, kRotInGrpObjsChk, FALSE);
                    RotOtherLayers := FALSE;
                    SetBooleanItem(Dialog, kRotOtherLyrsChk, FALSE);

                END;
            
            kOK:
                BEGIN
                    ok := GetEditReal(Dialog, kRotAngleEditBx, 2, angValue);
                    IF ok THEN
                        BEGIN
                            RotAngle := angValue;
                            GetBooleanItem(Dialog, kRotInGrpObjsChk, RotInsideGrps);
                            GetBooleanItem(Dialog, kRotOtherLyrsChk, RotOtherLayers);
                        END
                     ELSE
                         dlgItem := -1;
                END;
        END; {CASE dlgItem}
    END; {PROCEDURE HandleDialog}
    
{==================================================================}    

    PROCEDURE DoFlip(theObj:Handle);
    
    VAR
        locX : REAL;
        locY : REAL;
        locZ : REAL;
        postX : REAL;
        postY : REAL;
        grpSym : HANDLE;
        grpObj : HANDLE;
    
    BEGIN
        IF ((GetType(theObj) = 15) OR (GetType(theObj) = 86)) THEN {symbol type}
            BEGIN
                GetSymLoc(theObj,locX,locY); 
                HRotate(theObj,locX,locY, RotAngle);
                GetSymLoc(theObj,postX,postY);
                HMove(theObj,locX-postX, locy-postY);
            END
        ELSE
            BEGIN
                HCenter(theObj,locX,locY); 
                HRotate(theObj,locX,locY, RotAngle);
            END;
        ResetBBox(theObj);
        ResetObject(theObj);
    END; {PROCEDURE DoFlip}
    
{==================================================================}    

    PROCEDURE FillSelectedArray;
    
    VAR
        theObj : HANDLE;
        flipAcrossLayers : BOOLEAN;
        acrossLayersStr : STRING;
        objLayer : HANDLE;
        index : INTEGER;
        grpObj : HANDLE;
        theLayer : HANDLE;
    
    BEGIN
        FOR index := 1 TO 200 DO
            TheObjArray[index] := NIL;

        acrossLayersStr := '';
        index := 0;
        theLayer := FLayer;
        WHILE theLayer <> NIL DO
            BEGIN
                theObj := FSObject(theLayer);
                flipAcrossLayers := False;
                WHILE (theObj <> NIL) DO
                    BEGIN
                        objLayer := theLayer;
                        IF (GetLVis(objLayer) = 0) THEN
                            BEGIN    
                                IF (RotOtherLayers OR (objLayer = ActLayer)) THEN
                                    BEGIN
                                        IF (RotInsideGrps & (GetType(theObj) = 11)) THEN
                                            BEGIN
                                                grpObj := FInGroup(theObj);
                                                WHILE grpObj <> NIL DO
                                                    BEGIN
                                                        index := index + 1;
                                                        NumberOfObjs := index;
                                                        TheObjArray[index] := grpObj;
                                                        grpObj := NextObj(grpObj);
                                                    END;
                                            END {IF GetType(theObj) = 11}
                                        ELSE
                                            BEGIN
                                                index := index + 1;
                                                NumberOfObjs := index;
                                                TheObjArray[index] := theObj;
                                            END;
                                    END {IF (flipAcrossLayers OR (objLayer = ActLayer))}
                        
                            END; {IF (GetLVis(objLayer) = 0)}
                        theObj := NextSObj(theObj);
                    END; {WHILE (theObj <> NIL)}
                theLayer := NextLayer(theLayer);
            END; {WHILE theLayer <> NIL}
    END; {PROCEDURE FillSelectedArray}
    
{==================================================================}    

BEGIN

    SetUpDialog;
    DlgItemNum := RunLayoutDialog(Dialog,HandleDialog);
    IF DlgItemNum = 1 THEN
        BEGIN
            TheActiveLayer := GetLName(ActLayer);
            FillSelectedArray;
            DSelectObj(((L<>TheActiveLayer)));    
            DSelectAll;
            FOR Index := 1 TO NumberOfObjs DO
                DoFlip(TheObjArray[Index]);
            FOR Index := 1 TO NumberOfObjs DO
                BEGIN
                SetSelect(TheObjArray[Index]);
                ResetObject(TheObjArray[Index]);
                END;
        END; {IF (NOT DidCancel)}
        
    ClrMessage;
END;
RUN(RotateObjects);

{Script  ends here}

 

  • Like 1

Share this post


Link to post

Thanks @Sam Jonesfor sharing these.

I got the first script to work but no joy on the second one. Does it just work in vw2020 or hasit been tested it on vw2019?

 

Thanks

Share this post


Link to post

I just tested it, and It works in both 2019 and 2020.  But... there seems to be a bug that lets it only work on objects on the Active Layer.  I will investigate.  It should work across layers, but for now only the active layer.

Share this post


Link to post

There was a mistake in the SetUpDialog sub routine.  2 lines needed changing, but I am leaving the entire code for the command here.

 

{Script  starts here}

PROCEDURE RotateObjects;
{DEBUG}
CONST
    kGroup = 11;
    kSymInstance = 15;
    {Alignment constants}
    kRight                = 1;
    kBottom               = 2;
    kLeft                 = 3;
    kColumn               = 4;
    kResize               = 0;
    kShift                = 1;
    { Dialog resource ID }
    kOK                   = 1;
    kCancel               = 2;
    { control IDs}
    kRotAngleLbl          = 4;
    kRotAngleEditBx       = 5;
    kRotInGrpObjsChk      = 6;
    kRotOtherLyrsChk      = 7;
VAR
    TheObjArray         :ARRAY[1..200] OF HANDLE;
    NumberOfObjs        :INTEGER;
    TheActiveLayer      :STRING;
    RotAngle            :REAL;
    Index               :INTEGER;
    Dialog              :INTEGER;
    cnt                 :INTEGER;
    DlgItemNum          :INTEGER;
    RotInsideGrps       :BOOLEAN;
    RotOtherLayers      :BOOLEAN;
    DlgTitle            :STRING;
    RotQuery            :STRING;
    InGrpsQuery         :STRING;
    OtherLyrsQuery      :STRING;
    OKstr               :STRING;
    CancelStr           :STRING;
{==================================================================}    
{==================================================================}    
    PROCEDURE SetUpDialog;
    BEGIN
        OKstr            := 'OK'; {OK}
        CancelStr        := 'Cancel'; {Cancel}
        DlgTitle        := 'Enter Rotation Angle'; {Enter Rotation Angle}
        RotQuery        := 'Enter angle of rotation';
        OtherLyrsQuery    := 'Rotate selected objects on all visible layers';
        InGrpsQuery        := 'Rotate objects inside groups';
        Dialog := CreateLayout(DlgTitle, TRUE, OKstr, CancelStr);
        {create controls}
        CreateStaticText( Dialog, kRotAngleLbl, RotQuery, -1 );
        CreateEditReal(Dialog, kRotAngleEditBx, 2, 0, 10);
        CreateCheckBox( Dialog, kRotInGrpObjsChk, InGrpsQuery);
        CreateCheckBox( Dialog, kRotOtherLyrsChk, OtherLyrsQuery);
      {set relations}
        SetFirstLayoutItem( Dialog, kRotAngleLbl );
        SetBelowItem( Dialog, kRotAngleLbl, kRotAngleEditBx, 0, 0 );
        SetBelowItem( Dialog, kRotAngleEditBx, kRotInGrpObjsChk, 0, 4 );
        SetBelowItem( Dialog, kRotInGrpObjsChk, kRotOtherLyrsChk, 0, 1 );
    END;
{==================================================================}    
    PROCEDURE HandleDialog(var dlgItem :LONGINT; data :LONGINT);
    
    VAR
        angValue : REAL;
        ok : BOOLEAN;
    
    BEGIN
        CASE dlgItem OF
            SetupDialogC:
                BEGIN
                    RotInsideGrps := FALSE;
                    SetBooleanItem(Dialog, kRotInGrpObjsChk, FALSE);
                    RotOtherLayers := FALSE;
                    SetBooleanItem(Dialog, kRotOtherLyrsChk, FALSE);
                END;
            
            kOK:
                BEGIN
                    ok := GetEditReal(Dialog, kRotAngleEditBx, 2, angValue);
                    IF ok THEN
                        BEGIN
                            RotAngle := angValue;
                            GetBooleanItem(Dialog, kRotInGrpObjsChk, RotInsideGrps);
                            GetBooleanItem(Dialog, kRotOtherLyrsChk, RotOtherLayers);
                        END
                     ELSE
                         dlgItem := -1;
                END;
        END; {CASE dlgItem}
    END; {PROCEDURE HandleDialog}
    
{==================================================================}    
    PROCEDURE DoFlip(theObj:Handle);
    
    VAR
        locX : REAL;
        locY : REAL;
        locZ : REAL;
        postX : REAL;
        postY : REAL;
        grpSym : HANDLE;
        grpObj : HANDLE;
    
    BEGIN
        IF ((GetType(theObj) = 15) OR (GetType(theObj) = 86)) THEN {symbol type}
            BEGIN
                GetSymLoc(theObj,locX,locY); 
                HRotate(theObj,locX,locY, RotAngle);
 (*              
                GetSymLoc(theObj,postX,postY);
                HMove(theObj,locX-postX, locy-postY);
*)
            END
        ELSE
            BEGIN
                HCenter(theObj,locX,locY); 
                HRotate(theObj,locX,locY, RotAngle);
            END;
        ResetBBox(theObj);
        ResetObject(theObj);
    END; {PROCEDURE DoFlip}
    
{==================================================================}    
    PROCEDURE FillSelectedArray;
    
    VAR
        theObj : HANDLE;
        flipAcrossLayers : BOOLEAN;
        acrossLayersStr : STRING;
        objLayer : HANDLE;
        index : INTEGER;
        grpObj : HANDLE;
        theLayer : HANDLE;
        layerName : STRING;
    
    BEGIN
        FOR index := 1 TO 200 DO
            TheObjArray[index] := NIL;
        acrossLayersStr := '';
        index := 0;
        theLayer := FLayer;
        layerName := GetLName(theLayer);
        WHILE theLayer <> NIL DO
            BEGIN
                theObj := FSObject(theLayer);
                {flipAcrossLayers := False;}
                WHILE (theObj <> NIL) DO
                    BEGIN
                        objLayer := theLayer;
                        IF (GetLVis(objLayer) = 0) THEN
                            BEGIN    
                                IF (RotOtherLayers OR (objLayer = ActLayer)) THEN
                                    BEGIN
                                        IF (RotInsideGrps & (GetType(theObj) = 11)) THEN
                                            BEGIN
                                                grpObj := FInGroup(theObj);
                                                WHILE grpObj <> NIL DO
                                                    BEGIN
                                                        index := index + 1;
                                                        NumberOfObjs := index;
                                                        TheObjArray[index] := grpObj;
                                                        grpObj := NextObj(grpObj);
                                                    END;
                                            END {IF GetType(theObj) = 11}
                                        ELSE
                                            BEGIN
                                                index := index + 1;
                                                NumberOfObjs := index;
                                                TheObjArray[index] := theObj;
                                            END;
                                    END {IF (flipAcrossLayers OR (objLayer = ActLayer))}
                        
                            END; {IF (GetLVis(objLayer) = 0)}
                        theObj := NextSObj(theObj);
                    END; {WHILE (theObj <> NIL)}
                theLayer := NextLayer(theLayer);
            END; {WHILE theLayer <> NIL}
    END; {PROCEDURE FillSelectedArray}
    
{==================================================================}    
BEGIN
    SetUpDialog;
    DlgItemNum := RunLayoutDialog(Dialog,HandleDialog);
    IF DlgItemNum = 1 THEN
        BEGIN
            TheActiveLayer := GetLName(ActLayer);
            FillSelectedArray;
            DSelectObj(((L<>TheActiveLayer)));    
            DSelectAll;
            FOR Index := 1 TO NumberOfObjs DO
                DoFlip(TheObjArray[Index]);
            FOR Index := 1 TO NumberOfObjs DO
                BEGIN
                SetSelect(TheObjArray[Index]);
                ResetObject(TheObjArray[Index]);
                END;
        END; {IF (NOT DidCancel)}
        
    ClrMessage;
END;
RUN(RotateObjects);
{Script  ends here}

Share this post


Link to post

Thanks @Sam Jones.

 

I've tested it and it works, however it doesn't seem to want to behave on a template file we use all the time. No error message or anything just no change to selected objects. Any idea why that might be?

Share this post


Link to post

It shouldn't make a difference, but try to be sure that one of the selected objects is on the active layer.  Also send me the file and tell me what you are trying to rotate.

 

Share this post


Link to post

Thanks Sam. Will do tomorrow. It’s just a ‘blank’ file template with which the script doesn’t seem to work. The objects were definitely on the active layer.

Share this post


Link to post

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.


 

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.

×
×
  • Create New...