Breaking an arc into two arcs?

Discussion in 'AutoCAD' started by MarkEv, Apr 7, 2004.

  1. MarkEv

    MarkEv Guest

    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.
     
    MarkEv, Apr 7, 2004
    #1
  2. MarkEv

    Jackrabbit Guest

    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]
     
    Jackrabbit, Apr 9, 2004
    #2
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.