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  
quangthanhdu

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

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

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

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
phamthanhbinh    3.123
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.

 

  • 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

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ỡ.

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  

×