Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
18 replies to this topic

#1 cangua172

cangua172

    biết vẽ line

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

Đã gửi 04 September 2012 - 03:03 PM

Các bác viết giúp em cái lisp xóa text và các dấu mũi tên phía dưới mỗi text như trong file đính kèm... Chân thành cảm ơn!!!
  • 1

#2 cangua172

cangua172

    biết vẽ line

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

Đã gửi 04 September 2012 - 03:07 PM

File đính kèm:
  • 0

#3 cangua172

cangua172

    biết vẽ line

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

Đã gửi 04 September 2012 - 03:08 PM

Các bác viết giúp em cái lisp xóa text và các dấu mũi tên phía dưới mỗi text như trong file đính kèm... Chân thành cảm ơn!!!

http://www.cadviet.c...a_mui_ten_1.dwg
  • 0

#4 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 04 September 2012 - 08:59 PM

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 :)
  • 2

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


#5 cangua172

cangua172

    biết vẽ line

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

Đã gửi 05 September 2012 - 07:51 AM

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:
  • 0

#6 VoHoan

VoHoan

    biết lệnh move

  • Members
  • PipPipPip
  • 129 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 05 September 2012 - 08:15 AM

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]
  • 3

#7 cangua172

cangua172

    biết vẽ line

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

Đã gửi 05 September 2012 - 08:26 AM

Lisp chạy rất tốt, cảm ơn Các Bác đã giúp đỡ, chúc sức khỏe và thành công... Chân thành cảm ơn. :mellow:
  • 0

#8 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 05 September 2012 - 08:48 AM

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 :)
  • 1

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 luonhamhochoi

luonhamhochoi

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 September 2012 - 01:42 PM



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:
  • 0

#10 VoHoan

VoHoan

    biết lệnh move

  • Members
  • PipPipPip
  • 129 Bài viết
Điểm đánh giá: 8 (bình thường)

Đã gửi 06 September 2012 - 03:02 PM

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é.
  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 06 September 2012 - 03:18 PM

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

luonhamhochoi

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 September 2012 - 03:19 PM

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!!!
  • 0

#13 luonhamhochoi

luonhamhochoi

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 September 2012 - 03:29 PM

Sau khi xóa và chạy lại đoạn lisp thông báo:
Asigment to protected symbol:
T
Enter break look??
Bị sao thế các Bác???
  • 0

#14 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 06 September 2012 - 03:33 PM

File lisp bạn sửa đâu ?
  • 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


#15 luonhamhochoi

luonhamhochoi

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 September 2012 - 03:39 PM

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

  • 0

#16 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 06 September 2012 - 03:57 PM

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
  • 1

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


#17 luonhamhochoi

luonhamhochoi

    biết pan

  • Members
  • Pip
  • 5 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 06 September 2012 - 04:14 PM

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:
  • 0

#18 duygiang

duygiang

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 22 July 2014 - 02:11 PM

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.c..._trac_ngang.dwg


  • 0

#19 taybacincc

taybacincc

    biết vẽ circle

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

Đã gửi 31 July 2014 - 02:47 PM

Có file lisp cùi gửi a Duy Giang__Skull. Vẫn gà nên còn nhiều thiếu sót mong ae bỏ qua. Nếu dùng được hôm nào uống rượu mời e thêm chén nha

http://www.cadviet.c...21521_xmt_2.lsp


  • 0