Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
11 replies to this topic

#1 asu2006

asu2006

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 29 October 2013 - 11:18 AM

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!


  • 0

#2 asu2006

asu2006

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 29 October 2013 - 02:08 PM

có ai giúp mình với. mình đang cần gấp...


  • 0

#3 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 29 October 2013 - 02:27 PM

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)

  • 1
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#4 asu2006

asu2006

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 29 October 2013 - 02:50 PM

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!


  • 0

#5 asu2006

asu2006

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 29 October 2013 - 02:58 PM

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!


  • 0

#6 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 29 October 2013 - 03:14 PM

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


  • 1
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#7 asu2006

asu2006

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 29 October 2013 - 04:32 PM

:D . Cảm ơn bạn nhiều! k có cái này mình ngồi cắt thì gãy tay mất. :D


  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 29 October 2013 - 04:56 PM

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 ?


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#9 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 30 October 2013 - 08:12 AM

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

  • 0

#10 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 08:13 AM

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 


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 30 October 2013 - 01:39 PM

Ket đọc code của bạn thì hiểu mà. Đổi lại là giết ng r ^^ Làm như #8 k đc sao ?


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 01:44 PM

#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.c...hau-trong-list/


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.