[Đã xong] Lisp thêm đỉnh cho PL

Tháng 6 6, 2011

Cảm ơn anh Ketxu đã nhiệt tình giúp đỡ

Thực ra là em chưa biết gì nhiều về lisp,

em chỉ sửa thử cái lisp có sẳn nên có lỗi gì em cũng không hiểu,

thôi em nói rõ để anh dễ giúp

Em làm cắt ngang địa hình bằng Nova trên Cad 14 nên phải thường tạo thêm nhiều đỉnh mới trên PLine

Bình thường em phải làm bằng lệnh :

Command: pe

PEDIT Select polyline or [Multiple]:

Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo]: e

Enter a vertex editing option

[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: i

Specify location for new vertex:

Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"

không phải gõ "e" -> "i"

Cái lisp Nut cũ anh sửa, em load Nut -> vẽ Line . chỉ tạo được 1 đỉnh trên Line đó muốn tạo thêm đỉnh nửa nó thoát ra luôn

Tháng 6 6, 2011

Cảm ơn anh Ketxu đã nhiệt tình giúp đỡ

Thực ra là em chưa biết gì nhiều về lisp,

em chỉ sửa thử cái lisp có sẳn nên có lỗi gì em cũng không hiểu,

thôi em nói rõ để anh dễ giúp

Em làm cắt ngang địa hình bằng Nova trên Cad 14 nên phải thường tạo thêm nhiều đỉnh mới trên PLine

Bình thường em phải làm bằng lệnh :

Command: pe

PEDIT Select polyline or [Multiple]:

Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo]: e

Enter a vertex editing option

