![]() |
#1
|
|||
|
|||
![]()
Hi all!
Haven't been here for a loooong time, but made this super-simple little macro for a task and thought maybe it could come in handy to someone, it's kinda neat. What it does is it takes a bunch (or just one) of objects and then as you click it places a copy of a random object at a random angle. Here's an example: ![]() So you want to place those sea-things onto the water. Normally arranging them would be quite a chore, here you just select all the objects on top, start the macro, click like crazy, then press ESC to cancel the placement mode and get this: ![]() You can undo any placement or right click to move them mid-placement and, of course, change the positions after you are done placing. But it's a good start. Here's the code, I hope someone finds it useful: Code:
Sub ObPlacer() If ActiveSelection.Shapes.Count = 0 Then MsgBox "Please select at least one object.", vbOKOnly Exit Sub End If Dim X As Double, Y As Double Dim b As Boolean Dim s As Shape Dim Pool As ShapeRange Dim Count As Single, WhichOne As Single Set Pool = ActiveSelectionRange Count = Pool.Shapes.Count b = False While Not b b = ActiveDocument.GetUserClick(X, Y, 0, 10, False, cdrCursorSmallcrosshair) If Not b Then WhichOne = Int(Rnd * Count + 1) ActiveDocument.BeginCommandGroup ("Placed Object") Set s = Pool.Shapes(WhichOne).Duplicate(X - Pool.Shapes(WhichOne).CenterX, Y - Pool.Shapes(WhichOne).CenterY) s.Rotate (Rnd * 360) ActiveDocument.EndCommandGroup End If Wend End Sub Last edited by Joe; 18-05-2012 at 11:12. |
#2
|
|||
|
|||
![]()
Nifty idea. I'll have to see what I can do with this.
|
#3
|
|||
|
|||
![]()
Thanks, Sablesword
So it seemed like some options were missing and thus I have built a small GUI for the thing: ![]() With the new options you can set the range within which the objects are randomly turned and resized, and there's also an option for random flipping, thus enabling more natural placement of certain objects: ![]() The bottom panel lets you do similar things to objects already placed (nudge and rotate them) while the nodes option nudges the nodes of curve objects. There are no real error messages yet so be careful what objects you use it on - if it crashes with a non-curveable object it'll be stuck in the accelerated mode and won't redraw the screen (for now). Place the GMS in the usual directory and call ShowOrHideGUI Enjoy, feedback and suggestions welcome. |
#4
|
|||
|
|||
![]()
Never mind me, just adding more features as they come to mind:
![]() Orbit placement mode is the new thing in this revision. Best explained by example. So we have a barren little planet like this: ![]() And would like to place some alien vegetation on it: ![]() Using standard tools (or even the standard placement tools in this macro) it would take a while to position all these objects, but using the Orbit mode you just Select the vegetation objects, Push the button, Click in the middle of the planet and then Click around the perimeter. And get this: ![]() Enjoy, feedback and suggestions as always welcome. Last edited by Joe; 13-05-2012 at 04:47. |
#5
|
||||
|
||||
![]()
This is a great idea. I'll play with it a little and send some feedback.
__________________
Sean Waiting for a ride in the T.A.R.D.I.S. |
#6
|
|||
|
|||
![]()
It's not too easy, but I'm slowly getting the hang of the new WPF docker possibilities in X6 (thanks, Shelby!) so here is a taste of things to come:
![]() Once it's all working properly I'll try to post the docker as well. |
#8
|
|||
|
|||
![]()
Yeah, WPF is neat for sure, the only thing that I'm not too fond of is the implementing it in Corel part - the fact that you can't change the names easily, etc (Gotta make a new GUID for each name change if I understood that correctly and even then it seems to be fairly picky). Wish there was an easier way - like PS plugins, for example - just put the DLL in a folder, it's loaded and done.
|
#9
|
|||
|
|||
![]()
Well, continuing the tradition of adding more replies after my own replies (sorry), here's the latest + a chance to try out the thing (but only if you have X6...).
Anyhow, I'm attaching the DLL for the docker and you'll have to execute this VBA bit to (hopefully) add the docker to your X6. Then, in theory, you'll only have to replace the DLL as new versions come out. EDIT: Changed this code a bit, if it didn't work before, it should do now (tested on another machine). Code:
Sub addSelectionVB() Dim dockerAssembly As String dockerAssembly = "D:\YOUR PATH HERE\Placer.dll" Call FrameWork.AddDocker("EBA8171C-A6DD-402A-88F2-6F2ED70B6C9E", "Placer.Docker", dockerAssembly) Call FrameWork.CommandBars("Dockers").Controls.AddToggleButton("EBA8171C-A6DD-402A-88F2-6F2ED70B6C9E", 0, False) End Sub ![]() It's a tad big indeed. However, thanks to the magic of WPF it'll automatically scale to your window size (but anything under 768px vertically will be basically unreadable, though). So anyways, I am also including the little test CDR that lets you go from this: ![]() ...to this: ![]() In minutes. Here's a mini tutorial on how to do that (Things you do in the docker are In Blue): Select the houses, set Size Variance to 5 or so, no Angle Variance. Press Place Objects From Bottom and click on the bottom bit where you'd like to place a random house. The first click won't do anything since that takes you back to the CD workspace from the Docker. Press ESC when done. Now select all the trees, Set Size Variance to 20 or so, Angle Variance to 5 or so. Once again click away. If you don't like the object just do an Undo, you can also scroll and zoom in and out, no problem. Press ESC when done. Now all the trees are selected, Look at color options, set Hue Variance to 5 or so, Brightness variance to 10 and press Shift Colors. Now you can select the tiny doghouse and postbox and just use the same options as for the houses to place some in-between. Bam! You just made a small, somewhat natural town in minutes. To do the same for the planet select your objects, Pick Place in Outer Orbit, then click in the light circle to set the origin point and then click around the perimeter to place objects. Feel free to experiment with stronger Color values and placing LOTS of objects. Enjoy! Last edited by Joe; 28-05-2012 at 08:49. Reason: Removing Attachments due to plans for docker distribution |
#10
|
|||
|
|||
![]()
Alright, have been working a bit more on this, cleaned up the code, added a scrollbar and started using Virtualshapes so it's silly fast and smooth now.
The main change, though, is the inclusion of Origin points - you can now set one and the shapes will be placed in relation to that. Which is quite handy for all sorts of things. ![]() There are two side effects to this - since CorelDRAW remembers all the positions as you turn, flip or otherwise adjust you objects, it will only work properly with a non-transformed object. There's also a message box warning you about this and an override switch for those adventurous types. Curving, Welding or grouping objects will reset their transformations, so that's a good way to get good base objects. Now the second side effect - when you have 9 origin points to turn an object around the mathematical results are rather confusing, thus I have implemented a "Perceptive Angle Adjustment" system for the Orbit placement mode. What it does is adjust the angles according to certain logic. ![]() The perimeter of the imaginary circle becomes "ground" and thus whatever origin point you pick is going to stick to this " ground". If it's on the bottom it's going to be outside the perimeter, pick a side and it'll act as if that side is glued to the perimeter. And picking the top points lets you place objects inside the perimeter. Sounds complicated, quickly becomes clear as you play with the included test file. Well, hope to get some feedback and enjoy! Last edited by Joe; 28-05-2012 at 08:49. Reason: Removing Attachments due to plans for docker distribution |
![]() |
Tags |
objects, placement, vba |
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests) | |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Quick and easy way to removes empty lines of text | runflacruiser | Code Critique | 0 | 23-11-2010 14:37 |
Table scale and placement. Corel accuracy in question? | Morphevs | General | 2 | 18-11-2008 08:19 |
Dialog placement | ddonnahoe | CorelDRAW/Corel DESIGNER VBA | 2 | 17-06-2005 16:26 |
An Idea for a handy and easy to make macro | vallentin | Macros/Add-ons | 2 | 16-03-2004 12:35 |
newbie question but hopefully easy to answer. | cutter | CorelDRAW/Corel DESIGNER VBA | 0 | 05-11-2003 12:30 |