Chuyển đến nội dung
Diễn đàn CADViet
hugo007

[Yêu cầu] Lisp cắt đối tượng

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

Vẫn còn lỗi,1đoạn thẳng chia làm 3 đoạn sao nó lại xoá 2 đoạn ngắn đi vậy bạn?Mình muốn nó xoá đoạn ngắn nhất thôi.Thanks.

Mình test thử có thấy lỗi thế đâu nhỉ.

Đây là code của ket mình có edit tí chút.

(defun c:brd (/ lst_tmp lst_ss_bicat lst_ss_cat lst ST:Ent-Length ST:Ss->ListEnt ST:Ent-IntersObj ST:Ent-BrkLPSLine)

(defun ST:Ent-Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

(defun ST:Ent-IntersObj (e1 e2  / ob1 ob2 g L i kq) ;objExtend : doi tuong keo dai
(vl-load-com)
(setq
   ob1 (vlax-ename->vla-object e1)
   ob2 (vlax-ename->vla-object e2))	
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
(setq i 0)
(repeat (/ (length L) 3)
   (setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))
   (setq i (+ i 3))
)
kq
)
(defun ST:Ent-BrkLPSLine (obj LineDo / lstInters);ename
(if (setq lstInters (ST:Ent-IntersObj obj LineDo))
(progn
(foreach x lstInters
(command "_break" obj "_non" x "@")
)
)
)
)

(grtext -1 "Free Break and Del *Line @Ketxu Cadviet.com")
(command "undo"  "begin")
(setq ss_new (ssadd))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine.. b\U+1ECB c\U+1EAFt :")
(setq lst_ss_bicat (acet-ss-to-list (ssget)))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine...c\U+1EAFt :")
(setq lst_ss_cat (acet-ss-to-list (ssget)))
(foreach obj lst_ss_bicat 
(foreach Linedo lst_ss_cat
	(ST:Ent-BrkLPSLine obj Linedo)
	(setq ss_new (ssadd (entlast) ss_new)) 
)
(setq lst_tmp (acet-ss-to-list (ssadd obj ss_new)))
(entdel (nth (vl-position (apply 'min (setq lst (mapcar 'ST:Ent-Length lst_tmp))) lst) lst_tmp)) ;Bo dong nay neu khong muon xoa duong ngan nhat
(setq lst_tmp nil ss_new (ssadd))
)
(command "undo" "end")
)

  • 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

...chắc do viết vội quá nên tôi check thử thì thấy chưa đúng tuyệt đối...

Vẫn còn lỗi, bác phamngoctukts ạ! Lỗi tôi phát hiện ra là: nó xoá đoạn dài chứ không xoá đoạn ngắn nhất trong 1 đoạn thẳng bị cắt ra (khác lỗi bạn ấy phát hiện).

Thân thươ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

Vẫn còn lỗi, bác phamngoctukts ạ! Lỗi tôi phát hiện ra là: nó xoá đoạn dài chứ không xoá đoạn ngắn nhất trong 1 đoạn thẳng bị cắt ra (khác lỗi bạn ấy phát hiện).

Thân thương!

Bác thử gửi file dwg dùng bị lỗi lên xem. Tôi dùng không thấy lỗi như của Bác nó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

Vậy bạn giúp mình 2 ý sau :Nhờ bạn sửa cho chọn được nhiều line cắt,sau khi cắt xong các đoạn thẳng vừa mới bị cắt ra,đoạn ngắn nhất thì sẽ bị xoá đi được không?Chỉ là Line không phải Polyline.Thanks.

File minh họa đây các bác ah.

http://www.cadviet.com/upfiles/3/drawing1_77.dwg

Xin lỗi vì chưa đưa hết ý,n đường cắt,các line cần cắt và line cắt nằm bất kỳ vuông góc hay không vuông góc gì cũng được,các line có thể song song hoặc không song song.Cảm ơn bạn.

