Autocad反转曲线方面

liukaimin

Sub reverse_sel()
    Dim ent_reverse As AcadObject
    Dim count_unreverse As Long
    Dim sel_set_reverse As AcadSelectionSet
   
    On Error Resume Next
    Set sel_set_reverse = ThisDrawing.SelectionSets.Item("reverse")
    sel_set_reverse.Delete
    Err.Clear
    Set sel_set_reverse = ThisDrawing.SelectionSets.Add("reverse")
    If Err Then Exit Sub
    On Error GoTo 0
    sel_set_reverse.SelectOnScreen
   
    For Each ent_reverse In sel_set_reverse
        Select Case ent_reverse.ObjectName
        Case "AcDbPolyline", "AcDbArc", "AcDbLine", "AcDbCircle"
            If reverse(ent_reverse) Then
                ent_reverse.Delete
            Else
                count_unreverse = count_unreverse + 1
            End If
        Case Else
            count_unreverse = count_unreverse + 1
        End Select
    Next
    ThisDrawing.Utility.Prompt vbCrLf & sel_set_reverse.Count - count_unreverse & "个对象被反转。"
    ThisDrawing.SendCommand Chr(27)
End Sub
Private Function reverse(ent_reverse As AcadObject) As Boolean
    Dim coordinates_old As Variant
    Dim coordinates_new() As Double
    Dim radius As Double
    Dim bound_up As Long
    Dim index As Long
    Dim color_ent As New AcadAcCmColor
    Dim ent_polyline As AcadLWPolyline
    Dim coordinate_start As Variant, coordinate_end As Variant, coordinate_center As Variant
    Dim arr_bulge() As Double
    Dim coord As Variant
    reverse = True
    Set color_ent = ent_reverse.TrueColor
    If ent_reverse.ObjectName = "AcDbPolyline" Then
        coordinates_old = ent_reverse.coordinates
        
        If ent_reverse.Closed Then
            bound_up = UBound(coordinates_old)
            ReDim Preserve coordinates_old(bound_up + 2)
            coordinates_old(bound_up + 1) = coordinates_old(0)
            coordinates_old(bound_up + 2) = coordinates_old(1)
        End If
        bound_up = UBound(coordinates_old)
        ReDim coordinates_new(LBound(coordinates_old) To bound_up) As Double
        For index = bound_up To 0 Step -2
            coordinates_new(bound_up - index) = coordinates_old(index - 1)
            coordinates_new(bound_up - index + 1) = coordinates_old(index)
        Next
        
        Set ent_polyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(coordinates_new)
        For index = 0 To bound_up - 3 Step 2
            ent_polyline.SetBulge (bound_up - 3 - index) / 2, -ent_reverse.GetBulge(Int(index / 2))
        Next
        
        ent_polyline.TrueColor = color_ent
        ent_polyline.Update
        Set ent_polyline = Nothing
    ElseIf ent_reverse.ObjectName = "AcDbLine" Then
        coordinate_start = ent_reverse.StartPoint
        coordinate_end = ent_reverse.EndPoint
        ReDim coordinates_new(0 To 3) As Double
        coordinates_new(0) = coordinate_end(0)
        coordinates_new(1) = coordinate_end(1)
        coordinates_new(2) = coordinate_start(0)
        coordinates_new(3) = coordinate_start(1)
        
        Set ent_polyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(coordinates_new)
        
        ent_polyline.TrueColor = color_ent
        Set ent_polyline = Nothing
    ElseIf ent_reverse.ObjectName = "AcDbArc" Then
        coordinate_start = ent_reverse.StartPoint
        coordinate_end = ent_reverse.EndPoint
        ReDim coordinates_new(0 To 3) As Double
        coordinates_new(0) = coordinate_end(0)
        coordinates_new(1) = coordinate_end(1)
        coordinates_new(2) = coordinate_start(0)
        coordinates_new(3) = coordinate_start(1)
        
        Set ent_polyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(coordinates_new)
        ent_polyline.SetBulge 0, -Tan(ent_reverse.TotalAngle / 4)
        
        ent_polyline.TrueColor = color_ent
        Set ent_polyline = Nothing
    ElseIf ent_reverse.ObjectName = "AcDbCircle" Then
        coordinate_center = ent_reverse.Center
        radius = ent_reverse.radius
        ReDim coordinates_new(0 To 3) As Double
        coordinates_new(0) = coordinate_center(0) + radius
        coordinates_new(1) = coordinate_center(1)
        coordinates_new(2) = coordinate_center(0) - radius
        coordinates_new(3) = coordinate_center(1)
        
        Set ent_polyline = ThisDrawing.ModelSpace.AddLightWeightPolyline(coordinates_new)
        ent_polyline.Closed = True
        ent_polyline.SetBulge 0, -1
        ent_polyline.SetBulge 1, -1
        
        ent_polyline.TrueColor = color_ent
        Set ent_polyline = Nothing
    Else
        reverse = False
    End If
End Function