Nhờ các bác Viết Lisp kiểm tra Overlay của Polyline

Tháng 3 26, 2009

Viết Lisp kiểm tra Overlay của Polyline

+ Nếu tìm thấy overlay (2 polyline chồng lên nhau) thì in ra 1 đường tròn

(hay Point Style) và text =“ doan nay co 2 Polyline overlay voi nhau”

Các bác xem file ví đây:

http://www.cadviet.com/upfiles/OverlayPolyline.dwg

Thanks các bác quan tâm

Tháng 3 27, 2009

Viết Lisp kiểm tra Overlay của Polyline
+ Nếu tìm thấy overlay (2 polyline chồng lên nhau) thì in ra 1 đường tròn

(hay Point Style) và text =“ doan nay co 2 Polyline overlay voi nhau”

Các bác xem file ví đây:

http://www.cadviet.com/upfiles/OverlayPolyline.dwg

Thanks các bác quan tâm

Chào bạn Truongbv,

Muốn hỏi thêm bạn là bạn muốn tìm các polyline trùng nhau hoàn toàn hay chỉ trùng nhau từng khúc một. Theo bản vẽ bạn post thì hai polyline đó trùng nhau hoàn toàn. Nhưng thực tế trên bản vẽ có thể còn có các polyline không trùng nhau hoàn toàn mà chỉ trùng một vài đoạn thì sao? Có cần tìm kiếm chúng không?

Sau khi tìm thấy có cần xử lý xóa bớt đi một hay không?

Bạn hãy nêu rõ hơn nhé vì người viiết sẽ không phải sửa chữa lisp nhiều lần.

Thanks

Tháng 3 28, 2009

Chào bạn Truongbv,
Muốn hỏi thêm bạn là bạn muốn tìm các polyline trùng nhau hoàn toàn hay chỉ trùng nhau từng khúc một. Theo bản vẽ bạn post thì hai polyline đó trùng nhau hoàn toàn. Nhưng thực tế trên bản vẽ có thể còn có các polyline không trùng nhau hoàn toàn mà chỉ trùng một vài đoạn thì sao? Có cần tìm kiếm chúng không?

Sau khi tìm thấy có cần xử lý xóa bớt đi một hay không?

Bạn hãy nêu rõ hơn nhé vì người viiết sẽ không phải sửa chữa lisp nhiều lần.

Thanks

Thanks bác quan tâm. Mình muốn tìm các polyline trùng nhau hoàn toàn và trùng nhau từng khúc một cả 2 trường hợp

Khi tìm thấy thì chỉ cần tạo ra thông báo tại vị trí có polyline trùng nhau là

- text ="đoạn này có 2 polyline trùng nhau"

- và 1 style point (hay 1 đường tròn nhỏ)

(text, style point cùng 1 layer tên là: "Loi Overlay cua polyline"

như hình sau: http://www.cadviet.com/upfiles/Overlay.jpg

Tháng 3 28, 2009

Thanks bác quan tâm. Mình muốn tìm các polyline trùng nhau hoàn toàn và trùng nhau từng khúc một cả 2 trường hợp
Khi tìm thấy thì chỉ cần tạo ra thông báo tại vị trí có polyline trùng nhau là

- text ="đoạn này có 2 polyline trùng nhau"

- và 1 style point (hay 1 đường tròn nhỏ)

(text, style point cùng 1 layer tên là: "Loi Overlay cua polyline"

như hình sau: http://www.cadviet.com/upfiles/Overlay.jpg

Chào bạn Truongbv,

Mình mới làm đuợc một phần yêu cầu của bạn là phát hiện và đánh dấu các polyline trùng nhau hoàn toàn. Việc tìm và đánh dấu các polyline trùng nhau một phần khó hơn và mình đang thử làm. Bạn hãy thử đoạn líp này và cho mình biết ý kiến nhé.

(defun C:xdl2 ()
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq j 0)
(while (/= nil (ssname ss 0))
   (setq ename (ssname ss 0)
		 elist (entget ename)
		 lst0 (list)
   )
   (foreach a elist
			(if (= 10 (car a))
				(setq lst0 (append (list (cdr a)) lst0))
			)
   )

   (setq ss1 (ssdel ename ss)
		 n (sslength ss1)
		 i 0
		 lstn (list)
   )
   (if (> n 0)
   (progn
   (while (			  (setq en (ssname ss1 i)
				lstn (append (list en) lstn)
				i (1+ i)
		  )
   )  
   (foreach e lstn
			(setq elist1 (entget e)
				  lst1 (list)
			)
			(foreach b elist1
					(if (= 10 (car b))
						(setq lst1 (append (list (cdr b)) lst1))
					)
			)
			(if (equal lst0 lst1)
				(progn
				(setq j (1+ j))
				(setq p1 (car lst0)
					  p2 (cadr lst0)
				)
				(command "layer" "m" "Loi Overlay cua polyline" "c" 6 "" "")
				(command "circle" (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)) (/ (distance p1 p2) 2))
				(command "text" (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)) 1 0 "O day co polyline trung nhau hoan toan")
				)
			)
   )
   )
   )

   (setq ss ss1)
)


(alert (strcat "Co " (itoa j) " cap polyline trung nhau hoan toan"))
(princ)
)