Cám ơn bạn hình như bạn có hiểu sai ý mình các đoạn thẳng sau khi chia tại các đường cắt đoạn ngắn nhất trong 1 đoạn thẳng sau khi bị chia sẽ bị xoá chứ không phải ngắn nhất trong tất cả đoạn thẳng sau khi bị chia.Thí dụ mình có 2 đoạn thẳng A và B bị chia bởi 2 đoạn thẳng bất kỳ.đoạn A bị chia làm 3,đoạn B cũng bị chia làm 3.Trong 3 đoạn thằng bị chia bởi đoạn A đoạn nào ngắn nhất sẽ bị xoá tương tự đoạn ngắn nhất trong đoạn B cũng bị xoá.Tóm lại có bao nhiêu đoạn thằng bị cắt bởi đường cắt thì có bấy nhiêu đoạn ngắn nhất bị xoá.Bạn thêm giùm mình phần bẫy lỗi còn thiếu như bạn nói luôn nhe,mình đợi được.Thanks.

Phải tới ít nhất là 4 lần post mới chuyển tải được nội dung ?!

Tiếng Việt mình khó quá nhỉ?!

 

Bạn sài thử LISP này :

(defun C:brd (/ e i pts ss1 ss2  ss_tmp)
;; By : gia_bach @ www.CadViet.com ;;
 (defun Get_pts_ss_inter_ent (ss ent / e i lst_pt obj pts)
   (defun list->3pair (old / new)
     (while (setq new (cons (list (car old) (cadr old) (caddr old)) new)
	   old (cdddr old))) new )
   (setq i -1 obj (vlax-ename->vla-object ent))
   (while (setq e (ssname ss (setq i (1+ i))))
     (if (setq pts (vlax-invoke obj 'IntersectWith (vlax-ename->vla-object e) acExtendNone))
(setq lst_pt (append (list->3pair pts) lst_pt)) ))
   (vl-sort lst_pt '(lambda (x y) (> (vlax-curve-getParamAtPoint obj x) (vlax-curve-getParamAtPoint obj y))))    )
 (defun Get_ent_with_minLen (ss / e i lst)
   (setq i -1 )
   (while (setq e (ssname ss (setq i (1+ i))))
     (setq lst (cons (cons (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) e) lst) ) )
   (cdr(car(vl-sort lst '(lambda (x y) (< (car x) (car y))))))	        )
 ;--------------- main -------------------
 (vl-load-com)
 (if (and (princ "\nChon doi tuong bi cat :")
   (setq ss1 (ssget (list (cons 0 "*LINE,ARC"))))
   (princ "\nChon doi tuong cat :")
   (setq ss2 (ssget (list (cons 0 "*LINE,ARC")))))
   (progn
     (setq i -1)
     (while (setq e (ssname ss1 (setq i (1+ i))))
(setq pts (Get_pts_ss_inter_ent ss2 e))
(setq ss_tmp (ssadd))
(foreach pt pts
  (command "._break" e "_non" (trans pt 0 1) "_non" (trans pt 0 1))
  (ssadd (entlast) ss_tmp))
(ssadd e ss_tmp)
(entdel (Get_ent_with_minLen ss_tmp))	)  ) )
 (princ)  )

  • Vote tăng 2

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

Bác gia_bach đã giới thiệu lisp cắt đối tượng cho nhiều trường hợp nhưng mình chỉ cần 1 trường hợp khi ta có nhiều đoạn thẳng cắt nhau,khi đánh lệnh lisp,chọn đối tượng cần cắt xong chọn đường thẳng để làm gốc sau đó đường thẳng cần cắt sẽ bị cắt tại vị trí đường thẳng làm gốc.Chân thành cảm ơn.

em viết đoạn code này ko biết có đúng ý bạn hugo ko ah! "chọn đối tượng cần cắt xong chọn đường thẳng để làm gốc" và xóa đi đoạn ngắn hơn.

(defun c:ctt(/ dt sdt ind ob1 ob2 lst1 g a10 a11 d10 d11)
 (setq dt (ssget)
sdt (sslength dt)
ind 0
ob2 (vlax-ename->vla-object (car(entsel)))
)
 (repeat sdt
   (setq ent (ssname dt ind)
  ind (1+ ind))
 (setq ob1 (vlax-ename->vla-object ent)	
lst1 (entget ent)
)
 (setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
 (setq g (vlax-safearray->list g))
 (setq a10 (assoc 10 lst1)
a11 (assoc 11 lst1))
 (setq d10 (distance g (list(cadr a10) (caddr a10)) ))
 (setq d11 (distance g (list(cadr a11) (caddr a11)) ))
 (if (> d10 d11)
   (setq lst1(subst (vl-list* 11 g) a11 lst1))
   (setq lst1(subst (vl-list* 10 g) a10 lst1))    
    )
 (entmod lst1)
 )
 )
 (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

Bác thử lại code này xem đã test OK.

(defun c:brd (/ lst_tmp lst_ss_bicat lst_ss_cat lst ST:Ent-Length ST:Ss->ListEnt ST:Ent-IntersObj ST:Ent-BrkLPSLine)

(defun ST:Ent-Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

(defun ST:Ent-IntersObj (e1 e2  / ob1 ob2 g L i kq) ;objExtend : doi tuong keo dai
(vl-load-com)
(setq
   ob1 (vlax-ename->vla-object e1)
   ob2 (vlax-ename->vla-object e2))	
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
(setq i 0)
(repeat (/ (length L) 3)
   (setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))
   (setq i (+ i 3))
)
kq
)
(defun ST:Ent-BrkLPSLine (obj LineDo / lstInters);ename
(if (setq lstInters (ST:Ent-IntersObj obj LineDo))
(progn
(foreach x lstInters
(command "_break" obj "_non" x "@")
)
)
)
)

(grtext -1 "Free Break and Del *Line @Ketxu Cadviet.com")
(command "undo"  "begin")
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
(setq ss_new (ssadd))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine.. b\U+1ECB c\U+1EAFt :")
(setq lst_ss_bicat (acet-ss-to-list (ssget)))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine...c\U+1EAFt :")
(setq lst_ss_cat (acet-ss-to-list (ssget)))
(foreach obj lst_ss_bicat 
(foreach Linedo lst_ss_cat
	(ST:Ent-BrkLPSLine obj Linedo)
  	(setq ss_new (ssadd (entlast) ss_new))
  	(ST:Ent-BrkLPSLine (entlast) Linedo)
	(setq ss_new (ssadd (entlast) ss_new)) 
)
(setq lst_tmp (acet-ss-to-list (ssadd obj ss_new)))
(entdel (nth (vl-position (apply 'min (setq lst (mapcar 'ST:Ent-Length lst_tmp))) lst) lst_tmp)) ;Bo dong nay neu khong muon xoa duong ngan nhat
(setq lst_tmp nil ss_new (ssadd))
)
 (setvar "osmode" oldos)
(command "undo" "end")
)

  • 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

Ôi, cám ơn mọi người đã giúp ket, mới 1 buổi sáng mà đã có bao nhiêu lời giải rồi ^^ Vậy là hok phải bận tâm nữa ^^ Cái vụ del cái em ngắn nhất khù khoằm quá ^^

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

Bác thử lại code này xem đã test OK.

(defun c:brd (/ lst_tmp lst_ss_bicat lst_ss_cat lst ST:Ent-Length ST:Ss->ListEnt ST:Ent-IntersObj ST:Ent-BrkLPSLine)

(defun ST:Ent-Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))

(defun ST:Ent-IntersObj (e1 e2  / ob1 ob2 g L i kq) ;objExtend : doi tuong keo dai
(vl-load-com)
(setq
   ob1 (vlax-ename->vla-object e1)
   ob2 (vlax-ename->vla-object e2))	
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
(setq i 0)
(repeat (/ (length L) 3)
   (setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))
   (setq i (+ i 3))
)
kq
)
(defun ST:Ent-BrkLPSLine (obj LineDo / lstInters);ename
(if (setq lstInters (ST:Ent-IntersObj obj LineDo))
(progn
(foreach x lstInters
(command "_break" obj "_non" x "@")
)
)
)
)

(grtext -1 "Free Break and Del *Line @Ketxu Cadviet.com")
(command "undo"  "begin")
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
(setq ss_new (ssadd))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine.. b\U+1ECB c\U+1EAFt :")
(setq lst_ss_bicat (acet-ss-to-list (ssget)))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine...c\U+1EAFt :")
(setq lst_ss_cat (acet-ss-to-list (ssget)))
(foreach obj lst_ss_bicat 
(foreach Linedo lst_ss_cat
	(ST:Ent-BrkLPSLine obj Linedo)
  	(setq ss_new (ssadd (entlast) ss_new))
  	(ST:Ent-BrkLPSLine (entlast) Linedo)
	(setq ss_new (ssadd (entlast) ss_new)) 
)
(setq lst_tmp (acet-ss-to-list (ssadd obj ss_new)))
(entdel (nth (vl-position (apply 'min (setq lst (mapcar 'ST:Ent-Length lst_tmp))) lst) lst_tmp)) ;Bo dong nay neu khong muon xoa duong ngan nhat
(setq lst_tmp nil ss_new (ssadd))
)
 (setvar "osmode" oldos)
(command "undo" "end")
)

Bạn thử lại code này xem đã test chưa OK. ^_^

http://www.cadviet.com/upfiles/3/drawing1_79_2.dwg

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

Bạn thử lại code này xem đã test chưa OK. ^_^

http://www.cadviet.com/upfiles/3/drawing1_79_2.dwg

Cái thằng 2dPline (100 . AcDb2dPolyline) khó chịu quá Tue_NV ơi ! pótay :excl:

Convert qua Pline thì làm việc bình thườ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

Cái thằng 2dPline (100 . AcDb2dPolyline) khó chịu quá Tue_NV ơi ! pótay :excl:

Convert qua Pline thì làm việc bình thường.

Code em cũng đã viết xong. Chỉ là chưa xử lý trực tiếp trên 2dPline. Chỉ còn cách convert sang PLINE

Tue_NV xin góp thêm 1 code nữa

(defun get-Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun c:brel(/ sschinh sstrim lst_pt lst_ptc ssa i minleng)
;copyright by Tue_NV
 (vl-load-com)
 (if (and (princ "\nChon doi tuong bi cat :")
   (setq sschinh (ssget (list (cons 0 "*LINE,ARC"))))
   (princ "\nChon doi tuong cat :")
   (setq sstrim (ssget (list (cons 0 "*LINE,ARC")))))
   (progn
 (Foreach x (acet-ss-to-list sschinh)
   (setq lst_pt nil)
   (foreach y (acet-ss-to-list sstrim)
     (setq lst_pt (append lst_pt (ACET-GEOM-INTERSECTWITH y x 0)))
   )
   (setq lst_pt (vl-sort lst_pt '(lambda(p1 p2) (> (vlax-curve-getparamatpoint x p1)
			       		    (vlax-curve-getparamatpoint x p2)
			    		 )
	      		  )
	)
   )    
   (setq lst_ptc (append lst_ptc  (list lst_pt)) )
 )
     (setq e (entlast) ssa (ssadd) i 0) 
     (foreach x (acet-ss-to-list sschinh)
(setq ssa (ssadd x ssa))
(foreach y (nth i lst_ptc)
		(command "break" x "_non" (trans y 0 1) "_non" (trans y 0 1))
		(setq ssa (ssadd (entlast) ssa))	  
       )
	(setq minleng (apply 'min  (mapcar '(lambda(k) (get-Length k))
			 		(acet-ss-to-list ssa))
	 		)
	)
	(foreach z (acet-ss-to-list ssa)
	  (if (= (get-length z) minleng) (entdel z))
	)
	(setq ssa (ssadd) i (1+ i))

     )
   )
)
 )

  • Vote tăng 2

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ảm ơn các bác rất nhiều.quá nhiều lisp e đang thử xem lisp nào đáp ứng được nhu cầu của e.Hôm nay hết quyền để vote nên mai e sẽ vote tiếp cho các bác.

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ảm ơn các bác rất nhiều.quá nhiều lisp e đang thử xem lisp nào đáp ứng được nhu cầu của e.Hôm nay hết quyền để vote nên mai e sẽ vote tiếp cho các bác.

Hề hề hề,

các bác cho mình té nước theo mưa một tí.

Số là mình đọc cái lisp của bác Ketxu và nổi hứng nhảy vô sửa một tí để hy vọng vớ được một phiếu vote của nhà bác Hugo007. Chả biết có nên cơm cháo chi không nhưng cũng liều post nó lên để mọi người ném ...... bánh. Quả này có khi no được mấy ngày ấy chứ. Hề hề hề.

Nó đây ạ:

(defun c:brd (/ EL lst_ss_bicat lst_ss_cat lst ST:Ent-Length ST:Ss->ListEnt ST:Ent-IntersObj ST:Ent-BrkLPSLine
             n i lst_ss_dacat)

;;;;;;;; Local Functions
(defun ST:Ent-Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun ST:Ss->ListEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
   (setq l (cons e l))
 )  
)
(defun ST:Ent-IntersObj (e1 e2  / ob1 ob2 g L i kq) ;objExtend : doi tuong keo dai
(vl-load-com)
(setq
   ob1 (vlax-ename->vla-object e1)
   ob2 (vlax-ename->vla-object e2))	
(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))
(setq i 0)
(repeat (/ (length L) 3)
   (setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))
   (setq i (+ i 3))
)
kq
)
(defun ST:Ent-BrkLPSLine (obj LineDo / lstInters);ename
(if (setq lstInters (ST:Ent-IntersObj obj LineDo))
(progn
(foreach x lstInters
(command "_break" obj x "@")
)
)
)
)

