[ xin lisp ] đổi chiều đối tượng ( đường cong , thẳng , gấp khúc )

Tháng 10 23, 2012

e đang gặp phải một số vấn đề phải đổi chiều đối tượng . là cung tròn , SPL , PL

e đã tìm trên diễn đàn nhưng không thấy . chỉ có đổi chiều PL .

nên e post bài này để xin lisp giải quyết dc vấn đề này .

thank các anh .

Tháng 10 24, 2012

hic . ko ai giúp e à

Tháng 10 24, 2012

Hỏi nhỏ bạn tí: đổi chiều đối tượng để làm gì vậy (vì tôi chưa gặp)?

Bạn hãy liệt kê tất cả các kiểu đối tượng cần đổi chiều (vì mỗi kiểu mỗi khác nhau).

Dạo này nhiều lisper đang bận nên chưa giúp được. Nếu ngày mai không có ai giúp thì tôi sẽ ráng vậy.

Tháng 10 24, 2012

Hỏi nhỏ bạn tí: đổi chiều đối tượng để làm gì vậy (vì tôi chưa gặp)?

Bạn hãy liệt kê tất cả các kiểu đối tượng cần đổi chiều (vì mỗi kiểu mỗi khác nhau).

Dạo này nhiều lisper đang bận nên chưa giúp được. Nếu ngày mai không có ai giúp thì tôi sẽ ráng vậy.

1) Khi lập trình với các đối tượng dạng đường thì chiều của các đối tượng này là yếu tố quan trọng cần được xét đến. Nó ảnh hưởng trực tiếp đến kết quả xử lý. Ví dụ đơn giản: khi bạn cần tính diện tích của 1 hình pline kín bang cách sử dung danh sách đỉnh của nó. khi đó chiều của pline sẽ ảnh hưởng đến kết quả diện tích. 2) Khi vẽ các đối tượng đường sử dung các linetype có thể phân biệt chiều của chúng bang mắt thường. nếu không thuận chiều thì nảy sinh nhu cầu đổi chiều là lẽ đương nhiên. Ví dụ linetype kiểu này: -->--->--->--- sẽ có lúc cần được vẽ ra kiểu này --<---<---<---. Mình tin là mình đang múa rìu qua mắt thợ. 1 người có khả năng lập trình như bạn chắc sẽ hiểu quá rõ 2 điều mình nói trên. chỉ là chưa hiểu vì sao bạn lại đặt câu hỏi cho chủ topic thôi. Trên mạng có 1 lisp giúp đổi chiều hầu hết mọi đối tượng. bạn chủ topic thử google xem

Tháng 10 24, 2012

e đang gặp phải một số vấn đề phải đổi chiều đối tượng . là cung tròn , SPL , PL

e đã tìm trên diễn đàn nhưng không thấy . chỉ có đổi chiều PL .

nên e post bài này để xin lisp giải quyết dc vấn đề này .

thank các anh .

"Viết" k đến 5s :

https://www.google.com.vn/search?q=reverse+spline+lisp&oq=reverse+spline+lisp&sugexp=chrome,mod=0&sourceid=chrome&ie=UTF-8

Tháng 10 24, 2012

Mình tin là mình đang múa rìu qua mắt thợ. 1 người có khả năng lập trình như bạn chắc sẽ hiểu quá rõ 2 điều mình nói trên. chỉ là chưa hiểu vì sao bạn lại đặt câu hỏi cho chủ topic thôi.

Doan Van Ha, on Hôm nay, 08:02 PM, said:

Hỏi nhỏ bạn tí: đổi chiều đối tượng để làm gì vậy (vì tôi chưa gặp)?

Tháng 10 25, 2012

Mình cũng đang cần 1 lisp như thế này. Cái này ứng dụng khi làm cấp thoát nước này, VD: cần đổi chiều của hướng thoát nước

Tháng 10 25, 2012

nhiều khi vẽ thoát nước hoặc line có text mình phải đổi chiều để text quay đúng chiều bản vẽ , đấy là lý do em xin cái này bác à . và một số vấn đề khi e vẽ cần phải đổi chiều bác à.

Tháng 10 25, 2012

Lisp đổi chiều đối tượng (sưu tầm).

;|
REVERSE - Reverses line, arc, circle, ellipse, spline, polyline, text,
  		hatch pattern, or gradient fill.

  Reverses all line, arc, circle, ellipse, spline, polyline, and
  lightweight polyline entities.

  Circles, arcs, and ellipses are converted to polylines; other objects
  retain their respective entity type.  Circles and circular arcs are
  rendered as heavyweight polylines if the system variable plinetype = 0,
  or lightweight polylines if plinetype > 0.  Ellipses and elliptical
  arcs are rendered as high-resolution, curve-fit polylines with up to 64
  exact vertices and tangents.

  Reverses all text entities including single-line text, attributes,
  multiline text, dimension text, and remote text.  Fonts with leading or
  trailing white space, and text styles with upside down, backward, or
  vertical effects are fully supported.

  Rotates all hatch patterns 90° counterclockwise.  Rotates all gradient
  fills 180°. Solid fills are ignored.

  Single-line text, multiline text, attributes, hatch patterns, and
  gradient fills may be reversed within blocks.  All other block components
  are ignored.  Nested blocks are not supported.

  Preserves color, layer, linetype, linetype scale, plot style, lineweight,
  thickness, elevation, global width, and text style properties.  Preserves
  circular, quadratic, and cubic fitting.  Preserves vertex bulge, segment
  width, and vertex tangent.

Copyright(c)2005-2011 Version 3.0(US)
  Tom Davis (tdavis@metzgerwillard.com)

Revision History:

  08/19/10 - Added support for hatch patterns and gradient fills.
  01/27/10 - Removed references.
             See http://www.metzgerwillard.us/tdavis/lisp/reverse.html
  11/06/08 - Updated reference links.
  09/21/08 - Updated reference links.
  02/15/08 - Updated email address.
  09/09/07 - Added underscores for international language support.
  08/26/07 - Added support for mtext with exact line spacing; single-
             line text fonts with leading or trailing white space; and
             upside down, backward, and vertical text effects.
  08/05/07 - Modified to select objects with nentsel instead of entsel;
             extended support to all text objects in block references
             including attributes and dimension text.
  10/05/05 - Added limited dimension text support.
  09/22/05 - Added support for single-line text, multiline text, and
             remote text.
  09/17/05 - First release with initial support for all line, arc,
             circle, ellipse, spline, and polyline entities.
|;
;------------------------------------------------------------------------------
(defun c:reverse ( / oldecho oldsnap ent e etyp)
 ;reverse text, line, arc, circle, ellipse, spline, or polyline
 (setq oldecho (getvar "cmdecho")
       oldsnap (getvar "osmode")
 )
 (setvar "cmdecho" 0)                                   		;turn off echo
 (if (< oldsnap 16384) (setvar "osmode" (+ oldsnap 16384))) 	;turn off osnap
 (command "_select" "")                                 		;deselect all
 (while (setq ent (nentsel "\nSelect reversible object: "))
   (setq e    (car ent)
         etyp (cdr (assoc 0 (entget e)))
   )
   ;exclude block components that are neither text nor hatching
   (if (or (< (length ent) 4)(= etyp "TEXT")(= etyp "MTEXT")(= etyp "HATCH"))
     (progn
       (while (= (cdr (assoc 0 (entget e))) "VERTEX")   		;skip vertices
         (setq e (entnext e))
       )
       (if (= (cdr (assoc 0 (entget e))) "SEQEND")              ;get hwpolyline
         (setq e (cdr (assoc -2 (entget e))))           		;    or ellipse
       )
       (setq etyp (cdr (assoc 0 (entget e))))
       (princ etyp)
       (command "_undo" "_begin")
       (cond
         ((= etyp "LWPOLYLINE")(revlwpline e))
         ((= etyp "POLYLINE")  (revhwpline e))
         ((= etyp "LINE")      (revline    e))
         ((= etyp "ARC")   	(revarc 	e))
         ((= etyp "CIRCLE")    (revcircle  e))
         ((= etyp "HATCH") 	(revhatch   e))
         ((= etyp "ELLIPSE")   (revellipse e))
         ((= etyp "MTEXT") 	(revmtext   e))
         ((= etyp "TEXT")      (revtext    e etyp))
         ((= etyp "ATTRIB")    (revtext    e etyp) (entupd e))
         ((= etyp "RTEXT") 	(revrtext   e))
         ((= etyp "SPLINE")    (command "_splinedit" e "_e" ""))
       )
       (if (> (length ent) 3)(entupd (car (cadddr ent))))   	;block text
                                                        		;or hatching
       (command "_undo" "_end")
     )
     (princ "INSERT")
   )
 )
 (setvar "cmdecho" oldecho)
 (setvar "osmode"  oldsnap)
 (princ)
)
;------------------------------------------------------------------------------
;LWPOLYLINE

