Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
cangua172

[Yêu cầu] Lisp xóa text và mũi tên dưới text?

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

Nếu chỉ cho bản vẽ bạn up thì bạn copy đoạn này vào commandline của CAD :

((lambda()
(command "erase"
(ssget "x" (list (cons -4 "<OR")
 (cons -4 "<AND")(cons 0 "*TEXT")(cons 1 "*%")(cons 8 "text")(cons -4 "AND>")
 (cons -4 "<AND")(cons 0 "POLYLINE")(cons 8 "ENTTNTHIETKE")(cons -4 "AND>")
 (cons -4 "OR>")
)) "" )
))

 

- Nếu bản vẽ khác đi, bạn bắt buộc phải cung cấp điều kiện ràng buộc tổng quát cho người viết :)

  • 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

Nếu chỉ cho bản vẽ bạn up thì bạn copy đoạn này vào commandline của CAD :

((lambda()
(command "erase"
(ssget "x" (list (cons -4 "<OR")
 (cons -4 "<AND")(cons 0 "*TEXT")(cons 1 "*%")(cons 8 "text")(cons -4 "AND>")
 (cons -4 "<AND")(cons 0 "POLYLINE")(cons 8 "ENTTNTHIETKE")(cons -4 "AND>")
 (cons -4 "OR>")
)) "" )
))

 

- Nếu bản vẽ khác đi, bạn bắt buộc phải cung cấp điều kiện ràng buộc tổng quát cho người viết :)

Bác ketxu xem lại giúp em, em chỉ muốn xóa các text mang giá trị 150%, 40%, 0% và các dấu mũi tên phía dưới tương ứng mỗi text thôi, em chạy thử đoạn code của Bác nó xóa tất cả luôn... Mong Bác xem lại giúp em. :blink:

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 ketxu xem lại giúp em, em chỉ muốn xóa các text mang giá trị 150%, 40%, 0% và các dấu mũi tên phía dưới tương ứng mỗi text thôi, em chạy thử đoạn code của Bác nó xóa tất cả luôn... Mong Bác xem lại giúp em. :blink:

 

 

Bạn dùng tạm lisp này xem vừa ý không nhé.

[ code]

;**************Xoa do doc tren trac ngang****************

 

 

 