(grtext -1 "Free Break and Del *Line @Ketxu Cadviet.com")
(command "undo"  "begin")
(setq EL (entlast))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine.. b\U+1ECB c\U+1EAFt :")
(setq lst_ss_bicat (ST:Ss->ListEnt (ssget)))
(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine...c\U+1EAFt :")
(setq lst_ss_cat (ST:Ss->ListEnt (ssget)))             
(foreach obj lst_ss_bicat 
           (setq lst_ss_dacat (list obj))
           (setq n (length lst_ss_cat))
           (setq i 0)
           (While (< i n)
                     (setq Linedo (nth i lst_ss_cat))
                     (foreach obj1 lst_ss_dacat
	(ST:Ent-BrkLPSLine obj1 Linedo)
                            (while (setq EL (entnext EL)) (setq lst_ss_dacat (cons EL lst_ss_dacat)))
                            (setq EL (entlast))
                     )
                     (setq i (1+ i))      
           )
           (command "erase" (nth (vl-position (apply 'min (setq lst (mapcar 'ST:Ent-Length lst_ss_dacat))) lst) lst_ss_dacat) "")               
)
(command "undo" "end")
)

 

@ Bác Ketxu: Bác viết lisp bằng cai font chi mà dịch nó khổ quá. Giá bác cứ chơi tiếng Việt không dấu thì dễ đọc biết mấy????

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

