Breaking an arc into two arcs?

[Anonymous]

How do I break an arc into two arc's in VBA?
- In AutoCAD I would type (note is to do what I need)
Break
Then select the object
F
Select mid point of arc as first point
Select mid point of arc as second point
Done
- Name of arc is known within VBA code


Note - I need to achieve this in VBA without any user interaction.

[Anonymous]

I didn't test it but should give you an idea (or several) about how to proceed...

[pre]
Public Sub BreakArc()
Dim Center(0 To 2) As Double
Dim EndAngle As Double
Dim Entity As AcadEntity
Dim IncludedAngle As Double
Dim NewArc As AcadArc
Dim OriginalArc As AcadArc
Dim Radius As Double
Dim SelectionSet As AcadSelectionSet
Dim StartAngle As Double

On Error Resume Next
ThisDrawing.SelectionSets.Item("ARCS").Delete
On Error GoTo 0

Set SelectionSet = ThisDrawing.SelectionSets.Add("ARCS")
ThisDrawing.Utility.Prompt "Select the arc(s) to break..."
SelectionSet.SelectOnScreen

For Each Entity In SelectionSet
If TypeOf Entity Is AcadArc Then
Set OriginalArc = Entity
Radius = OriginalArc.Radius
Center(0) = OriginalArc.Center(0)
Center(1) = OriginalArc.Center(1)
Center(2) = OriginalArc.Center(2)

IncludedAngle = OriginalArc.EndAngle - OriginalArc.StartAngle
StartAngle = OriginalArc.StartAngle
EndAngle = (IncludedAngle / 2#) + StartAngle

Set NewArc = _
ThisDrawing.ModelSpace.AddArc(Center, Radius, StartAngle, EndAngle)
NewArc.Layer = OriginalArc.Layer
NewArc.lineType = OriginalArc.lineType
NewArc.color = OriginalArc.color
' etc.

StartAngle = EndAngle
EndAngle = (IncludedAngle / 2#) + StartAngle

Set NewArc = _
ThisDrawing.ModelSpace.AddArc(Center, Radius, StartAngle, EndAngle)
NewArc.Layer = OriginalArc.Layer
NewArc.lineType = OriginalArc.lineType
NewArc.color = OriginalArc.color
' etc.

OriginalArc.Delete
End If
Next Entity

ThisDrawing.SelectionSets.Item("ARCS").Delete
End Sub
[/pre]