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 IfEnd Function
