谁有将多线段反向的程序

hang789 · 发表于 2006-3-17 10:11:00

谁有将多线段反向的程序，在这先谢过了！

zyc1992 · 发表于 2018-3-6 16:10:15

自带的reserve命令呀

ljpnb · 发表于 2006-3-17 21:33:00

论坛里有，你搜索一下。

hang789 · 发表于 2006-3-18 09:50:00

我只找到直线反向的，可多段线没有！

yfy2003 · 发表于 2006-3-23 00:04:00

以前明总帖的：

Sub RevPline()
      Dim ent As AcadEntity
      Dim pnt As Variant
      Dim NewCoord() As Double
      Dim i As Integer
      On Error Resume Next
      Do
          ThisDrawing.Utility.GetEntity ent, pnt, "选择多段线："
          If Err Then Exit Sub
          If TypeName(ent) Like "IAcad*Polyline" Then Exit Do
      Loop
      Dim Coord As Variant
      Dim CoordCount As Integer
      Dim Bulge() As Double
      If TypeName(ent) = "IAcadLWPolyline" Then
          Coord = ent.Coordinates
          CoordCount = (UBound(Coord) + 1) / 2
          ReDim NewCoord(UBound(Coord)) As Double
          For i = 0 To UBound(Coord) - 1 Step 2
              NewCoord(UBound(Coord) - i - 1) = Coord(i)
              NewCoord(UBound(Coord) - i) = Coord(i + 1)
          Next
          ReDim Bulge(CoordCount - 1) As Double
          For i = 0 To CoordCount - 1
              Bulge(i) = ent.GetBulge(i)
          Next
          ent.Coordinates = NewCoord
          For i = 0 To CoordCount - 2
              ent.SetBulge i, -Bulge(CoordCount - 2 - i)
          Next
          ThisDrawing.Regen acActiveViewport
      ElseIf TypeName(ent) = "IAcadPolyline" Then
          Coord = ent.Coordinates
          CoordCount = (UBound(Coord) + 1) / 3
          ReDim NewCoord(UBound(Coord)) As Double
          For i = 0 To UBound(Coord) - 1 Step 3
              NewCoord(UBound(Coord) - i - 2) = Coord(i)
              NewCoord(UBound(Coord) - i - 1) = Coord(i + 1)
              NewCoord(UBound(Coord) - i) = Coord(i + 2)
          Next
          If ent.Type = acSimplePoly Then
              ReDim Bulge(CoordCount - 1) As Double
              For i = 0 To CoordCount - 1
                  Bulge(i) = ent.GetBulge(i)
              Next
          End If
          ent.Coordinates = NewCoord
          If ent.Type = acSimplePoly Then
              For i = 0 To CoordCount - 2
                  ent.SetBulge i, -Bulge(CoordCount - 2 - i)
              Next
          End If
         ThisDrawing.Regen acActiveViewport
      End If

  End Sub

leeyuan · 发表于 2006-3-24 09:03:00

有没有lisp版得呢

龙龙仔 · 发表于 2006-3-24 16:57:00

;;By LUCAS(龙龙仔)
;;FOR LWPOLYLINE ONLY
(defun C:TEST (/ ENT ENT1 Q Q1 Q3 Q4 N)
(setq ENT (entget (setq ENT1 (car (entsel)))))
(setq Q (reverse (member (assoc 39 (reverse ENT)) (reverse ENT))))
(setq Q1 (member (assoc 10 ENT) ENT))
(setq N 0
Q3 NIL
)
(repeat (/ (- (length Q1) 1) 4)
(setq Q3 (append Q3
(list (nth N Q1)
(cons 42 (* -1 (cdr (nth (+ N 3) Q1))))
(cons 41 (cdr (nth (+ N 1) Q1)))
(cons 40 (cdr (nth (+ N 2) Q1)))
)
)
)
(setq N (+ N 4))
)
(setq Q3 (reverse Q3))
(entmake (append Q
(member (assoc 10 Q3) Q3)
(list (nth 0 Q3))
(list (nth 1 Q3))
(list (nth 2 Q3))
(list (last Q1))
)
)
(entdel ENT1)
(princ)
)

mycad · 发表于 2006-4-3 20:18:00

很好

ZHONGSHENG · 发表于 2006-7-31 21:34:00

顶

唐僧肉 · 发表于 2006-9-16 22:06:00

有没有先判断方向,若符合再反向的?

董堃 · 发表于 2008-5-7 23:29:00

下定了

账号		自动登录	找回密码
密码			注册