Lệnh chạy líp là xdl2 bạn nhé.

Tháng 3 28, 2009

Thanks bác quan tâm. Mình muốn tìm các polyline trùng nhau hoàn toàn và trùng nhau từng khúc một cả 2 trường hợp
Khi tìm thấy thì chỉ cần tạo ra thông báo tại vị trí có polyline trùng nhau là

- text ="đoạn này có 2 polyline trùng nhau"

- và 1 style point (hay 1 đường tròn nhỏ)

(text, style point cùng 1 layer tên là: "Loi Overlay cua polyline"

như hình sau: http://www.cadviet.com/upfiles/Overlay.jpg

Chào bạn truongbv,

Mình đã viết hoàn chỉnh cái lisp theo ý bạn. Bạn thử dùng xem nhé. Có thể kích thước vòng tròn và vị trí đặt text cũng như cao độ text chưa hoàn toàn theo ý bạn, nhưng điều này cũng dễ hiệu chỉnh bằng cách thay đổi các tham số bán kính đường tròn, chiều cao text và điểm đặt text ở các dòng lệnh command. Bạn có thể tự chỉnh theo ý bạn nhé.

(defun C:xdl2 ()
(setq ss (ssget '((0 . "LWPOLYLINE"))))
(setq j 0)
(setq j1 0)
(while (/= nil (ssname ss 0))
   (setq ename (ssname ss 0)
		 elist (entget ename)
		 lst0 (list)
   )
   (foreach a elist
			(if (= 10 (car a))
				(setq lst0 (append (list (cdr a)) lst0))
			)
   )

   (setq lsp (list))
   (setq lst2 (reverse lst0))
   (while (/= nil (cdr lst2))
		  (setq lsp0 (list(list (car lst2) (cadr lst2)))
				lsp (append lsp lsp0)
				lst2 (cdr lst2)
		  )
   )   

   (setq ss1 (ssdel ename ss)
		 n (sslength ss1)
		 i 0
		 lstn (list)
   )
   (if (> n 0)
   (progn
   (while (			  (setq en (ssname ss1 i)
				lstn (append (list en) lstn)
				i (1+ i)
		  )
   )  
   (foreach e lstn
			(setq elist1 (entget e)
				  lst1 (list)
			)
			(foreach b elist1
					(if (= 10 (car b))
						(setq lst1 (append (list (cdr b)) lst1))
					)
			)

			(setq lsp1 (list)
				  lst3 (reverse lst1)
			)
			(while (/= nil (cdr lst3))
				   (setq lsp2 (list(list (car lst3) (cadr lst3)))					  
						 lsp1 (append lsp1 lsp2)
						 lst3 (cdr lst3)
				   )
			)

			(if (equal lst0 lst1)
				(progn
				(setq j (1+ j))
				(setq p1 (car lst0)
					  p2 (cadr lst0)
				)
				(command "layer" "m" "Loi Overlay cua polyline" "c" 6 "" "")
				(command "circle" (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)) (/ (distance p1 p2) 2))
				(command "text" (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)) 1 0 "O day co polyline trung nhau hoan toan")
				)
				(progn
					  (if (equal lst0 (reverse lst1))
						  (progn
								(setq j (1+ j))
								(setq p1 (car lst0)
									  p2 (cadr lst0)
								)
								(command "layer" "m" "Loi Overlay cua polyline" "c" 6 "" "")
								(command "circle" (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)) (/ (distance p1 p2) 2))
								(command "text" (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2)) 1 0 "O day co polyline trung nhau hoan toan")
						  )
						  (progn 
						  (foreach cp lsp
						  (foreach cp1 lsp1
							  (if (equal cp cp1)
								  (progn
								  (setq j1 (1+ j1)
										p3 (car cp)
										p4 (cadr cp)
								  )
								  (command "layer" "m" "Loi Overlay cua polyline" "c" 6 "" "")
								  (command "circle" (list (/ (+ (car p3) (car p4)) 2) (/ (+ (cadr p3) (cadr p4)) 2)) (/ (distance p3 p4) 2))
								  (command "text" (list (/ (+ (car p3) (car p4)) 2) (/ (+ (cadr p3) (cadr p4)) 2)) 1 0 "O day co polyline trung nhau mot phan")
								  )
								  (progn
										(if (equal cp (reverse cp1))
											(progn
											(setq j1 (1+ j1)
												  p3 (car cp)
												  p4 (cadr cp)
											)
											(command "layer" "m" "Loi Overlay cua polyline" "c" 6 "" "")
											(command "circle" (list (/ (+ (car p3) (car p4)) 2) (/ (+ (cadr p3) (cadr p4)) 2)) (/ (distance p3 p4) 2))
											(command "text" (list (/ (+ (car p3) (car p4)) 2) (/ (+ (cadr p3) (cadr p4)) 2)) 1 0 "O day co polyline trung nhau mot phan")
											)
										 )
								  )
							  )
						  )
						  )
						  )
					 )
				)
			)

   )
   )
   )

   (setq ss ss1)
)


(alert (strcat "Co " (itoa j) " cap polyline trung nhau hoan toan va " (itoa j1) " cap polyline trung nhau mot phan"))
(princ)
)