Code em cũng đã viết xong. Chỉ là chưa xử lý trực tiếp trên 2dPline. Chỉ còn cách convert sang PLINE

Tue_NV xin góp thêm 1 code nữa

(defun get-Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))
(defun c:brel(/ sschinh sstrim lst_pt lst_ptc ssa i minleng)
;copyright by Tue_NV
 (vl-load-com)
 (if (and (princ "\nChon doi tuong bi cat :")
   (setq sschinh (ssget (list (cons 0 "*LINE,ARC"))))
   (princ "\nChon doi tuong cat :")
   (setq sstrim (ssget (list (cons 0 "*LINE,ARC")))))
   (progn
 (Foreach x (acet-ss-to-list sschinh)
   (setq lst_pt nil)
   (foreach y (acet-ss-to-list sstrim)
     (setq lst_pt (append lst_pt (ACET-GEOM-INTERSECTWITH y x 0)))
   )
   (setq lst_pt (vl-sort lst_pt '(lambda(p1 p2) (> (vlax-curve-getparamatpoint x p1)
			       		    (vlax-curve-getparamatpoint x p2)
			    		 )
	      		  )
	)
   )    
   (setq lst_ptc (append lst_ptc  (list lst_pt)) )
 )
     (setq e (entlast) ssa (ssadd) i 0) 
     (foreach x (acet-ss-to-list sschinh)
(setq ssa (ssadd x ssa))
(foreach y (nth i lst_ptc)
		(command "break" x "_non" (trans y 0 1) "_non" (trans y 0 1))
		(setq ssa (ssadd (entlast) ssa))	  
       )
	(setq minleng (apply 'min  (mapcar '(lambda(k) (get-Length k))
			 		(acet-ss-to-list ssa))
	 		)
	)
	(foreach z (acet-ss-to-list ssa)
	  (if (= (get-length z) minleng) (entdel z))
	)
	(setq ssa (ssadd) i (1+ i))

     )
   )
)
 )