[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: i

Specify location for new vertex:

Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"

không phải gõ "e" -> "i"

Cái lisp Nut cũ anh sửa, em load Nut -> vẽ Line . chỉ tạo được 1 đỉnh trên Line đó muốn tạo thêm đỉnh nửa nó thoát ra luôn

Vì bạn không chịu đọc bài mình nói

Mình sửa lại như thế này, làm mỗi lần 1 điểm, nếu bạn thích giống CAD thì bỏ phần pause "x" "" đi.

Cái theo yêu cầu Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"

không phải gõ "e" -> "i"

Update code : cho phép bạn chèn liên tiếp, đến bao giờ ấn Esc thì thôi!

(defun C:pe(/ ent) (setq ent (car(entsel "\n Chon doi tuong"))) 
 (cond ((=(cdadr (entget ent)) "LINE")
	(command "pedit" ent "" "E" )
	(while (< 0 (getvar "CMDACTIVE")) (command "I" pause))			
	)
 ((=(cdadr (entget ent)) "LWPOLYLINE")
	(command "pedit" ent "E")
	(while (< 0 (getvar "CMDACTIVE")) (command "I" pause))		
 )
))

Tháng 6 29, 2011

Cảm ơn anh Ketxu đã nhiệt tình giúp đỡ

Thực ra là em chưa biết gì nhiều về lisp,

em chỉ sửa thử cái lisp có sẳn nên có lỗi gì em cũng không hiểu,

thôi em nói rõ để anh dễ giúp

Em làm cắt ngang địa hình bằng Nova trên Cad 14 nên phải thường tạo thêm nhiều đỉnh mới trên PLine

Bình thường em phải làm bằng lệnh :

Command: pe

PEDIT Select polyline or [Multiple]:

Enter an option [Close/Join/Width/Edit vertex/Fit/Spline/Decurve/Ltype gen/Undo]: e

Enter a vertex editing option

[Next/Previous/Break/Insert/Move/Regen/Straighten/Tangent/Width/eXit] <N>: i

Specify location for new vertex:

Nhờ anh tạo lại cái lisp Nut vẫn sử dụng lệnh PE nhưng vào thẳng "Specify location for new vertex:"

không phải gõ "e" -> "i"

Cái lisp Nut cũ anh sửa, em load Nut -> vẽ Line . chỉ tạo được 1 đỉnh trên Line đó muốn tạo thêm đỉnh nửa nó thoát ra luôn

Mình cũng có 1 cái đây.

-Tên lệnh. TDPL:

-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.

(Defun C:tdpl ( )   
(command "undo" "be")
(chonduong)
(chidienthem)
(taothemnut)
(while
(chidienthem)
(taothemnut)
)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chidienthem ( )  
 (setq luubatdiem (getvar "osmode")) 
 (setvar "osmode" 545)
(setq diemthem (getpoint "\nDiem muon tao nut tren duong dan:"))
(setq daidendiemthem (vlax-curve-getDistAtPoint doituongt diemthem))
(cond 
     ((= daidendiemthem nil) (princ "\nDiem chon khong thuoc doi tuong muon them, chon lai:") (chidienthem))
     ((/= daidendiemthem nil)
 )
 ) 
(setvar "osmode" luubatdiem)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduong ( )  
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
(while
(null doituong1)
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
)
(chonduongd)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduongd ( )  
(setq doituongt (car doituong1))
(setq doituong (entget doituongt))
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun taothemnut ( )  
 (setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq sodinh (cdr (assoc 90 doituong)))
(setq Rec (acet-geom-vertex-list doituongt))
(setq ttd 0)
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
(while (< daidendiemdinh daidendiemthem)
(setq ttd (1+ ttd))
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
)
(command "pedit" doituongt "E")
(while (< 0 (getvar "CMDACTIVE")) 
(repeat (fix (fix (- ttd 1)))
(command "n"))
(command "I" diemthem "x" ""))
(setvar "osmode" luubatdiem)
(Princ)
(Princ)
)

*THeo mình xoi thì lisp của bác ket không ổn: ví dụ có pline có 2 phân đoạn khi mình chọn điểm muốn chèn nút ở phân đoạn thứ 2 thì pline mới sẽ thay đổi hình dáng do ko xét vị trí của nút muốn thêm so với các phân đoạn. Mà mình cũng ngạc nhiên là người yêu cầu lại thấy ổn khi dùng. :blush:

Tháng 6 29, 2011

Mình cũng có 1 cái đây.

-Tên lệnh. TDPL:

-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.

*THeo mình xoi thì lisp của bác ket không ổn: ví dụ có pline có 2 phân đoạn khi mình chọn điểm muốn chèn nút ở phân đoạn thứ 2 thì pline mới sẽ thay đổi hình dáng do ko xét vị trí của nút muốn thêm so với các phân đoạn. Mà mình cũng ngạc nhiên là người yêu cầu lại thấy ổn khi dùng. :blush:

Hề hề hề,

Chào các bác, mình cũng có cái ni mới mần thử, đem ra đây khoe của một tí, các bác chớ giận hỉ.


(defun c:advt (/ oldos enpl enp1 obj p pp plst n)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 545 )
(setq enpl (car (entsel "\n Chon polyline can them vertext "))
       obj (vlax-ename->vla-object enpl)
       p (getpoint "\n Pick point de them vertext")        
)
(while p
(setq pp (vlax-curve-getclosestpointto obj p))
(if (equal p pp 0.001)
   (progn
         (setq p pp)
         (command "break" enpl p "@")
         (setq enp1 (entlast)
                 plst (acet-geom-vertex-list enp1)
                 n (vlax-curve-getendparam obj) 
         )
         (command "erase" enp1 "")
         (command "pedit" enpl "e")
         (repeat (fix n)
               (command "n")
         )
         (foreach pt (cdr plst)
               (command "i" pt "n")
         )
         (command "x" "")
   )
   (progn
         (setq n (vlax-curve-getendparam obj))
         (command "pedit" enpl "e")
         (repeat (fix n)
               (command "n")
         )
         (command "i" p "x" "")
   )
)
(setq p nil)
(setq p (getpoint "\n Chon diem ke tiep "))
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)

Tháng 6 29, 2011

Ket có up 1 cái tương tự kích vào phân đoạn nào thì thêm ở đó ở diễn đàn r, giờ tìm cũng không thấy ^^ Ts bác Bình :wub:

Tháng 7 3, 2011

Mình cũng có 1 cái đây.

-Tên lệnh. TDPL:

-Chọn pline xong thì chọn các điểm muốn tạo thêm nút.

(Defun C:tdpl ( )   
(command "undo" "be")
(chonduong)
(chidienthem)
(taothemnut)
(while
(chidienthem)
(taothemnut)
)
(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chidienthem ( )  
 (setq luubatdiem (getvar "osmode")) 
 (setvar "osmode" 545)
(setq diemthem (getpoint "\nDiem muon tao nut tren duong dan:"))
(setq daidendiemthem (vlax-curve-getDistAtPoint doituongt diemthem))
(cond 
     ((= daidendiemthem nil) (princ "\nDiem chon khong thuoc doi tuong muon them, chon lai:") (chidienthem))
     ((/= daidendiemthem nil)
 )
 ) 
(setvar "osmode" luubatdiem)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduong ( )  
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
(while
(null doituong1)
(Prompt "\nChon doi tuong duong muon them nut")
(setq doituong1 (entsel))
)
(chonduongd)
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun chonduongd ( )  
(setq doituongt (car doituong1))
(setq doituong (entget doituongt))
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun taothemnut ( )  
 (setq luubatdiem (getvar "osmode"))
 (setvar "osmode" 0)
(setq sodinh (cdr (assoc 90 doituong)))
(setq Rec (acet-geom-vertex-list doituongt))
(setq ttd 0)
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
(while (< daidendiemdinh daidendiemthem)
(setq ttd (1+ ttd))
(setq daidendiemdinh (vlax-curve-getDistAtPoint doituongt (nth ttd Rec)))
)
(command "pedit" doituongt "E")
(while (< 0 (getvar "CMDACTIVE")) 
(repeat (fix (fix (- ttd 1)))
(command "n"))
(command "I" diemthem "x" ""))
(setvar "osmode" luubatdiem)
(Princ)
(Princ)
)

*THeo mình xoi thì lisp của bác ket không ổn: ví dụ có pline có 2 phân đoạn khi mình chọn điểm muốn chèn nút ở phân đoạn thứ 2 thì pline mới sẽ thay đổi hình dáng do ko xét vị trí của nút muốn thêm so với các phân đoạn. Mà mình cũng ngạc nhiên là người yêu cầu lại thấy ổn khi dùng. :blush:

Cái của bá Duy hình như ko được đâu?

[you] thử chưa?

Tháng 7 21, 2011

Ket có up 1 cái tương tự kích vào phân đoạn nào thì thêm ở đó ở diễn đàn r, giờ tìm cũng không thấy ^^ Ts bác Bình :wub:

Đây rồi. Source nguồn của Gilles Chanteau, ket thêm tí muối,lisp áp dụng cho cả Pline có arc và Width thay đổi

Lệnh vtx.

Update :

Ấn u hoặc Ctrl Z để undo trong quá trình làm việc

Cảm ơn bác Thaistreetz ^^

(defun c:vtx () ;main
(vl-load-com)
(vl-cmdf "undo" "Begin")
(initget "t b T B")
(setq ans (getkword "Th\U+00EAm hay b\U+1EDBt vextex ? [T / B]"))
(cond ((or(= ans "t")(= ans "T")(not ans))(addvtx))
	(T (delvtx))
)
(vl-cmdf "undo" "end")
)

(defun addvtx	(/    err  AcDoc     pl	  ob   pk   pa	 ap   typ  org
	 ucs  ocs  pt	sp   ep	  co   no   p1	 p2   pt   ce
	 a1   a2   bu	pw   wi	  nw
	) 
 (setq	m:err	*error*
*error*	err
AcDoc	(vla-get-activeDocument (vlax-get-acad-object))
os (getvar "osmode")

 )  

 (while 
(or(initget "u")
(setq pl (entsel "\nCh\U+1ECDn ph\U+00E2n \U+0111o\U+1EA1n mu\U+1ED1n add th\U+00EAm vertex : ")))	 
(cond  ((or(= pl "u")(= pl "U"))(vl-cmdf "undo" "back"))	
	   (T 
			(setq ob (vlax-ename->vla-object (car pl)))
			(setq typ (vla-get-Objectname ob))    
			(if	(or (= typ "AcDbPolyline")
				(and (member typ '("AcDb2dPolyline" "AcDb3dPolyline"))
				(= 0 (vla-get-Type ob))
				)
				)
				(progn
					(vl-cmdf "undo" "mark")
						(setq pk
						(if (= typ "AcDb3dPolyline")
							(trans (osnap (cadr pl) "_nea") 1 0)
							(vlax-curve-getClosestPointToProjection
							ob
	   (trans (cadr pl) 1 0)
	   (mapcar '-
		   (trans (getvar "VIEWDIR") 1 0)
		   (trans '(0 0 0) 1 0)
	   )
	 )
       )
)
(setq ap (/ (* (getvar "APERTURE")
	       (getvar "VIEWSIZE")
	    )
	    (cadr (getvar "SCREENSIZE"))
	 )
)
(if (= typ "AcDbPolyline")
  (setq co (split-list (vlax-get ob 'Coordinates) 2))
  (setq co (split-list (vlax-get ob 'Coordinates) 3))
)
(cond
  ((equal pk (vlax-curve-getStartPoint ob) ap)
   (setq pa 0)
   (if (= (vla-get-Closed ob) :vlax-false)
     (setq sp (vlax-curve-getStartPoint ob)
	   ep nil
     )
     (setq ep nil
	   sp nil
     )
   )
  )
  ((equal pk (vlax-curve-getEndPoint ob) ap)
   (setq pa (1- (length co)))
   (if (= (vla-get-Closed ob) :vlax-false)
     (setq ep (vlax-curve-getEndPoint ob)
	   sp nil
     )
     (setq ep nil
	   sp nil
     )
   )
  )
  (T
   (setq pa (atoi (rtos (vlax-curve-getParamAtPoint ob pk) 2))
	 ep nil
	 sp nil
   )
  )
)
(if (and (/= typ "AcDb3dPolyline")
	 (or
	   (not	(equal (trans '(0 0 1) 1 0 T)
		       (setq no (vlax-get ob 'Normal))
		       1e-9
		)
	   )
	   (and	(= typ "AcDbPolyline")
		(/= 0 (vla-get-Elevation ob))
	   )
	   (and (= typ "AcDb2dPolyline") (/= 0 (caddar co)))
	 )
    )
  (progn
    (setq ucs (vla-add
		(vla-get-UserCoordinateSystems AcDoc)
		(vlax-3d-point (setq org (getvar "UCSORG")))
		(vlax-3d-point (mapcar '+ org (getvar "UCSXDIR")))
		(vlax-3d-point (mapcar '+ org (getvar "UCSYDIR")))
		"addvtxUCS"
	      )
	  ocs (vla-add
		(vla-get-UserCoordinateSystems AcDoc)
		(vlax-3d-Point
		  (setq org (vlax-curve-getStartPoint ob))
		)
		(vlax-3d-Point
		  (mapcar '+ org (trans '(1 0 0) no 0))
		)
		(vlax-3d-Point
		  (mapcar '+ org (trans '(0 1 0) no 0))
		)
		"addvtxOCS"
	      )
    )
    (vla-put-activeUCS AcDoc ocs)
  )
)
(if (setq
      pt
       (getpoint (trans (vlax-curve-getPointAtParam ob pa) 0 1)
		 "\nPick \U+0111i\U+1EC3m th\U+00EAm vertex : "
       )
    )
  (progn
    (and ep (setq pa (- (length co) 2)))
    (if	(/= typ "AcDb3dPolyline")
      (progn
	(setq p1 (trans (vlax-curve-getPointAtParam ob pa) 0 no)
	      pt (trans pt 1 no)
	      p2 (trans	(vlax-curve-getPointAtParam ob (1+ pa))
			0
			no
		 )
	)
	(cond
	  ((and ep (/= 0 (vla-getBulge ob pa)))
	   ((lambda (a)
	      (setq
		bu
		 (list (cons (1+ (fix pa)) (/ (sin a) (cos a))))
	      )
	    )
	     (/
	       (- (angle p2 pt)
		  (+ (angle p2 p1)
		     (* 2 (atan (vla-getBulge ob pa)))
		     pi
		  )
	       )
	       2.0
	     )
	   )
	  )
	  ((and sp (/= 0 (vla-getBulge ob pa)))
	   ((lambda (a)
	      (setq
		bu (list (cons 0 (/ (sin a) (cos a))))
	      )
	    )
	     (/
	       (- (+ (angle p1 p2)
		     (* -2 (atan (vla-getBulge ob pa)))
		     pi
		  )
		  (angle p1 pt)
	       )
	       2.0
	     )
	   )
	  )
	  (T
	   (setq
	     ce	((lambda (mid1 mid2)
		   (inters mid1
			   (polar mid1
				  (+ (angle p1 pt) (/ pi 2))
				  1.0
			   )
			   mid2
			   (polar mid2
				  (+ (angle pt p2) (/ pi 2))
				  1.0
			   )
			   nil
		   )
		 )
		  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))
			  p1
			  pt
		  )
		  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))
			  pt
			  p2
		  )
		)
	   )
	   (if (or (= 0 (vla-getBulge ob pa)) (null ce))
	     (setq a1 0.0
		   a2 0.0
	     )
	     (if (< pi
		    (ang<2pi (- (angle pt p2) (angle p1 pt)))
		    (* 2 pi)
		 )
	       (setq a1	(- (ang<2pi (- (angle ce p1) (angle ce pt)))
			)
		     a2	(- (ang<2pi (- (angle ce pt) (angle ce p2)))
			)
	       )
	       (setq a1	(ang<2pi (- (angle ce pt) (angle ce p1)))
		     a2	(ang<2pi (- (angle ce p2) (angle ce pt)))
	       )
	     )
	   )
	   (setq bu
		  (list	(cons pa (/ (sin (/ a1 4.0)) (cos (/ a1 4.0))))
			(cons (1+ (fix pa))
			      (/ (sin (/ a2 4.0)) (cos (/ a2 4.0)))
			)
		  )
	   )
	  )
	)
	(vla-getWidth ob pa 'sw 'ew)
	(cond
	  ((equal pk (vlax-curve-getStartPoint ob) ap)
	   (setq
	     pw	(+ sw
		   (/ (* (distance p1 pt) (- ew sw))
		      (+ (distance pt p1) (distance p1 p2))
		   )
		)
	   )
	  )
	  ((equal pk (vlax-curve-getEndPoint ob) ap)
	   (setq
	     pw	(+ sw
		   (/ (* (distance p1 p2) (- ew sw))
		      (+ (distance pt p2) (distance p1 p2))
		   )
		)
	   )
	  )
	  (T
	   (setq
	     pw	(+ sw
		   (/ (* (distance p1 pt) (- ew sw))
		      (+ (distance p1 pt) (distance pt p2))
		   )
		)
	   )
	  )
	)
	(setq wi (list (list pa sw pw) (list (1+ pa) pw ew))
	      nw (1+ pa)
	)
	(repeat	(- (fix (vlax-curve-getEndParam ob)) (1+ pa))
	  (vla-getWidth ob nw 'sw 'ew)
	  (setq wi (cons (list (setq nw (1+ nw)) sw ew) wi))
	)
      )
    )
    (cond
      ((= typ "AcDbPolyline")
       (setq pt (list (car pt) (cadr pt)))
      )
      ((= typ "AcDb3dPolyline") (setq pt (trans pt 1 0)))
    )
    (or sp (setq pa (1+ pa)))
    (cond
      (sp (setq co (cons pt co)))
      (ep (setq co (append co (list pt))))
      (T
       (setq co	(append	(sublist co 0 pa)
			(cons pt (sublist co pa nil))
		)
       )
      )
    )
    (or
      (= typ "AcDb3dPolyline")
      (while (<= (setq pa (1+ pa)) (vlax-curve-getEndParam ob))
	(setq bu (cons (cons pa (vla-getBulge ob (1- pa))) bu))
      )
    )
    (vlax-put ob 'Coordinates (apply 'append co))
    (or	(= typ "AcDb3dPolyline")
	(and
	  (mapcar '(lambda (x) (vla-setBulge ob (car x) (cdr x)))
		  bu
	  )
	  (mapcar '(lambda (x)
		     (vla-setWidth ob (car x) (cadr x) (caddr x))
		   )
		  wi
	  )
	)
    )
    (and ucs (vla-put-activeUCS AcDoc ucs))
    (vla-EndUndoMark AcDoc)
  )
)
     )
     (progn	 
(alert "Ch\U+1ECDn sai \U+0111\U+1ED1i t\U+01B0\U+1EE3ng!")
(exit)
     ) 
   );end if check type
);end T
);end cond

 );end while
   (and ocs (vla-delete ocs) (setq ocs nil))
 (setq	*error*	m:err
m:err nil
 )  
 (princ)
)

(defun DelVtx	(/ err os pt ent typ plst par blst n wlst)
 (vl-load-com)
 (setq	m:err	*error*
*error*	err
os	(getvar "OSMODE")
  )
 (setvar "OSMODE" 1)		
 (while 
(or (initget "u")
(setq pt
	(getpoint
	  "\nCh\U+1ECDn vertex c\U+1EA7n x\U+00F3a :"
	)
 ))
(cond  ((or(= pt "u")(= pt "U"))(vl-cmdf "undo" "back"))
(T
  (if	(and
  (setq	ent (ssget pt
		   '((-4 . "<OR")
		     (0 . "LWPOLYLINE")
		     (-4 . "<AND")
		     (0 . "POLYLINE")
		     (-4 . "<NOT")
		     (-4 . "&")
		     (70 . 118)
		     (-4 . "NOT>")
		     (-4 . "AND>")
		     (-4 . "OR>")
		    )
	    )
  )
  (setq ent (vlax-ename->vla-object (ssname ent 0)))
  (setq typ (vla-get-ObjectName ent))
)
     (if
(and
  (setq	plst (if (= typ "AcDbPolyline")
	       (split-list (vlax-get ent 'Coordinates) 2)
	       (split-list (vlax-get ent 'Coordinates) 3)
	     )
  )
  (< 2 (length plst))
)
 (progn
   (vl-cmdf "undo" "mark")	   
   (setq pt   (trans pt 1 0)
	 par  (cond
		((equal pt (vlax-curve-getStartPoint ent) 1e-9)
		 0
		)
		((equal pt (vlax-curve-getEndPoint ent) 1e-9)
		 (1- (length plst))
		)
		(T
		 (atoi (rtos (vlax-curve-getParamAtPoint ent pt) 2)
		 )
		)
	      )
	 blst nil
	 wlst nil
	 n    0
   )
   (if (/= typ "AcDb3dPolyline")
     (progn
       (repeat (length plst)
	 (if (/= n par)
	   (setq
	     blst
	      (cons (cons (length blst) (vla-getBulge ent n))
		    blst
	      )
	   )
	 )
	 (setq n (1+ n))
       )
       (if (/= 0 par)
	 (progn
	   (vla-getWidth ent (1- par) 'swid1 'ewid1)
	   (vla-getWidth ent par 'swid2 'ewid2)
	   (setq wlst (cons (list (1- par) swid1 ewid2) wlst))
	 )
       )
       (repeat
	 (- (setq n (1- (fix (vlax-curve-getEndParam ent))))
	    par
	 )
	  (vla-getWidth ent n 'swid 'ewid)
	  (setq
	    wlst (cons (list (setq n (1- n)) swid ewid) wlst)
	  )
       )
     )
   )
   (vlax-put ent
	     'Coordinates
	     (apply 'append (vl-remove (nth par plst) plst))
   )
   (or (= typ "AcDb3dPolyline")
       (and
	 (mapcar '(lambda (x) (vla-setBulge ent (car x) (cdr x)))
		 blst
	 )
	 (mapcar '(lambda (x)
		    (vla-setWidth ent (car x) (cadr x) (caddr x))
		  )
		 wlst
	 )
       )
   )
   (vla-EndUndoMark
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
 )
 (progn
   (alert "\nKh\U+00F4ng th\U+1EC3 x\U+00F3a \U+0111\U+01B0\U+1EE3c, Pline n\U+00E0y ch\U+1EC9 c\U+00F3 1 ph\U+00E2n \U+0111o\U+1EA1n!")
   (exit)
 )
     )
     (progn
(alert "Ch\U+1ECDn sai \U+0111\U+1ED1i t\U+01B0\U+1EE3ng!")
(exit)
     )
   )
);endT
);end cond
 )
 (setvar "OSMODE" os)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;; SUBLIST Return a sub-list
;;;
;;; Arguments
;;; lst : a list
;;; start : start index for the sub-list (first item = 0)
;;; leng : sub-list length (or nil)
;;;
;;; Examples :
;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)
;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)

(defun sublist (lst start leng / n r)
 (if (or (not leng) (< (- (length lst) start) leng))
   (setq leng (- (length lst) start))
 )
 (setq n (+ start leng))
 (repeat leng
   (setq r (cons (nth (setq n (1- n)) lst) r))
 )
)

;; SPLIT-LIST Split a list into sub-lists
;; Arguments
;; - lst : the list to be splited
;; - num : an integer, the number of items of sub-lists
;; Examples :
;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))
;; (split-list '(1 2 3 4 5 6 7 8) 3) -> ((1 2 3) (4 5 6) (7 8))

(defun split-list (lst n)
 (if lst
   (cons (sublist lst 0 n)
  (split-list (sublist lst n nil) n)
   )
 )
)

;;; ANG<2PI
;; Transform any angle (in radians) into its equivalent between 0 and 2*pi

(defun ang<2pi (ang)
 (if (and (<= 0 ang) (< ang (* 2 pi)))
   ang
   (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
 )
)


(defun err (msg)
   (if	(or
  (= msg "Function cancelled")
  (= msg "quit / exit abort")
)
     (princ)
     (princ (strcat "\nError: " msg))
   )
   (vla-EndUndoMark
     (vla-get-ActiveDocument (vlax-get-acad-object))
   )
   (setvar "OSMODE" os)
   (setq *error* m:err
  m:err	nil
   )
 )

Tháng 7 21, 2011

Thật tuyệt vời đó ketxu à. Hii. Vote vài cái nữa. Hiii

Tháng 7 23, 2011

code trên rất hay. nhưng có 1 nhuợc điểm cũng rất... dở là không cho undo trong quá trình thêm hoặc bớt đỉnh ketxu ạ. cách thức undo như khi vẽ 1 pline, có 1 đỉnh nào đó mình pick sai thì gõ U, bỏ đỉnh đó đi để vẽ lại í. Bạn có thể tham khảo code này của mình để sửa nó ngon hơn.

;;; Add vertext into Polyline and LWPolyline 2010 by Thaistreetz
(defun c:Adv (/ DKCV LST LSTPT N PL PL1 PLS PLSTLAST PT PTA WP)
 (if (and (setq PL (car (entsel (TCVN3-Unicode " - Chän ®êng Pline cÇn thªm ®Ønh ")))) (wcmatch (cdr (assoc 0 (entget PL))) "*POLYLINE"))
	(progn      
		(vl-cmdf "undo" "begin")
		(if (= (cdr (assoc 0 (entget PL))) "POLYLINE")
			(progn
				(setq DKCV T PLSTLAST (getvar "PLINETYPE"))
				(setvar "PLINETYPE" 1)
				(vl-cmdf "convert" "P" "S" PL "")
				(setvar "PLINETYPE" PLSTLAST)
				);progn
			);if
  (setq PLs (ssadd PL (ssadd)))
  (while (progn
           (sssetfirst nil PLs)
					(initget 128 "u")
					(setq PTa (getpoint (TCVN3-Unicode "\nPick ®Ønh cÇn thªm ")))
					(if (= PTa "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) PTa))
	(if (/= PTa "u")
	(progn
	(vl-cmdf "undo" "mark")
   (setq PT (vlax-curve-getPointatParam PL (setq n (fix (vlax-curve-getParamatPoint PL (vlax-curve-getClosestPointto PL (setq PTa (trans PTa 1 0))))))))
	(setq Lst nil)
	(if (= n 0)
		(progn
			(setq Lstpt (reverse(acet-geom-pline-point-list PL nil))
						PL1 (makeLWPolyline lstpt nil nil nil nil nil nil))
			(if (= (fix (vlax-curve-getParamatPoint PL1 (vlax-curve-getClosestPointto PL1 PTa))) (- (length Lstpt) 1))
				(mapcar	'(lambda (x)
					(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons x (cons (list 10 (car PTa) (cadr PTa)) Lst))
							(cons x Lst))))
					(entget PL))
				(mapcar	'(lambda (x)
					(setq Lst	(if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
							(cons x Lst))))
					(entget PL)))
			(entdel PL1))						
   (mapcar '(lambda (x)
		(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
							(cons x Lst)))) (entget PL)))
     (entmod (reverse Lst))))
 );while
 (sssetfirst)
 (if DKCV (vl-cmdf "CONVERTPOLY" "H" wp "")))
 (prompt (TCVN3-Unicode "\n§èi tîng kh«ng ph¶i Polyline ")));if
(vl-cmdf "undo" "end")
 (princ)
);end
;;; remove vertext into Polyline and LWPolyline
;;; copyright 2010 by Gia_Bach
;;; Edited 2010 by thaistreetz
(defun c:edv (/ removenth bulges coords ent idx param pt DKCV PLSTLAST)
 (defun removenth (n lst / i rtn)
   (setq i -1)
   (foreach x lst (if (/= n (setq i (1+ i)))	(setq rtn (cons x rtn))))
  (reverse rtn))
(vl-cmdf "undo" "begin")
 (while (progn
				 (initget 128 "u")
				 (setq ent (entsel (TCVN3-Unicode "\nChän ®Ønh Pline cÇn xãa: ")))
				 (if (= ent "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) ent))
	(if (and (/= ent "u") (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
		(progn
			(vl-cmdf "undo" "Mark")
			(princ (setq pt (osnap (cadr ent) "near")))
			(if (= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
				(progn
	       (setq DKCV T PLSTLAST (getvar "PLINETYPE"))
	       (setvar "PLINETYPE" 1)
	       (vl-cmdf "convert" "P" "S" (car ent) "")
	       (setvar "PLINETYPE" PLSTLAST)))		    
	    (setq ent (vlax-ename->vla-object (car ent))
						param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0))
						coords (vlax-get ent 'coordinates) idx -1 bulges nil)
	    (repeat (/ (length coords) 2) (setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges)))
	    (setq bulges (removenth param (reverse bulges)))
	    (repeat 2 (setq coords (removenth (* 2 param) coords)))
	    (vlax-put ent 'coordinates coords)
	    (setq idx -1)
	    (foreach bulge bulges (vla-setbulge ent (setq idx (1+ idx)) bulge))))
);while
(if DKCV (vl-cmdf "CONVERTPOLY" "H" ent ""))
(vl-cmdf "undo" "end")
 (princ)
 );end
(defun TCVN3-Unicode (stsua / index stdich chuht chusua tapsua)
(if (= (getvar "acadver") "16.1s (LMS Tech)") stsua (progn
(setq tapsua
(list	(cons "µ" "\U+00E0")(cons "Ì" "\U+00E8")(cons "ß" "\U+00F2")(cons "ï" "\U+00F9")
(cons "¸" "\U+00E1")(cons "Ð" "\U+00E9")(cons "ã" "\U+00F3")(cons "ó" "\U+00FA")
(cons "¶" "\U+1EA3")(cons "Î" "\U+1EBB")(cons "á" "\U+1ECF")(cons "ñ" "\U+1EE7")
(cons "·" "\U+00E3")(cons "Ï" "\U+1EBD")(cons "â" "\U+00F5")(cons "ò" "\U+0169")
(cons "¹" "\U+1EA1")(cons "Ñ" "\U+1EB9")(cons "ä" "\U+1ECD")(cons "ô" "\U+1EE5")
(cons "©" "\U+00E2")(cons "ª" "\U+00EA")(cons "«" "\U+00F4")(cons "" "\U+01B0")
(cons "Ç" "\U+1EA7")(cons "Ò" "\U+1EC1")(cons "å" "\U+1ED3")(cons "õ" "\U+1EEB")
(cons "Ê" "\U+1EA5")(cons "Õ" "\U+1EBF")(cons "è" "\U+1ED1")(cons "ø" "\U+1EE9")
(cons "È" "\U+1EA9")(cons "Ó" "\U+1EC3")(cons "æ" "\U+1ED5")(cons "ö" "\U+1EED")
(cons "É" "\U+1EAB")(cons "Ô" "\U+1EC5")(cons "ç" "\U+1ED7")(cons "÷" "\U+1EEF")
(cons "Ë" "\U+1EAD")(cons "Ö" "\U+1EC7")(cons "é" "\U+1ED9")(cons "ù" "\U+1EF1")
(cons "¨" "\U+0103")(cons "×" "\U+00EC")(cons "¬" "\U+01A1")(cons "ú" "\U+1EF3")
(cons "»" "\U+1EB1")(cons "Ý" "\U+00ED")(cons "ê" "\U+1EDD")(cons "ý" "\U+00FD")
(cons "¾" "\U+1EAF")(cons "Ø" "\U+1EC9")(cons "í" "\U+1EDB")(cons "û" "\U+1EF7")
(cons "¼" "\U+1EB3")(cons "Ü" "\U+0129")(cons "ë" "\U+1EDF")(cons "ü" "\U+1EF9")
(cons "½" "\U+1EB5")(cons "Þ" "\U+1ECB")(cons "ì" "\U+1EE1")(cons "þ" "\U+1EF5")
(cons "Æ" "\U+1EB7")(cons "®" "\U+0111")(cons "î" "\U+1EE3")(cons "¦" "\U+01AF")
(cons "¢" "\U+00C2")(cons "§" "\U+0110")(cons "¤" "\U+00D4")(cons "¥" "\U+01A0")
(cons "¡" "\U+0102")(cons "£" "\U+00CA")))
(setq index 1 stdich "")
(repeat (strlen stsua)
(setq chuht  (substr stsua index 1)
index  (1+ index)
chusua (cond ((assoc chuht tapsua) (cdr (assoc chuht tapsua))) (t chuht))
stdich (strcat stdich chusua)))
stdich)))
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end

Tháng 7 23, 2011

code trên rất hay. nhưng có 1 nhuợc điểm cũng rất... dở là không cho undo trong quá trình thêm hoặc bớt đỉnh ketxu ạ. cách thức undo như khi vẽ 1 pline, có 1 đỉnh nào đó mình pick sai thì gõ U, bỏ đỉnh đó đi để vẽ lại í. Bạn có thể tham khảo code này của mình để sửa nó ngon hơn.

;;; Add vertext into Polyline and LWPolyline 2010 by Thaistreetz
(defun c:Adv (/ DKCV LST LSTPT N PL PL1 PLS PLSTLAST PT PTA WP)
 (if (and (setq PL (car (entsel (TCVN3-Unicode " - Chän ®êng Pline cÇn thªm ®Ønh ")))) (wcmatch (cdr (assoc 0 (entget PL))) "*POLYLINE"))
	(progn      
		(vl-cmdf "undo" "begin")
		(if (= (cdr (assoc 0 (entget PL))) "POLYLINE")
			(progn
				(setq DKCV T PLSTLAST (getvar "PLINETYPE"))
				(setvar "PLINETYPE" 1)
				(vl-cmdf "convert" "P" "S" PL "")
				(setvar "PLINETYPE" PLSTLAST)
				);progn
			);if
  (setq PLs (ssadd PL (ssadd)))
  (while (progn
           (sssetfirst nil PLs)
					(initget 128 "u")
					(setq PTa (getpoint (TCVN3-Unicode "\nPick ®Ønh cÇn thªm ")))
					(if (= PTa "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) PTa))
	(if (/= PTa "u")
	(progn
	(vl-cmdf "undo" "mark")
   (setq PT (vlax-curve-getPointatParam PL (setq n (fix (vlax-curve-getParamatPoint PL (vlax-curve-getClosestPointto PL (setq PTa (trans PTa 1 0))))))))
	(setq Lst nil)
	(if (= n 0)
		(progn
			(setq Lstpt (reverse(acet-geom-pline-point-list PL nil))
						PL1 (makeLWPolyline lstpt nil nil nil nil nil nil))
			(if (= (fix (vlax-curve-getParamatPoint PL1 (vlax-curve-getClosestPointto PL1 PTa))) (- (length Lstpt) 1))
				(mapcar	'(lambda (x)
					(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons x (cons (list 10 (car PTa) (cadr PTa)) Lst))
							(cons x Lst))))
					(entget PL))
				(mapcar	'(lambda (x)
					(setq Lst	(if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
							(cons x Lst))))
					(entget PL)))
			(entdel PL1))						
   (mapcar '(lambda (x)
		(setq Lst (if (equal x (list 10 (car PT) (cadr PT)) 0.0001)
							(cons (list 10 (car PTa) (cadr PTa)) (cons x Lst))
							(cons x Lst)))) (entget PL)))
     (entmod (reverse Lst))))
 );while
 (sssetfirst)
 (if DKCV (vl-cmdf "CONVERTPOLY" "H" wp "")))
 (prompt (TCVN3-Unicode "\n§èi tîng kh«ng ph¶i Polyline ")));if
(vl-cmdf "undo" "end")
 (princ)
);end
;;; remove vertext into Polyline and LWPolyline
;;; copyright 2010 by Gia_Bach
;;; Edited 2010 by thaistreetz
(defun c:edv (/ removenth bulges coords ent idx param pt DKCV PLSTLAST)
 (defun removenth (n lst / i rtn)
   (setq i -1)
   (foreach x lst (if (/= n (setq i (1+ i)))	(setq rtn (cons x rtn))))
  (reverse rtn))
(vl-cmdf "undo" "begin")
 (while (progn
				 (initget 128 "u")
				 (setq ent (entsel (TCVN3-Unicode "\nChän ®Ønh Pline cÇn xãa: ")))
				 (if (= ent "u") (progn (prompt "- Undo") (vl-cmdf "undo" "Back")) ent))
	(if (and (/= ent "u") (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
		(progn
			(vl-cmdf "undo" "Mark")
			(princ (setq pt (osnap (cadr ent) "near")))
			(if (= (cdr (assoc 0 (entget (car ent)))) "POLYLINE")
				(progn
	       (setq DKCV T PLSTLAST (getvar "PLINETYPE"))
	       (setvar "PLINETYPE" 1)
	       (vl-cmdf "convert" "P" "S" (car ent) "")
	       (setvar "PLINETYPE" PLSTLAST)))		    
	    (setq ent (vlax-ename->vla-object (car ent))
						param (atoi (rtos (vlax-curve-getparamatpoint ent pt) 2 0))
						coords (vlax-get ent 'coordinates) idx -1 bulges nil)
	    (repeat (/ (length coords) 2) (setq bulges (cons (vla-getbulge ent (setq idx (1+ idx))) bulges)))
	    (setq bulges (removenth param (reverse bulges)))
	    (repeat 2 (setq coords (removenth (* 2 param) coords)))
	    (vlax-put ent 'coordinates coords)
	    (setq idx -1)
	    (foreach bulge bulges (vla-setbulge ent (setq idx (1+ idx)) bulge))))
);while
(if DKCV (vl-cmdf "CONVERTPOLY" "H" ent ""))
(vl-cmdf "undo" "end")
 (princ)
 );end
(defun TCVN3-Unicode (stsua / index stdich chuht chusua tapsua)
(if (= (getvar "acadver") "16.1s (LMS Tech)") stsua (progn
(setq tapsua
(list	(cons "µ" "\U+00E0")(cons "Ì" "\U+00E8")(cons "ß" "\U+00F2")(cons "ï" "\U+00F9")
(cons "¸" "\U+00E1")(cons "Ð" "\U+00E9")(cons "ã" "\U+00F3")(cons "ó" "\U+00FA")
(cons "¶" "\U+1EA3")(cons "Î" "\U+1EBB")(cons "á" "\U+1ECF")(cons "ñ" "\U+1EE7")
(cons "·" "\U+00E3")(cons "Ï" "\U+1EBD")(cons "â" "\U+00F5")(cons "ò" "\U+0169")
(cons "¹" "\U+1EA1")(cons "Ñ" "\U+1EB9")(cons "ä" "\U+1ECD")(cons "ô" "\U+1EE5")
(cons "©" "\U+00E2")(cons "ª" "\U+00EA")(cons "«" "\U+00F4")(cons "" "\U+01B0")
(cons "Ç" "\U+1EA7")(cons "Ò" "\U+1EC1")(cons "å" "\U+1ED3")(cons "õ" "\U+1EEB")
(cons "Ê" "\U+1EA5")(cons "Õ" "\U+1EBF")(cons "è" "\U+1ED1")(cons "ø" "\U+1EE9")
(cons "È" "\U+1EA9")(cons "Ó" "\U+1EC3")(cons "æ" "\U+1ED5")(cons "ö" "\U+1EED")
(cons "É" "\U+1EAB")(cons "Ô" "\U+1EC5")(cons "ç" "\U+1ED7")(cons "÷" "\U+1EEF")
(cons "Ë" "\U+1EAD")(cons "Ö" "\U+1EC7")(cons "é" "\U+1ED9")(cons "ù" "\U+1EF1")
(cons "¨" "\U+0103")(cons "×" "\U+00EC")(cons "¬" "\U+01A1")(cons "ú" "\U+1EF3")
(cons "»" "\U+1EB1")(cons "Ý" "\U+00ED")(cons "ê" "\U+1EDD")(cons "ý" "\U+00FD")
(cons "¾" "\U+1EAF")(cons "Ø" "\U+1EC9")(cons "í" "\U+1EDB")(cons "û" "\U+1EF7")
(cons "¼" "\U+1EB3")(cons "Ü" "\U+0129")(cons "ë" "\U+1EDF")(cons "ü" "\U+1EF9")
(cons "½" "\U+1EB5")(cons "Þ" "\U+1ECB")(cons "ì" "\U+1EE1")(cons "þ" "\U+1EF5")
(cons "Æ" "\U+1EB7")(cons "®" "\U+0111")(cons "î" "\U+1EE3")(cons "¦" "\U+01AF")
(cons "¢" "\U+00C2")(cons "§" "\U+0110")(cons "¤" "\U+00D4")(cons "¥" "\U+01A0")
(cons "¡" "\U+0102")(cons "£" "\U+00CA")))
(setq index 1 stdich "")
(repeat (strlen stsua)
(setq chuht  (substr stsua index 1)
index  (1+ index)
chusua (cond ((assoc chuht tapsua) (cdr (assoc chuht tapsua))) (t chuht))
stdich (strcat stdich chusua)))
stdich)))
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")
(cons 8 (if Layer Layer (getvar "Clayer")))
(cons 6 (if Linetype Linetype "bylayer"))
(cons 48 (if LTScale LTScale 1))
(cons 62 (if Color Color 256))
'(100 . "AcDbPolyline")
(cons 90 (length listpoint))
(cons 70 (if closed 1 0))))
(foreach PP listpoint	(setq Lst (append Lst (list (cons 10 PP)))))
(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))
(entmakex Lst));end

Lisp của bác viết rất hay. Vote cho bác 1 cái. Tuy nhiên nếu như mình kích chọn Pline rồi chọn 1 điểm xa cái Pline đó thì điểm thêm sẽ không đúng ý (Giống như của Ketxu đó). Vẫn còn thiếu chức năng xóa đỉnh Pline. Hii. Đấy là em nhận xét và so sánh thôi vì cả 2 lisp đều pro mà. Hii.

Tháng 7 23, 2011

Lisp của bác viết rất hay. Vote cho bác 1 cái. Tuy nhiên nếu như mình kích chọn Pline rồi chọn 1 điểm xa cái Pline đó thì điểm thêm sẽ không đúng ý (Giống như của Ketxu đó). Vẫn còn thiếu chức năng xóa đỉnh Pline. Hii. Đấy là em nhận xét và so sánh thôi vì cả 2 lisp đều pro mà. Hii.

trong đó có lệnh xóa đỉnh pline rồi mà bạn. lệnh edv đó, mình tách nó ra chứ không muốn gộp chung vào 1 lệnh cho đỡ lằng nhằng.

về việc pick 1 điểm xa pline kết quả không như ý là đúng rồi. bởi thực tế sử dụng mình thấy rất ít khi có nhu cầu như vậy nên bỏ lựa chọn phân đoạn để thêm đỉnh, giảm được 1 lần pick cho mỗi đỉnh cần thêm, điểm pick sẽ được gắn vào phân đoạn gần nó nhất.

Nếu cần tổng quát thì các bạn sử dụng lisp của ketxu, còn nếu đại lãn như mình, ngại 1 vài cái pick chuột thì.. lisp của mình chơi được :rolleyes:

Tháng 7 23, 2011

Hi hi, tks bác đã góp ý, cái này gọi là điểm thiếu chứ k gọi là điểm dở, vì e đã code case này đâu. Code update bên trên ạ :rolleyes:

Code của bác giúp e biết thêm phần iniget ^^

Còn chế độ bắt điểm khi add thì chưa hợp lý lắm, và đôi khi add hay erase không đúng ý ^^

Cái vụ TCVN-Unicode k hiển thị đúng trong máy e, lạ thật !

Tháng 8 31, 2011

Đề nghị các bạn cho mình đoạn lisp thêm đỉnh cho polyline khép kín với số lượng xác định trưỡc

Tháng 8 31, 2011

Đề nghị các bạn cho mình đoạn lisp thêm đỉnh cho polyline khép kín với số lượng xác định trưỡc

Đề nghị đã được xét duyệt. Vậy bạn chờ nhé :blush:

Tháng 4 3, 2013

Lisp của ketxu hoạt động rất tốt, tuy nhiên mỗi lần chèn đỉnh vẫn phải chọn phân đoạn nên rất bất tiện nếu muốn chèn nhiều điểm. Nếu cho phép chèn "multiple" trên một đoạn bất kỳ thì tốt hơn rất nhiều.

Tháng 4 3, 2013

Oh, tuỳ chọn Undo của ketxu rất nguy hiểm.

Command: VTX undo Current settings: Auto = On, Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: Begin
Command: Thêm hay bớt vextex ? [T / B]t
Chọn phân đoạn muốn add thêm vertex : undo Current settings: Auto = On, Control
= All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: mark
Command:
Pick điểm thêm vertex :
Chọn phân đoạn muốn add thêm vertex : u undo Current settings: Auto = On,
Control = All, Combine = Yes
Enter the number of operations to undo or [Auto/Control/BEgin/End/Mark/Back]
<1>: back This will undo everything. OK? <Y>
Chọn phân đoạn muốn add thêm vertex : u undo
Yes or No, please.
This will undo everything. OK? <Y> back
Yes or No, please.

Chọn phân đoạn muốn add thêm vertex : This will undo everything. OK? <Y> undo
Yes or No, please.
This will undo everything. OK? <Y> end
Yes or No, please.
nil
This will undo everything. OK? <Y> GROUP GROUP LINE VLIDE GROUP FILLET PLINE
PLINE GROUP
Everything has been undone

Nguy hiểm nhất là Undo everything với tuỳ chọn Yes mặc định, nếu nhấn enter thì coi như bạn ... chưa làm gì từ lúc mở bản vẽ.

Tháng 4 3, 2013

Cả 2 vấn đề LL nêu đều nhìn thấy trong code, vậy bạn thử tự sửa xem sao ^^

Tháng 4 3, 2013

Nếu tự sửa thì mình đã làm việc đó và up code mới lên rồi, cần gì phải nêu ra hả bạn? Nếu tất cả đều có thể tự làm thì việc tồn tại 4R liệu có cần thiết?

Tháng 4 3, 2013

Nếu tự sửa thì mình đã làm việc đó và up code mới lên rồi, cần gì phải nêu ra hả bạn? Nếu tất cả đều có thể tự làm thì việc tồn tại 4R liệu có cần thiết?

Vậy sao bạn k đặt câu hỏi ? Ban thử sửa chưa? Nó vấp ở đâu rồi ?

Nếu cứ nêu ra là mọi vấn đề được giải quyết thì ta dùng fb, blog, sms ... cũng đc vậy, khỏi 4r luôn :))

Vui vậy thôi, chẳng ai nâng quan điểm lên từ ch này cả Ll ạ. Mình trả lời theo tên nick của bạn thôi, nếu bạn cũng k hứng thú vận động trước thì chúng ta cùng ... chờ các bác khác giúp, vì lisp này ket chôm lại, ket đọc cũng mù tịt á ^^

Tháng 4 3, 2013

... ket đọc cũng mù tịt á ^^

Oh, really??

Tháng 6 8, 2016

chán ghê bây giò em muốn cát poline thành 2 đường tuỳ chọn .. các bác chỉ em phát .. em làm adv edv .. rùi vtx của các bác đều ko được và đều báo lỗi

Tháng 6 8, 2016

Có 1 vấn đề hơi nhức nhối là lisp vtx của bác rất hay, mà cad 2005 dùng không đưoc ( đã có Expess cho cad2005), cad 2007 thì OK

Có Bác nào có cách khắc phục không ta, mò miết mà không tìm thấy nguyên nhân tại sao cad 2005 lại dùng không được

Tháng 6 17, 2016

Đây rồi. Source nguồn của Gilles Chanteau, ket thêm tí muối,lisp áp dụng cho cả Pline có arc và Width thay đổi

Lệnh vtx.

Update :

Ấn u hoặc Ctrl Z để undo trong quá trình làm việc

Cảm ơn bác Thaistreetz ^^

(defun c:vtx () ;main

(vl-load-com)

(vl-cmdf "undo" "Begin")

(initget "t b T B")

(setq ans (getkword "Th\U+00EAm hay b\U+1EDBt vextex ? [T / B]"))

(cond ((or(= ans "t")(= ans "T")(not ans))(addvtx))

		(T (delvtx))

)

(vl-cmdf "undo" "end")

)



(defun addvtx	(/    err  AcDoc     pl	  ob   pk   pa	 ap   typ  org

		 ucs  ocs  pt	sp   ep	  co   no   p1	 p2   pt   ce

		 a1   a2   bu	pw   wi	  nw

		) 

  (setq	m:err	*error*

	*error*	err

	AcDoc	(vla-get-activeDocument (vlax-get-acad-object))

	os (getvar "osmode")

	 

  )  



  (while 

	(or(initget "u")

	(setq pl (entsel "\nCh\U+1ECDn ph\U+00E2n \U+0111o\U+1EA1n mu\U+1ED1n add th\U+00EAm vertex : ")))	 

	(cond  ((or(= pl "u")(= pl "U"))(vl-cmdf "undo" "back"))	

		   (T 

				(setq ob (vlax-ename->vla-object (car pl)))

				(setq typ (vla-get-Objectname ob))    

				(if	(or (= typ "AcDbPolyline")

					(and (member typ '("AcDb2dPolyline" "AcDb3dPolyline"))

					(= 0 (vla-get-Type ob))

					)

					)

					(progn

						(vl-cmdf "undo" "mark")

							(setq pk

							(if (= typ "AcDb3dPolyline")

								(trans (osnap (cadr pl) "_nea") 1 0)

								(vlax-curve-getClosestPointToProjection

								ob

		   (trans (cadr pl) 1 0)

		   (mapcar '-

			   (trans (getvar "VIEWDIR") 1 0)

			   (trans '(0 0 0) 1 0)

		   )

		 )

	       )

	)

	(setq ap (/ (* (getvar "APERTURE")

		       (getvar "VIEWSIZE")

		    )

		    (cadr (getvar "SCREENSIZE"))

		 )

	)

	(if (= typ "AcDbPolyline")

	  (setq co (split-list (vlax-get ob 'Coordinates) 2))

	  (setq co (split-list (vlax-get ob 'Coordinates) 3))

	)

	(cond

	  ((equal pk (vlax-curve-getStartPoint ob) ap)

	   (setq pa 0)

	   (if (= (vla-get-Closed ob) :vlax-false)

	     (setq sp (vlax-curve-getStartPoint ob)

		   ep nil

	     )

	     (setq ep nil

		   sp nil

	     )

	   )

	  )

	  ((equal pk (vlax-curve-getEndPoint ob) ap)

	   (setq pa (1- (length co)))

	   (if (= (vla-get-Closed ob) :vlax-false)

	     (setq ep (vlax-curve-getEndPoint ob)

		   sp nil

	     )

	     (setq ep nil

		   sp nil

	     )

	   )

	  )

	  (T

	   (setq pa (atoi (rtos (vlax-curve-getParamAtPoint ob pk) 2))

		 ep nil

		 sp nil

	   )

	  )

	)

	(if (and (/= typ "AcDb3dPolyline")

		 (or

		   (not	(equal (trans '(0 0 1) 1 0 T)

			       (setq no (vlax-get ob 'Normal))

			       1e-9

			)

		   )

		   (and	(= typ "AcDbPolyline")

			(/= 0 (vla-get-Elevation ob))

		   )

		   (and (= typ "AcDb2dPolyline") (/= 0 (caddar co)))

		 )

	    )

	  (progn

	    (setq ucs (vla-add

			(vla-get-UserCoordinateSystems AcDoc)

			(vlax-3d-point (setq org (getvar "UCSORG")))

			(vlax-3d-point (mapcar '+ org (getvar "UCSXDIR")))

			(vlax-3d-point (mapcar '+ org (getvar "UCSYDIR")))

			"addvtxUCS"

		      )

		  ocs (vla-add

			(vla-get-UserCoordinateSystems AcDoc)

			(vlax-3d-Point

			  (setq org (vlax-curve-getStartPoint ob))

			)

			(vlax-3d-Point

			  (mapcar '+ org (trans '(1 0 0) no 0))

			)

			(vlax-3d-Point

			  (mapcar '+ org (trans '(0 1 0) no 0))

			)

			"addvtxOCS"

		      )

	    )

	    (vla-put-activeUCS AcDoc ocs)

	  )

	)

	(if (setq

	      pt

	       (getpoint (trans (vlax-curve-getPointAtParam ob pa) 0 1)

			 "\nPick \U+0111i\U+1EC3m th\U+00EAm vertex : "

	       )

	    )

	  (progn

	    (and ep (setq pa (- (length co) 2)))

	    (if	(/= typ "AcDb3dPolyline")

	      (progn

		(setq p1 (trans (vlax-curve-getPointAtParam ob pa) 0 no)

		      pt (trans pt 1 no)

		      p2 (trans	(vlax-curve-getPointAtParam ob (1+ pa))

				0

				no

			 )

		)

		(cond

		  ((and ep (/= 0 (vla-getBulge ob pa)))

		   ((lambda (a)

		      (setq

			bu

			 (list (cons (1+ (fix pa)) (/ (sin a) (cos a))))

		      )

		    )

		     (/

		       (- (angle p2 pt)

			  (+ (angle p2 p1)

			     (* 2 (atan (vla-getBulge ob pa)))

			     pi

			  )

		       )

		       2.0

		     )

		   )

		  )

		  ((and sp (/= 0 (vla-getBulge ob pa)))

		   ((lambda (a)

		      (setq

			bu (list (cons 0 (/ (sin a) (cos a))))

		      )

		    )

		     (/

		       (- (+ (angle p1 p2)

			     (* -2 (atan (vla-getBulge ob pa)))

			     pi

			  )

			  (angle p1 pt)

		       )

		       2.0

		     )

		   )

		  )

		  (T

		   (setq

		     ce	((lambda (mid1 mid2)

			   (inters mid1

				   (polar mid1

					  (+ (angle p1 pt) (/ pi 2))

					  1.0

				   )

				   mid2

				   (polar mid2

					  (+ (angle pt p2) (/ pi 2))

					  1.0

				   )

				   nil

			   )

			 )

			  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))

				  p1

				  pt

			  )

			  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0))

				  pt

				  p2

			  )

			)

		   )

		   (if (or (= 0 (vla-getBulge ob pa)) (null ce))

		     (setq a1 0.0

			   a2 0.0

		     )

		     (if (< pi

			    (ang<2pi (- (angle pt p2) (angle p1 pt)))

			    (* 2 pi)

			 )

		       (setq a1	(- (ang<2pi (- (angle ce p1) (angle ce pt)))

				)

			     a2	(- (ang<2pi (- (angle ce pt) (angle ce p2)))

				)

		       )

		       (setq a1	(ang<2pi (- (angle ce pt) (angle ce p1)))

			     a2	(ang<2pi (- (angle ce p2) (angle ce pt)))

		       )

		     )

		   )

		   (setq bu

			  (list	(cons pa (/ (sin (/ a1 4.0)) (cos (/ a1 4.0))))

				(cons (1+ (fix pa))

				      (/ (sin (/ a2 4.0)) (cos (/ a2 4.0)))

				)

			  )

		   )

		  )

		)

		(vla-getWidth ob pa 'sw 'ew)

		(cond

		  ((equal pk (vlax-curve-getStartPoint ob) ap)

		   (setq

		     pw	(+ sw

			   (/ (* (distance p1 pt) (- ew sw))

			      (+ (distance pt p1) (distance p1 p2))

			   )

			)

		   )

		  )

		  ((equal pk (vlax-curve-getEndPoint ob) ap)

		   (setq

		     pw	(+ sw

			   (/ (* (distance p1 p2) (- ew sw))

			      (+ (distance pt p2) (distance p1 p2))

			   )

			)

		   )

		  )

		  (T

		   (setq

		     pw	(+ sw

			   (/ (* (distance p1 pt) (- ew sw))

			      (+ (distance p1 pt) (distance pt p2))

			   )

			)

		   )

		  )

		)

		(setq wi (list (list pa sw pw) (list (1+ pa) pw ew))

		      nw (1+ pa)

		)

		(repeat	(- (fix (vlax-curve-getEndParam ob)) (1+ pa))

		  (vla-getWidth ob nw 'sw 'ew)

		  (setq wi (cons (list (setq nw (1+ nw)) sw ew) wi))

		)

	      )

	    )

	    (cond

	      ((= typ "AcDbPolyline")

	       (setq pt (list (car pt) (cadr pt)))

	      )

	      ((= typ "AcDb3dPolyline") (setq pt (trans pt 1 0)))

	    )

	    (or sp (setq pa (1+ pa)))

	    (cond

	      (sp (setq co (cons pt co)))

	      (ep (setq co (append co (list pt))))

	      (T

	       (setq co	(append	(sublist co 0 pa)

				(cons pt (sublist co pa nil))

			)

	       )

	      )

	    )

	    (or

	      (= typ "AcDb3dPolyline")

	      (while (<= (setq pa (1+ pa)) (vlax-curve-getEndParam ob))

		(setq bu (cons (cons pa (vla-getBulge ob (1- pa))) bu))

	      )

	    )

	    (vlax-put ob 'Coordinates (apply 'append co))

	    (or	(= typ "AcDb3dPolyline")

		(and

		  (mapcar '(lambda (x) (vla-setBulge ob (car x) (cdr x)))

			  bu

		  )

		  (mapcar '(lambda (x)

			     (vla-setWidth ob (car x) (cadr x) (caddr x))

			   )

			  wi

		  )

		)

	    )

	    (and ucs (vla-put-activeUCS AcDoc ucs))

	    (vla-EndUndoMark AcDoc)

	  )

	)

      )

      (progn	 

	(alert "Ch\U+1ECDn sai \U+0111\U+1ED1i t\U+01B0\U+1EE3ng!")

	(exit)

      ) 

    );end if check type

	);end T

	);end cond

	

  );end while

    (and ocs (vla-delete ocs) (setq ocs nil))

  (setq	*error*	m:err

	m:err nil

  )  

  (princ)

)



(defun DelVtx	(/ err os pt ent typ plst par blst n wlst)

  (vl-load-com)

  (setq	m:err	*error*

	*error*	err

	os	(getvar "OSMODE")

	  )

  (setvar "OSMODE" 1)		

  (while 

	(or (initget "u")

	(setq pt

		(getpoint

		  "\nCh\U+1ECDn vertex c\U+1EA7n x\U+00F3a :"

		)

	 ))

(cond  ((or(= pt "u")(= pt "U"))(vl-cmdf "undo" "back"))

	(T

   (if	(and

	  (setq	ent (ssget pt

			   '((-4 . "<OR")

			     (0 . "LWPOLYLINE")

			     (-4 . "<AND")

			     (0 . "POLYLINE")

			     (-4 . "<NOT")

			     (-4 . "&")

			     (70 . 118)

			     (-4 . "NOT>")

			     (-4 . "AND>")

			     (-4 . "OR>")

			    )

		    )

	  )

	  (setq ent (vlax-ename->vla-object (ssname ent 0)))

	  (setq typ (vla-get-ObjectName ent))

	)

      (if

	(and

	  (setq	plst (if (= typ "AcDbPolyline")

		       (split-list (vlax-get ent 'Coordinates) 2)

		       (split-list (vlax-get ent 'Coordinates) 3)

		     )

	  )

	  (< 2 (length plst))

	)

	 (progn

	   (vl-cmdf "undo" "mark")	   

	   (setq pt   (trans pt 1 0)

		 par  (cond

			((equal pt (vlax-curve-getStartPoint ent) 1e-9)

			 0

			)

			((equal pt (vlax-curve-getEndPoint ent) 1e-9)

			 (1- (length plst))

			)

			(T

			 (atoi (rtos (vlax-curve-getParamAtPoint ent pt) 2)

			 )

			)

		      )

		 blst nil

		 wlst nil

		 n    0

	   )

	   (if (/= typ "AcDb3dPolyline")

	     (progn

	       (repeat (length plst)

		 (if (/= n par)

		   (setq

		     blst

		      (cons (cons (length blst) (vla-getBulge ent n))

			    blst

		      )

		   )

		 )

		 (setq n (1+ n))

	       )

	       (if (/= 0 par)

		 (progn

		   (vla-getWidth ent (1- par) 'swid1 'ewid1)

		   (vla-getWidth ent par 'swid2 'ewid2)

		   (setq wlst (cons (list (1- par) swid1 ewid2) wlst))

		 )

	       )

	       (repeat

		 (- (setq n (1- (fix (vlax-curve-getEndParam ent))))

		    par

		 )

		  (vla-getWidth ent n 'swid 'ewid)

		  (setq

		    wlst (cons (list (setq n (1- n)) swid ewid) wlst)

		  )

	       )

	     )

	   )

	   (vlax-put ent

		     'Coordinates

		     (apply 'append (vl-remove (nth par plst) plst))

	   )

	   (or (= typ "AcDb3dPolyline")

	       (and

		 (mapcar '(lambda (x) (vla-setBulge ent (car x) (cdr x)))

			 blst

		 )

		 (mapcar '(lambda (x)

			    (vla-setWidth ent (car x) (cadr x) (caddr x))

			  )

			 wlst

		 )

	       )

	   )

	   (vla-EndUndoMark

	     (vla-get-ActiveDocument (vlax-get-acad-object))

	   )

	 )

	 (progn

	   (alert "\nKh\U+00F4ng th\U+1EC3 x\U+00F3a \U+0111\U+01B0\U+1EE3c, Pline n\U+00E0y ch\U+1EC9 c\U+00F3 1 ph\U+00E2n \U+0111o\U+1EA1n!")

	   (exit)

	 )

      )

      (progn

	(alert "Ch\U+1ECDn sai \U+0111\U+1ED1i t\U+01B0\U+1EE3ng!")

	(exit)

      )

    )

	);endT

	);end cond

  )

  (setvar "OSMODE" os)

  (setq	*error*	m:err

	m:err nil

  )

  (princ)

)



;;; SUBLIST Return a sub-list

;;;

;;; Arguments

;;; lst : a list

;;; start : start index for the sub-list (first item = 0)

;;; leng : sub-list length (or nil)

;;;

;;; Examples :

;;; (sublist '(1 2 3 4 5 6) 2 2) -> (3 4)

;;; (sublist '(1 2 3 4 5 6) 2 nil) -> (3 4 5 6)



(defun sublist (lst start leng / n r)

  (if (or (not leng) (< (- (length lst) start) leng))

    (setq leng (- (length lst) start))

  )

  (setq n (+ start leng))

  (repeat leng

    (setq r (cons (nth (setq n (1- n)) lst) r))

  )

)



;; SPLIT-LIST Split a list into sub-lists

;; Arguments

;; - lst : the list to be splited

;; - num : an integer, the number of items of sub-lists

;; Examples :

;; (split-list '(1 2 3 4 5 6 7 8) 2) -> ((1 2) (3 4) (5 6) (7 8))

;; (split-list '(1 2 3 4 5 6 7 8) 3) -> ((1 2 3) (4 5 6) (7 8))



(defun split-list (lst n)

  (if lst

    (cons (sublist lst 0 n)

	  (split-list (sublist lst n nil) n)

    )

  )

)



;;; ANG<2PI

;; Transform any angle (in radians) into its equivalent between 0 and 2*pi



(defun ang<2pi (ang)

  (if (and (<= 0 ang) (< ang (* 2 pi)))

    ang

    (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))

  )

)





(defun err (msg)

    (if	(or

	  (= msg "Function cancelled")

	  (= msg "quit / exit abort")

	)

      (princ)

      (princ (strcat "\nError: " msg))

    )

    (vla-EndUndoMark

      (vla-get-ActiveDocument (vlax-get-acad-object))

    )

    (setvar "OSMODE" os)

    (setq *error* m:err

	  m:err	nil

    )

  )

Mong mọi người giúp sao em dùng lisp này cho cad 2005 đc ko ạ, em dùng trên cad 2007 thì ngon lành nhưng qua cad 2005 thì ko được ạ

Tháng 7 6, 2016

Các bác có thể sửa dùm em 1 chút để lisp có thể chạy được trên file này cad 2005 được không ạ.. em muốn chỉnh sửa đường trắc ngang tự nhiên mà không dùng được trên nova cad 2005 , em test trên 2007 thì ok ạ

Mong mọi người bỏ ít công sức giúp đỡ

Tháng 11 21, 2018

(defun C:td1 ()
(setq d (vlax-ename->vla-object (car (entsel))))

(cond

((=(vla-get-ObjectName d) "AcDbPolyline")
(progn
(while (setq e (getpoint))
(setq e (vlax-curve-getClosestPointToProjection d e '(0 0 1)))
(setq param (vlax-curve-getParamAtPoint d e))
(setq param (+ (fix param) 1))
(setq e (vl-remove (last e) e))
(vlax-invoke d 'AddVertex Param e)
)))



((=(vla-get-ObjectName d) "AcDb3dPolyline")
(progn
(while (setq e (getpoint))
(setq endparam (vlax-curve-getEndParam d))
(setq dsparam nil)
(while (>= endparam 0)
(setq dsparam (append dsparam (list endparam)))
(setq endparam (1- endparam))
)
(setq e (vlax-curve-getClosestPointToProjection d e '(0 0 1)))
(setq param (vlax-curve-getParamAtPoint d e))
(setq dsparam (append dsparam (list param)))
(setq dsparam (vl-sort dsparam '>))
(setq dspoint nil)
(foreach tam dsparam
(setq e (vlax-curve-getPointAtParam d tam))
(setq dspoint (append e dspoint))
);foreach
(vlax-put d 'coordinates dspoint)
)))



((=(vla-get-ObjectName d) "AcDbSpline")
(progn
(while (setq e (getpoint))
(setq e (vlax-curve-getClosestPointToProjection d e '(0 0 1)))
(setq dsfit (vlax-get d 'fitpoints))
(setq dsfit2 nil)
(while dsfit
(setq dsfit2 (cons (list (car dsfit) (cadr dsfit) (caddr dsfit)) dsfit2))
(setq dsfit (cdddr dsfit))
)
(setq dsparam (mapcar '(lambda (a) (vlax-curve-getparamatpoint d a)) dsfit2))
(setq dsparam (cons (vlax-curve-getparamatpoint d e) dsparam))
(setq dsparam (vl-sort dsparam '>))
(setq n (length (member (vlax-curve-getparamatpoint d e) dsparam)))
(vlax-invoke-method d 'addfitpoint (- n 1) (vlax-3d-point e))
)))
(t nil)
);cond
)

dùng cho polyline, 3dpolyline, spline

Chỉnh sửa Tháng 11 22, 2018 theo Phamdung01

Đăng nhập

[Đã xong] Lisp thêm đỉnh cho PL

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

beba 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

ketxu 2.984

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

duy782006 1.533

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

ketxu 2.984

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

tvgtyb08 10

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

ketxu 2.984

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

thanhduan2407 272

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

Thaistreetz 539

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

thanhduan2407 272

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

Thaistreetz 539

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

ketxu 2.984

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

nmhbg 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

ketxu 2.984

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

LoveLisp 21

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

LoveLisp 21

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

ketxu 2.984

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

LoveLisp 21

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

ketxu 2.984

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

LoveLisp 21