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 24-06-2011, 12:13
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default Not log or Un-log shape creation?

Hi.
How can I create multiple shapes using a loop and do events.

I do want to see the items created on the screen.

When esc is pressed only use the last shape that was generated in the loop.
All others generated while using the do event will not be recorded into undo list.
Therefore pressing undo would only delete this final shape and not all others generated in do events loop.

Such as virtual shapes?

~John
Reply With Quote
  #2  
Old 17-07-2011, 17:09
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Not log or Un-log shape creation?

Alright, the only issue I ran into was pressing the Esc key fast enough ;-) Because using VirtualShapes is so dang fast. So I simulate a keypress by just jumping out at a random number. If Esc (or in this case my random number) is not detected then I delete the shape and create a new one. Then I just log the final shape and you only get one undo. Hopefully it all makes sense.
Code:
Sub OptimizeVirtual()
    Dim i As Long, nStop As Long
    Dim x As Double, y As Double, r As Double
    Dim n As Long, num As Long
    Dim MaxX As Double, MaxY As Double, MaxR As Double
    Dim s As Shape
    
    MaxX = ActivePage.SizeWidth
    MaxY = ActivePage.SizeHeight
    MaxR = 1
    num = ActivePalette.ColorCount
    
    nStop = Rnd() * 100
    
    For i = 1 To 100
        x = Rnd() * MaxX
        y = Rnd() * MaxY
        r = Rnd() * MaxR
        n = CLng(Fix(Rnd() * num)) + 1
        Set s = ActiveVirtualLayer.CreateEllipse2(x, y, r)
        s.Fill.ApplyUniformFill ActivePalette.Color(n)
        
        If i = nStop Then 'Simulate Esc key press
            Exit For
        Else
            s.Delete
        End If
    Next i
    
    ActiveDocument.LogCreateShape s
    ActiveWindow.Refresh
End Sub
Hope that helps,

-Shelby
Reply With Quote
  #3  
Old 17-07-2011, 17:24
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

HI.
When I use it with this code I get a crash.
I guess I'm asking to much...lol

I changed this:
Code:
Set sLine = ActiveLayer.CreateLineSegment(x1, y1, x, y)
to:

Code:
Set sLine = ActiveVirtualLayer.CreateLineSegment(x1, y1, x, y)
and then try to log shape at end....


Here's the code:
Code:
Option Explicit
Public Type lpPoint
    x As Long
    y As Long
End Type
Public BC As Double, AC As Double, AB As Double
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Function GetCursorPos Lib "user32" (ByRef pos As lpPoint) As Boolean

Sub DrawLine()
    Dim p As lpPoint
    Dim curX As Double, curY As Double, start
    Dim s As Shape, l As Layer
    Dim bClick As Boolean, Shift&, x#, y#, i%, x1#, y1#
    Dim sLine As Shape
    
    On Error GoTo DrawGuideHorizontal_Error

    ActiveDocument.BeginCommandGroup "linemaker"
    bClick = False
    bClick = ActiveDocument.GetUserClick(x, y, Shift, 10, True, cdrCursorEyeDrop)
    If Not bClick Then
        x1 = x: y1 = y
    End If
    
    GetCursorPos p
    ActiveDocument.ActiveWindow.ScreenToDocument p.x, p.y, x, y
     
        Do While GetAsyncKeyState(vbKeyEscape) = 0
            
            DoEvents
            GetCursorPos p
            ActiveDocument.ActiveWindow.ScreenToDocument p.x, p.y, x, y
            If curX <> x Or curY <> y Then
                If Not sLine Is Nothing Then sLine.Delete
                Set sLine = ActiveVirtualLayer.CreateLineSegment(x1, y1, x, y)
            End If
            If GetAsyncKeyState(vbKeyRButton) Then Exit Sub
        Loop
        ActiveDocument.EndCommandGroup
   On Error GoTo 0
   Exit Sub

DrawGuideHorizontal_Error:

   ActiveDocument.EndCommandGroup
        
    End Sub
~John
Reply With Quote
  #4  
Old 17-07-2011, 17:39
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Line

Asking to much, never, you just need to take out the CommandGroup, since we will not be using it to hide the undos. Then clean up the code a bit add a Refresh or two and I think you will have your desired result.
Code:
Option Explicit

Public Type lpPoint
    x As Long
    y As Long
End Type
Public BC As Double, AC As Double, AB As Double
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Function GetCursorPos Lib "user32" (ByRef pos As lpPoint) As Boolean

Sub DrawLine()
     Dim p As lpPoint
     Dim curX As Double, curY As Double, start
     Dim s As Shape, l As Layer
     Dim bClick As Boolean, Shift&, x#, y#, i%, x1#, y1#
     Dim sLine As Shape
    
     bClick = False
     bClick = ActiveDocument.GetUserClick(x, y, Shift, 10, True, cdrCursorEyeDrop)
     If Not bClick Then
         x1 = x: y1 = y
     End If
     
     GetCursorPos p
     ActiveDocument.ActiveWindow.ScreenToDocument p.x, p.y, x, y
      
         Do While GetAsyncKeyState(vbKeyEscape) = 0
             DoEvents
             GetCursorPos p
             ActiveDocument.ActiveWindow.ScreenToDocument p.x, p.y, x, y
             If curX <> x Or curY <> y Then
                 If Not sLine Is Nothing Then sLine.Delete
                 Set sLine = ActiveVirtualLayer.CreateLineSegment(x1, y1, x, y)
             End If
             If GetAsyncKeyState(vbKeyRButton) Then Exit Do
             ActiveWindow.Refresh
         Loop
    
    ActiveDocument.LogCreateShape sLine
    ActiveWindow.Refresh
  End Sub
Hope that helps,

-Shelby
Reply With Quote
  #5  
Old 17-07-2011, 19:30
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Ah. Nice.
So the command group was causing the crash.
Thanks!
~John
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
Export creation of puzzle as a SWF Jean-Paul Grimaldi Jigsaw Puzzle Creator 1 16-01-2011 19:16
Changing selection when two-shape group loses one shape Joe CorelDRAW/Corel DESIGNER VBA 1 19-02-2009 03:50
Help - Creation of GMS - IVGGMSManager wOxxOm CorelDRAW/Corel DESIGNER VBA 6 02-07-2007 13:44
pdf file creation queries ozambersand General 0 12-05-2005 04:20
New document creation problem ddonnahoe CorelDRAW/Corel DESIGNER VBA 2 20-11-2004 01:26


All times are GMT -5. The time now is 05:14.


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