Cho e hỏi 1 ý nhỏ nữa là tại sao các bác viết code không đưa những dòng yêu cầu lên màn hình ngay vị trí con trỏ chuột,chẳng hạn lisp này dòng CHỌN ĐỐI TƯỢNG BỊ CẮTĐỐI TƯỢNG CẮT lên màn hình để đỡ phải nhìn xuống dòng command.Cảm ơn các bác 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

Cho e hỏi 1 ý nhỏ nữa là tại sao các bác viết code không đưa những dòng yêu cầu lên màn hình ngay vị trí con trỏ chuột,chẳng hạn lisp này dòng CHỌN ĐỐI TƯỢNG BỊ CẮTĐỐI TƯỢNG CẮT lên màn hình để đỡ phải nhìn xuống dòng command.Cảm ơn các bác nhiều.

Hề hề hề,

Bạn có thể thay hàm (princ..... ) bằng hàm (alert ....) nó sẽ hiện lên màn hình cho bạn nhòm thoải mái, sau đó nhấn enter để thoát cho khỏi ngứa con mắt....

Hề hề hề....

Mà "nhìn xuống dòng command" cũng là nhìn "lên màn hình" chớ bộ, hề hề hề,.... Hổng nhẽ lại là nhìn sang cô hàng xóm.... hề hề hề

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

