OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > Code Critique

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 02-01-2008, 13:33
m31uk3
Guest
 
Posts: n/a
Default Bug with existing selection

Hello I give the following code for review. However there is one thing I am aware of to start.

If the user has something selected it will cause undesired affects to random shapes within the document. And sometimes even crash CorelDraw.

Therefore I added the bugfix

Code:
        'Bug fix when a selection exists
    ActiveDocument.ClearSelection
I am using CorelDraw 13.0.0.576

Let me know if it is actually a bug or if I am being silly...

Code:
Sub KillnWeld()
    On Error Resume Next
    ActiveDocument.BeginCommandGroup "KillnWeld"
    Dim sr As New ShapeRange
    
        'Check all the shapes on the current page.
    If ActivePage.Shapes.count > 0 Then
        KillnWeldEx ActivePage.Shapes, sr
            'Report back what was welded.
        If sr.count > 0 Then
            MsgBox "Welded " & sr.count & " shapes.", vbInformation, "KillnWeld"
        Else
            MsgBox "No shapes to weld.", vbInformation, "KillnWeld"
        End If
    Else
        MsgBox "Please create 1 or more object(s).", vbExclamation, "KillnWeld"
    End If

    ActiveDocument.ClearSelection
    ActiveDocument.EndCommandGroup
End Sub

Private Sub KillnWeldEx(ss As Shapes, sr As ShapeRange)
    Dim s As Shape
    
        'Bug fix when a selection exists
    ActiveDocument.ClearSelection

    For Each s In ss
            'Check if group
        If s.Type = cdrGroupShape Then
                'If locked unlock.
            If s.Locked = True Then s.Locked = False
                'Null group name
            s.Name = ""
                'Loop all shapes in the group
            Nesting.KillnWeldEx s.Shapes, sr
        Else
                'If locked unlock.
            If s.Locked = True Then s.Locked = False
                'If shape has no fill and no outline delete.
            If s.Fill.Type = cdrNoFill And s.Outline.Type = cdrNoOutline Then
                s.Delete
                'If shape has fill process.
            ElseIf s.Fill.Type <> cdrNoFill Then
                    'If shape is text weld.
                If s.Type = cdrTextShape Then
                    Set s = s.Weld(s, False, False)
                    sr.Add s
                End If
            Else
                'Shape did not match warn and delete.
                s.Delete
                MsgBox "Bad shape found and deleted.", vbExclamation, "KillnWedEx"
            End If
        End If
    Next s
End Sub
Looking back over my code I am still thinking it would be good to understand the differences between Shapes and ShapeRanges.

For instance:

Does ActivePage.Shapes.All return a ShapeRange?

And how is ActivePage.Shapes different?

Thanks a million!

Last edited by m31uk3; 02-01-2008 at 13:38.
Reply With Quote
  #2  
Old 02-01-2008, 18:18
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

  1. please use X3 build 739
  2. a bug may be triggered by deleting shapes of which some are selected (just a wild guess)
  3. Shapes vs ShapeRange - post #7 here
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
FindShapes Selection irregularity Shaddy CorelDRAW/Corel DESIGNER VBA 2 18-07-2006 20:41
Rubber Selection d-signer New product ideas 2 22-11-2005 07:20
Re-Create existing Envelopes with Code Jadus CorelDRAW/Corel DESIGNER VBA 2 12-07-2005 21:22
activeselection cloning s_federici CorelDRAW/Corel DESIGNER VBA 2 05-11-2004 09:59
Selection of Text off-page D_Green CorelDRAW/Corel DESIGNER VBA 2 04-10-2003 16:34


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


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