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

Tháng 8 17, 2020

Thay vì lệnh Filter (FI) mặc định chọn rồi xoá xoá. Lisp Quick Filter (QF) này sẽ chọn một số thuộc tính thông dụng để lọc, giảm bớt vài thao tác thừa không cần thiết:

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(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 "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   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 ")"))
                      ;  (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)
;====================================Main Lisp: Quick Filter (QF)======================================
(defun C:QF (/ ss ss1 ob lyrname colr blkname txth txtn lstQF lstDCL lstidx lstfi a)
  (setq ss1 (entsel "\nSelect Object: "))
  (while (or
	   (null ss1)
	   (= "" (cdr (assoc 0 (entget (car ss1)))))
	 )
  (setq ss1 (entsel "\nSelect Object Again: "))
  )
  (setq ss (entget (car ss1)))

  (setq ob (cdr (assoc 0 ss)))
  (setq lstQF (list (cons 0 ob)))
  (if (= "INSERT" ob)
  	(setq lstDCL (list (strcat "Object           : " "Block")))
	(setq lstDCL (list (strcat "Object           : " ob)))
  );endif
  (setq lyrname (cdr (assoc 8 ss)))
  (setq lstQF (append lstQF (list (cons 8 lyrname))))
  (setq lstDCL (append lstDCL (list (strcat "Layer            : " lyrname))))
  (if (= 62 (car (assoc 62 ss)))
     (progn	
    	(setq colr (cdr (assoc 62 ss)))
        (setq lstQF (append lstQF (list(cons 62 colr))))
	(setq lstDCL (append lstDCL (list (strcat "Color            : " (rtos colr 2 0)))))
     );progn
	(progn
	(setq lstQF (append lstQF '((62 . 256))))
	(setq lstDCL (append lstDCL (list (strcat "Color            : " "256"))))
	)
  )					;end if
  (if (= 2 (car (assoc 2 ss)))
    (progn	
    	(setq blkname (cdr (assoc 2 ss)))
	(setq lstQF (append lstQF (list (cons 2 blkname))))
	(setq lstDCL (append lstDCL (list (strcat "Block Name       : " blkname))))
    );end progn
  )					;end if
  (if (= 40 (car (assoc 40 ss)))
    (progn	
    	(setq txth (cdr (assoc 40 ss)))
	(setq lstQF (append lstQF (list (cons 40 txth))))
	(setq lstDCL (append lstDCL (list (strcat "Text Height      : " (rtos txth)))))
    );end progn
  )					;end if
  (if (= 7 (car (assoc 7 ss)))
    (progn	
    	(setq txtn (cdr (assoc 7 ss)))
	(setq lstQF (append lstQF (list (cons 7 txtn))))
	(setq lstDCL (append lstDCL (list (strcat "Text Style Name  : " txtn))))
    );end progn
  )					;end if
 (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1))
 (foreach a lstidx
	(setq lstfi (append lstfi (list (nth a lstQF))))
 )
(sssetfirst nil (ssget lstfi))
(Print "Write by: NghiaKieu")
(princ)
)

Tháng 8 17, 2020

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

Thay vì lệnh Filter (FI) mặc định chọn rồi xoá xoá. Lisp Quick Filter (QF) này sẽ chọn một số thuộc tính thông dụng để lọc, giảm bớt vài thao tác thừa không cần thiết:

qf.lsp
[✎]


;; List Box  -  Lee Mac
; Displays a DCL list box allowing the user to make a selection from the supplied data.
; msg - [str] Dialog label
; lst - [lst] List of strings to display
; bit - [int] 1=allow multiple; 2=return indexes
; Returns: [lst] List of selected items/indexes, else nil
(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 "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
                            (if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
                        )
                        des
                    )
                    (not (close des))
                    (< 0 (setq dch (load_dialog tmp)))
                    (new_dialog "listbox" dch)
                )
            )
            (prompt "\nError Loading List Box Dialog.")
        )
        (   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 ")"))
                      ;  (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
                    )
                )
            )
        )
    )
    (if (< 0 dch)
        (unload_dialog dch)
    )
    (if (and tmp (setq tmp (findfile tmp)))
        (vl-file-delete tmp)
    )
    rtn
)
;====================================Main Lisp: Quick Filter (QF)======================================
(defun C:QF (/ ss ss1 ob lyrname colr blkname txth txtn lstQF lstDCL lstidx lstfi a)
  (setq ss1 (entsel "\nSelect Object: "))
  (while (or
	   (null ss1)
	   (= "" (cdr (assoc 0 (entget (car ss1)))))
	 )
  (setq ss1 (entsel "\nSelect Object Again: "))
  )
  (setq ss (entget (car ss1)))

  (setq ob (cdr (assoc 0 ss)))
  (setq lstQF (list (cons 0 ob)))
  (if (= "INSERT" ob)
  	(setq lstDCL (list (strcat "Object           : " "Block")))
	(setq lstDCL (list (strcat "Object           : " ob)))
  );endif
  (setq lyrname (cdr (assoc 8 ss)))
  (setq lstQF (append lstQF (list (cons 8 lyrname))))
  (setq lstDCL (append lstDCL (list (strcat "Layer            : " lyrname))))
  (if (= 62 (car (assoc 62 ss)))
     (progn	
    	(setq colr (cdr (assoc 62 ss)))
        (setq lstQF (append lstQF (list(cons 62 colr))))
	(setq lstDCL (append lstDCL (list (strcat "Color            : " (rtos colr 2 0)))))
     );progn
	(progn
	(setq lstQF (append lstQF '((62 . 256))))
	(setq lstDCL (append lstDCL (list (strcat "Color            : " "256"))))
	)
  );end if
  (if (= 2 (car (assoc 2 ss)))
    (progn	
    	(setq blkname (cdr (assoc 2 ss)))
	(setq lstQF (append lstQF (list (cons 2 blkname))))
	(setq lstDCL (append lstDCL (list (strcat "Block Name       : " blkname))))
    );end progn
  );end if
  (if (= 40 (car (assoc 40 ss)))
    (progn	
    	(setq txth (cdr (assoc 40 ss)))
	(setq lstQF (append lstQF (list (cons 40 txth))))
	(setq lstDCL (append lstDCL (list (strcat "Text Height      : " (rtos txth)))))
    );end progn
  );end if
  (if (= 7 (car (assoc 7 ss)))
    (progn	
    	(setq txtn (cdr (assoc 7 ss)))
	(setq lstQF (append lstQF (list (cons 7 txtn))))
	(setq lstDCL (append lstDCL (list (strcat "Text Style Name  : " txtn))))
    );end progn
  );end if
 (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1))
 (foreach a lstidx
	(setq lstfi (append lstfi (list (nth a lstQF))))
 )
(sssetfirst nil (ssget lstfi))
(Print "Write by: NghiaKieu")
(princ)
)

lisp hay nhưng chọn màu còn bị lỗi rồi bác ơi,em test thử thấy cùng một màu 256 mà màu trắng với màu đỏ nó đều chọn hết,cùng một mã màu xanh mà cái thì nó chọn cái nó lại không chọn,những cái khác chưa test hết ạ

Tháng 8 17, 2020

13 phút trước, vanlam6408 đã nói:

lisp hay nhưng chọn màu còn bị lỗi rồi bác ơi,em test thử thấy cùng một màu 256 mà màu trắng với màu đỏ nó đều chọn hết,cùng một mã màu xanh mà cái thì nó chọn cái nó lại không chọn,những cái khác chưa test hết ạ

Mã 256 là By layer mà. Màu khác nhau nhưng để By layer thì nó chọn cả (Filter mặc định cũng vậy). Ý thứ 2 của bạn cũng như vậy.

Tháng 8 17, 2020

5 phút trước, naturooo đã nói:

Mã 256 là By layer mà. Màu khác nhau nhưng để By layer thì nó chọn cả (Filter mặc định cũng vậy). Ý thứ 2 của bạn cũng như vậy.

à vâng,ra thế,em tưởng nó có thể phân biệt được các màu khác nhau cả trong trường hợp by layer thì tốt quá

Tháng 8 17, 2020

26 phút trước, vanlam6408 đã nói:

à vâng,ra thế,em tưởng nó có thể phân biệt được các màu khác nhau cả trong trường hợp by layer thì tốt quá

Lọc theo màu mà có màu đặt theo By layer thì khoai quá. Mình thì các nét toàn để By layer hết nên ít khi lọc theo màu lắm. Không biết các cao thủ trên có giải quyết được món này không? (Mình cũng Beginner :D)

Tháng 8 17, 2020

53 phút trước, naturooo đã nói:

Lọc theo màu mà có màu đặt theo By layer thì khoai quá. Mình thì các nét toàn để By layer hết nên ít khi lọc theo màu lắm. Không biết các cao thủ trên có giải quyết được món này không? (Mình cũng Beginner :D)

vâng.hi

Tháng 8 18, 2020

11 giờ trước, vanlam6408 đã nói:

vâng.hi

(defun c:SelectByColour ( / c d e l )
   (if (setq e (car (entsel)))
       (progn
           (setq c
               (cond
                   (   (cdr (assoc 62 (entget e)))   )
                   (   (abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget e)))))))   )
               )
           )                     
           (while (setq d (tblnext "LAYER" (null d)))
               (if (= c (abs (cdr (assoc 62 d))))
                   (setq l (cons "," (cons (cdr (assoc 2 d)) l)))
               )
           )
           (sssetfirst nil
               (ssget "_X"
                   (if l
                       (list
                           (cons -4 "<OR")
                               (cons 62 c)
                               (cons -4 "<AND")
                                   (cons 62 256)
                                   (cons 8 (apply 'strcat (cdr l)))
                               (cons -4 "AND>")
                           (cons -4 "OR>")
                       )
                       (list (cons 62 c))
                   )
               )
           )
       )
   )
   (princ)
)