Rất mong bạn có ý kiến phản hồi để mình có thể chỉnh sửa cái lisp này tốt hơn.

Chúc bạn thành công

Tháng 3 30, 2009

Thanks bác nhé.

Chương trình của bác chạy ổn rồi với trường hợp overlay toàn phần

còn overlay 1 phần thì chưa tìm được

Bác có thế viết thêm tìm overlay của TEXT gúp mình nhé.

Tháng 3 30, 2009

Thanks bác nhé.
Chương trình của bác chạy ổn rồi với trường hợp overlay toàn phần

còn overlay 1 phần thì chưa tìm được

Bác có thế viết thêm tìm overlay của TEXT gúp mình nhé.

Chào bạn Truongbv,

Cái overlay một phần của polyline mình đã làm rồi mà, ở cái lisp mình post lần thứ hai đó. Mình vẫn dùng lệnh là xdl2 vì mình bổ sung từ cái lisp cũ. Bạn mở ra sẽ thấy mà. Bạn nói chưa được là ở chỗ nào nhỉ? Mong bạn nói rõ cái chưa được thì mình mới chỉnh sửa được bạn ạ. Khi mình chạy thử với bản vẽ tự làm thì thấy OK nhưng chưa rõ cái bạn bảo chưa được.

Về cái lisp trùng text, bạn cũng cần nói rõ là trùng hoàn toàn hay trùng một phần chứ. Bỏi vì cũng như polyline, cái sự trùng này có nhiều cách hiểu lắm. Trùng hoàn toàn, trùng nội dung, trùng điểm đặt, trùng màu, ...... hầm bà lằng các thuộc tính của text. Nếu trùng hoàn toàn thì dễ hơn, còn nếu trùng một phần ào đó thì phải biết rõ yêu cầu mới được bạn ạ.

Thanks bạn đã phản hồi.

Tháng 3 30, 2009

Chào bạn Truongbv,
Cái overlay một phần của polyline mình đã làm rồi mà, ở cái lisp mình post lần thứ hai đó. Mình vẫn dùng lệnh là xdl2 vì mình bổ sung từ cái lisp cũ. Bạn mở ra sẽ thấy mà. Bạn nói chưa được là ở chỗ nào nhỉ? Mong bạn nói rõ cái chưa được thì mình mới chỉnh sửa được bạn ạ. Khi mình chạy thử với bản vẽ tự làm thì thấy OK nhưng chưa rõ cái bạn bảo chưa được.

Về cái lisp trùng text, bạn cũng cần nói rõ là trùng hoàn toàn hay trùng một phần chứ. Bỏi vì cũng như polyline, cái sự trùng này có nhiều cách hiểu lắm. Trùng hoàn toàn, trùng nội dung, trùng điểm đặt, trùng màu, ...... hầm bà lằng các thuộc tính của text. Nếu trùng hoàn toàn thì dễ hơn, còn nếu trùng một phần ào đó thì phải biết rõ yêu cầu mới được bạn ạ.

