|
|
发表于 2006-3-9 14:28:00
|
显示全部楼层
去掉一个顶点,闭合重生成
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 |
|
置顶卡