Mình tìm thấy cái chọn màu kể cả By layer của Lee Mac đây. Để lúc nào m thêm tuỳ chọn chọn cả theo màu của layer xem sao :)

Tháng 8 18, 2020

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

Lọc theo màu mà có màu đặt theo By layer thì khoai quá. Mình thì các nét toàn để By layer hết nên ít khi lọc theo màu lắm. Không biết các cao thủ trên có giải quyết được món này không? (Mình cũng Beginner :D)

Cũng chỉ là vào Table Layer của đối tượng đó rồi lấy màu thôi mà :)

Tháng 8 18, 2020

26 phút trước, ketxu đã nói:

Cũng chỉ là vào Table Layer của đối tượng đó rồi lấy màu thôi mà :)

Vâng bác. Tại em chưa ngâm cứu đến bước đó nên thấy mới lạ lắm :(

Tháng 8 18, 2020

Ở đây cũng có lọc chọn màu rồi nè. Chỉnh sửa chút xíu nữa là được.

Tháng 8 18, 2020

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

selectbycolour.lsp
[✎]


(defun c:SelectByColour ( / c d e l )
   (if (setq e (car (entsel)))
       (progn
           (setq c
               (cond
                   (   (cdr (assoc 62 (entget e)))   )
                   (   (abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 (entget e)))))))   )
               )
           )                     
           (while (setq d (tblnext "LAYER" (null d)))
               (if (= c (abs (cdr (assoc 62 d))))
                   (setq l (cons "," (cons (cdr (assoc 2 d)) l)))
               )
           )
           (sssetfirst nil
               (ssget "_X"
                   (if l
                       (list
                           (cons -4 "<OR")
                               (cons 62 c)
                               (cons -4 "<AND")
                                   (cons 62 256)
                                   (cons 8 (apply 'strcat (cdr l)))
                               (cons -4 "AND>")
                           (cons -4 "OR>")
                       )
                       (list (cons 62 c))
                   )
               )
           )
       )
   )
   (princ)
)