(defun c:xoa ( / SS i N ent P0 P1 A lstent)

(FNN)

(setq SS (ssget "X" '((8 . "ENTTNTHIETKE") (0 . "POLYLINE")))

i 0

N (sslength SS)

)

(ss2ent SS)

(repeat (- N 1)

(setq ent (nth i lstent)

P0 (vlax-curve-getPointAtParam ent 0)

P1 (vlax-curve-getPointAtParam ent 2)

A (angle P0 P1)

i (1+ i)

)

(if (or (equal A 0 0.005) (equal A 3.142 0.005) (equal A 0.381 0.005)

(equal A 2.761 0.005) (equal A 2.159 0.005) (equal A 0.983 0.005))

(command "ERASE" ent "")

)

)

)

 

;-----------------------------

 

(defun ss2ent (ss / sodt index)

(setq

sodt (cond

(ss (sslength ss))

(t 0)

)

index 0

)

(repeat sodt

(setq ent (ssname ss index)

index (1+ index)

lstent (cons ent lstent)

)

)

lstent

)

 

;--------------------------------

(defun FNN ( / ss t1 t2 t3 t4 e)

(setq

t1 "40%"

t2 "150%"

t3 "0%"

ss (ssget "X" '((0 . "TEXT")))

ss1 (ssadd)

ss2 (ssadd)

ss3 (ssadd)

)

(while (setq e (ssname ss 0))

(setq t (cdr (assoc 1 (entget e))))

(if (vl-string-search t1 t) (setq ss1 (ssadd e ss1)))

(if (vl-string-search t2 t) (setq ss2 (ssadd e ss2)))

(if (vl-string-search t3 t) (setq ss3 (ssadd e ss3)))

(ssdel e ss)

)

(command "ERASE" ss1 ss2 ss3 "")

)

[ /code]

  • Vote tăng 3

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 ketxu xem lại giúp em, em chỉ muốn xóa các text mang giá trị 150%, 40%, 0% và các dấu mũi tên phía dưới tương ứng mỗi text thôi, em chạy thử đoạn code của Bác nó xóa tất cả luôn... Mong Bác xem lại giúp em. :blink:

SR. Ketxu đọc lại hiểu nhầm bạn muốn xóa những thằng dạng 150%,40% ...(bao gồm cả 1%,2% ...) ^^ chứ k biết là bạn chỉ đích danh những thằng đó. Dù sao bạn cũng có câu trả lời rồi :)

  • 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ạn dùng tạm lisp này xem vừa ý không nhé.

[ code]

;**************Xoa do doc tren trac ngang****************

 

 

 

(defun c:xoa ( / SS i N ent P0 P1 A lstent)

(FNN)

(setq SS (ssget "X" '((8 . "ENTTNTHIETKE") (0 . "POLYLINE")))

i 0

N (sslength SS)

)

(ss2ent SS)

(repeat (- N 1)

(setq ent (nth i lstent)

P0 (vlax-curve-getPointAtParam ent 0)

P1 (vlax-curve-getPointAtParam ent 2)

A (angle P0 P1)

i (1+ i)

)

(if (or (equal A 0 0.005) (equal A 3.142 0.005) (equal A 0.381 0.005)

(equal A 2.761 0.005) (equal A 2.159 0.005) (equal A 0.983 0.005))

(command "ERASE" ent "")

)

)

)

 

;-----------------------------

 

(defun ss2ent (ss / sodt index)

(setq

sodt (cond

(ss (sslength ss))

(t 0)

)

index 0

)

(repeat sodt

(setq ent (ssname ss index)

index (1+ index)

lstent (cons ent lstent)

)

)

lstent

)

 

;--------------------------------

(defun FNN ( / ss t1 t2 t3 t4 e)

(setq

t1 "40%"

t2 "150%"

t3 "0%"

ss (ssget "X" '((0 . "TEXT")))

ss1 (ssadd)

ss2 (ssadd)

ss3 (ssadd)

)

(while (setq e (ssname ss 0))

(setq t (cdr (assoc 1 (entget e))))

(if (vl-string-search t1 t) (setq ss1 (ssadd e ss1)))

(if (vl-string-search t2 t) (setq ss2 (ssadd e ss2)))

(if (vl-string-search t3 t) (setq ss3 (ssadd e ss3)))

(ssdel e ss)

)

(command "ERASE" ss1 ss2 ss3 "")

)

[ /code]

Mình thấy Lisp trên sử dụng rất hay nhưng... có một cái trục trặc nhỏ như thế này, khi sử dụng Lisp sẽ xóa tất cả các đối tượng (cần xóa) trên bảng vẽ, giá như các Anh sửa lại là: lisp chỉ xóa các đối tượng mình chon trên bản vẽ trước đó. Nghĩa là: chọn tập đối tượng trên bản vẽ, xóa các text cần xóa trong tập đẫ chọn... :mellow:

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 bỏ dấu "x" trong đoạn (setq SS (ssget "X" '((8 . "ENTTNTHIETKE") (0 . "POLYLINE"))) và ss (ssget "X" '((0 . "TEXT")))

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 xóa 3 ký tự "X" trước chữ "(ssget" là được nhưng lúc chon đối tượng nhớ chọn 2 lần nhé.

Làm như thế nó bị lỗi, không dùng được Bác ơi!!! Bác xem lại giúp em!!!

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

File lisp bạn sửa đâu ?

;**************Xoa do doc tren trac ngang****************

(defun c:xoa ( / SS i N ent P0 P1 A lstent)
(FNN)
(setq SS (ssget  '((8 . "ENTTNTHIETKE") (0 . "POLYLINE")))
i 0
N (sslength SS)
)
(ss2ent SS)
(repeat (- N 1)
(setq ent (nth i lstent)
P0 (vlax-curve-getPointAtParam ent 0)
P1 (vlax-curve-getPointAtParam ent 2)
A (angle P0 P1)
i (1+ i)
)
(if (or (equal A 0 0.005) (equal A 3.142 0.005) (equal A 0.381 0.005)
(equal A 2.761 0.005) (equal A 2.159 0.005) (equal A 0.983 0.005))
(command "ERASE" ent "")
)
)
)
;-----------------------------
(defun ss2ent (ss / sodt index)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
lstent
)
;--------------------------------
(defun FNN ( / ss t1 t2 t3 t4 e)
(setq
t1 "40%"
t2 "150%"
t3 "0%"
ss (ssget  '((0 . "TEXT")))
ss1 (ssadd)
ss2 (ssadd)
ss3 (ssadd)
)
(while (setq e (ssname ss 0))
(setq t (cdr (assoc 1 (entget e))))
(if (vl-string-search t1 t) (setq ss1 (ssadd e ss1)))
(if (vl-string-search t2 t) (setq ss2 (ssadd e ss2)))
(if (vl-string-search t3 t) (setq ss3 (ssadd e ss3)))
(ssdel e ss)
)
(command "ERASE" ss1 ss2 ss3 "")
)

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

Lỗi này là lỗi của người viết cố gắng thay đổi định nghĩa 1 hàm đã được bảo vệ (ở đây là hàm T). Bạn sửa tất cả những chữ t đứng 1 mình từ đoạn (setq t (cdr (assoc 1 (entget e)))) thành ký tự gì đó tùy bạn

  • 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

Lỗi này là lỗi của người viết cố gắng thay đổi định nghĩa 1 hàm đã được bảo vệ (ở đây là hàm T). Bạn sửa tất cả những chữ t đứng 1 mình từ đoạn (setq t (cdr (assoc 1 (entget e)))) thành ký tự gì đó tùy bạn

Cảm ơn Bác Kẹt_xu (thiếu tiền) hihi :wacko:

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 tạm lisp này xem vừa ý không nhé.

[ code]

;**************Xoa do doc tren trac ngang****************

 

 

 

(defun c:xoa ( / SS i N ent P0 P1 A lstent)

(FNN)

(setq SS (ssget "X" '((8 . "ENTTNTHIETKE") (0 . "POLYLINE")))

i 0

N (sslength SS)

)

(ss2ent SS)

(repeat (- N 1)

(setq ent (nth i lstent)

P0 (vlax-curve-getPointAtParam ent 0)

P1 (vlax-curve-getPointAtParam ent 2)

A (angle P0 P1)

i (1+ i)

)

(if (or (equal A 0 0.005) (equal A 3.142 0.005) (equal A 0.381 0.005)

(equal A 2.761 0.005) (equal A 2.159 0.005) (equal A 0.983 0.005))

(command "ERASE" ent "")

)

)

)

 

;-----------------------------

 

(defun ss2ent (ss / sodt index)

(setq

sodt (cond

(ss (sslength ss))

(t 0)

)

index 0

)

(repeat sodt

(setq ent (ssname ss index)

index (1+ index)

lstent (cons ent lstent)

)

)

lstent

)

 

;--------------------------------

(defun FNN ( / ss t1 t2 t3 t4 e)

(setq

t1 "40%"

t2 "150%"

t3 "0%"

ss (ssget "X" '((0 . "TEXT")))

ss1 (ssadd)

ss2 (ssadd)

ss3 (ssadd)

)

(while (setq e (ssname ss 0))

(setq t (cdr (assoc 1 (entget e))))

(if (vl-string-search t1 t) (setq ss1 (ssadd e ss1)))

(if (vl-string-search t2 t) (setq ss2 (ssadd e ss2)))

(if (vl-string-search t3 t) (setq ss3 (ssadd e ss3)))

(ssdel e ss)

)

(command "ERASE" ss1 ss2 ss3 "")

)

[ /code]

Thanks ban, lips này rất hay. Bạn có thể sửa giúp mình lisp này không. yêu cầu như trên, nhưng bước đầu mình chọn % muốn xóa trên trắc ngang. ví dụ: lệnh lips --> chọn % muốn xóa --> xóa text % và mũi tên tương ứng. Dùng cho trắc ngang mình gửi kèm bên dưới nhé. Thanks!

http://www.cadviet.com/upfiles/3/46621_trac_ngang.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

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  

×