Lisp Quick Filter: Lọc nhanh theo một số thuộc tính thông dụng

[amateurday 24]

7 giờ trước, naturooo đã nói:

Vâng bác. Qselect lọc theo 1 thuộc tính, lisp thì lọc được theo mấy thuộc tính thông dụng hay dùng. Kể cả lọc theo 1 thuộc tính thì với em thì thao tác Qselect cũng không tiện bằng lisp :D

Chào bạn,

1. Code mới lọc được linetype nhưng lại không lọc được color bylayer như code cũ bạn ơi.

2. Thêm nữa là text thì có thêm được contents khi lọc không?

3. Block hình như cũng bị rắc rối với các loại block *Uxxx nữa.

Nếu được thì nhờ bạn cập nhật giúp nhé. Sẽ còn cập nhật nữa nếu trong quá trình sử dụng sẽ gặp trường hợp nào.

[Nguyễn Hà Huy 51]

;;=============================================================
;; TÊN FILE: QuickFilter(QF).lsp đặt tên ở notepad
;; TÁC GIẢ: Copilot Pro (cùng bạn xây dựng lisp để tăng tốc độ vẽ)
;; CHỨC NĂNG: Lọc nâng cao đối tượng theo mẫu chọn ban đầu
;;=============================================================

;;============================================
;; TẠO DANH SÁCH CHỌN LỌC (HỘP THOẠI DCL)
;;============================================
(defun LM:listbox (msg lst bit / dch des tmp rtn)
  (cond
    ((not
       (and
         (setq tmp (vl-filename-mktemp nil nil ".dcl"))
         (setq des (open tmp "w"))
         (write-line
           (strcat
             "hopthoai:dialog{label=\"" msg "\";"
             "spacer;"
             ":list_box{label=\"Chọn thuộc tính để lọc:\"; key=\"list\"; multiple_select="
             (if (= 1 (logand 1 bit)) "true" "false")
             "; width=40; height=20;}"
             "spacer; ok_cancel;}"
           )
           des
         )
         (not (close des))
         (< 0 (setq dch (load_dialog tmp)))
         (new_dialog "hopthoai" dch)
       )
     )
     (prompt "\nKhông thể tải hộp thoại.")
    )
    (t
     (start_list "list")
     (foreach itm lst (add_list itm))
     (end_list)
     (setq rtn (set_tile "list" "0"))
     (action_tile "list" "(setq rtn $value)")
     (setq rtn
            (if (= 1 (start_dialog))
              (if (= 2 (logand 2 bit))
                (mapcar '(lambda (x) (nth x lst)) (read (strcat "(" rtn ")")))
                (read (strcat "(" rtn ")"))
              )
            )
     )
    )
  )
  (if (< 0 dch) (unload_dialog dch))
  (if (and tmp (setq tmp (findfile tmp))) (vl-file-delete tmp))
  rtn
)

;;============================================
;; LẤY DANH SÁCH LAYER CÓ CÙNG MÀU
;;============================================
(defun get-layers-by-color (color-code / d layer-list)
  (setq layer-list '())
  (while (setq d (tblnext "LAYER" (null d)))
    (if (= color-code (abs (cdr (assoc 62 d))))
      (setq layer-list (cons (cdr (assoc 2 d)) layer-list))
    )
  )
  layer-list
)
;;============================================
;; TẠO FILTER THEO TRUE COLOR VÀ LAYER
;;============================================
(defun create-color-filter (color-code layer-list / filter-list)
  (if layer-list
    (progn
      (setq filter-list (list (cons -4 "<OR") (cons 62 color-code) (cons -4 "<AND") (cons 62 256)))
      (foreach layer-name layer-list
        (setq filter-list (append filter-list (list (cons 8 layer-name))))
      )
      (setq filter-list (append filter-list (list (cons -4 "AND>") (cons -4 "OR>"))))
    )
    (list (cons 62 color-code))
  )
)

;;============================================
;; PHÂN TÍCH THÔNG TIN ĐỐI TƯỢNG ĐƯỢC CHỌN
;;============================================
(defun get-entity-info (ent-data / info-list display-list obj-type layer-name color-code linetype-name block-name text-height text-style ltscale lw len area txt obj)
  (setq info-list '() display-list '())

  ;; Loại đối tượng
  (setq obj-type (cdr (assoc 0 ent-data)))
  (setq info-list (cons (cons 0 obj-type) info-list))
  (setq display-list (cons (strcat "Loại đối tượng     : " (if (= "INSERT" obj-type) "BLOCK" obj-type)) display-list))

  ;; Layer
  (setq layer-name (cdr (assoc 8 ent-data)))
  (setq info-list (cons (cons 8 layer-name) info-list))
  (setq display-list (cons (strcat "Lớp (Layer)        : " layer-name) display-list))

  ;; Màu (true color)
  (setq color-code
    (cond
      ((cdr (assoc 62 ent-data)))
      ((abs (cdr (assoc 62 (tblsearch "LAYER" layer-name)))))
    )
  )
  (setq info-list (cons "True Color" info-list))
  (setq display-list (cons (strcat "Màu (True Color)   : " (rtos color-code 2 0)) display-list))
  ;; Kiểu đường (linetype)
  (setq linetype-name
    (cond
      ((cdr (assoc 6 ent-data)))
      ((cdr (assoc 6 (tblsearch "LAYER" layer-name))))
      ("BYLAYER")
    )
  )
  (if linetype-name
    (progn
      (setq info-list (cons (cons 6 linetype-name) info-list))
      (setq display-list (cons (strcat "Kiểu đường kẻ      : " linetype-name) display-list))
    )
  )

  ;; Tên Block (nếu là INSERT)
  (if (and (= "INSERT" obj-type) (setq block-name (cdr (assoc 2 ent-data))))
    (progn
      (setq info-list (cons (cons 2 block-name) info-list))
      (setq display-list (cons (strcat "Tên Block          : " block-name) display-list))
    )
  )

  ;; Chiều cao chữ
  (if (setq text-height (cdr (assoc 40 ent-data)))
    (progn
      (setq info-list (cons (cons 40 text-height) info-list))
      (setq display-list (cons (strcat "Chiều cao chữ      : " (rtos text-height)) display-list))
    )
  )

  ;; Kiểu chữ (style)
  (if (setq text-style (cdr (assoc 7 ent-data)))
    (progn
      (setq info-list (cons (cons 7 text-style) info-list))
      (setq display-list (cons (strcat "Kiểu chữ (Style)   : " text-style) display-list))
    )
  )

  ;; Tỷ lệ kiểu đường (Linetype Scale)
  (if (setq ltscale (cdr (assoc 48 ent-data)))
    (progn
      (setq info-list (cons (cons 48 ltscale) info-list))
      (setq display-list (cons (strcat "Tỷ lệ kiểu đường   : " (rtos ltscale)) display-list))
    )
  )

  ;; Độ dày nét vẽ (Lineweight)
  (if (setq lw (cdr (assoc 370 ent-data)))
    (progn
      (setq info-list (cons (cons 370 lw) info-list))
      car ss1(setq display-list (cons (strcat "Độ dày nét vẽ      : " (rtos (/ lw 100.0) 2 2) " mm") display-list))
    )
  )

  ;; Chiều dài (cho LINE, LWPOLYLINE, SPLINE)
  (if (member obj-type '("LINE" "LWPOLYLINE" "SPLINE"))
    (progn
      (setq len (vlax-curve-getdistatparam (car ss1) (vlax-curve-getendparam (car ss1))))
      (setq info-list (cons (cons "Length" len) info-list))
      (setq display-list (cons (strcat "Chiều dài          : " (rtos len)) display-list))
    )
  )

  ;; Diện tích (cho HATCH, REGION, LWPOLYLINE)
  (if (member obj-type '("HATCH" "REGION" "LWPOLYLINE"))
    (progn
      (setq obj (vlax-ename->vla-object (car ss1)))
      (if (vlax-property-available-p obj 'Area)
        (progn
          (setq area (vlax-get obj 'Area))
          (setq info-list (cons (cons "Area" area) info-list))
          (setq display-list (cons (strcat "Diện tích          : " (rtos area)) display-list))
        )
      )
    )
  )

  ;; Nội dung văn bản (TEXT, MTEXT)
  (if (member obj-type '("TEXT" "MTEXT"))
    (progn
      (setq txt (cdr (assoc 1 ent-data)))
      (setq info-list (cons (cons 1 txt) info-list))
      (setq display-list (cons (strcat "Nội dung văn bản   : " txt) display-list))
    )
  )

  (list (reverse info-list) (reverse display-list))
)
(defun C:QF (/ ss1 ent-data info-result lstQF lstDCL lstidx lstfi color-code layer-list selected-item
               ssRaw ssFinal ent i passed obj val len area entType baseType
               length-area-conditions)

  ;; Bước 1: Chọn đối tượng mẫu
  (setq ss1 (entsel "\nChọn đối tượng để tạo bộ lọc: "))
  (while (or (null ss1) (= "" (cdr (assoc 0 (entget (car ss1))))))
    (setq ss1 (entsel "\nVui lòng chọn lại đối tượng: "))
  )

  ;; Bước 2: Phân tích mẫu
  (setq ent-data (entget (car ss1)))
  (setq info-result (get-entity-info ent-data))
  (setq lstQF (car info-result))
  (setq lstDCL (cadr info-result))
  (setq baseType (cdr (assoc 0 ent-data)))

  ;; Bước 3: Màu & Layer
  (setq color-code
    (cond
      ((cdr (assoc 62 ent-data)))
      ((cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 ent-data))))))
    )
  )
  (setq color-code (abs color-code))
  (setq layer-list (get-layers-by-color color-code))

  ;; Bước 4: Hộp thoại chọn điều kiện
  (setq lstidx (LM:listbox "Chọn thông tin để lọc" lstDCL 1))

  ;; Bước 5: Tạo bộ lọc & xác định cần hậu kiểm gì
  (if lstidx
    (progn
      (setq lstfi '() length-area-conditions '())
      (foreach idx lstidx
        (setq selected-item (nth idx lstQF))
        (cond
          ((= selected-item "True Color")
           (setq lstfi (append lstfi (create-color-filter color-code layer-list))))
          ((and (listp selected-item) (eq (car selected-item) "Length"))
           (setq length-area-conditions (cons selected-item length-area-conditions)))
          ((and (listp selected-item) (eq (car selected-item) "Area"))
           (setq length-area-conditions (cons selected-item length-area-conditions)))
          (t
           (setq lstfi (append lstfi (list selected-item))))
        )
      )

      ;; Bước 6: Quét vùng
      (prompt "\n→ Quét vùng đối tượng để áp dụng bộ lọc...")
      (setq ssRaw (ssget lstfi))

      ;; Bước 7: Lọc hậu kiểm (chiều dài & diện tích)
      (if (and ssRaw length-area-conditions)
        (progn
          (setq ssFinal (ssadd) i 0)
          (while (< i (sslength ssRaw))
            (setq ent (ssname ssRaw i)
                  obj (vlax-ename->vla-object ent)
                  entType (cdr (assoc 0 (entget ent)))
                  passed T)
            ;; Chỉ giữ đối tượng cùng loại mẫu
            (if (/= entType baseType) (setq passed nil))

            ;; Duyệt các điều kiện hậu kiểm
            (foreach cond length-area-conditions
              (setq val (cdr cond))
              (cond
                ;; Chiều dài
                ((and passed (eq (car cond) "Length")
                      (vlax-method-applicable-p obj 'GetLength))
                 (setq len (vla-getLength obj))
                 (if (= (fix val) (fix len))
                   (setq passed passed)
                   (setq passed nil)))

                ;; Diện tích – so sánh phần nguyên
                ((and passed (eq (car cond) "Area"))
                 (cond
                   ;; LWPOLYLINE kín
                   ((and (= entType "LWPOLYLINE")
                         (vlax-property-available-p obj 'Area)
                         (= (vla-get-Closed obj) :vlax-true))
                    (setq area (vla-get-Area obj))
                    (if (= (fix val) (fix area))
                      (setq passed passed)
                      (setq passed nil)))
                   ;; CIRCLE, REGION, HATCH...
                   ((and (vlax-property-available-p obj 'Area)
                         (member entType '("CIRCLE" "HATCH" "REGION")))
                    (setq area (vla-get-Area obj))
                    (if (= (fix val) (fix area))
                      (setq passed passed)
                      (setq passed nil)))
                   (t (setq passed nil))
                 )
                )
              )
            )
            (if passed (ssadd ent ssFinal))
            (setq i (1+ i))
          )
        )
        (setq ssFinal ssRaw)
      )

      ;; Bước 8: Hiển thị kết quả
      (if (and ssFinal (> (sslength ssFinal) 0))
        (progn
          (sssetfirst nil ssFinal)
          (prompt (strcat "\n✓ Đã chọn " (itoa (sslength ssFinal)) " đối tượng phù hợp."))
        )
        (prompt "\n⚠ Không tìm thấy đối tượng nào phù hợp.")
      )
    )
  )

  (princ)
)
 

gửi mọi người lisp ai viết nhé, công nhận nó khôn thật, lỗi gì thì copy đoạn code này vào con copilot rồi báo lỗi nó, nó sửa cho. xài ok thì gửi lên cho mọi người nhé

[Htn02 2]

Vào lúc 8/7/2025 tại 08:20, naturooo đã nói:

Vâng bác. Qselect lọc theo 1 thuộc tính, lisp thì lọc được theo mấy thuộc tính thông dụng hay dùng. Kể cả lọc theo 1 thuộc tính thì với em thì thao tác Qselect cũng không tiện bằng lisp :D

E chào bác, thấy lisp của bác hay quá. Bác có thể giúp e lọc theo "contents" nữa được ko. Và trên mặt bằng có nhiều kích thước dầm giống và khác nhau thì lisp có thể thống kê ra được số lượng của các dầm theo "Contents" đó được không bác (giống như bảng thống kê dầm ấy ạ)

[naturooo 38]

2 giờ trước, Htn02 đã nói:

E chào bác, thấy lisp của bác hay quá. Bác có thể giúp e lọc theo "contents" nữa được ko. Và trên mặt bằng có nhiều kích thước dầm giống và khác nhau thì lisp có thể thống kê ra được số lượng của các dầm theo "Contents" đó được không bác (giống như bảng thống kê dầm ấy ạ)

Cứ cho vào AI yêu cầu nó bổ sung là được thôi bạn.