Mình tìm thấy cái chọn màu kể cả By layer của Lee Mac đây. Để lúc nào m thêm tuỳ chọn chọn cả theo màu của layer xem sao :)

vâng,mong là qf sẽ sớm được hoàn thiện nhất.hi

Tháng 8 19, 2020

22 giờ trước, vanlam6408 đã nói:

vâng,mong là qf sẽ sớm được hoàn thiện nhất.hi

Đã chế lại màu lọc theo True Color (màu hiển thị). Bạn thử xem có lỗi gì k nhé!

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(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 "listbox:dialog{label=\""
		   msg
		   "\";spacer;:list_box{key=\"list\";multiple_select="
		   (if (= 1 (logand 1 bit))
		     "true"
		     "false"
		   )
		   ";width=50;height=15;}spacer;ok_cancel;}"
	   )
	   des
	 )
	 (not (close des))
	 (< 0 (setq dch (load_dialog tmp)))
	 (new_dialog "listbox" dch)
       )
     )
     (prompt "\nError Loading List Box Dialog.")
    )
    (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 ")"))
		;  (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
	      )
	    )
     )
    )
  )
  (if (< 0 dch)
    (unload_dialog dch)
  )
  (if (and tmp (setq tmp (findfile tmp)))
    (vl-file-delete tmp)
  )
  rtn
)
;====================================Main Lisp: Quick Filter (QF) Update 19/08/2020 Loc theo "True Color"======================================
(defun C:QF (/	    ss	   ss1	  ob	 lyrname       colr   blkname
	     txth   txtn   lstQF  lstDCL lstidx	lstfi  a      c
	     d	    l
	    )
  (setq ss1 (entsel "\nSelect Object: "))
  (while (or
	   (null ss1)
	   (= "" (cdr (assoc 0 (entget (car ss1)))))
	 )
    (setq ss1 (entsel "\nSelect Object Again: "))
  )
  (setq ss (entget (car ss1)))
  (setq ob (cdr (assoc 0 ss)))
  (setq lstQF (list (cons 0 ob)))
  (if (= "INSERT" ob)
    (setq lstDCL (list (strcat "Object           : " "Block")))
    (setq lstDCL (list (strcat "Object           : " ob)))
  );endif
  (setq lyrname (cdr (assoc 8 ss)))
  (setq lstQF (append lstQF (list (cons 8 lyrname))))
  (setq	lstDCL (append lstDCL
		       (list (strcat "Layer            : " lyrname))
	       )
  )

  (setq	c
	 (cond
	   ((cdr (assoc 62 ss)))
	   ((abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 ss)))))
	    )
	   )
	 )
  )

  (while (setq d (tblnext "LAYER" (null d)))
    (if	(= c (abs (cdr (assoc 62 d))))
      (setq l (cons "," (cons (cdr (assoc 2 d)) l)))
    )
  )