(defun revlwpline (e / footer done vertices header flag)
 ;reverse lightweight polyline
 (foreach item (reverse (entget e))
   (cond
     ((not done)
       (cond
         ((= (car item) 40)
           (setq footer (cons (cons 41 (cdr item)) footer)      ;swap width
                 done t
           )
         )
         ((= (car item) 41)
           (setq footer (cons (cons 40 (cdr item)) footer)) 	;swap width
         )
         ((= (car item) 42)
           (setq footer (cons (cons 42 (- (cdr item))) footer)) ;negate bulge
         )
         ((= (car item) 210)
           (setq footer (cons item footer))
         )
       )
     )
     ((= (car item) 10)
       (setq vertices (cons item vertices))
     )
     ((= (car item) 40)
       (setq vertices (cons (cons 41 (cdr item)) vertices)) 	;swap width
     )
     ((= (car item) 41)
       (setq vertices (cons (cons 40 (cdr item)) vertices)) 	;swap width
     )
     ((= (car item) 42)
       (setq vertices (cons (cons 42 (- (cdr item))) vertices)) ;negate bulge
     )
     (t (setq header (cons item header)))
   )
 )
 (setq flag (assoc 70 header))
 (if (< (cdr flag) 128)         		;turn on linetype generation
   (setq header (subst (cons 70 (+ (cdr flag) 128)) flag header))
 )
 (entmod (append header (reverse vertices) footer))
)
;------------------------------------------------------------------------------
;POLYLINE

(defun revhwpline (e / oldname old ent1 buldge end start ent tangent radians
              		vertex vertices flag)
 ;reverse heavyweight polyline
 (setq oldname  e
       old   (entget oldname)
       e 	(entnext e)
       ent1  (entget e)         		;get first vertex
       bulge (cdr (assoc 42 ent1))
       end   (cdr (assoc 41 ent1))
       start (cdr (assoc 40 ent1))
       e 	(entnext e)
       ent   (entget e)         		;get second vertex
 )
 (while (= (cdr (assoc 0 ent)) "VERTEX")
   (if (= (logand (cdr (assoc 70 ent)) 2) 2)
     (setq tangent (assoc 50 ent)
           radians (- (cdr tangent) pi) ;reverse tangent
           ent 	(subst (cons 50 radians) tangent ent)
     )
   )
   (setq vertex   (subst (cons 42 (- bulge))(assoc 42 ent) ent)    ;negate bulge
         vertex   (subst (cons 41 start)    (assoc 41 ent) vertex) ;swap width
         vertex   (subst (cons 40 end)      (assoc 40 ent) vertex) ;swap width
         bulge    (cdr  (assoc 42 ent))
         end      (cdr  (assoc 41 ent))
         start    (cdr  (assoc 40 ent))
         vertices (cons vertex vertices)
         e        (entnext e)
         ent      (entget e)            ;get next vertex or seqend
   )
 )
 (setq flag (assoc 70 old))
 (if (< (cdr flag) 128)         		;turn on linetype generation
   (setq old (subst (cons 70 (+ (cdr flag) 128)) flag old))
 )
 (entmake old)                          ;make new polyline
 (foreach ent vertices (entmake ent))   ;make new vertices
 (if (= (logand (cdr (assoc 70 ent1)) 2) 2)
   (setq tangent (assoc 50 ent1)
         radians (- (cdr tangent) pi)   ;reverse tangent
         ent1    (subst (cons 50 radians) tangent ent1)
   )
 )
 (setq ent1 (subst (cons 42 (- bulge))(assoc 42 ent1) ent1) ;negate bulge
       ent1 (subst (cons 41 start)    (assoc 41 ent1) ent1) ;swap width
       ent1 (subst (cons 40 end)      (assoc 40 ent1) ent1) ;swap width
 )
 (entmake ent1)                 		;make last new vertex
 (entmake ent)                          ;make new seqend
 (entdel oldname)               		;delete old polyline
)
;------------------------------------------------------------------------------
;LINE

(defun revline (e / ent start end)
 ;reverse line
 (setq ent   (entget e)
       start (assoc 10 ent)
       end   (assoc 11 ent)     		;swap line endpoints
       ent   (subst (cons 10 (cdr end)) start ent)
       ent   (subst (cons 11 (cdr start)) end ent)
 )
 (entmod ent)
)
;------------------------------------------------------------------------------
;ARC

(defun revarc (e)
 ;reverse arc
 (command "_pedit" e "_y" "_l" "_on" "");turn arc into polyline
 (setq e (entlast))
 (if (> (getvar "plinetype") 0)
   (revlwpline e)
   (revhwpline e)
 )
)
;------------------------------------------------------------------------------
;CIRCLE

