[Yêu cầu] lisp đổi chiều đường polyline

[minhngockt 5]

Nhờ các bác viết cho em lisp đổi chiều đường polyline,chẳng hạn như em vẽ một đường pl đi từ A->B, giờ em muốn đổi lại thành từ B->A,vẽ lại hướng cũng đuợc nhưng bản vẽ của em cần đổi nhiều quá.Em cảm ơn các bác

[phamthanhbinh 3.146]

Nhờ các bác viết cho em lisp đổi chiều đường polyline,chẳng hạn như em vẽ một đường pl đi từ A->B, giờ em muốn đổi lại thành từ B->A,vẽ lại hướng cũng đuợc nhưng bản vẽ của em cần đổi nhiều quá.Em cảm ơn các bác

Hề hề hề,

Việc này dễ như ăn ớt. Song mình cần bạn giải thích rõ mục đích của việc đổi này đã.

Bởi vì việc đổi này chả hề làm cho bản vẽ đẹp hơn. Mình e rằng bạn có một mục tiêu khác và biết đâu khi bạn nói ra lại có cách chả phải đổi điếc gì cả vẫn OK xa lem.

Ấy là chưa kể tới việc làm sao để bạn biết đâu là cái polyline cần đổi và đâu là cái đã được đổi.

Hề hề hề, mình cũng rất không muốn viết xong cái việc đổi bạn lại đẻ thêm ra việc khác nữa nên thà bạn nói rõ mục tiêu để làm một lần cho bõ công bạn ạ.

Hy vọng bạn hiểu và thông cảm với các lisper cùi bắp như mình.

hề hề hề....

[thanhduan2407 272]

Nhờ các bác viết cho em lisp đổi chiều đường polyline,chẳng hạn như em vẽ một đường pl đi từ A->B, giờ em muốn đổi lại thành từ B->A,vẽ lại hướng cũng đuợc nhưng bản vẽ của em cần đổi nhiều quá.Em cảm ơn các bác

Bạn nên sử dụng chức năng tìm kiếm để tìm đươc cái theo yêu cầu nhé. Mình tìm cho bạn đây

http://www.cadviet.com/forum/index.php?showtopic=10341&st=20

[minhngockt 5]

Hề hề hề,

Việc này dễ như ăn ớt. Song mình cần bạn giải thích rõ mục đích của việc đổi này đã.

Bởi vì việc đổi này chả hề làm cho bản vẽ đẹp hơn. Mình e rằng bạn có một mục tiêu khác và biết đâu khi bạn nói ra lại có cách chả phải đổi điếc gì cả vẫn OK xa lem.

Ấy là chưa kể tới việc làm sao để bạn biết đâu là cái polyline cần đổi và đâu là cái đã được đổi.

Hề hề hề, mình cũng rất không muốn viết xong cái việc đổi bạn lại đẻ thêm ra việc khác nữa nên thà bạn nói rõ mục tiêu để làm một lần cho bõ công bạn ạ.

Hy vọng bạn hiểu và thông cảm với các lisper cùi bắp như mình.

hề hề hề....

thực ra em sử dụng các đường linetype có hướng mũi tên để qui định chiều( chẳng hạn chiều nước chảy),thường thường là vẽ các pl ra trước,đến khi dùng lệnh MA vào thì thấy nhiều đường có chiều ngược lại,nên em muốn nhờ các bác viết hộ em cái lisp đổi chiều nhanh đường pl,em cảm ơn bác.

[phamthanhbinh 3.146]

thực ra em sử dụng các đường linetype có hướng mũi tên để qui định chiều( chẳng hạn chiều nước chảy),thường thường là vẽ các pl ra trước,đến khi dùng lệnh MA vào thì thấy nhiều đường có chiều ngược lại,nên em muốn nhờ các bác viết hộ em cái lisp đổi chiều nhanh đường pl,em cảm ơn bác.

Hề hề hề,

Của bạn đây, mình để các polyline được đổ chiều là màu vàng để bạn dễ kiểm tra. Nếu không thích thì bạn vô hiệu hóa cái dòng code (setvar "cecolor" "2") đi nhé.

(defun c:conpl (/ col ssp en pls )
(vl-load-com)
(command "undo" "be")
(setq col (getvar "cecolor"))
(setvar "cecolor" "2")
(alert "\n Chon cac polyline muon doi chieu")
(setq ssp (acet-ss-to-list (ssget (list (cons 0 "*polyline")))))
(foreach en ssp
      (setq pls (reverse (acet-geom-vertex-list en)))
      (command "erase" en "")
      (command "pline"
              (foreach p pls
                      (command p)
              )
              (command "")
      )
)
(setvar "cecolor" col)
(command "undo" "e")
)

Hề hề hề, lisp này chỉ dùng cho các polyline chứa toàn các phân đoạn thẳng.

Chúc bạn vui.

Chỉnh sửa Tháng 6 29, 2011 theo phamthanhbinh
bổ sung phạm vi dùng của lisp

[minhngockt 5]

em cảm ơn bác rất nhiều

[ketxu 2.984]