(setq lstQF (append lstQF (list "True Color")))
  (setq	lstDCL (append lstDCL (list (strcat "True Color       : " (rtos c 2 0)))  )  )
  (if (= 2 (car (assoc 2 ss)))
    (progn
      (setq blkname (cdr (assoc 2 ss)))
      (setq lstQF (append lstQF (list (cons 2 blkname))))
      (setq
	lstDCL (append lstDCL
		       (list (strcat "Block Name       : " blkname))
	       )
      )
    )					;end progn
  )					;end if
  (if (= 40 (car (assoc 40 ss)))
    (progn
      (setq txth (cdr (assoc 40 ss)))
      (setq lstQF (append lstQF (list (cons 40 txth))))
      (setq lstDCL
	     (append lstDCL
		     (list (strcat "Text Height      : " (rtos txth)))
	     )
      )
    )					;end progn
  )					;end if
  (if (= 7 (car (assoc 7 ss)))
    (progn
      (setq txtn (cdr (assoc 7 ss)))
      (setq lstQF (append lstQF (list (cons 7 txtn))))
      (setq lstDCL (append lstDCL
			   (list (strcat "Text Style Name  : " txtn))
		   )
      )
    );end progn
  );end if
  (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1))
  (if lstidx
    (progn
      (foreach a lstidx
	(if (= "True Color" (nth a lstQF))
		(if l
   			(setq lstfi (append lstfi
    			  (list
      				(cons -4 "<OR")
      				(cons 62 c)
      				(cons -4 "<AND")
      				(cons 62 256)
      				(cons 8 (apply 'strcat (cdr l)))
      				(cons -4 "AND>")
      				(cons -4 "OR>")
    			  )
   			))
   			(setq lstfi (append lstfi
    			  (list (cons 62 c))
   			))
 		)
		(setq lstfi (append lstfi (list (nth a lstQF))))
      )
    )
      (sssetfirst nil (ssget lstfi))
    )
  )
  (Print "Write by: NghiaKieu")
  (princ)
)

Tháng 8 20, 2020

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

Đã chế lại màu lọc theo True Color (màu hiển thị). Bạn thử xem có lỗi gì k nhé!

qf.lsp
[✎]


;; List Box  -  Lee Mac
; Displays a DCL list box allowing the user to make a selection from the supplied data.
; msg - [str] Dialog label
; lst - [lst] List of strings to display
; bit - [int] 1=allow multiple; 2=return indexes
; Returns: [lst] List of selected items/indexes, else nil
(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 "listbox:dialog{label=\""
		   msg
		   "\";spacer;:list_box{key=\"list\";multiple_select="
		   (if (= 1 (logand 1 bit))
		     "true"
		     "false"
		   )
		   ";width=50;height=15;}spacer;ok_cancel;}"
	   )
	   des
	 )
	 (not (close des))
	 (< 0 (setq dch (load_dialog tmp)))
	 (new_dialog "listbox" dch)
       )
     )
     (prompt "\nError Loading List Box Dialog.")
    )
    (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 ")"))
