Get the Center Point of Selected Arc

[Anonymous]

Hello All,

I'm writing a script to mirror a line off of an arc. I'm having troubles finding a way to automatically identify a mirror line, (presumably one that would go from the arc's edge to its center point). The way the code works right now is that a user must select the center point to define the line over which the line will be mirrored.

Sub PLINEMIRROR()

    Dim rayLine As AcadLWPolyline
    Dim perpLine As AcadLWPolyline
    Dim Points(0 To 3) As Double
    Dim pt1 As Variant
    Dim pt2 As Variant
    Dim mirrorObj As AcadLWPolyline
    
    'Allows user to define ray points
    pt1 = ThisDrawing.Utility.GetPoint(, "Pick Point to Begin Line:")
    pt2 = ThisDrawing.Utility.GetPoint(pt1, "Pick Trace Start Point:")
    
    'Stores pt Variant values to Points Double values.
    Points(0) = pt1(0)
    Points(1) = pt1(1)
    Points(2) = pt2(0)
    Points(3) = pt2(1)
    
    'Creates PLine object "rayLine"
    Set rayLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
    
    focCtr = ThisDrawing.Utility.GetPoint(, "Choose Focal Center of Curve")
    
    Set mirrorObj = rayLine.Mirror(pt2, focCtr)

End Sub

Essentially what I want to happen is for focCtr to be found automatically upon selection of pt2.

I've been playing around with some solutions that I've found on other forums, but have had no luck. The most promising piece of code that I've found is this: 

Sub ss()
Dim ss As AcadSelectionSet
Dim obj As AcadObject
Dim oArc As AcadArc

Set ss = ThisDrawing.SelectionSets.Add("ss1")
ss.SelectOnScreen
For Each obj In ss
If TypeOf obj Is AcadArc Then
Set oArc = obj
Debug.Print oLine.StartPoint(0)
End If
Next
ss.Delete
End Sub

However, the AcadArc object doesn't have a GetCenter property like the AcadCircle object.

[Ed__Jobe · Accepted solution]

Yes, the Arc object has a Center property. Here is a modification of the code sample for the GetEntity method

    ' Begin the selection
    Dim returnObj As AcadObject
    Dim basePnt As Variant
    
    On Error Resume Next
    
    ' The following example waits for a selection from the user
RETRY:
    ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an arc object"
    If returnObj Is Typeof AcadArc then
      focCtr = returnObj.Center
    Else
      Goto RETRY
    End If
'Put the rest of the error handler here.

[Anonymous]

Thank you, this worked like a charm.

[norman.yuan]

Well, if you have obtained an AcadArc object, you should know its StartPoint, EndPoint and its Radius. Now to get the arc's center points becomes pure math calculating.

Hint: the distance from the center point to either start or end point is equal (radius). Assume start point is at x1, y1; end point is at x2, y2, and the center is at x3, y3. Then

(x3-x1)(x3-x1) + (y3-y1)(y3-y1) = r*r

(x3-x2)(x3-x2) + (y3-y2)(y3-y2) = r*r

You have 2 equations and 2 unknown values (x3 and y3), do the math.

Another simpler way: use Arc's StartAngle/EndAngle and StartPoint/EndPoint to calculate the center point.

[Anonymous]

Is there a way to use pt2 (presuming it is on the arc) to be the selection point? In other words, the entire process would only take two clicks, one to start the polyline, then the endpoint of the polyline (pt2). This would allow me to omit the "select an arc" step because it would have been inherently selected by the user.

[Ed__Jobe]

What about working the other way around. Select the arc, then use it's center point as the start point of your line, then pick the end point.

[Anonymous]

The line can't be started from the center of the arc. We're using this to look at reflection paths off of an arc from an arbitrary starting point, in this case the small circle.

From a user standpoint it makes more sense to start from the source (small circle) and go to the arc you would like to reflect off of. When the first line is created (pt1 to pt2) I am wondering if there might be a way to use pt2 as the point of selection on the arc.

I realized you can't do that with the .GetEntity property because it requests user input. In order to get around this, I tried to piece this together, which is leading to errors: 

Sub SelectCenter()

'    Dim ssetObj As AcadSelectionSet
'    Set ssetObj = ThisDrawing.SelectionSets.Add("TEST_SSET1")
'
'    Dim gpCode(0) As Integer
'    Dim dataValue(0) As Variant
'    gpCode(0) = 0
'    dataValue(0) = "Circle"
'
'    Dim groupCode As Variant, dataCode As Variant
'    groupCode = gpCode
'    dataCode = dataValue
'
'    ssetObj.SelectAtPoint pt2, groupCode, dataCode
'
'    Dim returnObj As AcadObject
'    returnObj = ssetObj
'    If TypeOf returnObj Is AcadArc Then
'    focCtr = returnObj.Center
'
'    End If
'
'
End Sub

I very much appreciate your help. 

[Ed__Jobe]

What are the errors? Could it be a problem with the following?

Dim returnObj As AcadObject
'    returnObj = ssetObj 'returnObj is now an ss
'    If TypeOf returnObj Is AcadArc Then 'You need to iterate the items in an ss, which should already be
an arc, because you filtered it. BTW, your filter was for a circle, not an arc.
'    focCtr = returnObj.Center

[Anonymous]

The error reads the following: "Run-time error '-2147024809 (80070057)': Invalid argument Point in SelectAtPoint." I think this is due to pt2. I've made it a Public variable, and it is still a Variant type.

If I run the code again, I get this error: "Run-time error '-2145320851 (8021006d)': The named selection set exists."

PS. Thank you for pointing out the Arc v. Circle dataCode. I have corrected that, and have the same errors.

[Ed__Jobe]

pt2 doesn't need to be Public if its used in the same sub. The point argument for the SelectAtPoint method requires a three-element array of doubles. Make sure you're not supplying a 2-element array. Creating a named selectionset errors because one already exists. Use the following function to return a new selectionset.

Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping necessary for when you want to create a
' selection set. It takes the proposed name and either adds it to the selectionsets
' collection or sets it.
    On Error Resume Next
    Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName)
    If Err.Number <> 0 Then
        Set AddSelectionSet = ThisDrawing.SelectionSets.Item(SetName)
        AddSelectionSet.Clear
    End If
