Jump to content

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
Link to comment

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

Link to comment
  • 2 weeks later...

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);

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

Link to comment
  • 1 year later...
  • 1 year later...

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
Link to comment

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);

Link to comment
  • 4 years later...

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);

Link to comment

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);

Link to comment

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);

Link to comment

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);

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

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

 

 

Link to comment

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
Link to comment

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}

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