Pat Stanford Posted December 22, 2007 Share Posted December 22, 2007 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); ============ 1 Quote Link to comment
islandmon Posted December 23, 2007 Share Posted December 23, 2007 Very concise , powerful , and clever script ... thnx ; ) Quote Link to comment
ccroft Posted December 23, 2007 Share Posted December 23, 2007 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 Quote Link to comment
Chris D Posted January 2, 2008 Share Posted January 2, 2008 Rotate or Scale Pat? Very useful. Do you have a Rotate one? Quote Link to comment
Pat Stanford Posted January 3, 2008 Author Share Posted January 3, 2008 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); ============== Quote Link to comment
Chris D Posted January 4, 2008 Share Posted January 4, 2008 Good work. Now this corresponds with the thread title. I've added these scripts to my workspace as menu commands. Quote Link to comment
Dexie Posted February 9, 2009 Share Posted February 9, 2009 Thanks for that. The help was much appreciated. Quote Link to comment
Pat Stanford Posted November 17, 2010 Author Share Posted November 17, 2010 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); 1 Quote Link to comment
Pat Stanford Posted November 17, 2010 Author Share Posted November 17, 2010 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); Quote Link to comment
MarcU Posted September 14, 2015 Share Posted September 14, 2015 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); Quote Link to comment
MarcU Posted September 14, 2015 Share Posted September 14, 2015 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); Quote Link to comment
MarcU Posted September 14, 2015 Share Posted September 14, 2015 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); Quote Link to comment
MarcU Posted September 14, 2015 Share Posted September 14, 2015 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); 1 Quote Link to comment
Pat Stanford Posted September 14, 2015 Author Share Posted September 14, 2015 Looks good. The attribution is fine. Glad you were able to work it out for yourself. That is the best way to learn. Quote Link to comment
kongdesignld Posted March 28, 2017 Share Posted March 28, 2017 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 Quote Link to comment
Robert J Posted February 25, 2020 Share Posted February 25, 2020 @Pat Stanford I know this is a old topic but I have tested script in 2020 and I noticed that VSEL criteria works better than SEL. Do you agree? Quote Link to comment
Pat Stanford Posted February 26, 2020 Author Share Posted February 26, 2020 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. 😉 Quote Link to comment
Sam Jones Posted February 29, 2020 Share Posted February 29, 2020 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} 1 Quote Link to comment
Pat Stanford Posted February 29, 2020 Author Share Posted February 29, 2020 Thanks Sam! Quote Link to comment
Boh Posted March 1, 2020 Share Posted March 1, 2020 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 Quote Link to comment
Sam Jones Posted March 1, 2020 Share Posted March 1, 2020 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. Quote Link to comment
Sam Jones Posted March 1, 2020 Share Posted March 1, 2020 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} Quote Link to comment
Boh Posted March 1, 2020 Share Posted March 1, 2020 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? Quote Link to comment
Sam Jones Posted March 2, 2020 Share Posted March 2, 2020 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. Quote Link to comment
Boh Posted March 2, 2020 Share Posted March 2, 2020 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. Quote Link to comment
Recommended Posts
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.