OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Copy another objects Height or Width (http://forum.oberonplace.com/showthread.php?t=24790)

dungbtl 22-04-2017 07:50

Copy another objects Height or Width
 
Any code for copying another objects Width OR Height?
Either one but not both, not proportional.
So I guess 8 code snippets? Just difining which direction.

I have at least over a 100+ shortcuts so a few more
isnt going to hurt.

Im thinking maybe I could use Alt+Shift along with
QWE/ASD/ZXC to resemble the normal sizing grid.
Skip S, wont work or maybe that could match same size height/width?

Sometimes grabbing the handle bar and drag to snap is a PITA
so a shortcut would be a helluva lot faster.

I would assume you need to select the desired object to change size,
invoke shortcut then cursor turns to an arrow,
next would be to choose the "sized" object to match in length/height.

Is this possible?

shark 25-04-2017 05:37

I think you can use ActiveDocument.GetUserClick. 3rd parameter returns ShiftState, i.e. whether the keys Ctrl, Shift and Alt are pressed.
Code:

b = ActiveDocument.GetUserClick(x, y, Shift, 10, False, 31)
If Not b Then
  With ActivePage.SelectShapesAtPoint(x, y, SelectUnfilled:=True)
        If .Shapes.Count = 0 Then Beep: Exit Sub
        Set s = .Shapes(.Shapes.Count)
    End With
    s.GetBoundinBox x, y, w, h
    If (Shift And 1) = 1 Then 'set Width only
    elseIf (Shift And 2) = 2 Then ' set Height only
    else 'set same width/height


dungbtl 27-04-2017 04:50

Thanks shark but doesnt do anything, Compile Error.

Isnt the code partial?

shark 28-04-2017 02:58

Here is ready macro, works with Ctrl/Shift/without
Code:

Private Sub CopyWH()
Dim s As Shape, cs As Shape, w#, h#, b As Boolean, Shift&
    Set cs = ActiveShape: If cs Is Nothing Then Exit Sub
    b = ActiveDocument.GetUserClick(w, h, Shift, -1, True, 309)
    If Not b Then
        With ActivePage.SelectShapesAtPoint(w, h, SelectUnfilled:=True)
            If .Shapes.Count = 0 Then Beep: Exit Sub
            Set s = .Shapes(.Shapes.Count)
        End With
        s.GetSize w, h
        If (Shift And 1) = 1 Then
            cs.SetSize w
        ElseIf (Shift And 2) = 2 Then
            cs.SetSize , h
        Else
            cs.SetSize w, h
        End If
    End If
End Sub


dungbtl 11-05-2017 05:39

Oh man Shark.... sorry for the late reply. Very Bizzie.

Thanks for this... need some time to digest it though.

Any way to get it to remove Proportionate sizing?

Otherwise it's working good.

So its either the Height & No Width (CTRL) or Width & No Height (Shift)
Obviously nothing pressed is same size as selected.

Sorry for the PITA questions.

How could I get it to size from the side I select?
If I select the Right side of an object, how to size the new objects
width to go left? Or select Bottom to go up? Etc Etc Etc
for all sides. Possible?

Lol... i played around with the code, tried this/that.
I have no clue nor time to understand it. Some is easy
to figure out. Errors aren't.

Thanks again for your troubles!

;)

shark 12-05-2017 06:28

Remove proportional sizing
 
Code:

Private Sub CopyWH()
Dim s As Shape, cs As Shape, w#, w1#, h#, h1#, b As Boolean, Shift&
    Set cs = ActiveShape: If cs Is Nothing Then Exit Sub
    cs.GetSize w1, h1  'get source size
    b = ActiveDocument.GetUserClick(w, h, Shift, -1, True, 309)
    If Not b Then
        With ActivePage.SelectShapesAtPoint(w, h, SelectUnfilled:=True)
            If .Shapes.Count = 0 Then Beep: Exit Sub
            Set s = .Shapes(.Shapes.Count)
        End With
        s.GetSize w, h
        If (Shift And 1) = 1 Then
            cs.SetSize w, h1  'apply new width and old height
        ElseIf (Shift And 2) = 2 Then
            cs.SetSize w1, h  'apply old width and new height
        Else
            cs.SetSize w, h
        End If
    End If
End Sub

Quote:

If I select the Right side of an object
You mean - select two nodes on right side?

dungbtl 13-05-2017 10:21

Forget that.... This is ideal!! Works for me.
Dont need to get more complicated.

What about multiple objects... is that a shaperange?

I'll draw up what I was referring to in a few.

Thnaks


All times are GMT -5. The time now is 02:28.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com