OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 22-04-2017, 07:50
dungbtl's Avatar
dungbtl dungbtl is offline
Senior Member
 
Join Date: Apr 2004
Posts: 138
Default 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?

Last edited by dungbtl; 23-04-2017 at 05:10.
Reply With Quote
  #2  
Old 25-04-2017, 05:37
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

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

Last edited by shark; 25-04-2017 at 05:39.
Reply With Quote
  #3  
Old 27-04-2017, 04:50
dungbtl's Avatar
dungbtl dungbtl is offline
Senior Member
 
Join Date: Apr 2004
Posts: 138
Default

Thanks shark but doesnt do anything, Compile Error.

Isnt the code partial?
Reply With Quote
  #4  
Old 28-04-2017, 02:58
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default

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
Reply With Quote
  #5  
Old 11-05-2017, 05:39
dungbtl's Avatar
dungbtl dungbtl is offline
Senior Member
 
Join Date: Apr 2004
Posts: 138
Default

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!

Reply With Quote
  #6  
Old 12-05-2017, 06:28
shark shark is offline
Senior Member
 
Join Date: Aug 2010
Location: Russia, Belgorod
Posts: 145
Default 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?

Last edited by shark; 12-05-2017 at 06:45.
Reply With Quote
  #7  
Old 13-05-2017, 10:21
dungbtl's Avatar
dungbtl dungbtl is offline
Senior Member
 
Join Date: Apr 2004
Posts: 138
Default

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
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
How to select shape of same width & height using CQL and not selecting groupshape aakkaarr CorelDRAW/Corel DESIGNER VBA 3 19-09-2011 09:44
macro add a page after (exact height and width)currently active page buga Macros/Add-ons 1 20-01-2011 05:42
How do I get Text Width and Height in TextOnPath ljesus7 CorelDRAW/Corel DESIGNER VBA 0 15-03-2009 22:28
How do I get font width and height? ljesus7 CorelDRAW/Corel DESIGNER VBA 1 14-03-2009 02:31
get the OrigSelection's width and height zxy050 CorelDRAW/Corel DESIGNER VBA 2 28-12-2007 05:48


All times are GMT -5. The time now is 19:46.


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