;  (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
	      )
	    )
     )
    )
  )
  (if (< 0 dch)
    (unload_dialog dch)
  )
  (if (and tmp (setq tmp (findfile tmp)))
    (vl-file-delete tmp)
  )
  rtn
)
;====================================Main Lisp: Quick Filter (QF) Update 19/08/2020 Loc theo "True Color"======================================
(defun C:QF (/	    ss	   ss1	  ob	 lyrname       colr   blkname
	     txth   txtn   lstQF  lstDCL lstidx	lstfi  a      c
	     d	    l
	    )
  (setq ss1 (entsel "\nSelect Object: "))
  (while (or
	   (null ss1)
	   (= "" (cdr (assoc 0 (entget (car ss1)))))
	 )
    (setq ss1 (entsel "\nSelect Object Again: "))
  )
  (setq ss (entget (car ss1)))
  (setq ob (cdr (assoc 0 ss)))
  (setq lstQF (list (cons 0 ob)))
  (if (= "INSERT" ob)
    (setq lstDCL (list (strcat "Object           : " "Block")))
    (setq lstDCL (list (strcat "Object           : " ob)))
  );endif
  (setq lyrname (cdr (assoc 8 ss)))
  (setq lstQF (append lstQF (list (cons 8 lyrname))))
  (setq	lstDCL (append lstDCL
		       (list (strcat "Layer            : " lyrname))
	       )
  )

  (setq	c
	 (cond
	   ((cdr (assoc 62 ss)))
	   ((abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 ss)))))
	    )
	   )
	 )
  )

  (while (setq d (tblnext "LAYER" (null d)))
    (if	(= c (abs (cdr (assoc 62 d))))
      (setq l (cons "," (cons (cdr (assoc 2 d)) l)))
    )
  )
