曲线（LINE,POLYLINE,SPLINE...)反向

marting · 发表于 2021-1-20 04:35:19

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;; ------------------------------------------------------------------------
;;; ReverseLines.lsp v1.1
;;;
;;; Copyright?03.18.10
;;; Alan J. Thompson (alanjt)
;;; a l a n j t AT g m a i l DOT c o m
;;;
;;; Permission to use, copy, modify, and distribute this software
;;; for any purpose and without fee is hereby granted, provided
;;; that the above copyright notice appears in all copies and
;;; that both that copyright notice and the limited warranty and
;;; restricted rights notice below appear in all supporting
;;; documentation.
;;;
;;; The following program(s) are provided "as is" and with all faults.
;;; Alan J. Thompson DOES NOT warrant that the operation of the program(s)
;;; will be uninterrupted and/or error free.
;;;
;;; Allows user to reverse direction of selected LWPolyline, Line and
;;; Spline objects.
;;;
;;; Revision History:
;;;
;;; v1.1 (03.19.10) 1. Went with entmod for LWPolyline instead of recreating (stupid).
;;; Thanks for the example Gile.
;;; 2. Switched from vla to entmod for Lines.
;;;
;;; ------------------------------------------------------------------------
(defun c:RL (/) (c:ReverseLines))
(defun c:ReverseLines (/ *error* _RevLWP #SS #Ent #Inc)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; error handler
(defun *error* (#Message)
(and *AcadDoc* (vla-endundomark *AcadDoc*))
(and #Message
(not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
(princ (strcat "\nError: " #Message))
) ;_ and
) ;_ defun
(setq _RevLWP (lambda (o / e l n)
(foreach x (setq e (entget o))
(if (vl-position (car x) '(10 40 41 42))
(setq l (cons x l))
(or (eq 210 (car x)) (setq n (cons x n)))
) ;_ if
) ;_ foreach
(setq l (append (cdddr l) (list (car l) (cadr l) (caddr l)))
n (reverse n)
) ;_ setq
(while l
(setq n (append n
(list (assoc 10 l)
(cons 40 (cdr (assoc 41 l)))
(cons 41 (cdr (assoc 40 l)))
(cons 42 (- (cdr (assoc 42 l))))
) ;_ list
) ;_ append
l (cddddr l)
) ;_ setq
) ;_ while
(entmod (append n (list (assoc 210 e))))
) ;_ lambda
) ;_ setq
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(vl-load-com)
(or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
(vla-startundomark *AcadDoc*)
(and (setq #SS (ssget "_:L" '((0 . "LINE,LWPOLYLINE,SPLINE"))))
(setq #Inc -1)
(while (setq #Ent (ssname #SS (setq #Inc (1+ #Inc))))
(cond
;; Line
((eq "LINE" (cdr (assoc 0 (entget #Ent))))
(entmod (mapcar '(lambda (x)
(cond ((eq 10 (car x)) (cons 11 (cdr x)))
((eq 11 (car x)) (cons 10 (cdr x)))
(T x)
) ;_ cond
) ;_ lambda
(entget #Ent)
) ;_ mapcar
) ;_ entmod
)
;; LWPolyline
((eq "LWPOLYLINE" (cdr (assoc 0 (entget #Ent)))) (_RevLWP #Ent))
;; SPLINE
((eq "SPLINE" (cdr (assoc 0 (entget #Ent)))) (vla-reverse (vlax-ename->vla-object #Ent)))
) ;_ cond
) ;_ foreach
) ;_ and
(*error* nil)
(princ)
) ;_ defun

;;; ------------------------------------------------------------------------ 
;;;        ReverseLines.lsp v1.1 
;;; 
;;;        Copyright?03.18.10 
;;;        Alan J. Thompson (alanjt) 
;;;        a l a n j t AT g m a i l DOT c o m 
;;; 
;;;        Permission to use, copy, modify, and distribute this software 
;;;        for any purpose and without fee is hereby granted, provided 
;;;        that the above copyright notice appears in all copies and 
;;;        that both that copyright notice and the limited warranty and 
;;;        restricted rights notice below appear in all supporting 
;;;        documentation. 
;;; 
;;;        The following program(s) are provided "as is" and with all faults. 
;;;        Alan J. Thompson DOES NOT warrant that the operation of the program(s) 
;;;        will be uninterrupted and/or error free. 
;;; 
;;;        Allows user to reverse direction of selected LWPolyline, Line and 
;;;        Spline objects. 
;;; 
;;;        Revision History: 
;;; 
;;;        v1.1 (03.19.10) 1. Went with entmod for LWPolyline instead of recreating (stupid). 
;;;                           Thanks for the example Gile. 
;;;                        2. Switched from vla to entmod for Lines. 
;;; 
;;; ------------------------------------------------------------------------ 
 
(defun c:RL (/) (c:ReverseLines)) 
(defun c:ReverseLines (/ *error* _RevLWP #SS #Ent #Inc) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; SUBROUTINES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
;;; error handler 
  (defun *error* (#Message) 
    (and *AcadDoc* (vla-endundomark *AcadDoc*)) 
    (and #Message 
         (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*")) 
         (princ (strcat "\nError: " #Message)) 
    ) ;_ and 
  ) ;_ defun 
 
  (setq _RevLWP (lambda (o / e l n) 
                  (foreach x (setq e (entget o)) 
                    (if (vl-position (car x) '(10 40 41 42)) 
                      (setq l (cons x l)) 
                      (or (eq 210 (car x)) (setq n (cons x n))) 
                    ) ;_ if 
                  ) ;_ foreach 
                  (setq l (append (cdddr l) (list (car l) (cadr l) (caddr l))) 
                        n (reverse n) 
                  ) ;_ setq 
                  (while l 
                    (setq n (append n 
                                    (list (assoc 10 l) 
                                          (cons 40 (cdr (assoc 41 l))) 
                                          (cons 41 (cdr (assoc 40 l))) 
                                          (cons 42 (- (cdr (assoc 42 l)))) 
                                    ) ;_ list 
                            ) ;_ append 
                          l (cddddr l) 
                    ) ;_ setq 
                  ) ;_ while 
                  (entmod (append n (list (assoc 210 e)))) 
                ) ;_ lambda 
  ) ;_ setq 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; MAIN ROUTINE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
  (vl-load-com) 
 
  (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))) 
  (vla-startundomark *AcadDoc*) 
 
  (and (setq #SS (ssget "_:L" '((0 . "LINE,LWPOLYLINE,SPLINE")))) 
       (setq #Inc -1) 
       (while (setq #Ent (ssname #SS (setq #Inc (1+ #Inc)))) 
         (cond 
           ;; Line 
           ((eq "LINE" (cdr (assoc 0 (entget #Ent)))) 
            (entmod (mapcar '(lambda (x) 
                               (cond ((eq 10 (car x)) (cons 11 (cdr x))) 
                                     ((eq 11 (car x)) (cons 10 (cdr x))) 
                                     (T x) 
                               ) ;_ cond 
                             ) ;_ lambda 
                            (entget #Ent) 
                    ) ;_ mapcar 
            ) ;_ entmod 
           ) 
           ;; LWPolyline 
           ((eq "LWPOLYLINE" (cdr (assoc 0 (entget #Ent)))) (_RevLWP #Ent)) 
           ;; SPLINE 
           ((eq "SPLINE" (cdr (assoc 0 (entget #Ent)))) (vla-reverse (vlax-ename->vla-object #Ent))) 
         ) ;_ cond 
       ) ;_ foreach 
  ) ;_ and 
  (*error* nil) 
  (princ) 
) ;_ defun

aisong220 · 发表于 2021-1-20 08:20:29

zero423 · 发表于 2021-1-21 10:33:54

跟大神学习学习!

qq1254582201 · 发表于 2021-1-21 19:33:06

好东西，要好好的收藏了

创佳 · 发表于 2021-4-4 13:34:05

你知道的太晚了

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

[每日一码] 曲线（LINE,POLYLINE,SPLINE...)反向

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。