Hề hề hề,

Bạn có thể thay hàm (princ..... ) bằng hàm (alert ....) nó sẽ hiện lên màn hình cho bạn nhòm thoải mái, sau đó nhấn enter để thoát cho khỏi ngứa con mắt....

Hề hề hề....

Mà "nhìn xuống dòng command" cũng là nhìn "lên màn hình" chớ bộ, hề hề hề,.... Hổng nhẽ lại là nhìn sang cô hàng xóm.... hề hề hề

Không phải bác ah,ý e là nó hiện lên giống khi ta dùng cad 2007 trở lên khi đánh lệnh MOVE hoặc COPY thì ngay vị trí con trỏ chuột hiện lên dòng SELECT OBJECTS đó bác.Thanks.

  • 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

Không phải bác ah,ý e là nó hiện lên giống khi ta dùng cad 2007 trở lên khi đánh lệnh MOVE hoặc COPY thì ngay vị trí con trỏ chuột hiện lên dòng SELECT OBJECTS đó bác.Thanks.

nhấn F12

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

Hề hề hề,

@ Bác Ketxu: Bác viết lisp bằng cai font chi mà dịch nó khổ quá. Giá bác cứ chơi tiếng Việt không dấu thì dễ đọc biết mấy????

Hề hề, Unicode Hexa, cây nhà lá vườn tội chi không dùng bác ơi ^^

 