(setq lstQF (append lstQF (list "True Color")))
  (setq	lstDCL (append lstDCL (list (strcat "True Color       : " (rtos c 2 0)))  )  )
  (if (= 2 (car (assoc 2 ss)))
    (progn
      (setq blkname (cdr (assoc 2 ss)))
      (setq lstQF (append lstQF (list (cons 2 blkname))))
      (setq
	lstDCL (append lstDCL
		       (list (strcat "Block Name       : " blkname))
	       )
      )
    );end progn
  );end if
  (if (= 40 (car (assoc 40 ss)))
    (progn
      (setq txth (cdr (assoc 40 ss)))
      (setq lstQF (append lstQF (list (cons 40 txth))))
      (setq lstDCL
	     (append lstDCL
		     (list (strcat "Text Height      : " (rtos txth)))
	     )
      )
    );end progn
  );end if
  (if (= 7 (car (assoc 7 ss)))
    (progn
      (setq txtn (cdr (assoc 7 ss)))
      (setq lstQF (append lstQF (list (cons 7 txtn))))
      (setq lstDCL (append lstDCL
			   (list (strcat "Text Style Name  : " txtn))
		   )
      )
    );end progn
  );end if
  (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1))
  (if lstidx
    (progn
      (foreach a lstidx
	(if (= "True Color" (nth a lstQF))
		(if l
   			(setq lstfi (append lstfi
    			  (list
      				(cons -4 "<OR")
      				(cons 62 c)
      				(cons -4 "<AND")
      				(cons 62 256)
      				(cons 8 (apply 'strcat (cdr l)))
      				(cons -4 "AND>")
      				(cons -4 "OR>")
    			  )
   			))
   			(setq lstfi (append lstfi
    			  (list (cons 62 c))
   			))
 		)
		(setq lstfi (append lstfi (list (nth a lstQF))))
      )
    )
      (sssetfirst nil (ssget lstfi))
    )
  )
  (Print "Write by: NghiaKieu")
  (princ)
)

hôm nay mới vào diễn đàn test thử hàng mới của bác ạ!Lisp chuẩn rồi bác ạ!cảm ơn bác đã cho em và diễn đàn một lisp mới thật là hay ạ!

Tháng 6 15, 2021

Em có tải thử và sử dụng lisp, thấy khá tiện, mà không biết cách viết thêm để show 1 tính chất là dimstyle ấy ạ, Bác Naturooo có thể add thêm giúp em với hoặc chỉ em cách thêm được không ạ. Đa tạ bác nhiều.

Tháng 6 15, 2021

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

Em có tải thử và sử dụng lisp, thấy khá tiện, mà không biết cách viết thêm để show 1 tính chất là dimstyle ấy ạ, Bác Naturooo có thể add thêm giúp em với hoặc chỉ em cách thêm được không ạ. Đa tạ bác nhiều.

Đây nhé bạn:

;; List Box  -  Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(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 "listbox:dialog{label=\""
		   msg
		   "\";spacer;:list_box{key=\"list\";multiple_select="
		   (if (= 1 (logand 1 bit))
		     "true"
		     "false"
		   )
		   ";width=50;height=15;}spacer;ok_cancel;}"
	   )
	   des
	 )
	 (not (close des))
	 (< 0 (setq dch (load_dialog tmp)))
	 (new_dialog "listbox" dch)
       )
     )
     (prompt "\nError Loading List Box Dialog.")
    )
    (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 ")"))
					;  (mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
	      )
	    )
     )
    )
  )
  (if (< 0 dch)
    (unload_dialog dch)
  )
  (if (and tmp (setq tmp (findfile tmp)))
    (vl-file-delete tmp)
  )
  rtn
)
					;====================================Main Lisp: Quick Filter (QF) Update 19/08/2020 Loc theo "True Color"======================================
