[Yêu cầu] Lisp xóa đối tượng

[phamthanhbinh 3.146]

Có vấn đề thế này ạ. Khi có 2 mũi tên và 2 giá trị cạnh sát nhau. Nó xoá mất 1 giá trị mình định trước và xoá luôn cả 2 mũi tên. Bi h làm sao để khống chế cho lisp chỉ xoá 1 mũi tên+1giá trị thôi ạ ? Bởi vì chạy nova thì mũi tên và giá trị thường theo cặp. Em upload file lên, ở đây ta chỉ xoá giá trị 57.69% và cái mũi tên đi kèm của nó. Đây là file ạ : http://www.cadviet.c...nova_tc1tc2.dwg

Hề hề hề,

Vậy bạn thủ dùng cái này xem sao nhé.

Mình có thay đổi lại một chút cái lisp cũ như sau:

1/- Yêu cầu chọn text mẫu để xác định khoảng cách cần xóa.(như cũ)

2/- Nhập nội dung các text cần xóa. Cái này mới hơn vì có thể nội dung các text cần xóa của bạn khác với của bạn Nguyen ngoc Son.

3/- Lisp sẽ xóa tất cả các text có nội dung như bạn đã nhập và các mũi tên tương ứng với các text này

Đây là code:

(defun c:xoa (/ oldos *h h txt ss ssl ss1 ss1l plst goc vt )
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq *h 0.5)
(setq h (cdr (assoc 40 (entget (car (entsel "\n Chon mot text can xoa"))))))
(if (> h 0) (setq *h h) (setq h *h))
(setq txt (getstring "\n Nhap noi dung cac text can xoa cach nhau mot dau phay: "))
(setq ss (ssget "x" (list (cons 0 "text") (cons 1 txt) (cons 8 "enttnthietke,ENTTNTHIETKE1"))))
(setq ssl (acet-ss-to-list ss))
(command "zoom" "e")
(foreach en ssl
  	(setq plst (acet-ent-geomextents en))
  	(setq plst (mapcar '(lambda (x) (trans x 0 1)) plst ))
  	(setq goc (cdr (assoc 50 (entget en))))    
  	(setq ss1 (ssget "w" (list (- (caar plst) h) (- (cadar plst) h) (caddar plst)) \
                                   (list (+ (caadr plst) h) (+ (cadadr plst) h) (caddr (cadr plst)))
                                   (list (cons 0 "polyline") (cons 8 "enttnthietke"))))
  	(setq ss1l (acet-ss-to-list ss1))
  	(foreach en1 ss1l
          	(setq vt (vlax-curve-getfirstderiv (setq obj (vlax-ename->vla-object en1)) (vlax-curve-getparamatpoint obj (vlax-curve-getstartpoint obj))))
          	(if (or (equal goc (atan (cadr vt) (car vt)) 0.01 ) (equal (- goc pi) (atan (cadr vt) (car vt)) 0.01))
              	(setq ss (ssadd en1 ss))
          	)
  	)
)
(command "erase" ss "")
(command "zoom" "p")
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)

 

Chúc bạn vui.

[quochung.vpr 1]

Cậu ơi xem lai giúp mình với hình như cái lisp ko chay được.

[phamthanhbinh 3.146]

Cậu ơi xem lai giúp mình với hình như cái lisp ko chay được.

Hề hề hề,

Nó báo lỗi chi nhể???

Tớ chưa test kỹ nên cậu cần cho tớ biết nó báo lỗi chi mới có thể sửa được. Hãy test lại coi....