Cho e hỏi 1 ý nhỏ nữa là tại sao các bác viết code không đưa những dòng yêu cầu lên màn hình ngay vị trí con trỏ chuột,chẳng hạn lisp này dòng CHỌN ĐỐI TƯỢNG BỊ CẮTĐỐI TƯỢNG CẮT lên màn hình để đỡ phải nhìn xuống dòng command.Cảm ơn các bác nhiều.

Bạn nên set Dynamic Prompt và tự trừ điểm của mình vì câu hỏi này, vì nói trên diễn đàn nhiều quá rồi ^^ , và xét cho cùng, 1 lệnh chỉ có 2 bước chọn đối tượng thì chỉ cần đến lần thứ 2 là bạn chẳng cần ai nhắc nữa, nó sẽ thành phản xạ như offset, stretch vậy ... :)

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

Bạn dùng thử cái này xem nhé.


Bác #DoanVanHa ơi đoạn setq dt (entsel "Chon Line cat: ")) có thể chọn nhiều  đối tượng line được không bác nhỉ. Phải sửa code thế nào ạ. Kính mong bác chỉ giúp với!

  • Vote giảm 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

Mình test thử có thấy lỗi thế đâu nhỉ.

Đây là code của ket mình có edit tí chút.

(defun c:brd (/ lst_tmp lst_ss_bicat lst_ss_cat lst ST:Ent-Length ST:Ss->ListEnt ST:Ent-IntersObj ST:Ent-BrkLPSLine)(defun ST:Ent-Length(e) (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)))(defun ST:Ent-IntersObj (e1 e2  / ob1 ob2 g L i kq) ;objExtend : doi tuong keo dai(vl-load-com)(setq    ob1 (vlax-ename->vla-object e1)    ob2 (vlax-ename->vla-object e2))		(setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))(if (/= (vlax-safearray-get-u-bound g 1) -1) (setq L (vlax-safearray->list g)))(setq i 0)(repeat (/ (length L) 3)    (setq kq (append (list (list (nth i L) (nth (+ i 1) L) (nth (+ i 2) L))) kq))    (setq i (+ i 3)))kq)(defun ST:Ent-BrkLPSLine (obj LineDo / lstInters);ename(if (setq lstInters (ST:Ent-IntersObj obj LineDo))(progn(foreach x lstInters(command "_break" obj "_non" x "@")))))(grtext -1 "Free Break and Del *Line @Ketxu Cadviet.com")(command "undo"  "begin")(setq ss_new (ssadd))(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine.. b\U+1ECB c\U+1EAFt :")(setq lst_ss_bicat (acet-ss-to-list (ssget)))(prompt "\nCh\U+1ECDn c\U+00E1c Line, Pline, SLine...c\U+1EAFt :") (setq lst_ss_cat (acet-ss-to-list (ssget)))(foreach obj lst_ss_bicat 	(foreach Linedo lst_ss_cat		(ST:Ent-BrkLPSLine obj Linedo)		(setq ss_new (ssadd (entlast) ss_new)) 	)	(setq lst_tmp (acet-ss-to-list (ssadd obj ss_new)))(entdel (nth (vl-position (apply 'min (setq lst (mapcar 'ST:Ent-Length lst_tmp))) lst) lst_tmp)) ;Bo dong nay neu khong muon xoa duong ngan nhat(setq lst_tmp nil ss_new (ssadd)))(command "undo" "end"))

Cảm ơn bạn nhé! Đã đúng theo ý của mình. Bữa giờ tìm mãi mà giờ mới thấy. Hi vọng sẽ được học hỏi nhiều hơn.

  • Vote giảm 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

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


×