(defun C:QF (/	    ss	   ss1	  ob	 lyrname       colr   blkname
	     txth   txtn   txtvl  lstQF	 lstDCL	lstidx dimsty lstfi
	     a	    c	   d	  l
	    )
  (setq ss1 (entsel "\nSelect Object: "))
  (while (or
	   (null ss1)
	   (= "" (cdr (assoc 0 (entget (car ss1)))))
	 )
    (setq ss1 (entsel "\nSelect Object Again: "))
  )
  (setq ss (entget (car ss1)))
  (setq ob (cdr (assoc 0 ss)))
  (setq lstQF (list (cons 0 ob)))
  (if (= "INSERT" ob)
    (setq lstDCL (list (strcat "Object           : " "Block")))
    (setq lstDCL (list (strcat "Object           : " ob)))
  )					;endif
  (setq lyrname (cdr (assoc 8 ss)))
  (setq lstQF (append lstQF (list (cons 8 lyrname))))
  (setq	lstDCL (append lstDCL
		       (list (strcat "Layer            : " lyrname))
	       )
  )

  (setq	c
	 (cond
	   ((cdr (assoc 62 ss)))
	   ((abs (cdr (assoc 62 (tblsearch "LAYER" (cdr (assoc 8 ss)))))
	    )
	   )
	 )
  )

  (while (setq d (tblnext "LAYER" (null d)))
    (if	(= c (abs (cdr (assoc 62 d))))
      (setq l (cons "," (cons (cdr (assoc 2 d)) l)))
    )
  )
  (setq lstQF (append lstQF (list "True Color")))
  (setq
    lstDCL (append lstDCL
		   (list (strcat "True Color       : " (rtos c 2 0)))
	   )
  )
  (if (= 2 (car (assoc 2 ss)))
    (progn
      (setq blkname (cdr (assoc 2 ss)))
      (setq lstQF (append lstQF (list (cons 2 blkname))))
      (setq
	lstDCL (append lstDCL
		       (list (strcat "Block Name       : " blkname))
	       )
      )
    )					;end progn
  )					;end if
  (if (= 40 (car (assoc 40 ss)))
    (progn
      (setq txth (cdr (assoc 40 ss)))
      (setq lstQF (append lstQF (list (cons 40 txth))))
      (setq lstDCL
	     (append lstDCL
		     (list (strcat "Text Height      : " (rtos txth)))
	     )
      )
    )					;end progn
  )					;end if
  (if (= 7 (car (assoc 7 ss)))
    (progn
      (setq txtn (cdr (assoc 7 ss)))
      (setq lstQF (append lstQF (list (cons 7 txtn))))
      (setq lstDCL (append lstDCL
			   (list (strcat "Text Style Name  : " txtn))
		   )
      )
    )					;end progn
  )					;end if
  (if (= 1 (car (assoc 1 ss)))
    (progn
      (setq txtvl (cdr (assoc 1 ss)))
      (setq lstQF (append lstQF (list (cons 1 txtvl))))
      (setq lstDCL (append lstDCL
			   (list (strcat "Text Value       : " txtvl))
		   )
      )
    )					;end progn
  )					;end if  
  (if (= 3 (car (assoc 3 ss)))
    (progn
      (setq dimsty (cdr (assoc 3 ss)))
      (setq lstQF (append lstQF (list (cons 3 dimsty))))
      (setq
	lstDCL (append lstDCL
		       (list (strcat "Dimension Style     : " dimsty))
	       )
      )
    )					;end progn
  )					;end if 
  (setq lstidx (LM:listbox "Selection to Filter:" lstDCL 1))
  (if lstidx
    (progn
      (foreach a lstidx
	(if (= "True Color" (nth a lstQF))
	  (if l
	    (setq lstfi	(append	lstfi
				(list
				  (cons -4 "<OR")
				  (cons 62 c)
				  (cons -4 "<AND")
				  (cons 62 256)
				  (cons 8 (apply 'strcat (cdr l)))
				  (cons -4 "AND>")
				  (cons -4 "OR>")
				)
			)
	    )
	    (setq lstfi	(append	lstfi
				(list (cons 62 c))
			)
	    )
	  )
	  (setq lstfi (append lstfi (list (nth a lstQF))))
	)
      )
      (sssetfirst nil)			; clear original-selection highlighting/gripping, then:
      (sssetfirst nil (ssget lstfi))
    )
  )
  (Print "Write by: NghiaKieu")
  (princ)
)

Tháng 6 15, 2021

Dạ em cảm ơn Bác nhiều !!!!

Tháng 6 15, 2021

Mà hình như lisp đang bị lỗi, bấm chọn vô cái nào nó cũng hiện bảng rồi tự động tắt luôn ạ.

Select Object: ; error: no function definition: ANDÏ»¿

Tháng 6 15, 2021

1 giờ} trướ}c, tranhoang1218 đã nói:

Mà hình như lisp đang bị lỗi, bấm chọn vô cái nào nó cũng hiện bảng rồi tự động tắt luôn ạ.

Select Object: ; error: no function definition: ANDÏ»¿

Bản tải lại thử xem nhé

Tháng 6 15, 2021

3 phút trước, naturooo đã nói:

Bản tải lại thử xem nhé

Dạ ổn rồi ạ ! Cảm ơn bác nhiều !

Đăng nhập

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

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

naturooo 36

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

vanlam6408 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

naturooo 36

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

vanlam6408 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

naturooo 36

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

vanlam6408 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

naturooo 36

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

ketxu 2.984

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

naturooo 36

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

ngokiet 169

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

vanlam6408 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

naturooo 36

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

vanlam6408 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

tranhoang1218 0

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

naturooo 36

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

tranhoang1218 0

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

tranhoang1218 0

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

naturooo 36

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

tranhoang1218 0

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