Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
asu2006

Cắt pline theo chiều dài cho trước

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

Mình đã tìm hết trong diễn đàn nhưng không được lisp như mình mong muốn.

Lisp mình mong muốn như tiêu đề:

Mình có một pline gồm cả đường thẳng và đường cong. giờ mình muốn lấy một phần đường pline với chiều dài cho trước.

Đánh tên lệnh ----> kích vào đầu pline cần cắt ----> nhập chiều cài cần cắt ----> enter, đường pline được chia làm 2 đoạn, một đoạn là chiều dài mình cần cắt và phần còn lại.

Cảm ơn nhiều!

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

Của bạn đầy

(defun c:tt (/ ENT KC KCTR SS SSN TD)

  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: ")))) 
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "") 
  (princ)
  )

Chúc bạn may mắn.

(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)
 
(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)
 
(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)
  • Vote tăng 1

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

 

Của bạn đầy

(defun c:tt (/ ENT KC KCTR SS SSN TD)

  (vl-load-com)

  (while (null(setq ss (entsel "\n Chon doituong: ")))) 

  (setq ssn (car ss))

  (setq ent (entget ssn))

  (setq kc (getreal "\n Nhap khoang cach: "))

  (setq td (vlax-curve-getPointAtDist ssn kc))

  (command "Break" td td "") 

  (princ)

  )

Chúc bạn may mắn.

(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)
 
(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)
 
(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)

Đúng cái mình đang cần. cảm ơn bạn rất rất nhiều!

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

 

Của bạn đầy

(defun c:tt (/ ENT KC KCTR SS SSN TD)

  (vl-load-com)

  (while (null(setq ss (entsel "\n Chon doituong: ")))) 

  (setq ssn (car ss))

  (setq ent (entget ssn))

  (setq kc (getreal "\n Nhap khoang cach: "))

  (setq td (vlax-curve-getPointAtDist ssn kc))

  (command "Break" td td "") 

  (princ)

  )

Chúc bạn may mắn.

(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)
 
(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)
 
