去掉一个顶点,闭合重生成
Sub tt1() Dim ent1 As AcadLWPolyline, ent2 As AcadLWPolyline, pnt, p Dim s As Double, e As Double ThisDrawing.Utility.GetEntity ent1, pnt p = ent1.Coordinates ReDim Preserve p(UBound(p) - 2) Set ent2 = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) ent2.Closed = True For i = 0 To (UBound(ent1.Coordinates) - 1) / 2 - 1 ent1.GetWidth i, s, e ent2.SetWidth i, s, e ent2.SetBulge i, ent1.GetBulge(i) Next ent2.Layer = ent1.Layer ent1.Delete End Sub
|