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 08-09-2012, 14:29
vavalexus vavalexus is offline
Junior Member
 
Join Date: Sep 2012
Location: Ukraine
Posts: 5
Default Finding text that intersects the shape

Hi guys!

Spent all day for a simple task. Maybe if I were a VBA programmer it'd take me faster but unfortunately I'm not. So really looking forward for your help!
Here is the pic

I need to analyze all text for its intersections with a shape (if it touches the shape). If text intersects - say make it red (leave text inside shape untouched).
Since Shape.intersect(Text) also considers text inside shape as intersection it is no good.
What algorithm I have come to at the moment is:
  • Find intersections with "Intersect" command (thus I will have selection of intersecting the shape text objects and text inside the shape)
  • Create a copy of weld shape with previously found text objects (intersected and laying inside)
  • Compare perimeter of the initial shape and weld shapes created in previous step. If perimeters are not equal than the text objects that formed that weld objects are intersected so i make a selection.

I guess it is overly complicated algorithm and if there are few hundred objects it will take much time for it to finish. Maybe there is better solution?

I have Corel X3.

My code:
Layer "Stands" - with shapes
Layer "Names" - with objects (text) that are compared with shapes in "Stands" for intersection
Layer "Weld" and "Intersections" - are temporary layers
Layer "Mistakes" - here I put all intersecting text copies
I will add later checking for duplicates in "Mistakes with use of IsOnShape

Sub Find_overlaps() ' find objects touching shape by comparing perimeters

Dim doc As Document

Dim IntSel As New ShapeRange
Dim WeldSel As New ShapeRange
Dim MisSel As New ShapeRange

Dim sSelection As Shape
Dim s As Shape
Dim WeldS As Shape
Dim sIntersect As Shape
Dim Tgt As Shape

Dim AllShapes As ShapeRange
Dim TargetShapes As ShapeRange

Dim InitPerimeter As Long
Dim TgtPerimeter As Long

Dim i As Integer


'Optimization = True
ActiveDocument.BeginCommandGroup "touching find"

Set TargetShapes = ActivePage.Layers.Item("Stands").Shapes.All
For Each Tgt In TargetShapes ' cycle initial shapes
Tgt.CreateSelection
Set sSelectionR = Nothing
Set WeldSel = Nothing
Set MisSel = Nothing
Set sSelection = ActiveShape
InitPerimeter = CorelScript.GetCurveLength()

Set AllShapes = ActivePage.Layers.Item("Name").Shapes.All
For i = 1 To AllShapes.Count
Set sIntersect = AllShapes(i).Intersect(sSelection, True, True) 'Intersect each shape with the orginal selected shape
If Not sIntersect Is Nothing Then ' objects eather intersect or are inside, so lets weld it to compare their perimeter to initial one (we filter out objects outside shape so they won't be weld in the next step)
IntSel.Add sIntersect
sIntersect.MoveToLayer ActivePage.Layers("Intersections")

Set WeldS = sSelection.Weld(AllShapes(i), True, True)
If Not WeldS Is Nothing Then ' we have weld objects so lets count their perimeter
TgtPerimeter = CorelScript.GetCurveLength()
WeldSel.Add WeldS
WeldS.MoveToLayer ActivePage.Layers("Weld")

If InitPerimeter <> TgtPerimeter Then
'MsgBox AllShapes(i).Name
MisSel.Add AllShapes(i)

End If
End If
End If

Next i
WeldSel.Delete
IntSel.Delete
MisSel.CreateSelection
MisSel.CopyToLayer ActivePage.Layers("Mistakes")
ActivePage.Layers.Item("Mistakes").Shapes.All.CreateSelection
ActiveSelection.Fill.ApplyUniformFill CreateCMYKColor(0, 100, 100, 0)
ActiveDocument.ClearSelection
Next Tgt

ActiveDocument.EndCommandGroup
'Optimization = False
ActiveWindow.Refresh
Application.Refresh

End Sub

Last edited by vavalexus; 09-09-2012 at 02:37.
Reply With Quote
  #2  
Old 10-09-2012, 11:36
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

HI.
Check out this thread.
It works with shapes but is similar to waht you are attempting.

http://forum.oberonplace.com/showthread.php?t=7136

~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
Text in shape Olegych CorelDRAW/Corel DESIGNER VBA 2 01-10-2011 08:35
Curving text within a shape (as paragraph text) SallyS General 1 28-04-2011 22:03
Finding a text into a layer mateushenrico CorelDRAW/Corel DESIGNER VBA 3 10-09-2008 10:28
How to set margin of text inside shape? wOxxOm General 2 08-03-2006 03:42
Getting the center X on a text shape Rick Randall CorelDRAW/Corel DESIGNER VBA 4 03-08-2004 18:27


All times are GMT -5. The time now is 07:13.


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