Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] Lisp lọc các dấu mũi tên có cùng thuộc tính?


  • Please log in to reply
2 replies to this topic

#1 quangthanhdu

quangthanhdu

    biết vẽ rectang

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

Đã gửi 27 July 2012 - 09:24 AM

Em muốn lọc các dấu mũi tên trong bản vẽ (file đính kềm), ý tưởng như sau:
Bước 1. Chon đối tượng cần lọc
Bước 2. Chon một vùng chứa các đối tượng trong bản vẽ
Bước 3. Lọc ra các đối tượng giống với đối tượng được chon ở bước 1
(các dấu mũi tên cần lọc ra, sẽ có cùng thuộc tính: hướng quay, chiều dài...), Các Bác viết hộ em cái Lisp, vì số lượng mũi tên này rất nhiều nên không thể ngồi lọc bằng phương pháp thủ công. Chân thành cảm ơn.
http://www.cadviet.c...loc_mui_ten.dwg
  • 0

#2 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 27 July 2012 - 04:40 PM

Em muốn lọc các dấu mũi tên trong bản vẽ (file đính kềm), ý tưởng như sau: Bước 1. Chon đối tượng cần lọc Bước 2. Chon một vùng chứa các đối tượng trong bản vẽ Bước 3. Lọc ra các đối tượng giống với đối tượng được chon ở bước 1 (các dấu mũi tên cần lọc ra, sẽ có cùng thuộc tính: hướng quay, chiều dài...), Các Bác viết hộ em cái Lisp, vì số lượng mũi tên này rất nhiều nên không thể ngồi lọc bằng phương pháp thủ công. Chân thành cảm ơn. http://www.cadviet.c...loc_mui_ten.dwg

Hề hề hề,
Hãy dùng thử cái này coi đã ưng cái bụng chưa nghen:

(defun ttpl (pl / a al plst n m d g )
(setq a (entnext pl)
al (entget a)
ttl (list)
plst (list)
n 0 )
(while (/= (cdr (assoc 0 al)) "SEQEND")
(if (= (cdr (assoc 0 al)) "VERTEX")
(setq n (1+ n)
plst (append plst (list (cdr (assoc 10 al))))
m 0 )
)
(setq al (entget (setq a (entnext a))) )
)
(while (< m (1- n))
(setq d (distance (nth m plst) (nth (1+ m) plst))
g (angle (nth m plst) (nth (1+ m) plst))
ttl (append ttl (list d g))
m (1+ m)
)
)
ttl

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:lpl (/ plm ttlm la ssl p1 p2 sspl ttl1)
(vl-load-com)
(while (= plm nil)
(setq plm (car (entsel "\n Chon polyline mui ten mau")))
(if (= (cdr (assoc 0 (entget plm))) "POLYLINE")
(setq ttlm (ttpl plm)
la (cdr (assoc 8 (entget plm)))
ssl (ssadd) )
(progn
(alert "\n Ban chon sai doi tuong mau. Hay chon lai")
(setq plm nil)
)
)
)
(setq p1 (getpoint "\n Chon goc trai ben duoi vung chon"))
(setq p2 (getpoint p1 "\n Chon goc phai ben tren vung chon"))
(command "zoom" "e")
(setq sspl (acet-ss-to-list (ssget "w" p1 p2 (list (cons 0 "Polyline") (cons 8 la)) )))
(foreach pl sspl
(setq ttl1 (ttpl pl))
(if (equal ttlm ttl1)
(setq ssl (ssadd pl ssl))
)
)
(command "zoom" "p")
(sssetfirst nil ssl)
(princ)
)

Chúc bạn vui.

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3 quangthanhdu

quangthanhdu

    biết vẽ rectang

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

Đã gửi 27 July 2012 - 04:53 PM

Hề hề hề,
Hãy dùng thử cái này coi đã ưng cái bụng chưa nghen:


(defun ttpl (pl / a al plst n m d g )
(setq a (entnext pl)
al (entget a)
ttl (list)
plst (list)
n 0 )
(while (/= (cdr (assoc 0 al)) "SEQEND")
(if (= (cdr (assoc 0 al)) "VERTEX")
(setq n (1+ n)
plst (append plst (list (cdr (assoc 10 al))))
m 0 )
)
(setq al (entget (setq a (entnext a))) )
)
(while (< m (1- n))
(setq d (distance (nth m plst) (nth (1+ m) plst))
g (angle (nth m plst) (nth (1+ m) plst))
ttl (append ttl (list d g))
m (1+ m)
)
)
ttl

)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:lpl (/ plm ttlm la ssl p1 p2 sspl ttl1)
(vl-load-com)
(while (= plm nil)
(setq plm (car (entsel "\n Chon polyline mui ten mau")))
(if (= (cdr (assoc 0 (entget plm))) "POLYLINE")
(setq ttlm (ttpl plm)
la (cdr (assoc 8 (entget plm)))
ssl (ssadd) )
(progn
(alert "\n Ban chon sai doi tuong mau. Hay chon lai")
(setq plm nil)
)
)
)
(setq p1 (getpoint "\n Chon goc trai ben duoi vung chon"))
(setq p2 (getpoint p1 "\n Chon goc phai ben tren vung chon"))
(command "zoom" "e")
(setq sspl (acet-ss-to-list (ssget "w" p1 p2 (list (cons 0 "Polyline") (cons 8 la)) )))
(foreach pl sspl
(setq ttl1 (ttpl pl))
(if (equal ttlm ttl1)
(setq ssl (ssadd pl ssl))
)
)
(command "zoom" "p")
(sssetfirst nil ssl)
(princ)
)

Chúc bạn vui.

Lisp rất hay!!! Cảm ơn Anh đã giúp dỡ.
  • 0