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 02-06-2008, 13:43
click101
Guest
 
Posts: n/a
Smile Delete matching objects

I am trying...and failing badly to write a script to delete matching objects in a file.
I have multiple rectangles of matching colors (cmyk) and/or size and I would like to delete these to use the rest of the parts of the file in another document.
Here is what I have so far...

Sub boxdelete()
Dim myRect As Shape
Dim ishape As Shape
Set myRect = ActiveShape 'must be selected

For Each ishape In ActiveLayer.Shapes
If Shape <> myRect Then
If (ishape.sizeX = myRect.sizeX) And ishape.Type = cdrRectangleShape Then
Delete.ishape
End If

End If
Next
myRect.Delete
End Sub

Any help would be greatly appreciated.
Reply With Quote
  #2  
Old 02-06-2008, 16:10
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 Try this...

Try something like this....
Code:
Sub boxdelete()
Dim myRect As Shape
Dim ishape As Shape
Set myRect = ActiveShape 'must be selected

For Each ishape In ActiveLayer.Shapes
If ishape.StaticID <> myRect.StaticID Then
If (ishape.SizeWidth = myRect.SizeWidth) And ishape.Type = cdrRectangleShape Then
ishape.Delete
End If

End If
Next
myRect.Delete
End Sub
-Shelby
Reply With Quote
  #3  
Old 02-06-2008, 16:14
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 Couple of suggestions....

I might just add them to a shaperange then delete the range....also comparing the shape.type to what you have selected will allow it to work for more shapes. In case you want to do the same thing to delete ellipses.
Code:
Sub LikeShapes()
    Dim sMyShape As Shape
    Dim s As Shape
    Dim sr As New ShapeRange
    
    Set sMyShape = ActiveShape
    
    For Each s In ActiveLayer.Shapes
        If s.StaticID <> sMyShape.StaticID Then
            If (s.SizeWidth = sMyShape.SizeWidth) And s.Type = sMyShape.Type Then
                sr.Add s
            End If
        End If
    Next s
    
    sr.Add sMyShape
    sr.Delete
End Sub
-Shelby
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
Find and delete objects with no fill or outline keytecstaff CorelDRAW/Corel DESIGNER VBA 17 22-06-2010 23:34
Trimming multiple objects in one swoop? jahmer General 1 17-11-2006 08:10
Stepping through objects, identifying attributes, storing data for later use Mitsu1 CorelDRAW/Corel DESIGNER VBA 6 08-11-2006 11:09
Glitches with Names of Objects Granite Golem CorelDRAW/Corel DESIGNER VBA 14 01-06-2005 03:38
I need to update objects visibility faster NEHovis Corel Photo-Paint VBA 0 18-07-2003 07:54


All times are GMT -5. The time now is 08:27.


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