End Function

[Anonymous]

Okay, so I'm no longer getting the selection set error that I was getting, however I am getting a type mismatch error (error code 13) on the line " AddSelectionSet("TEST_SSET1").SelectAtPoint pt2, groupCode, dataCode "

I've checked the pt2 values and it is indeed an array 3-element array with the last value being 0.

[Ed__Jobe]

Post the whole sub you have so far.

[Anonymous]

Note that I have AddSelectionSet and SelectCenter in a module, and I've defined the few variables as public at the top so I can access them in different sub methods.

Public focCtr As Variant
Public pt1 As Variant
Public pt2 As Variant
---------------------
Sub PLINEMIRROR()

    Dim rayLine As AcadLWPolyline
    Dim perpLine As AcadLWPolyline
    Dim Points(0 To 3) As Double
    Dim mirrorObj As AcadLWPolyline
    
    'Allows user to define ray points
    pt1 = ThisDrawing.Utility.GetPoint(, "Pick Point to Begin Line:")
    pt2 = ThisDrawing.Utility.GetPoint(pt1, "Pick Trace Start Point:")

    'Stores pt Variant values to Points Double values.
    Points(0) = pt1(0)
    Points(1) = pt1(1)
    Points(2) = pt2(0)
    Points(3) = pt2(1)
    
    'Creates PLine object "rayLine"
    Set rayLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(Points)
    
    Call SelectCenter
    
    Set mirrorObj = rayLine.Mirror(pt2, focCtr)

End Sub

-------------
Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping necessary for when you want to create a
' selection set. It takes the proposed name and either adds it to the selectionsets
' collection or sets it.
    On Error Resume Next
    Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName)
    If Err.Number <> 0 Then
        Set AddSelectionSet = ThisDrawing.SelectionSets.Item(SetName)
        AddSelectionSet.Clear
    End If
End Function

----------------
Sub SelectCenter()

    AddSelectionSet ("TEST_SSET1")

    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    gpCode(0) = 0
    dataValue(0) = "Arc"

    Dim groupCode As Variant, dataCode As Variant
    groupCode = gpCode
    dataCode = dataValue

    AddSelectionSet("TEST_SSET1").SelectAtPoint pt2, groupCode, dataCode

    Dim returnObj As AcadObject
    Set returnObj = AddSelectionSet("TEST_SSET1")
    
    If TypeOf returnObj Is AcadArc Then
        
        focCtr = returnObj.Center

    End If

End Sub

[Ed__Jobe]

I'm kinda busy this morning, but a couple of suggestions. You didn't fix any of the errors I mentioned regarding your SelectCenter sub. Any errors not handled by a subroutine will bubble up to the parent calling it. Also, rather than declaring Public vars at Project scope, I would make them arguments to the SelectCenter sub and declare the sub As Variant. Set SelectCenter to return the center point. Sort of like this

returnPT = SelectCenter(pt2)

sub SelectCenter (pt2 As Variant) As Variant

   SelectCenter = CircleObj.Center

end sub