(Đã xong) XIN LISP TÍNH ĐỘ DỐC ĐOẠN THẲNG VÀ XÓA NHỮNG ĐOẠN THẲNG CÓ ĐỘ DỐC THEO ĐIỀU KIỆN

[hatrongquan88 4]

Mình đang làm hồ sơ hoàn công, cần tính độ dốc đường tự nhiên rất nhiều mặt cắt. Mong các bạn viết lisp giúp đỡ với yêu cầu như sau:

1. Tính độ dốc của nhiều đoạn thẳng ngắn (là đỉnh của đường polyline) trong 1 đường polyline có nhiều đỉnh.

2. Xóa hết những đoạn thẳng có độ dốc nhỏ hơn 30%

Chi tiết mình có gửi file đính kèm.

Cảm ơn các bạn!

Tinh do doc.dwg

[tien2005 242]

Ý của Bạn là khi xóa các đoạn thẳng có độ dóc <30% thì có nghĩa là xóa đi đường polyline cũa và vẽ lạ các đường line mới tương ứng có độ dốc >=30% phải không. Sau khi có các line mới thì có cần làm thêm gì không?

[hatrongquan88 4]

5 phút trước, tien2005 đã nói:

Ý của Bạn là khi xóa các đoạn thẳng có độ dóc <30% thì có nghĩa là xóa đi đường polyline cũa và vẽ lạ các đường line mới tương ứng có độ dốc >=30% phải không. Sau khi có các line mới thì có cần làm thêm gì không?

Đúng như ý bạn nói mình muốn xóa đi polyline cũ, sau khi tách được những đoạn có độ đốc bằng và lớn hơn 30% thì mình tính chiều dài của các đoạn có polyline  >= 30% rồi pick ra text là được bạn ạ.

 

[tien2005 242]

Bạn dùng cái này. Lệnh là NHT

(defun c:nht (/ EN L LAY LSP P X Y)
  (while (setq en (entsel "\nChon duong pline"))
    (setq en (car en))
    (setq lay (cdr (assoc 8 (entget en))))
    (setq lsp
	   (mapcar
	     'cdr
	     (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))
	   ) ;_ end of mapcar
    ) ;_ end of setq
    (mapcar
      '(lambda (x y)
	 (setq l (mapcar '- x y))
	 (if (>= (abs (/ (cadr l) (car l))) 0.3);DO DOC LON HON 30%
	   (entmakex
	     (append
	       (list (cons 0 "LWPOLYLINE")
		     (cons 100 "AcDbEntity")
		     (cons 100 "AcDbPolyline")
		     (cons 90 2)
		     (cons 8 LAY)
	       ) ;_ end of list
	       (mapcar (function (lambda (p) (cons 10 p))) (LIST X Y))
	     ) ;_ end of append
	   ) ;_ end of entmakex
	 ) ;_ end of if
       ) ;_ end of lambda
      lsp
      (cdr lsp)
    ) ;_ end of mapcar
    (entdel en)
  ) ;_ end of while
  (princ)
) ;_ end of defun

 

[hatrongquan88 4]

Cảm ơn bạn đã giúp đỡ. Mình chạy thử lisp trên một số mặt cắt ngang thì những polyline có có độ dốc lớn hơn 30% bị xóa bạn ạ (đặc biệt là pick đâu xóa đấy), ban thử kiểm tra lại giúp mình nhé.

[hatrongquan88 4]

Do mình chưa test kỹ, lisp nhận đường polyline. Được voi đòi tiên tí, bạn đã giúp thì giúp cho trót nhé hihi, lisp trên làm việc được từng mặt cắt bạn có thể giúp mình thao tác khi chọn polyline thì mình quét nhiều đường polyline để lisp xử lý nhiều mặt cắt cùng một lúc được k bạn? mình xin cảm ơn

[tien2005 242]

@hatrongquan88của bạn đây

