[求助][编程申请]样条曲线如何反向?vba在源码
在论坛上搜索了一下 找到下面的源码 但是是多段线的,请帮帮我搞一个样条曲线的反向源码,谢谢!虽然简单的谢谢是多么的苍白无力,但我也只能这样了<br/><br/>多段线反向源码如下<br/>Sub RevPline()<br/> Dim ent As AcadEntity<br/> Dim pnt As Variant<br/> Dim NewCoord() As Double<br/> Dim i As Integer<br/> On Error Resume Next<br/> Do<br/> ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线:"<br/> If Err Then Exit Sub<br/> If TypeName(ent) Like "IAcad*Polyline" Then Exit Do<br/> Loop<br/> Dim Coord As Variant<br/> Dim CoordCount As Integer<br/> Dim Bulge() As Double<br/> If TypeName(ent) = "IAcadLWPolyline" Then<br/> Coord = ent.Coordinates<br/> CoordCount = (UBound(Coord) + 1) / 2<br/> ReDim NewCoord(UBound(Coord)) As Double<br/> For i = 0 To UBound(Coord) - 1 Step 2<br/> NewCoord(UBound(Coord) - i - 1) = Coord(i)<br/> NewCoord(UBound(Coord) - i) = Coord(i + 1)<br/> Next<br/> ReDim Bulge(CoordCount - 1) As Double<br/> For i = 0 To CoordCount - 1<br/> Bulge(i) = ent.GetBulge(i)<br/> Next<br/> ent.Coordinates = NewCoord<br/> For i = 0 To CoordCount - 2<br/> ent.SetBulge i, -Bulge(CoordCount - 2 - i)<br/> Next<br/> ThisDrawing.Regen acActiveViewport<br/> ElseIf TypeName(ent) = "IAcadPolyline" Then<br/> Coord = ent.Coordinates<br/> CoordCount = (UBound(Coord) + 1) / 3<br/> ReDim NewCoord(UBound(Coord)) As Double<br/> For i = 0 To UBound(Coord) - 1 Step 3<br/> NewCoord(UBound(Coord) - i - 2) = Coord(i)<br/> NewCoord(UBound(Coord) - i - 1) = Coord(i + 1)<br/> NewCoord(UBound(Coord) - i) = Coord(i + 2)<br/> Next<br/> If ent.Type = acSimplePoly Then<br/> ReDim Bulge(CoordCount - 1) As Double<br/> For i = 0 To CoordCount - 1<br/> Bulge(i) = ent.GetBulge(i)<br/> Next<br/> End If<br/> ent.Coordinates = NewCoord<br/> If ent.Type = acSimplePoly Then<br/> For i = 0 To CoordCount - 2<br/> ent.SetBulge i, -Bulge(CoordCount - 2 - i)<br/> Next<br/> End If<br/> ThisDrawing.Regen acActiveViewport<br/> End If<br/><br/> <br/>End Sub<br/> 对所有曲线都能使用就好了! 也为这问题挠头.
页:
[1]