Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Sửa lisp chọn đối tượng theo điều kiện


  • Please log in to reply
11 replies to this topic

#1 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 01 October 2012 - 04:09 PM

Mình xin nhờ các bạn như sau:
Chọn một tập hợp các đối tượng trong bản vẽ.
Từ tập hợp đó tác ra:
- Tập ss1: Các đối tượng block có tên TC và lớp KE.
- Tập ss2: Các đối tượng ở lớp 1 và lớp 3

Mình đã viết thủ công như sau nhưng không được:
Nhược nhiểm:
- Phải chọn vùng bằng cách pick điểm.
- Không tạo chung được tập ss2 bao gồi các đối tượng ở lớp 1 và lớp 3 được (cái này mình dùng để xóa các đối tượng đi)


(setq diem1 (getpoint "Diem thu nhat...")
diem2 (getpoint diem1 "Diem thu hai...")
(setq
ss (ssget "_W" diem1 diem2 '((2 . "TC") (8 . "Ke")))
ss1 (ssget "_W" diem1 diem2 '((8 . "1")))
ss2 (ssget "_W" diem1 diem2 '((8 . "3")))
)

Rất mong các bạn giúp đỡ !

P/s: mình đang tập viết LISP!
  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 01 October 2012 - 04:53 PM


(defun C:HA ()
(setq ss1 nil ss2 nil)
(if (setq ss1 (ssget '((-4 . "<OR") (-4 . "<AND") (2 . "TC") (8 . "Ke") (-4 . "AND>") (8 . "1,3") (-4 . "OR>"))))
(foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
(if (/= (strcase (cdr (assoc 2 (entget itm)))) "TC")
(progn
(or ss2 (setq ss2 (ssadd)))
(ssadd itm ss2)
(ssdel itm ss1))))))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 01 October 2012 - 04:59 PM

Để không pick điểm thì chọn tất cả các đối tượng trên bản vé nhưng vẫn đảm bảo điều kiênk lọc:
(ssget "X" '((2 . "TC") (8 . "Ke")))

Chọn các đối tượng ở lớp 1, 3 không pịk điểm
(ssget "x" '((-4 . "<OR")(8 . "1")(8 . "3")(-4 . "OR>")))
  • 0

#4 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 01 October 2012 - 08:39 PM

Cám ơn các bạn! Đã giúp mình sẽ test kết quả mà bạn Hà đã viết.
Còn hướng dẫn của bạn tien2005 mình thấy chưa đạt được mong muốn như sau:
- Bằng một lần chon không tách ra được hai tập chọn như mình đã nêu ra.
Rất cám ơn các bạn !
  • 0

#5 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 01 October 2012 - 09:29 PM



(defun C:HA ()
(setq ss1 nil
ss2 nil
)
(if (setq ss1 (ssget
'((-4 . "<OR")
(-4 . "<AND")
(2 . "TC")
(8 . "Ke")
(-4 . "AND>")
(8 . "1,3")
(-4 . "OR>")
)
)
)
(foreach itm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
(if (/= (strcase (cdr (assoc 2 (entget itm)))) "TC")
(progn
(or ss2 (setq ss2 (ssadd)))
(ssadd itm ss2)
(ssdel itm ss1)
)
)
)
)
(command ".erase" ss2 "")
)

Chân thành cảm ơn bạn HA. Mình thử test lisp bạn viết bằng cách thêm dòng bổ sung thêm dòng
(command ".erase" ss2 "")
vào chương trình như trên. Khi chạy chương trình không xóa được tập SS2. Không biết có lỗi gì nữa. Nhờ bạn kiểm tra giúp mình.
P/s: Tập ss1 là các Block có tên TC ở lớp KE mình sẽ dùng vào mục đích khác
  • 0

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 01 October 2012 - 10:08 PM

Bạn sửa dòng:
(if (/= (strcase (cdr (assoc 2 (entget itm)))) "TC")
Thành dòng:
(if (or (= (cdr (assoc 8 (entget itm))) "1") (= (cdr (assoc 8 (entget itm))) "3"))
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 01 October 2012 - 10:45 PM

Chương trình chạy tốt! Cảm ơn bạn HA và các bạn! Chúc bạn sức khỏe và thành đạt.
Rất mong được sự giúp đỡ của các bạn rất nhiều!
  • 0

#8 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 01 October 2012 - 11:54 PM

Mình xin hỏi thêm các bạn một chút:
Trên bản vẽ mình có một Block có chứa các TAG (File bản vẽ đính kèm)
Để lấy được giá trị của TAG có tên "Station" và "L_Wid" mình phải dùng lisp dưới đây để lấy giá trị(Cái này học mót trên diễn đàn). Có điều cái lisp mình viết dài quá. Nhất là khi Block có nhiều TAG.
Xin giúp:
- Viết một hàm để lấy giá trị theo tên TAG hoặc theo chỉ số của TAG ví dụ: (Gettag tên_TAG). Hàm nhỏ gọn càng tốt vì thường phải sử lý nhiều Block.

File bản vẽ: http://www.mediafire...v11fm6wlbl7j0h7
P/s: Các bạn thông cảm, mình Upload bằng chức năng của diễn đàn nhưng bị lỗi, Mình sẽ kiểm tra lại.

(if (setq i -1
ss (ssget '((2 . "xs_def2") (8 . "XSTA")))
)
(progn
(while (setq e (ssname ss (setq i (1+ i))))
(setq
Station (atof (cdr (ASSOC 1 (entget (entnext (entnext e))))))
L_Wid (atof
(cdr (ASSOC
1
(entget
(entnext
(entnext
(entnext
(entnext
(entnext
(entnext
(entnext
(entnext
(entnext
(entnext (entnext e))
)
)
)
)
)

)
)
)
)
)
)
)
)
)
)
)
)

  • 0

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 02 October 2012 - 06:45 AM

Hàm lấy value của tag, của block có ename là ent.
Còn nếu muốn dùng entnext thì bạn nên sử dụng thêm hàm while, chứ viết như bạn thì khi block có cỡ 100 att nó sẽ dài như... vạn lý trường thành.

(defun GetAtt (ent tag)
(vl-load-com)
(cdr (assoc tag (mapcar '(lambda (Att) (cons (vla-get-TagString Att) (vla-get-TextString Att)))
(vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes)))))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 02 October 2012 - 09:19 AM

Cảm ơn bạn!
Mình tự đọc và học lisp thôi. Cũng không có kiến thức cơ bản nên có nhiều điều chưa rõ. Cảm ơn bạn nhiều. Khi nào có thời gian bạn chỉ giúp mình cách dùng entnext bằng hàm While nhé.
Chúc bạn sức khỏe và thành đạt !
  • 0

#11 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 02 October 2012 - 09:29 AM

Đây bạn

(defun GetAtt (ent tag / lst)
(while (not (= (cdr (assoc 0 (entget (setq ent (entnext ent))))) "SEQEND"))
(setq lst (append lst (list (list (cdr (assoc 2 (entget ent))) (cdr (assoc 1 (entget ent))))))))
(cdr (assoc tag lst)))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#12 aliosa

aliosa

    biết vẽ polygon

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

Đã gửi 02 October 2012 - 09:52 AM

Hàm chạy tốt rồi . Mình chỉ dùng được thôi, còn chưa hiểu code. Có lẽ hơi phức tạp chút... Cảm ơn các bạn !!! Phục các bạn quá !!!
  • 0