(defun c:tt (/ ENT KC KCTR SS SSN TD)
  (vl-load-com)
  (while (null(setq ss (entsel "\n Chon doituong: "))))  
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (command "Break" td td "")  
  (princ)

bạn có thể sửa lại cho mình một chút được không? hiện tại lisp chỉ cắt được một đầu của pline. mình muốn chọn đầu nào nó cắt đầu đó của pline. có những đường mình cắt cả 2 đầu, nhưng lisp mới cắt được một đầu. cảm ơn bạn nhiều!

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ặng bạn VOI rồi. Giờ tặng bạn HAI BÀ TRƯNG

(defun c:tt (/ C10 C40 C41 C42 C50 C70 CC40 CC41 CC42 DINH ENT2 I N N10 N40 N41 N42 N50 N70 NC40 NC41 NC42 OSMODEC SSN2 TEST0 TEST1 TEST2)

  (vl-load-com)
  (setq osmodec (getvar "osmode"))
  (setvar "osmode" 1)
  (while (null(setq ss (entsel "\n Chon doituong: ")))) 
  (setq ssn (car ss))
  (setq ent (entget ssn))
  (setq dinh (getpoint "\n Chon diem dau: "))
  (if (= (cdr(assoc 0 ent)) "POLYLINE")
    (progn
      (setq test1 (vlax-curve-getEndPoint ssn))
      (setq test2 (vlax-curve-getStartPoint ssn))
      (if (=(cdr(assoc 66 ent)) 1)
(progn
   (setq ssn2 (entnext ssn))
   (setq ent2 (entget ssn2))
   (setq test0 (cdr(assoc 10 ent2)))
   (if (or(equal dinh test1 0.00001)(equal test1 test2))
     (progn
       (setq c42 (append c42 (list(cons 42 0))))
       (setq c40 (append c40 (list(cons 40 0))))
       (setq c41 (append c41 (list(cons 41 0))))
       (While(/= (cdr(assoc 0 ent2)) "SEQEND")
  (setq c10 (append c10 (list(assoc 10 ent2))))
  (setq c40 (append c40 (list(assoc 40 ent2))))
  (setq c41 (append c41 (list(assoc 41 ent2))))
  (setq c42 (append c42 (list(assoc 42 ent2))))
  (setq c70 (append c70 (list(assoc 70 ent2))))
  (setq c50 (append c50 (list(assoc 50 ent2))))
  (setq ssn2 (entnext ssn2))
  (setq ent2 (entget ssn2))
  );end while
       (setq n (- (length c42) 2))
       (setq i 0)
       (while (<= i n)
  (setq nc42 (append nc42 (list(nth i c42))))
  (setq nc40 (append nc40 (list(nth i c40))))
  (setq nc41 (append nc41 (list(nth i c41))))
  (setq i (1+ i))
  );end while
       (setq i 1)
       (while (<= i n)
  (setq cc42 (append cc42 (list(nth i c42))))
  (setq cc41 (append cc41 (list(nth i c41))))
  (setq cc40 (append cc40 (list(nth i c40))))
  (setq i (1+ i))
  );end while
       (setq c42 nil c42 cc42 c41 nil c41 cc41 c40 nil c40 cc40)
       (setq ss (ssget "_P"))
       (setq ent (entget ssn))
       (if (=(cdr(assoc 66 ent)) 1)
  (progn
    (setq i 0)
    (setq ssn2 (entnext ssn))
    (setq ent2 (entget ssn2))
    (setq n10 (reverse c10))
    (setq n40 (reverse nc40))
    (setq n41 (reverse nc41))
    (setq n42 (reverse nc42))
    (setq n70 (reverse c70))
    (setq n50 (reverse c50))
    (While(/= (cdr(assoc 0 ent2)) "SEQEND")
      (setq ent2 (subst (nth i n10) (nth i c10) ent2))
      (setq ent2 (subst (cons 40 (cdr(nth i n41))) (nth i c40) ent2))
      (setq ent2 (subst (cons 41 (cdr(nth i n40))) (nth i c41) ent2))
      (setq ent2 (subst (cons 42 (- 0 (cdr(nth i n42)))) (nth i c42) ent2))
      (setq ent2 (subst (nth i n70) (nth i c70) ent2))
      (setq ent2 (subst (nth i n50) (nth i c50) ent2))
      (entmod ent2)
      (setq i (1+ i))
      (setq ssn2 (entnext ssn2))
      (setq ent2 (entget ssn2))
      );end while
    (entupd ssn)
    );end progn
  );end if
       );end progn
     );end if
   );end progn
);end if
      );end progn
    );end if 
  (setq kc (getreal "\n Nhap khoang cach: "))
  (setq td (vlax-curve-getPointAtDist ssn kc))
  (setvar "osmode" 0)
  (command "Break" td td "") 
  (princ)
  )

:D

  • Vote tăng 1

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

Sao code nghe có vẻ dài ^^ Vì điểm pick ban đầu chỉ là đầu hoặc cuối Pline, nên Ket nghĩ thế này này 18011985

 Pick điểm đầu P, kiểm tra cond đó là start hay end (1)

- Nhập chiều dài cần cắt L

+ Nếu P là đầu => cắt ở vị trí Length = L

+ Nếu P là cuối => cắt ở vị trí Length = (chiều dài Pline - L)

Đương nhiên khi Pline mà kín thì bài toán của chủ Topic vô nghĩa

Thế có được không ?

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

Tham khảo Lisp chia Curve tôi viết cách đây 4 năm : link here 

(defun c:DC(/ vl ov Ent isClosed lst_pt dis dis0 bit khcach sodoan p pt ); DC -> Divide Curve
  (if (and (setq Ent (car (entsel "\nChon doi tuong can chia :")))
	   (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE,LINE,ARC")
	   (not (setq isClosed (vlax-curve-isClosed ent)))  )
    (progn
      (command "undo" "be")
      (setq vl '("osmode" "orthomode" "cmdecho")
	    ov (mapcar 'getvar vl)) 
      (mapcar 'setvar vl '(0 0 0))      
      
      (setq lst_Pt nil
	    dis0 (vlax-curve-getDistAtParam Ent (vlax-curve-getEndParam Ent))  )
      (initget "K D")
      (setq bit (getkword "\nChia theo Khoang cach hay chia deu theo so Doan <K/D>: " ) )
      (if (= bit "K")
	(progn
	  (or *khcach* (setq *khcach* 250))
	  (setq khcach (getreal (strcat"\nNhap khoang cach <" (rtos *khcach*) ">:")) )
	  (if khcach (setq *khcach* khcach) (setq khcach *khcach*))
	  (initget "G B")
	  (setq bit (getkword "\nCan Giua hay can tu Bien <G/B>: " ) )
	  (if (= bit "G")
	    (progn
	      (setvar "osmode" 513)
	      (setq p (getpoint (vlax-curve-getPointAtDist Ent (/ dis0 2))"\nDiem bat dau:"))
	      (if (< (distance p (vlax-curve-getStartPoint ent))(distance p (vlax-curve-getEndPoint ent)))
		(setq dis 0)
		(setq dis (rem dis0 khcach)) )   )
	    (setq dis (/(rem dis0 khcach)2))  ) )
	(progn
	  (or *sodoan* (setq *sodoan* 10))
	  (setq sodoan (getint (strcat"\nNhap so doan <" (itoa *sodoan*) ">:")) )
	  (if sodoan (setq *sodoan* sodoan) (setq sodoan *sodoan*))
	  (setq dis 0
		khcach (/ dis0 sodoan) ) )	)
      (while (< dis dis0)
	(setq pt (vlax-curve-getPointAtDist Ent dis)
	      dis (+ dis khcach)
	      lst_Pt (append lst_Pt (list pt)) ))
      (if lst_Pt
	(foreach pt (reverse lst_Pt)
	  (command "._break" ent "_non" (trans pt 0 1) "_non" (trans pt 0 1)) ))
      (mapcar 'setvar vl ov)
      (command "undo" "e")  )
    (if isClosed
      (alert "List khong chay duoc tren doi tuong kin ")
      (alert "Khong chon duoc doi tuong !")))
  (princ))

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

Lisp dài vì mình chuyển đổi cả tính chất của đường Pline và mình chuyển điểm đầu luôn Ketxu à.

Lisp của mình là chuyển điểm đầu.

Kiểm tra nếu đúng -> nhập chiều dài

Sai -> đảo điểm đầu -> nhập chiều dài 

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

#8 quá được ý chứ nhưng sao lại không đưa lên bài nè lỡ sau này có bạn nào cần đổi đỉnh PL thì sao nhỉ ketxu.

Ket ghé qua đây giúp 18 tý chút nhé.

http://www.cadviet.com/forum/topic/85393-sua-lisp-loai-phan-tu-giong-nhau-trong-list/

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

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×