(defun c:nht (/ EN L LAY LSP P X Y)
  (princ "\nChon duong pline")
  (while (setq en (ssget '((0 . "*POLYLINE"))))
    (foreach en	(vl-remove-if 'listp (mapcar 'cadr (ssnamex en)))
      (setq lay (cdr (assoc 8 (entget en))))
      (setq lsp
	     (mapcar
	       'cdr
	       (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))
	     ) ;_ end of mapcar
      ) ;_ end of setq
      (mapcar
	'(lambda (x y)
	   (setq l (mapcar '- x y))
	   (if (>= (abs (/ (cadr l) (car l))) 0.3) ;DO DOC LON HON 30%
	     (entmakex
	       (append
		 (list (cons 0 "LWPOLYLINE")
		       (cons 100 "AcDbEntity")
		       (cons 100 "AcDbPolyline")
		       (cons 90 2)
		       (cons 8 LAY)
		 ) ;_ end of list
		 (mapcar (function (lambda (p) (cons 10 p))) (LIST X Y))
	       ) ;_ end of append
	     ) ;_ end of entmakex
	   ) ;_ end of if
	 ) ;_ end of lambda
	lsp
	(cdr lsp)
      ) ;_ end of mapcar
      (entdel en)
    ) ;_ end of foreach
  ) ;_ end of while
  (princ)
) ;_ end of defun

 

[hatrongquan88 4]

1 giờ} trướ}c, tien2005 đã nói:

@hatrongquan88của bạn đây

• nht.lsp
  
• [✎]
   

(defun c:nht (/ EN L LAY LSP P X Y)
  (princ "\nChon duong pline")
  (while (setq en (ssget '((0 . "*POLYLINE"))))
    (foreach en	(vl-remove-if 'listp (mapcar 'cadr (ssnamex en)))
      (setq lay (cdr (assoc 8 (entget en))))
      (setq lsp
	     (mapcar
	       'cdr
	       (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget en))
	     ) ;_ end of mapcar
      ) ;_ end of setq
      (mapcar
	'(lambda (x y)
	   (setq l (mapcar '- x y))
	   (if (>= (abs (/ (cadr l) (car l))) 0.3) ;DO DOC LON HON 30%
	     (entmakex
	       (append
		 (list (cons 0 "LWPOLYLINE")
		       (cons 100 "AcDbEntity")
		       (cons 100 "AcDbPolyline")
		       (cons 90 2)
		       (cons 8 LAY)
		 ) ;_ end of list
		 (mapcar (function (lambda (p) (cons 10 p))) (LIST X Y))
	       ) ;_ end of append
	     ) ;_ end of entmakex
	   ) ;_ end of if
	 ) ;_ end of lambda
	lsp
	(cdr lsp)
      ) ;_ end of mapcar
      (entdel en)
    ) ;_ end of foreach
  ) ;_ end of while
  (princ)
) ;_ end of defun

 

Cảm ơn bạn mình đã giải quyết được vấn đề

[phongnh 0]

Em có ý kiến thêm, anh chủ topic và anh viết lisp xem thế nào:

Thêm lựa chọn góc dốc lớn hơn "đánh số độ vào" thay vì như mặc định 30 độ.

[hatrongquan88 4]

8 giờ trước, phongnh đã nói:

Em có ý kiến thêm, anh chủ topic và anh viết lisp xem thế nào:

Thêm lựa chọn góc dốc lớn hơn "đánh số độ vào" thay vì như mặc định 30 độ.

Bạn có thể sửa độ dốc theo độ dốc mình cần tại dòng này:

            (if (>= (abs (/ (cadr l) (car l))) 0.3) ;DO DOC LON HON 30%

Bạn có thể nhờ bạn viết lisp để hoàn thiện thêm. Mình thì ít khi dùng lisp dạng thế này, tuy chưa hoàn thiện nhưng chỉ cần giải quyết được vấn đề là ok rồi bạn :D

[phongnh 0]

Vào lúc 1/8/2019 tại 21:20, hatrongquan88 đã nói:

Bạn có thể sửa độ dốc theo độ dốc mình cần tại dòng này:

            (if (>= (abs (/ (cadr l) (car l))) 0.3) ;DO DOC LON HON 30%

Bạn có thể nhờ bạn viết lisp để hoàn thiện thêm. Mình thì ít khi dùng lisp dạng thế này, tuy chưa hoàn thiện nhưng chỉ cần giải quyết được vấn đề là ok rồi bạn :D

Em góp ý cho nó tốt hơn thôi.

Hiện giờ em không có cần dùng lisp này. Khi nào cần giúp đỡ em sẽ nhờ.

Cảm ơn!