Thanks bạn đã phản hồi.

Thanks bác nhé.

Mình chạy thử rồi bác ạ bây giờ đã ok hết rồi mong bác gúp phần overlay text

trong trường hợp overlay text bác cho mình toàn phần: Trùng hoàn toàn, trùng nội dung, trùng điểm đặt, trùng màu, ..

Tháng 3 30, 2009

Thanks bác nhé.
Mình chạy thử rồi bác ạ bây giờ đã ok hết rồi mong bác gúp phần overlay text

trong trường hợp overlay text bác cho mình toàn phần: Trùng hoàn toàn, trùng nội dung, trùng điểm đặt, trùng màu, ..

Chào bạn Truongbv,

Đây là cái lisp xác định text trùng nhau hoàn toàn.

(defun c:xdt2 ()
(setq ss (ssget '((0 . "TEXT")))
  n (sslength ss)
  i 0
  lst (list)
)
(While (	  (setq en (ssname ss i)
		elst (entget en)
		lst (append lst (list elst))
		i (1+ i)
  )
)
(setq j 0)
(while (/= nil (cdr lst))
   (setq a (cddddr (car lst))
		 lstp (cdr lst)
		 p (cdr (assoc 10 a))
   )
   (foreach b lstp
			(setq c (cddddr b))
			(if (equal a c)
				(progn
					  (setq j (1+ j))
					  (command "layer" "m" "Loi overlay text" "c" 6 "" "")
					  (command "circle" p 5)
					  (command "text" (list (car p) (- (cadr p) 2)) 1 0 "O day co text trung nhau hoan toan")
				)
			)
   )
   (setq lst lstp)
)
(alert (strcat "Co " (itoa j) " cap text trung nhau hoan toan"))
(princ)
)

Cũng như lisp trườc lệnh là xdt2, bạn có thể thay đổi bán kính vòng tròn, vị trí đặt text, chiếu cao text theo ý bạn nhé. Mình cũng tạo một lớp mới là Loi overlay text để lưu các thông báo phát hiện lỗi.

Bạn chú ý rằng tâm vòng tròn chính là điểm đặt của text bị trùng.

Chúc bạn vui.

Tháng 3 31, 2009

Chào bạn Truongbv,
Đây là cái lisp xác định text trùng nhau hoàn toàn.
(defun c:xdt2 ()
(setq ss (ssget '((0 . "TEXT")))
  n (sslength ss)
  i 0
  lst (list)
)
(While (< i n)
  (setq en (ssname ss i)
		elst (entget en)
		lst (append lst (list elst))
		i (1+ i)
  )
)
(setq j 0)
(while (/= nil (cdr lst))
   (setq a (cddddr (car lst))
		 lstp (cdr lst)
		 p (cdr (assoc 10 a))
   )
   (foreach b lstp
			(setq c (cddddr b))
			(if (equal a c)
				(progn
					  (setq j (1+ j))
					  (command "layer" "m" "Loi overlay text" "c" 6 "" "")
					  (command "circle" p 5)
					  (command "text" (list (car p) (- (cadr p) 2)) 1 0 "O day co text trung nhau hoan toan")
				)
			)
   )
   (setq lst lstp)
)
(alert (strcat "Co " (itoa j) " cap text trung nhau hoan toan"))
(princ)
)
Cũng như lisp trườc lệnh là xdt2, bạn có thể thay đổi bán kính vòng tròn, vị trí đặt text, chiếu cao text theo ý bạn nhé. Mình cũng tạo một lớp mới là Loi overlay text để lưu các thông báo phát hiện lỗi.

Bạn chú ý rằng tâm vòng tròn chính là điểm đặt của text bị trùng.

Chúc bạn vui.

Thanks bác rất nhiều.

ct đã chạy ổn rồi

Đăng nhập

Nhờ các bác Viết Lisp kiểm tra Overlay của Polyline

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

truongbv 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

phamthanhbinh 3.146

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

truongbv 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

phamthanhbinh 3.146

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

phamthanhbinh 3.146

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

truongbv 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

phamthanhbinh 3.146

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

truongbv 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

phamthanhbinh 3.146

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

truongbv 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

Tạo một tài khoản hoặc đăng nhập để nhận xét

Tạo tài khoản

Đăng nhập

Diễn đàn

Download

Đào tạo CADViet

Browse