谁有将多线段反向的程序

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 N0
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

下定了

页: [1] 2

明经CAD社区's Archiver

谁有将多线段反向的程序