(defun revcircle (e / ent radius center pt1 pt2)
 ;reverse circle
 (setq ent    (entget e)
       radius (cdr (assoc 40 ent))
       center (cdr (assoc 10 ent))
       pt1    (mapcar '+ center (list radius 0 0))
       pt2    (mapcar '- center (list radius 0 0))
 )
 (command "_break" e pt1 pt2)                ;turn circle into semicircle
 (command "_pedit" e "_y" "_l" "_on" "_c" "");turn semicircle into closed polyline
 (setq e (entlast))
 (if (> (getvar "plinetype") 0)
   (revlwpline e)
   (revhwpline e)
 )
)
;------------------------------------------------------------------------------
;HATCH

(defun revhatch (e / ent solid item ang pi2 new y)
 ;reverse hatch
 (setq ent   (entget e)
       solid (cdr (assoc 70 ent))           		;solid fill flag
       pi2   (* 2 pi)
 )
 (cond
   ((= solid 0)                             		;pattern fill
     (foreach item (reverse ent)
       (cond
         ((or (= (car item) 52) (= (car item) 53))  ;pattern or line angle
           (setq ang (+ (* pi 0.5) (cdr item))) 	;rotate 90°
           (if (>= ang pi2) (setq ang (- ang pi2))) ;normalize angle
           (setq new (cons (cons (car item) ang) new))
         )
         ((or (= (car item) 43) (= (car item) 45))  ;line origin or offset x
           ;rotate line origin or offset 90°: new y = old x; new x = - old y
           (setq new (cons (cons (1+ (car item)) (cdr item)) new)
                 new (cons (cons (car item) (- y)) new))
         )
         ((or (= (car item) 44) (= (car item) 46))  ;line origin or offset y
           (setq y (cdr item))
         )
         (t (setq new (cons item new)))
       )
     )
     (entmod new)
   )
   ((= solid 1)                             		;solid fill
     (if (= (cdr (assoc 450 ent)) 1)                ;gradient fill
       (progn
         (setq item (assoc 460 ent)         		;gradient angle
               ang  (+ pi (cdr item))       		;rotate 180°
         )
         (if (>= ang pi2) (setq ang (- ang pi2)))   ;normalize angle
         (setq ent (subst (cons 460 ang) item ent))
         (entmod ent)
       )
     )
   )
 )
)
;------------------------------------------------------------------------------
;RTEXT

(defun revrtext (e / ent ins w h rot ang hd vd new)
 ;reverse rtext
 (command "_explode" e)                 		;explode rtext into mtext
 (setq ent  (entget (entlast))                  ;get mtext
       w    (cdr (assoc 42 ent))                ;width
       h    (cdr (assoc 43 ent))                ;height
 )
 (command "_undo" 1)
 (setq ent  (entget e)                          ;get rtext
       ins  (assoc 10 ent)                      ;insertion point
       rot  (assoc 50 ent)                      ;rotation
       ang  (cdr rot)
       hd   (polar '(0 0 0)    ang   		w) ;horizontal displacement
       vd   (polar '(0 0 0) (- ang (/ pi 2)) h) ;vertical displacement
       new  (mapcar '+ (cdr ins) hd vd) 		;new insertion point
       ang  (rem (+ ang pi) (* 2 pi))   		;normalize angle
       ent  (subst (cons 50 ang) rot ent)   	;reverse direction
       ent  (subst (cons 10 new) ins ent)   	;set new insertion point
 )
 (entmod ent)
)
;------------------------------------------------------------------------------
;TEXT or ATTRIB

(defun revtext (e etyp / vc ent box hj vj rot ang p1 p2 h w
                		dist phi hd vd new gf gfs sn p s done)
 ;reverse text or attribute
 (if (= etyp "TEXT")
   (setq vc 73) ;text
   (setq vc 74) ;attribute
 )
 (setq ent (entget e)
       box (textbox ent)                              ;((x1 y1 z1)(x2 y2 z2))
       gf  (cdr (assoc 71 ent))               		;generation flag
       sn  (cdr (assoc  7 ent))               		;style name
       hj  (cdr (assoc 72 ent))               		;horizontal justification
       vj  (cdr (assoc vc ent))               		;vertical justification
       rot (assoc 50 ent)                     		;rotation
       ang (cdr rot)                                  ;angle
       p1  (assoc 10 ent)                     		;first  alignment point
       p2  (assoc 11 ent)                     		;second alignment point
       h   (cdr (assoc 40 ent))               		;displacement height
       p   1                                          ;rewind pointer
 )
 (while (not done)                      ;traverse style table
   (setq s   (tblnext "Style" p)
         p   nil                        ;reset pointer
   )
   (if (= sn (cdr (assoc 2 s))) 		;find style name
     (progn
       (setq done t
             gfs  (cdr (assoc 71 s))    ;style generation flag
       )
       (if (= (logand (cdr (assoc 70 s)) 4) 4)
         (setq gf (1+ gf))              ;vertical
       )
     )
   )
 )
 (if  (= gfs (logand gf gfs)) ;exclude conflicting generation flags
   (progn
     (cond                                            ;displacement width
       ((= hj 0)                        ;left
         (setq w (+ (caadr box) (caar box)))
       )
       (t                       		;otherwise
         (setq dist (distance (cdr p1) (cdr p2))
               phi  (angle    (cdr p1) (cdr p2))
               dist (abs (* dist (cos (- phi ang))))
         )
         (if (= (logand gf 2) 2) (setq dist (- dist)))   	;backward
         (if (or (= hj 5) (= hj 3))
           (setq w (-(+ (caar box) (caadr box))      dist))  ;fit or aligned
           (setq w (-(+ (caar box) (caadr box)) (* 2 dist))) ;right, center, middle
         )
       )
     )
     (if (= vj 1)               		;bottom
       (setq dist (distance (cdr p1) (cdr p2))
             phi  (angle    (cdr p1) (cdr p2))
             dist (abs(* dist (sin (- phi ang)))) 	;descender depth
             h    (+ h (* 2 dist))
       )
     )
     (if (= (logand gf 1) 1)            ;vertical
       (cond
         ((or (> hj 2) (= hj 1))                      ;center,aligned,middle,fit
           (setq h 0)
         )
         (t                                   		;otherwise
           (setq h (- (cadadr box) (cadar box)))
           (if (= (+ hj vj) 0) (setq h (- h)))        ;baseline left
           (cond
             ((and (= hj 0) (> vj 0)) (setq vj 3))    ;bottom,middle,top left
             ((= hj 2) (setq vj 0))           		;right
           )
         )
       )
     )
     (if (= (logand gf 4) 4) (setq h (- h)))          ;upside down
     (setq hd   (polar '(0 0 0)    ang   		w)   ;horizontal displacement
           vd   (polar '(0 0 0) (+ ang (/ pi 2)) h)   ;vertical displacement
     )
     (cond                              ;compute new alignment point
       ((or (and (= vj 0) (= hj 1)) 	;center
    		(and (= vj 0) (= hj 2)) 	;right
    		(= vj 1))           		;bottom
         (setq new (mapcar '+ (cdr p2) hd vd))
       )
       ((or (= vj 2) (= hj 4))          ;middle
         (setq new (mapcar '+ (cdr p2) hd))
       )
       ((= vj 3)                        ;top
         (setq new (mapcar '+ (cdr p2) hd)
               new (mapcar '- new vd)
         )
       )
     )
     (cond
       ((= (+ hj vj) 0)         		;left
         (setq new (mapcar '+ (cdr p1) hd vd)
               ent (subst (cons 10 new) p1 ent) 		;set new alignment point
               ent (subst (cons 50 (+ ang pi)) rot ent) ;reverse direction
         )
       )
       ((or (= hj 5) (= hj 3))          ;fit or aligned
         (setq new (mapcar '+ (cdr p2) vd hd)
               ent (subst (cons 10 new) p1 ent) 		;swap alignment points
               new (mapcar '+ (cdr p1) vd hd)
               ent (subst (cons 11 new) p2 ent)
         )
       )
       (t
         (setq ent (subst (cons 11 new) p2 ent) 		;set new alignment point
               ent (subst (cons 50 (+ ang pi)) rot ent) ;reverse direction
         )
       )
     )
     (entmod ent)
   )
   (alert (strcat "The selected text object is not compatible with\n"
          		"its text style.  When the text style is upside\n"
          		"down or backwards, the text object should also    \n"
          		"be upside down or backwards."))
 )
)
;------------------------------------------------------------------------------
;MTEXT (including dimension text)

(defun revmtext (e / ent ins w h just lss ls ch rot hd vd new)
 ;reverse mtext or dimension text
 (setq ent  (entget e)
       ins  (assoc 10 ent)              ;insertion point
       w    (cdr (assoc 42 ent))        ;width
       h    (cdr (assoc 43 ent))        ;displacement height
       just (cdr (assoc 71 ent))        ;justification
       rot  (assoc 50 ent)              ;rotation
       lss  (cdr (assoc 73 ent))        ;line spacing style
       ch   (cdr (assoc 40 ent))        ;character height
       ls   (/ ch 3)                    ;interline half-space
  	;ls = (5 ch/3 - ch)/2 = ch/3
 )
 (cond
   ((and (= lss 2) (> just 6))          ;exact bottom
     (setq h (+ h ls))
   )
   ((and (= lss 2) (< just 4))          ;exact top
     (setq h (- h ls))
   )
   ((= lss 2)                   		;exact middle
     (setq h ls)
   )
   ((and (> just 3) (< just 7)) 		;at least middle
     (setq h 0)
   )
 )
 (setq hd   (polar '(0 0 0)    (cdr rot)   		w) ;horizontal displacement
       vd   (polar '(0 0 0) (- (cdr rot) (/ pi 2)) h) ;vertical displacement
 )
 (cond                                  ;compute new insertion point
   ((= just 1)                          ;top left
     (setq new (mapcar '+ (cdr ins) hd vd))
   )
   ((= just 2)                          ;top center
     (setq new (mapcar '+ (cdr ins) vd))
   )
   ((= just 3)                          ;top right
     (setq new (mapcar '- (cdr ins) hd)
           new (mapcar '+ new vd)
     )
   )
   ((= just 4)                          ;middle left
     (setq new (mapcar '+ (cdr ins) hd)
           new (mapcar '- new vd)
     )
   )
   ((= just 5)                          ;middle center
     (setq new (mapcar '- (cdr ins) vd))
   )
   ((= just 6)                          ;middle right
     (setq new (mapcar '- (cdr ins) hd vd))
   )
   ((= just 7)                          ;bottom left
     (setq new (mapcar '+ (cdr ins) hd)
           new (mapcar '- new vd)
     )
   )
   ((= just 8)                          ;bottom center
     (setq new (mapcar '- (cdr ins) vd))
   )
   ((= just 9)                          ;bottom right
     (setq new (mapcar '- (cdr ins) hd vd))
   )
 )
 (setq ent (subst (cons 10 new) ins ent)              ;set new insertion point
       ent (subst (cons 50 (+ (cdr rot) pi)) rot ent) ;reverse direction
 )
 (entmod ent)
)
;------------------------------------------------------------------------------
;ELLIPSE

(defun revellipse (e / old oldent center p1 ratio start end major a b rot
              		minor inc tol 2pi i j phi closed p tan ent flag)
 ;reverse ellipse
 (setq old    e
       oldent (entget old)
       center (cdr (assoc 10 oldent))
       p1 	(cdr (assoc 11 oldent))
       ratio  (cdr (assoc 40 oldent))
       start  (cdr (assoc 41 oldent))
       end    (cdr (assoc 42 oldent))
       major  (mapcar '+ center p1)
       a      (distance center major)
       b      (* ratio a)
       rot    (angle center major)
       minor  (polar center (+ rot (/ pi 2)) B)
 )
 (setq inc 64                   		;number of vertices on full ellipse
       tol 1e-5                 		;closure tolerance
       2pi (* 2 pi)
       i   (1+ (fix (+ (* (/ inc 2pi) start) 0.5))) ;start index
       j   	(fix (+ (* (/ inc 2pi)   end) 0.5))  ;end index
       phi (list start)
 )
 (while (< i j)                 		;build parameter list
   (setq phi (cons (* (/ 2pi inc) i) phi)
         i   (1+ i)
   )
 )
 (if (and (< start tol) (< (abs (- end 2pi)) tol))
   (setq closed t)
   (setq closed nil
         phi    (cons end phi)
   )
 )
 ;parametric ellipse in object coordinate system
 ;  x = a cos(q);  y = b sin(q);  r = b/a
 ;  dx/dq = -a sin(q);  dy/dq = b cos(q)
 ;  dy/dx = -b/a cot(q) = -r^2 x/y
 ;  tangent direction = atan(dy/dx)

 (setq p   (mapcar '(lambda (q) 		;compute OCS points on ellipse
              		(list (* a (cos q)) (* b (sin q)))
            		)
            		phi
           )
       tan (mapcar '(lambda (q) 		;compute WCS tangent directions
              		(+ (atan (* (- (expt ratio 2)) (car q)) (cadr q)) rot)
            		)
            		p
           )
 )
 (command "_ucs" "_n" 3 center major minor) 		;create OCS
 (setq p (mapcar '(lambda (q)(trans q 1 0)) p)) 	;transform from OCS to WCS
 (command "_ucs" "_p")                              ;restore UCS
 (command "_pline")
 (mapcar 'command p)
 (command "")
 (command "_matchprop" old (entlast) "")
 (if closed
   (command "_pedit" (entlast) "_l" "_on" "_c" "_f" "");force hwpline creation
   (command "_pedit" (entlast) "_l" "_on"      "_f" "")
 )
 (setq e   (entnext (entlast))
       ent (entget e)           		;get first vertex
       i   0
 )
 (while (= (cdr (assoc 0 ent)) "VERTEX")
   (setq flag (assoc 70 ent))
   (if (/= (logand (cdr flag) 1) 1) 	;skip curve fitting vertices
     (progn                     		;set tangent and flag bit
       (setq ent (subst (cons 50 (nth i tan)) (assoc 50 ent) ent)
             i   (1+ i)
             ent (subst (cons 70 (+ (cdr flag) 2)) flag ent)
       )
       (entmod ent)
     )
   )
   (setq e   (entnext e)
         ent (entget e)         		;get next vertex or seqend
   )
 )
 (command "_pedit" (entlast) "_f" "")   ;update fit
 (entdel old)                   		;delete ellipse
)
(princ)

Tháng 10 25, 2012

Bên trên là version 3.0. người viết lisp trên chưa hỗ trợ chọn nhiều đối tượng 1 lần. Chưa hỗ trợ đối tượng mũi tên Leader. Mình update lên version 3.1 hỗ trợ thêm 2 tính năng này. Mình đổi luôn tên lệnh thành RV và RVV tránh trùng với lệnh Reverse của Cad

10/25/12 - Added support for Leader object by Le Thuy Linh

10/25/12 - Updated support multiselect object by Le Thuy Linh

;|
REVERSE - Reverses line, arc, circle, ellipse, spline, polyline, text,
   	hatch pattern, or gradient fill.

  Reverses all line, arc, circle, ellipse, spline, polyline, and
  lightweight polyline entities.

  Circles, arcs, and ellipses are converted to polylines; other objects
  retain their respective entity type.  Circles and circular arcs are
  rendered as heavyweight polylines if the system variable plinetype = 0,
  or lightweight polylines if plinetype > 0.  Ellipses and elliptical
  arcs are rendered as high-resolution, curve-fit polylines with up to 64
  exact vertices and tangents.

  Reverses all text entities including single-line text, attributes,
  multiline text, dimension text, and remote text.  Fonts with leading or
  trailing white space, and text styles with upside down, backward, or
  vertical effects are fully supported.

  Rotates all hatch patterns 90&;#176; counterclockwise.  Rotates all gradient
  fills 180&;#176;. Solid fills are ignored.

  Single-line text, multiline text, attributes, hatch patterns, and
  gradient fills may be reversed within blocks.  All other block components
  are ignored.  Nested blocks are not supported.

  Preserves color, layer, linetype, linetype scale, plot style, lineweight,
  thickness, elevation, global width, and text style properties.  Preserves
  circular, quadratic, and cubic fitting.  Preserves vertex bulge, segment
  width, and vertex tangent.

Copyright(c)2005-2012 Version 3.1 (US)
  Tom Davis (tdavis@metzgerwillard.com)

Revision History:
  10/10/12 - Added support for Leader object by Le Thuy Linh - Tri Tue Viet.jsc - VietNam
  10/10/12 - Updated support multiselect object by Le Thuy Linh - Tri Tue Viet.jsc - VietNam
  08/19/10 - Added support for hatch patterns and gradient fills.
  01/27/10 - Removed references.
         	See http://www.metzgerwillard.us/tdavis/lisp/reverse.html
  11/06/08 - Updated reference links.
  09/21/08 - Updated reference links.
  02/15/08 - Updated email address.
  09/09/07 - Added underscores for international language support.
  08/26/07 - Added support for mtext with exact line spacing; single-
         	line text fonts with leading or trailing white space; and
         	upside down, backward, and vertical text effects.
  08/05/07 - Modified to select objects with nentsel instead of entsel;
         	extended support to all text objects in block references
         	including attributes and dimension text.
  10/05/05 - Added limited dimension text support.
  09/22/05 - Added support for single-line text, multiline text, and
         	remote text.
  09/17/05 - First release with initial support for all line, arc,
         	circle, ellipse, spline, and polyline entities.
|;
;------------------------------------------------------------------------------
(defun c:rvv ( / oldecho oldsnap ent e etyp)
 ;reverse text, line, arc, circle, ellipse, spline, or polyline
 (setq oldecho (getvar "cmdecho")
   	oldsnap (getvar "osmode")
 )
 (setvar "cmdecho" 0)                                    	;turn off echo
 (if (< oldsnap 16384) (setvar "osmode" (+ oldsnap 16384)))  ;turn off osnap
 (command "_select" "")                                  	;deselect all
 (while (setq ent (nentsel "\nSelect reversible object: "))
(setq e	(car ent)
     	etyp (cdr (assoc 0 (entget e)))
)
;exclude block components that are neither text nor hatching
(if (or (< (length ent) 4)(= etyp "TEXT")(= etyp "MTEXT")(= etyp "HATCH"))
 	(progn
   	(while (= (cdr (assoc 0 (entget e))) "VERTEX")    	;skip vertices
     	(setq e (entnext e))
   	)
   	(if (= (cdr (assoc 0 (entget e))) "SEQEND")          	;get hwpolyline
     	(setq e (cdr (assoc -2 (entget e))))            	;	or ellipse
   	)
   	(setq etyp (cdr (assoc 0 (entget e))))
   	(princ etyp)
   	(command "_undo" "_begin")
   	(cond
     	((= etyp "LWPOLYLINE")(revlwpline e))
     	((= etyp "POLYLINE")  (revhwpline e))
     	((= etyp "LINE")  	(revline	e))
     	((= etyp "ARC")	(revarc  e))
     	((= etyp "CIRCLE")	(revcircle  e))
     	((= etyp "HATCH")  (revhatch   e))
     	((= etyp "LEADER")	(revleader  e))
     	((= etyp "ELLIPSE")   (revellipse e))
     	((= etyp "MTEXT")  (revmtext   e))
     	((= etyp "TEXT")  	(revtext	e etyp))
     	((= etyp "ATTRIB")	(revtext	e etyp) (entupd e))
     	((= etyp "RTEXT")  (revrtext   e))
     	((= etyp "SPLINE")	(command "_splinedit" e "_e" ""))
   	)
   	(if (> (length ent) 3)(entupd (car (cadddr ent))))	;block text
                                                         	;or hatching
   	(command "_undo" "_end")
 	)
 	(princ "INSERT")
)
 )
 (setvar "cmdecho" oldecho)
 (setvar "osmode"  oldsnap)
 (princ)
)
(defun c:rv ( / oldecho oldsnap ent e etyp ss id)
 (prompt "\nSelect reversible object: ")
 (setq oldecho (getvar "cmdecho")
   	oldsnap (getvar "osmode"))
 (setvar "cmdecho" 0)                                   		;turn off echo
 (if (< oldsnap 16384) (setvar "osmode" (+ oldsnap 16384))) 	;turn off osnap
 (command "_select" "")                                 		;deselect all
 (if (setq id -1 ss (ssget))
 (repeat (sslength ss)
(setq  e (ssname ss (setq id (1+ id)))
  		etyp (cdr (assoc 0 (entget e))))
;exclude block components that are neither text nor hatching
(if (or (< (length ent) 4)(= etyp "TEXT")(= etyp "MTEXT")(= etyp "HATCH"))
 	(progn
   	(while (= (cdr (assoc 0 (entget e))) "VERTEX")   		;skip vertices
     	(setq e (entnext e)))
   	(if (= (cdr (assoc 0 (entget e))) "SEQEND")          	;get hwpolyline
     	(setq e (cdr (assoc -2 (entget e)))))              	;	or ellipse
   	(setq etyp (cdr (assoc 0 (entget e))))
   	;(princ etyp)
   	(command "_undo" "_begin")
   	(cond
     	((= etyp "LWPOLYLINE")(revlwpline e))
     	((= etyp "POLYLINE")  (revhwpline e))
     	((= etyp "SPLINE")	(command "_splinedit" e "_e" ""))
     	((= etyp "TEXT")  	(revtext	e etyp))
     	((= etyp "MTEXT") 	(revmtext   e))
     	((= etyp "HATCH") 	(revhatch   e))        
     	((= etyp "LEADER")	(revleader  e))
     	((= etyp "LINE")  	(revline	e))
     	((= etyp "ARC")   	(revarc 	e))
     	((= etyp "CIRCLE")	(revcircle  e))
     	((= etyp "ELLIPSE")   (revellipse e))        
     	((= etyp "ATTRIB")	(revtext	e etyp) (entupd e))
     	((= etyp "RTEXT") 	(revrtext   e)))
   	(if (> (length ent) 3)(entupd (car (cadddr ent))))   	;block text  ;or hatching
   	(command "_undo" "_end"))
 	(princ "INSERT"))))
 (setvar "cmdecho" oldecho)
 (setvar "osmode"  oldsnap)
 (princ))
;------------------------------------------------------------------------------
;LWPOLYLINE

(defun revlwpline (e / footer done vertices header flag)
 ;reverse lightweight polyline
 (foreach item (reverse (entget e))
(cond
 	((not done)
   	(cond
     	((= (car item) 40)
       	(setq footer (cons (cons 41 (cdr item)) footer)  	;swap width
             	done t
       	)
     	)
     	((= (car item) 41)
       	(setq footer (cons (cons 40 (cdr item)) footer))  ;swap width
     	)
     	((= (car item) 42)
       	(setq footer (cons (cons 42 (- (cdr item))) footer)) ;negate bulge
     	)
     	((= (car item) 210)
       	(setq footer (cons item footer))
     	)
   	)
 	)
 	((= (car item) 10)
   	(setq vertices (cons item vertices))
 	)
 	((= (car item) 40)
   	(setq vertices (cons (cons 41 (cdr item)) vertices))  ;swap width
 	)
 	((= (car item) 41)
   	(setq vertices (cons (cons 40 (cdr item)) vertices))  ;swap width
 	)
 	((= (car item) 42)
   	(setq vertices (cons (cons 42 (- (cdr item))) vertices)) ;negate bulge
 	)
 	(t (setq header (cons item header)))
)
 )
 (setq flag (assoc 70 header))
 (if (< (cdr flag) 128)          	;turn on linetype generation
(setq header (subst (cons 70 (+ (cdr flag) 128)) flag header))
 )
 (entmod (append header (reverse vertices) footer))
)
;------------------------------------------------------------------------------
;POLYLINE

(defun revhwpline (e / oldname old ent1 buldge end start ent tangent radians
               	vertex vertices flag)
 ;reverse heavyweight polyline
 (setq oldname  e
   	old   (entget oldname)
   	e  (entnext e)
   	ent1  (entget e)          	;get first vertex
   	bulge (cdr (assoc 42 ent1))
   	end   (cdr (assoc 41 ent1))
   	start (cdr (assoc 40 ent1))
   	e  (entnext e)
   	ent   (entget e)          	;get second vertex
 )
 (while (= (cdr (assoc 0 ent)) "VERTEX")
(if (= (logand (cdr (assoc 70 ent)) 2) 2)
 	(setq tangent (assoc 50 ent)
       	radians (- (cdr tangent) pi) ;reverse tangent
       	ent  (subst (cons 50 radians) tangent ent)
 	)
)
(setq vertex   (subst (cons 42 (- bulge))(assoc 42 ent) ent)	;negate bulge
     	vertex   (subst (cons 41 start)	(assoc 41 ent) vertex) ;swap width
     	vertex   (subst (cons 40 end)  	(assoc 40 ent) vertex) ;swap width
     	bulge	(cdr  (assoc 42 ent))
     	end  	(cdr  (assoc 41 ent))
     	start	(cdr  (assoc 40 ent))
     	vertices (cons vertex vertices)
     	e    	(entnext e)
     	ent  	(entget e)        	;get next vertex or seqend
)
 )
 (setq flag (assoc 70 old))
 (if (< (cdr flag) 128)          	;turn on linetype generation
(setq old (subst (cons 70 (+ (cdr flag) 128)) flag old))
 )
 (entmake old)                      	;make new polyline
 (foreach ent vertices (entmake ent))   ;make new vertices
 (if (= (logand (cdr (assoc 70 ent1)) 2) 2)
(setq tangent (assoc 50 ent1)
     	radians (- (cdr tangent) pi)   ;reverse tangent
     	ent1	(subst (cons 50 radians) tangent ent1)
)
 )
 (setq ent1 (subst (cons 42 (- bulge))(assoc 42 ent1) ent1) ;negate bulge
   	ent1 (subst (cons 41 start)	(assoc 41 ent1) ent1) ;swap width
   	ent1 (subst (cons 40 end)  	(assoc 40 ent1) ent1) ;swap width
 )
 (entmake ent1)                  	;make last new vertex
 (entmake ent)                      	;make new seqend
 (entdel oldname)                	;delete old polyline
)
;------------------------------------------------------------------------------
;LINE

(defun revline (e / ent start end)
 ;reverse line
 (setq ent   (entget e)
   	start (assoc 10 ent)
   	end   (assoc 11 ent)      	;swap line endpoints
   	ent   (subst (cons 10 (cdr end)) start ent)
   	ent   (subst (cons 11 (cdr start)) end ent)
 )
 (entmod ent)
)
;------------------------------------------------------------------------------
;ARC

(defun revarc (e)
 ;reverse arc
 (command "_pedit" e "_y" "_l" "_on" "");turn arc into polyline
 (setq e (entlast))
 (if (> (getvar "plinetype") 0)
(revlwpline e)
(revhwpline e)
 )
)
;------------------------------------------------------------------------------
;CIRCLE

(defun revcircle (e / ent radius center pt1 pt2)
 ;reverse circle
 (setq ent	(entget e)
   	radius (cdr (assoc 40 ent))
   	center (cdr (assoc 10 ent))
   	pt1	(mapcar '+ center (list radius 0 0))
   	pt2	(mapcar '- center (list radius 0 0))
 )
 (command "_break" e pt1 pt2)            	;turn circle into semicircle
 (command "_pedit" e "_y" "_l" "_on" "_c" "");turn semicircle into closed polyline
 (setq e (entlast))
 (if (> (getvar "plinetype") 0)
(revlwpline e)
(revhwpline e)
 )
)
;------------------------------------------------------------------------------
;HATCH

(defun revhatch (e / ent solid item ang pi2 new y)
 ;reverse hatch
 (setq ent   (entget e)
   	solid (cdr (assoc 70 ent))            	;solid fill flag
   	pi2   (* 2 pi)
 )
 (cond
((= solid 0)                              	;pattern fill
 	(foreach item (reverse ent)
   	(cond
     	((or (= (car item) 52) (= (car item) 53))  ;pattern or line angle
       	(setq ang (+ (* pi 0.5) (cdr item)))  ;rotate 90°
       	(if (>= ang pi2) (setq ang (- ang pi2))) ;normalize angle
       	(setq new (cons (cons (car item) ang) new))
     	)
     	((or (= (car item) 43) (= (car item) 45))  ;line origin or offset x
       	;rotate line origin or offset 90°: new y = old x; new x = - old y
       	(setq new (cons (cons (1+ (car item)) (cdr item)) new)
             	new (cons (cons (car item) (- y)) new))
     	)
     	((or (= (car item) 44) (= (car item) 46))  ;line origin or offset y
       	(setq y (cdr item))
     	)
     	(t (setq new (cons item new)))
   	)
 	)
 	(entmod new)
)
((= solid 1)                              	;solid fill
 	(if (= (cdr (assoc 450 ent)) 1)            	;gradient fill
   	(progn
     	(setq item (assoc 460 ent)          	;gradient angle
           	ang  (+ pi (cdr item))        	;rotate 180°
     	)
     	(if (>= ang pi2) (setq ang (- ang pi2)))   ;normalize angle
     	(setq ent (subst (cons 460 ang) item ent))
     	(entmod ent)
   	)
 	)
)
 )
)
;------------------------------------------------------------------------------
;RTEXT

(defun revrtext (e / ent ins w h rot ang hd vd new)
 ;reverse rtext
 (command "_explode" e)                  	;explode rtext into mtext
 (setq ent  (entget (entlast))              	;get mtext
   	w	(cdr (assoc 42 ent))            	;width
   	h	(cdr (assoc 43 ent))            	;height
 )
 (command "_undo" 1)
 (setq ent  (entget e)                      	;get rtext
   	ins  (assoc 10 ent)                  	;insertion point
   	rot  (assoc 50 ent)                  	;rotation
   	ang  (cdr rot)
   	hd   (polar '(0 0 0)	ang    	w) ;horizontal displacement
   	vd   (polar '(0 0 0) (- ang (/ pi 2)) h) ;vertical displacement
   	new  (mapcar '+ (cdr ins) hd vd)  	;new insertion point
   	ang  (rem (+ ang pi) (* 2 pi))    	;normalize angle
   	ent  (subst (cons 50 ang) rot ent)	;reverse direction
   	ent  (subst (cons 10 new) ins ent)	;set new insertion point
 )
 (entmod ent)
)
;------------------------------------------------------------------------------
;TEXT or ATTRIB

(defun revtext (e etyp / vc ent box hj vj rot ang p1 p2 h w
                 	dist phi hd vd new gf gfs sn p s done)
 ;reverse text or attribute
 (if (= etyp "TEXT")
(setq vc 73) ;text
(setq vc 74) ;attribute
 )
 (setq ent (entget e)
   	box (textbox ent)                          	;((x1 y1 z1)(x2 y2 z2))
   	gf  (cdr (assoc 71 ent))                	;generation flag
   	sn  (cdr (assoc  7 ent))                	;style name
   	hj  (cdr (assoc 72 ent))                	;horizontal justification
   	vj  (cdr (assoc vc ent))                	;vertical justification
   	rot (assoc 50 ent)                      	;rotation
   	ang (cdr rot)                              	;angle
   	p1  (assoc 10 ent)                      	;first  alignment point
   	p2  (assoc 11 ent)                      	;second alignment point
   	h   (cdr (assoc 40 ent))                	;displacement height
   	p   1                                      	;rewind pointer
 )
 (while (not done)                  	;traverse style table
(setq s   (tblnext "Style" p)
     	p   nil                    	;reset pointer
)
(if (= sn (cdr (assoc 2 s)))  	;find style name
 	(progn
   	(setq done t
         	gfs  (cdr (assoc 71 s))	;style generation flag
   	)
   	(if (= (logand (cdr (assoc 70 s)) 4) 4)
     	(setq gf (1+ gf))          	;vertical
   	)
 	)
)
 )
 (if  (= gfs (logand gf gfs)) ;exclude conflicting generation flags
(progn
 	(cond                                        	;displacement width
   	((= hj 0)                    	;left
     	(setq w (+ (caadr box) (caar box)))
   	)
   	(t                        	;otherwise
     	(setq dist (distance (cdr p1) (cdr p2))
           	phi  (angle	(cdr p1) (cdr p2))
           	dist (abs (* dist (cos (- phi ang))))
     	)
     	(if (= (logand gf 2) 2) (setq dist (- dist)))	;backward
     	(if (or (= hj 5) (= hj 3))
       	(setq w (-(+ (caar box) (caadr box))  	dist))  ;fit or aligned
       	(setq w (-(+ (caar box) (caadr box)) (* 2 dist))) ;right, center, middle
     	)
   	)
 	)
 	(if (= vj 1)                	;bottom
   	(setq dist (distance (cdr p1) (cdr p2))
         	phi  (angle	(cdr p1) (cdr p2))
         	dist (abs(* dist (sin (- phi ang))))  ;descender depth
         	h	(+ h (* 2 dist))
   	)
 	)
 	(if (= (logand gf 1) 1)        	;vertical
   	(cond
     	((or (> hj 2) (= hj 1))                  	;center,aligned,middle,fit
       	(setq h 0)
     	)
     	(t                                    	;otherwise
       	(setq h (- (cadadr box) (cadar box)))
       	(if (= (+ hj vj) 0) (setq h (- h)))    	;baseline left
       	(cond
         	((and (= hj 0) (> vj 0)) (setq vj 3))	;bottom,middle,top left
         	((= hj 2) (setq vj 0))            	;right
       	)
     	)
   	)
 	)
 	(if (= (logand gf 4) 4) (setq h (- h)))      	;upside down
 	(setq hd   (polar '(0 0 0)	ang    	w)   ;horizontal displacement
       	vd   (polar '(0 0 0) (+ ang (/ pi 2)) h)   ;vertical displacement
 	)
 	(cond                          	;compute new alignment point
   	((or (and (= vj 0) (= hj 1))  ;center
     	(and (= vj 0) (= hj 2))  ;right
     	(= vj 1))            	;bottom
     	(setq new (mapcar '+ (cdr p2) hd vd))
   	)
   	((or (= vj 2) (= hj 4))      	;middle
     	(setq new (mapcar '+ (cdr p2) hd))
   	)
   	((= vj 3)                    	;top
     	(setq new (mapcar '+ (cdr p2) hd)
           	new (mapcar '- new vd)
     	)
   	)
 	)
 	(cond
   	((= (+ hj vj) 0)          	;left
     	(setq new (mapcar '+ (cdr p1) hd vd)
           	ent (subst (cons 10 new) p1 ent)  	;set new alignment point
           	ent (subst (cons 50 (+ ang pi)) rot ent) ;reverse direction
     	)
   	)
   	((or (= hj 5) (= hj 3))      	;fit or aligned
     	(setq new (mapcar '+ (cdr p2) vd hd)
           	ent (subst (cons 10 new) p1 ent)  	;swap alignment points
           	new (mapcar '+ (cdr p1) vd hd)
           	ent (subst (cons 11 new) p2 ent)
     	)
   	)
   	(t
     	(setq ent (subst (cons 11 new) p2 ent)  	;set new alignment point
           	ent (subst (cons 50 (+ ang pi)) rot ent) ;reverse direction
     	)
   	)
 	)
 	(entmod ent)
)
(alert (strcat "The selected text object is not compatible with\n"
           	"its text style.  When the text style is upside\n"
           	"down or backwards, the text object should also	\n"
           	"be upside down or backwards."))
 )
)
;------------------------------------------------------------------------------
;MTEXT (including dimension text)

(defun revmtext (e / ent ins w h just lss ls ch rot hd vd new)
 ;reverse mtext or dimension text
 (setq ent  (entget e)
   	ins  (assoc 10 ent)          	;insertion point
   	w	(cdr (assoc 42 ent))    	;width
   	h	(cdr (assoc 43 ent))    	;displacement height
   	just (cdr (assoc 71 ent))    	;justification
   	rot  (assoc 50 ent)          	;rotation
   	lss  (cdr (assoc 73 ent))    	;line spacing style
   	ch   (cdr (assoc 40 ent))    	;character height
   	ls   (/ ch 3)                	;interline half-space
;ls = (5 ch/3 - ch)/2 = ch/3
 )
 (cond
((and (= lss 2) (> just 6))      	;exact bottom
 	(setq h (+ h ls))
)
((and (= lss 2) (< just 4))      	;exact top
 	(setq h (- h ls))
)
((= lss 2)                    	;exact middle
 	(setq h ls)
)
((and (> just 3) (< just 7))  	;at least middle
 	(setq h 0)
)
 )
 (setq hd   (polar '(0 0 0)	(cdr rot)    	w) ;horizontal displacement
   	vd   (polar '(0 0 0) (- (cdr rot) (/ pi 2)) h) ;vertical displacement
 )
 (cond                              	;compute new insertion point
((= just 1)                      	;top left
 	(setq new (mapcar '+ (cdr ins) hd vd))
)
((= just 2)                      	;top center
 	(setq new (mapcar '+ (cdr ins) vd))
)
((= just 3)                      	;top right
 	(setq new (mapcar '- (cdr ins) hd)
       	new (mapcar '+ new vd)
 	)
)
((= just 4)                      	;middle left
 	(setq new (mapcar '+ (cdr ins) hd)
       	new (mapcar '- new vd)
 	)
)
((= just 5)                      	;middle center
 	(setq new (mapcar '- (cdr ins) vd))
)
((= just 6)                      	;middle right
 	(setq new (mapcar '- (cdr ins) hd vd))
)
((= just 7)                      	;bottom left
 	(setq new (mapcar '+ (cdr ins) hd)
       	new (mapcar '- new vd)
 	)
)
((= just 8)                      	;bottom center
 	(setq new (mapcar '- (cdr ins) vd))
)
((= just 9)                      	;bottom right
 	(setq new (mapcar '- (cdr ins) hd vd))
)
 )
 (setq ent (subst (cons 10 new) ins ent)          	;set new insertion point
   	ent (subst (cons 50 (+ (cdr rot) pi)) rot ent) ;reverse direction
 )
 (entmod ent)
)
;------------------------------------------------------------------------------
;ELLIPSE

(defun revellipse (e / old oldent center p1 ratio start end major a b rot
               	minor inc tol 2pi i j phi closed p tan ent flag)
 ;reverse ellipse
 (setq old	e
   	oldent (entget old)
   	center (cdr (assoc 10 oldent))
   	p1  (cdr (assoc 11 oldent))
   	ratio  (cdr (assoc 40 oldent))
   	start  (cdr (assoc 41 oldent))
   	end	(cdr (assoc 42 oldent))
   	major  (mapcar '+ center p1)
   	a  	(distance center major)
   	b  	(* ratio a)
   	rot	(angle center major)
   	minor  (polar center (+ rot (/ pi 2)) B)
 )
 (setq inc 64                    	;number of vertices on full ellipse
   	tol 1e-5                  	;closure tolerance
   	2pi (* 2 pi)
   	i   (1+ (fix (+ (* (/ inc 2pi) start) 0.5))) ;start index
   	j	(fix (+ (* (/ inc 2pi)   end) 0.5))  ;end index
   	phi (list start)
 )
 (while (< i j)                  	;build parameter list
(setq phi (cons (* (/ 2pi inc) i) phi)
     	i   (1+ i)
)
 )
 (if (and (< start tol) (< (abs (- end 2pi)) tol))
(setq closed t)
(setq closed nil
     	phi	(cons end phi)
)
 )
 ;parametric ellipse in object coordinate system
 ;  x = a cos(q);  y = b sin(q);  r = b/a
 ;  dx/dq = -a sin(q);  dy/dq = b cos(q)
 ;  dy/dx = -b/a cot(q) = -r^2 x/y
 ;  tangent direction = atan(dy/dx)

 (setq p   (mapcar '(lambda (q)  	;compute OCS points on ellipse
               	(list (* a (cos q)) (* b (sin q)))
             	)
             	phi
       	)
   	tan (mapcar '(lambda (q)  	;compute WCS tangent directions
               	(+ (atan (* (- (expt ratio 2)) (car q)) (cadr q)) rot)
             	)
             	p
       	)
 )
 (command "_ucs" "_n" 3 center major minor)  	;create OCS
 (setq p (mapcar '(lambda (q)(trans q 1 0)) p))  ;transform from OCS to WCS
 (command "_ucs" "_p")                          	;restore UCS
 (command "_pline")
 (mapcar 'command p)
 (command "")
 (command "_matchprop" old (entlast) "")
 (if closed
(command "_pedit" (entlast) "_l" "_on" "_c" "_f" "");force hwpline creation
(command "_pedit" (entlast) "_l" "_on"  	"_f" "")
 )
 (setq e   (entnext (entlast))
   	ent (entget e)            	;get first vertex
   	i   0
 )
 (while (= (cdr (assoc 0 ent)) "VERTEX")
(setq flag (assoc 70 ent))
(if (/= (logand (cdr flag) 1) 1)  ;skip curve fitting vertices
 	(progn                      	;set tangent and flag bit
   	(setq ent (subst (cons 50 (nth i tan)) (assoc 50 ent) ent)
         	i   (1+ i)
         	ent (subst (cons 70 (+ (cdr flag) 2)) flag ent)
   	)
   	(entmod ent)
 	)
)
(setq e   (entnext e)
     	ent (entget e)          	;get next vertex or seqend
)
 )
 (command "_pedit" (entlast) "_f" "")   ;update fit
 (entdel old)                    	;delete ellipse
)
(princ)
;------------------------------------------------------------------------------
;LEADER by Le Thuy Linh - Tri Tue Viet.jsc
(defun revleader (e / lst1 lst2 lst10)
(if (> (atoi (getvar "acadver")) 17) (vl-cmdf "._Chprop" e "" "A" "N" ""))
(foreach asoc (entget e)
 (if (/= (car asoc) 10)
  (if lst10
(setq lst2 (cons asoc lst2))
(setq lst1 (cons asoc lst1)))
  (setq lst10 (cons asoc lst10))))
(entmod (append (reverse lst1) lst10 (reverse lst2)))
(if (> (atoi (getvar "acadver")) 17) (vl-cmdf "._Chprop" e "" "A" "Y" "")))

Tháng 10 25, 2012

THUYLINH313 có thể giải thích lệnh RVV và RV có tác dụng khác nhau như thế nào ko ?

sau khi thử thì cái rv khó sử dụng và ko hiểu tính năng

Tháng 10 25, 2012

Khó sử dụng ở chỗ nào vậy bạn? topic bạn yêu cầu lisp đổi chiều đối tượng đường thì lisp trên sử dụng cho mục đích đó thôi. Lệnh RV dùng cho 1 lúc nhiều đối tượng 1 lần, Chọn các đối tượng bạn muốn đổi chiều rồi enter. RVV dùng cho đổi chiều từng đối tượng 1 bằng cách pick chọn

Tháng 10 25, 2012

RV nó bắt chọn delta ( theo e nghĩ là sai số ) nhưng ko dc đối với đường cong ( e mới thử mỗi đường cong ) bác thử file nay nhéhttp://www.cadviet.com/upfiles/3/113313_drawing2.dwg

Tháng 10 25, 2012

Hơi lạ vì máy của mình chạy bản vẽ của bạn dùng bình thường. Mình dùng cad 2013. Code của lisp trên cũng rất khó để có thể sảy ra lỗi với đối tượng là LWPOLYLINE. Mình không có cad thấp hơn để kiểm tra lỗi. nhờ các bạn khác tìm giúp bạn vậy. (Mình còn trẻ, đừng kêu mình là bác, mình tổn thọ mất)

Tháng 10 25, 2012

Nói chung là mình thấy chủ topic khá bị động :)

Tháng 10 25, 2012

vâng em đang chạy sô mấy công trình nên test hơi khó . 2 nữa là em ko biết tí gì về lisp chỉ biết sử dụng nên hoi gà , khi e test thì nó báo lỗi vậy .

các bác có thể sử giúp e từ lisp gốc cho chọn nhiều đối tượng 1 lúc cad 2007 dc ko a . lisp bác thuylinh313 bị lỗi .

Tháng 10 25, 2012

vâng em đang chạy sô mấy công trình nên test hơi khó . 2 nữa là em ko biết tí gì về lisp chỉ biết sử dụng nên hoi gà , khi e test thì nó báo lỗi vậy .

các bác có thể sử giúp e từ lisp gốc cho chọn nhiều đối tượng 1 lúc cad 2007 dc ko a . lisp bác thuylinh313 bị lỗi .

Tôi test trên 2007, file của bạn: không lỗi. Mà nói như bạn ThuyLinh thì cũng khó lỗi lắm.

Tháng 10 25, 2012

Tôi test trên 2007, file của bạn: không lỗi. Mà nói như bạn ThuyLinh thì cũng khó lỗi lắm.

bác có cách nào khắc phục cái này ko bác , e rất mong líp này chọn dc nhiều đối tượng 1 lúc và các đối tượng có thể khác nhau như arc , pl , L ...

Tháng 10 25, 2012

Tôi test bản vẽ bạn gởi lên, cũng cad2007 như bạn, thì thấy mượt. Vậy thì làm sao biết lỗi gì mà tư vấn. Bạn chạy xong, báo lỗi, nhấn F2, copy tất cả rồi paste lên xem đó là lỗi gì?

Tháng 10 25, 2012

Command: rv

Select objects: Specify opposite corner: 1 found

Select objects:

Delta <1>: ( nó đòi nhập )

và ko di chuyển hay đổi hướng gì cả .

bác sửa hộ e tí xem nó có vấn đề gì

Tháng 10 25, 2012

Bạn có nhầm với 1 lệnh RV nào trùng tên với 1 lệnh của 1 lisp nào cài sẵn không đó?

Trong lisp này không có 2 dòng như bạn nói là:

Select objects:

Delta <1>:

Tháng 10 25, 2012

muốn kiểm tra lệnh trùng thỉ phải làm thế nào bác nhỉ . dò lại từng lisp mình có thì hơi mất thời gian . có cách nào nhanh hơn ko bác

Tháng 10 25, 2012

Vậy là tôi đoán bậy mà trúng tới... 100% :lol:

Cách hay nhất là bạn lấy cái lisp vừa down đó, tìm đến dòng có chữ C:RV.

Sau đó bạn sửa thành C:OBAMA là được.

Khi dùng thì đánh lệnh OBAMA.

Không thích OBAMA thì sửa là ROMEY. v.v... và v.v...

Tháng 10 25, 2012

thôi thì e tìm anh BINLADEN cũng dc . keke . thanh các bác .

tiện đây cho e hỏi tí e có cái lisp tạo style mới nhưng e sửa bằng cách copy 1 lần nữa xuống dưới để tạo mấy font cùng lúc nhưng ko dc . bác chỉ hộ e cách sửa cái .

thêm bớt đoạn code nào vào để tạo liên tục bằng lệnh : TAOC1 , TAOC2 ..... bác nhỉ . thank

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=143
(defun c:TaoC()
 (command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
 (princ)
)

Tháng 10 25, 2012

thôi thì e tìm anh BINLADEN cũng dc . keke . thanh các bác .

tiện đây cho e hỏi tí e có cái lisp tạo style mới nhưng e sửa bằng cách copy 1 lần nữa xuống dưới để tạo mấy font cùng lúc nhưng ko dc . bác chỉ hộ e cách sửa cái .

thêm bớt đoạn code nào vào để tạo liên tục bằng lệnh : TAOC1 , TAOC2 ..... bác nhỉ . thank
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=143
(defun c:TaoC()
 (command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")
 (princ)
)

Ví dụ, tạo thêm 2 sytle nữa thành 3 sytle.

(defun c:TaoC()
 (command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")   ;dong co san
 (command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")   ;sua dong nay
 (command "style" "VnArial NarrowH" ".VnArial NarrowH" "" "" "" "" "")   ;sua dong nay
 (princ)
)

Đăng nhập

[ xin lisp ] đổi chiều đối tượng ( đường cong , thẳng , gấp khúc )

Các bài được khuyến nghị

traigtmientay 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

traigtmientay 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3211

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ThuyLinh313 160

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 3005

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3211

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

quochuyksxd 25

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

traigtmientay 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3211

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ThuyLinh313 160

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

traigtmientay 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ThuyLinh313 160

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

traigtmientay 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ThuyLinh313 160

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ketxu 3005

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

traigtmientay 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3211

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

traigtmientay 0

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Van Ha 3211

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

traigtmientay 0