#1




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 
#2




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 Shelby 
#3




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 
#4




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 
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)  
Thread Tools  Search this Thread 
Display Modes  


Similar Threads  
Thread  Thread Starter  Forum  Replies  Last Post 
Oberon Fit Objects To Path  Alex  Other Oberon Commercial Products  11  28062012 11:55 
Problem using "GetUserClick" with Snap?  Jon Lorber  CorelDRAW/Corel DESIGNER VBA  3  12062006 11:47 
New macro: Oberon Calendar Wizard 4.0  Alex  Site News  0  18112003 02:03 
I need to update objects visibility faster  NEHovis  Corel PhotoPaint VBA  0  18072003 07:54 