Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
naturooo

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ị

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)
)

 

  • Like 2

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
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:


;; 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 ạ

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

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
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á

 

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
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)

  • Like 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
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

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
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 :)

  • Like 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
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à :)
 

  • Like 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
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 :(

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
12 giờ trước, naturooo đã nói:
  • selectbycolour.lsp
    lisp help
  •  

(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

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
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)
)

 

  • Like 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

 

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é!


;; 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 ạ!

  • Like 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

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.

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
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)
)

 

  • Like 2

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

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Ï»¿

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
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é

  • Like 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

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  

×