@bác Bình : như topic a Duân trích dẫn đã đề cập, trong việc tái tạo các Pline có khả năng sẽ gặp các vấn đề đầu xuôi nhưng đuôi không lọt, tỉ như Pl chứa Xdata, hay Pl chứa Arc... ^^

[phamthanhbinh 3.146]

@bác Bình : như topic a Duân trích dẫn đã đề cập, trong việc tái tạo các Pline có khả năng sẽ gặp các vấn đề đầu xuôi nhưng đuôi không lọt, tỉ như Pl chứa Xdata, hay Pl chứa Arc... ^^

Hề hề hề,

Đúng vậy, mình cũng mới đọc xong. Do lúc viết chưa nhìn thấy bài của bác thanhduan2407 nên nghĩ không tới. Cái lisp trên của mình chưa xét tới các polyline có chứa các phân đoạn cong hay elíp hay ......

Mong các bác chú ý khi dùng vậy.

[Thaistreetz 539]

Mình nhớ có lần mình đã post 1 lisp đổi chiều hầu hết mọi đối tượng có thể đổi chiều: *LINE, Arc, circle, ellipse, *Text, hatch, gradient... nhưng quên mất post ở đâu rồi.

đây là 2 hàm đổi chiều LWpolyline và Polyline đầu xuôi đuôi cũng lọt. Chỉ đổi chiều, mọi thông tin khác của đối tuợng đuợc bảo toàn

;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
)

[minhngockt 5]

bác cho em hỏi là khi ap lisp vào thì dùng lệnh gì để sử dụng vậy ạ,em đánh theo lệnh sau từ defun mà ko được.Em cảm ơn bác

[Thaistreetz 539]

bạn copy đoạn này dán vào đít của code trên. Dùng lệnh RV

(defun c:rv (/ EN)
(if (setq EN (car(entsel "- Chon duong Polyline de doi chieu")))
(cond
((= "POLYLINE" (cdr(assoc 0 (entget EN)))) (revhwpline EN) (prompt " - OK!"))
((= "LWPOLYLINE" (cdr(assoc 0 (entget EN)))) (revlwpline EN) (prompt " - OK!"))
(t (prompt "\n Doi tuong khong phai Polyline"))
))
(princ))

[Thaistreetz 539]

bạn làm vậy là đúng rồi. mình đã test lại. chạy bình thuờng

[thanhduan2407 272]

Em xin thêm 1 lisp sưu tầm được.

(defun c:rev(/ ss count lwp ent obj oname sss revlwpl revln)
 (defun revlwpl(/ eo el len)
(setq eo ent)
(setq el (list(assoc 210 ent)))
(while (member (assoc 10 ent) ent)
  (if (= 0.0 (assoc 42 ent))
  (setq el (cons (assoc 42 ent) el))
  (setq el (cons (cons 42 (- (cdr (assoc 42 ent)))) el))
  )
  (setq el (cons (assoc 41 ent) el))
  (setq el (cons (assoc 40 ent) el))
  (setq el (cons (assoc 10 ent) el))
  (setq ent (member (assoc 10 ent) ent))
  (setq ent (cdr ent))
)
(setq len(- (LENGTH eo) (LENGTH (member (assoc 10 eo) eo)) 1))
(while (>= len 0)
  (setq el (cons (nth len eo) el))
  (setq len (- len 1))
)
(setq ent el)
(entmod ent)
 )
 (defun revln (/ pt1 pt2)
(setq pt1 (cons 10 (cdr (assoc 11 ent))))
(setq pt2 (cons 11 (cdr (assoc 10 ent))))
(setq ent (subst pt1 (assoc 10 ent) ent))
(setq ent (subst pt2 (assoc 11 ent) ent))
(entmod ent)
 )

 (princ "\nSelect Lines & Polylines to reverse direction of:   ")
 (setq ss (ssget '((0 . "POLYLINE,LWPOLYLINE,LINE"))))
 (setvar "CMDECHO" 0)
 (command "._UNDO" "_BEgin")
 (if ss
(progn
  (setq count 0 lwp 0)
  (while (> (sslength ss) count)
	(setq ent (ENTGET (ssname ss count))
			  obj (vlax-ename->vla-object (ssname ss count))
			  oname (vlax-get-property obj 'ObjectName)
	)
	(cond
	  ((= oname "AcDb3dPolyline")(setq lwp(+ 1 lwp)))
	  ((= (cdadr ent) "LWPOLYLINE")(revlwpl))
	  ((= (cdadr ent) "POLYLINE")
		(progn
		  (setq sss (ssadd (ssname ss count)))
		  (vl-cmdf "convertpoly" "Light" sss "")
		  (setq ent (ENTGET (ssname sss 0)))
		  (revlwpl)
		)
	  )
	  ((= (cdadr ent) "LINE")(revln))
	)
	(setq count (+ count 1))
  )
)
 )
 (command "._UNDO" "_End")
 (if(> lwp 0)
(if(> lwp 1)
  (princ(strcat "\nCould not reverse " (itoa lwp) " 3dPolylines."))
  (princ"\nCould not reverse the 3dPolyline.")
)
 )
 (princ)
)