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 20-08-2006, 12:44
Booker
Guest
 
Posts: n/a
Thumbs up selectSmallObjects ....

selectSmallObjects

selectSmallObjects - when you trace bitmap in CorelTRACE there are many small insignifacant objects, you may delete them using this macro, specifying minimum size in mm

Possible you can share this w0xx0m ???

If so... any chance of doing this in Inches also?

Thanx!
Reply With Quote
  #2  
Old 20-08-2006, 16:56
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

not at pc now. google for "selectsmallobjects woxxom" - it was published on some .ru site
Reply With Quote
  #3  
Old 20-08-2006, 18:21
Booker
Guest
 
Posts: n/a
Thumbs up

Nice one w0xx...

works plentyful!
Reply With Quote
  #4  
Old 24-08-2006, 14:03
superdeluxe
Guest
 
Posts: n/a
Default

Can't seem to find it. Any suggestions as to where exactly I might look?

thanks
Reply With Quote
  #5  
Old 24-08-2006, 14:16
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

now at last I've got time to visit my PC, so here is the code source (to make it work with "option excplicit" some declarations should be added otherwise comment out "opt.expl.")

Code:
Sub selectSmallObjects()
Dim sr As New ShapeRange, sh As Shape, source As ShapeRange, stat As AppStatus
   On Error Resume Next
   maxsize = CDbl(InputBox("Size limit (mm)" & vbCr & "[negative value = immediate delete]", "Select SMALL objects", "1"))
   If maxsize = 0 Then Beep: Exit Sub
   Delete = maxsize < 0: maxsize = Abs(maxsize)
   
   Optimization = True
   EventsEnabled = False
   ActiveDocument.PreserveSelection = False
   If Delete Then ActiveDocument.BeginCommandGroup "DELETE small objects"
   
   i = 0:  Set stat = Application.Status:  stat.BeginProgress CanAbort:=True
   saveUnit = ActiveDocument.unit:   ActiveDocument.unit = cdrMillimeter
   Set source = ActiveSelectionRange: cnt = source.Count:
   If cnt = 0 Then Set source = ActivePage.shapes.All: cnt = source.Count
   If cnt = 0 Then Beep: Exit Sub

   For Each sh In source
      i = i + 1: stat.Progress = Round(i / cnt * 100): If stat.Aborted Then Exit For
      If sh.SizeHeight <= maxsize And sh.SizeWidth <= maxsize Then sr.Add sh
   Next sh

   stat.EndProgress
   ActiveDocument.unit = saveUnit: ActiveDocument.ClearSelection

   If Delete Then sr.Delete Else ActiveDocument.AddToSelection sr

   ActiveDocument.PreserveSelection = True
   EventsEnabled = True
   Optimization = False
   Application.CorelScript.RedrawScreen
   If delete Then ActiveDocument.EndCommandGroup
End Sub
Reply With Quote
  #6  
Old 24-08-2006, 15:37
superdeluxe
Guest
 
Posts: n/a
Default

Awesome -

I set up cnc files for a sign shop and you just saved me hours of pointless scrolling and selecting.

I'm going home early today!

thanks!
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


All times are GMT -5. The time now is 04:30.


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