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 04-09-2006, 14:47
dgearl
Guest
 
Posts: n/a
Default Snap to Objects in Oberon ThreePointArc Macro

Is there a way to make the Oberon ThreePointArc macro snap to objects?
I have snap to objects turned on in the View menu.
I tried changing the snap parameter in the GetUserClick method to true but that did not seem to work.
Thanks, David
Reply With Quote
  #2  
Old 04-09-2006, 19:50
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 10
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 Three Point Arc

I think it is working, it just doesn't provide the visual feedback. You can rem the sr.delete line in the ExitSub: and this will leave the circles it is using to create the arc. All mine were snapped to their proper locations. If you want to be 100% that they are snapped you can use the manual version. It works by creating three circles, seleting them and running the script. The arce is then drawn with the three circle you have created. I have also added undo to this code. Place it in the same modul as the create arc so it can use the atan2 function. Here is that code:
Code:
Sub ManualThreePointArc()

Dim sr As ShapeRange, s As Shape
Dim bFail As Boolean
Dim bx As Double, cx As Double, dx As Double
Dim by As Double, cy As Double, dy As Double
Dim t As Double, bc As Double, cd As Double
Dim x As Double, y As Double
Dim a1 As Double, a2 As Double, a3 As Double
Dim det As Double

ActiveDocument.BeginCommandGroup "Manual Three Point Arc"
On Error GoTo ErrHandler
Optimization = True
    
Set sr = ActiveSelectionRange
bFail = False

If sr.Count = 3 Then
    For Each s In sr
        If s.Type <> cdrEllipseShape Then
            bFail = True
            Exit For
        End If
    Next s
Else
    bFail = True
End If

If bFail Then
    MsgBox "Please select 3 circles to define the 3 points", vbCritical
    Optimization = False
    Exit Sub
End If

sr(1).Ellipse.GetCenterPosition bx, by
sr(2).Ellipse.GetCenterPosition cx, cy
sr(3).Ellipse.GetCenterPosition dx, dy
t = cx * cx + cy * cy
bc = (bx * bx + by * by - t) / 2
cd = (t - dx * dx - dy * dy) / 2
det = (bx - cx) * (cy - dy) - (cx - dx) * (by - cy)

If Abs(det) < 0.0000001 Then
    MsgBox "Cannot draw a circle through these 3 points", vbCritical
    Exit Sub
End If

det = 1 / det
x = (bc * (cy - dy) - cd * (by - cy)) * det
y = ((bx - cx) * cd - (cx - dx) * bc) * det
t = Sqr((x - bx) * (x - bx) + (y - by) * (y - by))
a1 = atan2(y - by, bx - x)
a2 = atan2(y - cy, cx - x)
a3 = atan2(y - dy, dx - x)
bc = a2 - a1
cd = a3 - a1
If bc < 0 Then bc = bc + 360
If cd < 0 Then cd = cd + 360
If bc > cd Then det = a1: a1 = a3: a3 = det
ActiveLayer.CreateEllipse2 x, y, t, , a1, a3

ExitSub:
    sr.Delete
    ActiveDocument.EndCommandGroup
    Optimization = False
    ActiveDocument.ClearSelection
    ActiveWindow.Refresh
    Exit Sub
    
ErrHandler:
    MsgBox "Unexpected error occured: " & Err.Description & " [" & Err.Number & "]", vbCritical, "Error"
    Resume ExitSub

End Sub
Hope it helps,
Shelby
Reply With Quote
  #3  
Old 05-09-2006, 11:58
dgearl
Guest
 
Posts: n/a
Default Display snaps for ThreePointArc macro

Shelby, thanks for taking the time to look at this. As you said, changing the GetUserClick snap parameter to True does snap to objects but does not display the snap points. I have found the following workaround does display the snap points:
1. Select all objects that you want to snap to.
2. Run the ThreePointArc macro.
3. Hold down the CTRL key while snapping to three points on the arc. The snap points are displayed correctly.
I am not sure why this works but it solves my problem.
Thanks again, David
Reply With Quote
  #4  
Old 05-09-2006, 12:58
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 10
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 Makes Sense

OK the makes Sense. Holding the control key suppresses the creation of the circles, with I bet throws off the visual feedback. Glad you figured it out, and I will have to file that one in the old memory banks.

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
Oberon Fit Objects To Path Alex Other Oberon Commercial Products 11 28-06-2012 11:55
Problem using "GetUserClick" with Snap? Jon Lorber CorelDRAW/Corel DESIGNER VBA 3 12-06-2006 11:47
New macro: Oberon Calendar Wizard 4.0 Alex Site News 0 18-11-2003 02:03
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 15:54.


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