Chuyển đến nội dung
Diễn đàn CADViet
proconeng86

[Xin] lisp chuyển màu các thuộc tính dynamic block

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

Cái danh cao thủ hay thấp thủ thì mình không dám nhận. Viết lisp cho vui thôi, nhân tiện có nhiều cái mới để học.

Bạn nói ngắn gọn thì tôi hiểu, nói càng dài thì tôi càng không hiểu.

Tóm lại ý bạn là có 2 cái lệnh:

1. Đổi màu những tiết diện giống nhau.

2. Đổi cả màu và text của tiết diện theo mẫu.

Thật ra 2 cái cũng gần giống nhau, bạn xài cái dưới đây, lệnh mat1 và mat2.

 


(defun dxf(id v) (cdr (assoc id (entget v))))
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
   ))
)
 
(defun C:mat1()  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list  '(0 . "INSERT") '(2 . "att_ten dam") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2()  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
    (acet-ss-to-list (ssget (list  '(0 . "INSERT") '(2 . "att_ten dam") (cons 66 1)))))
  (princ)
)
 

  • 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

Lisp của bạn Tot77 không có tác dụng với Block dynamic vì dòng này:

(acet-ss-to-list (ssget (list  '(0 . "INSERT") '(2 . "att_ten dam") (cons 66 1)))))

 

Có thể thiết kế giao diện bạn cho đó là hình thức nhưng nó có thể cho mình chọn 1 lần được nhiều tiết diện dầm và đổi màu 1 lần, đương nhiên tốc độ sẽ nhanh hơn so với cách 1 lần chỉ đổi được 1 cái

  • Vote tăng 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

Test trên file chủ thớt đưa thấy ok là được, trừ khi đổi tên block thì xoá dòng đó đi.

Chắc chỉ có bác Tuệ sửa được lisp của lee mac thôi.

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

 

Cái danh cao thủ hay thấp thủ thì mình không dám nhận. Viết lisp cho vui thôi, nhân tiện có nhiều cái mới để học.

Bạn nói ngắn gọn thì tôi hiểu, nói càng dài thì tôi càng không hiểu.

Tóm lại ý bạn là có 2 cái lệnh:

1. Đổi màu những tiết diện giống nhau.

2. Đổi cả màu và text của tiết diện theo mẫu.

Thật ra 2 cái cũng gần giống nhau, bạn xài cái dưới đây, lệnh mat1 và mat2.

 


(defun dxf(id v) (cdr (assoc id (entget v))))
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
   ))
)
 
(defun C:mat1()  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list  '(0 . "INSERT") '(2 . "att_ten dam") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2()  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
    (acet-ss-to-list (ssget (list  '(0 . "INSERT") '(2 . "att_ten dam") (cons 66 1)))))
  (princ)
)
 

 

 

 

Bạn Tot77 xem lại cho mình lệnh mat1 được không, block của mình khi chuyển sang loại "leader" thì không chọn để đổi được nữa

Ngoài ra mình muốn áp dụng với các dynamic block khác nhưng không được. ví dụ mình có block ghi chú thép (file đính kèm) mình cũng muốn làm là đường kính giông nhau thì màu giống nhau, khoảng cách thép giống nhau thì mầu giống nhau nhưng lisp trên không dùng được.

bạn xem lại hộ mình cái nhé

http://www.cadviet.com/upfiles/3/9928_dynamic_block_3.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

Lisp của bạn Tot77 không có tác dụng với Block dynamic vì dòng này:

(acet-ss-to-list (ssget (list  '(0 . "INSERT") '(2 . "att_ten dam") (cons 66 1)))))

 

Có thể thiết kế giao diện bạn cho đó là hình thức nhưng nó có thể cho mình chọn 1 lần được nhiều tiết diện dầm và đổi màu 1 lần, đương nhiên tốc độ sẽ nhanh hơn so với cách 1 lần chỉ đổi được 1 cái

 

Tất nhiên là nếu tạo được liệt kê dạng bảng thì sẽ nhanh hơn nhiều rồi nhưng mà chắc là cũng khó vì mình thấy lisp tạo bảng của LeeMac dài thế kia cơ mà. Nếu bạn Tue_NV mà làm được thì làm giúp mình cái. cám ơn bạn 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

Bác Tot77 Chưa biết đấy thôi, cũng trên file của chủ topic đó nếu chưa thay đổi tính năng Dynamic thì mã dxf 2 chính là tên của nó

Còn khi thay đổi tính năng Block dynamic (như thay đổi thuộc tính Visible chẳng hạn) thì mà dxf 2 không phải là tên đó nữa, nó có tên là *U...

Mã code của bác bị ngay dòng mình đã viết  (acet-ss-to-list (ssget (list  '(0 . "INSERT") '(2 . "att_ten dam") (cons 66 1)))))

  • 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

Cái vụ này mới!! cái đó gọi là "chi phí phát sinh", bạn đưa file mới xem sao.

 

Mình gửi file rồi mà, mình gửi lại vậy. http://www.cadviet.com/upfiles/3/9928_dynamic_block_4.dwg

Bạn có thể sửa lại lisp sao cho dùng với dynamic block nào cũng được thì tốt quá

Cám ơn bạn 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

Ý kiến của Tue_NV về vấn đề  '(2 . "att_ten dam")  là 1 ý kiến đáng trân trọng, dù chỉ là delete 1 cặp dấu ngoặc thôi, nhưng nếu không có người chỉ ra thì tai họa sẽ ập đến khi thiết kế những chương trình lớn.

Tôi vote! 

  • 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

Ý kiến của Tue_NV về vấn đề  '(2 . "att_ten dam")  là 1 ý kiến đáng trân trọng, dù chỉ là delete 1 cặp dấu ngoặc thôi, nhưng nếu không có người chỉ ra thì tai họa sẽ ập đến khi thiết kế những chương trình lớn.

Tôi vote! 

 

Lâu lắm mới thấy 2 bác k tranh luận :')  Cháu vote nố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

Vậy bạn xoá chỗ nào có  '(2 . "att_ten dam") đi thôi là xong.

 

Đúng là chỉ cần bỏ  '(2 . "att_ten dam")  đi là xài được với cả dynamic block khác nữa. thế là ok rồi. cám ơn các bạn nhiều nhé

Nhưng nếu là được dạng bảng liệt kê như của mình thì khi dùng sẽ tiện hơn và nhanh hơn nhiều nữa. bạn nào làm được thì giúp mình cái nhé. mình cám ơn 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

Bạn Tot77 xem lại hộ mình cái được không. không hiểu lí do gì mà mình thử lisp trên là cứ bị treo máy ah. cứ đang chọn màu là treo luôn. 4,5 lần rồi toàn bị thế

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

Lạ nhỉ!! chỉ khi tạo giao diện là có đụng tới file thôi, khi bạn chọn màu tức là giao diện đã bật lên thì không phải do file.

Bạn xài win gì cad gì? Bạn có thể gửi cái file bị treo đó để test xem sao.

Bạn thử trên nhiều file xem có bị không.

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ôi viết lại gọn hơn và thêm cơ chế bắt lỗi, bạn thử lại xem sao.


(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
    ))
)
 
(defun getColor(tag v / rt)
  (setq rt nil)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (= tag (vla-get-TagString item)) 
    (setq rt (list (vla-get-TextString item) (vla-get-Color item)))
    ))
  rt
)
 
(defun C:mat1(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
   (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun c:mat3(/ a tag l ssl tm)
  
;;  Author: Lee McDonell, Copyright © 2011 - www.lee-mac.com       ;;
(defun _dclsel ( l / file tmp dch l1 l2 *attcolour*)
  (defun _dclimg ( k c )
    (start_image k) (fill_image 0 0 (dimx_tile k) (dimy_tile k) c) (end_image)
  )
 
  (defun _unique ( l ) (if l (cons (car l) (_unique (vl-remove (car l) (cdr l))))))
  
  (defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
  )
  
  (defun act1()
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
    (_dclimg "img" (atoi (nth (atoi (get_tile "imgC")) l2)))
  )
  
  (defun act2()
    (set_tile "tags" "") (set_tile "tags" (get_tile "imgC"))
    (_dclimg "img" (setq *attcolour* (acad_colordlg (atoi (nth (atoi (get_tile "imgC")) l2)))))
    (start_list "imgC")
    (mapcar 'add_list (setq l2 (LM:SubstNth (itoa *attcolour*) (atoi (get_tile "imgC")) l2)))
    (end_list)
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
  )  
      
  (setq l (_unique l)
str (strcat
                "ATTCOL : dialog { label = \"Attribute Colour\"; spacer;"
                "  : row { "
                "  :   list_box { label = \"Select Tags\"; key = \"tags\"; width = 20.0; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "  :   list_box { label = \"Colour\" ; key = \"imgC\" ; width = 8.0 ; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "    }"
"  : row { "
                "  :   image_button { key = \"img\"; alignment = centered; height = 3.0; fixed_width = false;"
                "                        fixed_height = true; }"
                "    }"
                "  spacer; ok_cancel;"
                "}"
    ))
  
    (if (not (findfile (setq name 
(strcat (substr (setq sup (vla-get-SupportPath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object)))))
  1 (vl-string-search ";" sup)) "\\ATTCOL.DCL"))))
      (progn (setq file (open name "w"))
             (write-line str file)
             (close file))     
    )
    (setq dch (load_dialog name))
    (new_dialog "ATTCOL" dch)
  
 
    (setq l1 (mapcar 'car l)
          l2 (mapcar '(lambda(x) (itoa (cadr x))) l))
       
    (start_list "tags")  (mapcar 'add_list l1)  (end_list)
    (start_list "imgC")  (mapcar 'add_list l2)  (end_list)
    (set_tile "tags" "0") (set_tile "imgC" "0")
       
    (setq *attcolour* (atoi (car l2)))       
    (_dclimg "img" *attcolour*)
  
    (action_tile "tags" "(act1)")
    (action_tile "imgC" "(act2)")
    (start_dialog)        
 
    (if (< 0 dch) (unload_dialog dch))
    (mapcar 'cons l1 l2)
)
  
;;=======================================;;
  (setq a   (car (nentsel "\nChon Attribute:"))
tag (dxf 2 a))
  
  (vl-catch-all-error-p (vl-catch-all-apply '(lambda() 
     (setq l (_dclsel (mapcar '(lambda(x) (getcolor tag x))
      (setq ssl (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))))))))
  
  (mapcar '(lambda(x) (setColor tag (car (setq tm (assoc (car (getcolor tag x)) l)))
            (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 

  • 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

Tôi viết lại gọn hơn và thêm cơ chế bắt lỗi, bạn thử lại xem sao.


(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
    ))
)
 
(defun getColor(tag v / rt)
  (setq rt nil)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (= tag (vla-get-TagString item)) 
    (setq rt (list (vla-get-TextString item) (vla-get-Color item)))
    ))
  rt
)
 
(defun C:mat1(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
   (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun c:mat3(/ a tag l ssl tm)
  
;;  Author: Lee McDonell, Copyright © 2011 - www.lee-mac.com       ;;
(defun _dclsel ( l / file tmp dch l1 l2 *attcolour*)
  (defun _dclimg ( k c )
    (start_image k) (fill_image 0 0 (dimx_tile k) (dimy_tile k) c) (end_image)
  )
 
  (defun _unique ( l ) (if l (cons (car l) (_unique (vl-remove (car l) (cdr l))))))
  
  (defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
  )
  
  (defun act1()
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
    (_dclimg "img" (atoi (nth (atoi (get_tile "imgC")) l2)))
  )
  
  (defun act2()
    (set_tile "tags" "") (set_tile "tags" (get_tile "imgC"))
    (_dclimg "img" (setq *attcolour* (acad_colordlg (atoi (nth (atoi (get_tile "imgC")) l2)))))
    (start_list "imgC")
    (mapcar 'add_list (setq l2 (LM:SubstNth (itoa *attcolour*) (atoi (get_tile "imgC")) l2)))
    (end_list)
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
  )  
      
  (setq l (_unique l)
str (strcat
                "ATTCOL : dialog { label = \"Attribute Colour\"; spacer;"
                "  : row { "
                "  :   list_box { label = \"Select Tags\"; key = \"tags\"; width = 20.0; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "  :   list_box { label = \"Colour\" ; key = \"imgC\" ; width = 8.0 ; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "    }"
"  : row { "
                "  :   image_button { key = \"img\"; alignment = centered; height = 3.0; fixed_width = false;"
                "                        fixed_height = true; }"
                "    }"
                "  spacer; ok_cancel;"
                "}"
    ))
  
    (if (not (findfile (setq name 
(strcat (substr (setq sup (vla-get-SupportPath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object)))))
  1 (vl-string-search ";" sup)) "\\ATTCOL.DCL"))))
      (progn (setq file (open name "w"))
             (write-line str file)
             (close file))     
    )
    (setq dch (load_dialog name))
    (new_dialog "ATTCOL" dch)
  
 
    (setq l1 (mapcar 'car l)
          l2 (mapcar '(lambda(x) (itoa (cadr x))) l))
       
    (start_list "tags")  (mapcar 'add_list l1)  (end_list)
    (start_list "imgC")  (mapcar 'add_list l2)  (end_list)
    (set_tile "tags" "0") (set_tile "imgC" "0")
       
    (setq *attcolour* (atoi (car l2)))       
    (_dclimg "img" *attcolour*)
  
    (action_tile "tags" "(act1)")
    (action_tile "imgC" "(act2)")
    (start_dialog)        
 
    (if (< 0 dch) (unload_dialog dch))
    (mapcar 'cons l1 l2)
)
  
;;=======================================;;
  (setq a   (car (nentsel "\nChon Attribute:"))
tag (dxf 2 a))
  
  (vl-catch-all-error-p (vl-catch-all-apply '(lambda() 
     (setq l (_dclsel (mapcar '(lambda(x) (getcolor tag x))
      (setq ssl (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))))))))
  
  (mapcar '(lambda(x) (setColor tag (car (setq tm (assoc (car (getcolor tag x)) l)))
            (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 

Cám ơn bạn Tot77 rất nhiệt tình, mình cũng đã check lại với lisp sau của bạn nhưng vẫn bị tình trạng đơ như vậy. mình đã thử nhiều lần và thấy CAD bị lỗi khi ta ấn Cancel trong khi chọn màu và mình cũng đã chụp lại màn hình của CAD bị đơ khi ấy thông báo như  ảnh đính kèm. mình dùng win 7 64 bit, CAD 2010 9928_lisp_doi_mau_att_gay_loi_cad.jpg

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

Không nghĩ tới tình huống bạn bấm cancel khi chọn màu. Bạn thử cái dưới đây xem sao.

 


(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (princ)
)
(setq temperr *error*)
 
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
    ))
)
 
(defun getColor(tag v / rt)
  (setq rt nil)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (= tag (vla-get-TagString item)) 
    (setq rt (list (vla-get-TextString item) (vla-get-Color item)))
    ))
  rt
)
 
(defun C:mat1(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
   (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun c:mat3(/ a tag l ssl tm)
  
;;  Author: Lee McDonell, Copyright © 2011 - www.lee-mac.com       ;;
(defun _dclsel ( l / str name sup file dch l1 l2 *attcolour*)
  (defun _dclimg ( k c )
    (start_image k) (fill_image 0 0 (dimx_tile k) (dimy_tile k) c) (end_image)
  )
 
  (defun _unique ( l ) (if l (cons (car l) (_unique (vl-remove (car l) (cdr l))))))
  
  (defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
  )
  
  (defun act1()
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
    (_dclimg "img" (atoi (nth (atoi (get_tile "imgC")) l2)))
  )
  
  (defun act2()
    (set_tile "tags" "") (set_tile "tags" (get_tile "imgC"))
    (_dclimg "img" (setq *attcolour* (acad_colordlg (atoi (nth (atoi (get_tile "imgC")) l2)))))
    (start_list "imgC")
    (mapcar 'add_list (setq l2 (LM:SubstNth (itoa *attcolour*) (atoi (get_tile "imgC")) l2)))
    (end_list)
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
  )  
      
  (setq l (_unique l)
str (strcat
                "ATTCOL : dialog { label = \"Attribute Colour\"; spacer;"
                "  : row { "
                "  :   list_box { label = \"Select Tags\"; key = \"tags\"; width = 20.0; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "  :   list_box { label = \"Colour\" ; key = \"imgC\" ; width = 8.0 ; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "    }"
"  : row { "
                "  :   image_button { key = \"img\"; alignment = centered; height = 3.0; fixed_width = false;"
                "                        fixed_height = true; }"
                "    }"
                "  spacer; ok_cancel;"
                "}"
    ))
  
    (if (not (findfile (setq name 
(strcat (substr (setq sup (vla-get-SupportPath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object)))))
  1 (vl-string-search ";" sup)) "\\ATTCOL.DCL"))))
      (progn (setq file (open name "w"))
             (write-line str file)
             (close file))     
    )
    (setq dch (load_dialog name))
    (new_dialog "ATTCOL" dch)
  
 
    (setq l1 (mapcar 'car l)
          l2 (mapcar '(lambda(x) (itoa (cadr x))) l))
       
    (start_list "tags")  (mapcar 'add_list l1)  (end_list)
    (start_list "imgC")  (mapcar 'add_list l2)  (end_list)
    (set_tile "tags" "0") (set_tile "imgC" "0")
       
    (setq *attcolour* (atoi (car l2)))       
    (_dclimg "img" *attcolour*)
  
    (action_tile "tags" "(act1)")
    (action_tile "imgC" "(act2)")
    (start_dialog)        
 
    (if (< 0 dch) (unload_dialog dch))
    (mapcar 'cons l1 l2)
)
  
;;=======================================;;
  
  (setq a   (car (nentsel "\nChon Attribute:"))
tag (dxf 2 a)
ssl (vl-remove-if-not '(lambda(x) (getcolor tag x))
(acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
l  (mapcar '(lambda(x) (getcolor tag x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor tag (car (setq tm (assoc (car (getcolor tag x)) l)))
                   (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 

  • 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

Không nghĩ tới tình huống bạn bấm cancel khi chọn màu. Bạn thử cái dưới đây xem sao.

 


(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (princ)
)
(setq temperr *error*)
 
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
    ))
)
 
(defun getColor(tag v / rt)
  (setq rt nil)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (= tag (vla-get-TagString item)) 
    (setq rt (list (vla-get-TextString item) (vla-get-Color item)))
    ))
  rt
)
 
(defun C:mat1(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
   (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun c:mat3(/ a tag l ssl tm)
  
;;  Author: Lee McDonell, Copyright © 2011 - www.lee-mac.com       ;;
(defun _dclsel ( l / str name sup file dch l1 l2 *attcolour*)
  (defun _dclimg ( k c )
    (start_image k) (fill_image 0 0 (dimx_tile k) (dimy_tile k) c) (end_image)
  )
 
  (defun _unique ( l ) (if l (cons (car l) (_unique (vl-remove (car l) (cdr l))))))
  
  (defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
  )
  
  (defun act1()
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
    (_dclimg "img" (atoi (nth (atoi (get_tile "imgC")) l2)))
  )
  
  (defun act2()
    (set_tile "tags" "") (set_tile "tags" (get_tile "imgC"))
    (_dclimg "img" (setq *attcolour* (acad_colordlg (atoi (nth (atoi (get_tile "imgC")) l2)))))
    (start_list "imgC")
    (mapcar 'add_list (setq l2 (LM:SubstNth (itoa *attcolour*) (atoi (get_tile "imgC")) l2)))
    (end_list)
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
  )  
      
  (setq l (_unique l)
str (strcat
                "ATTCOL : dialog { label = \"Attribute Colour\"; spacer;"
                "  : row { "
                "  :   list_box { label = \"Select Tags\"; key = \"tags\"; width = 20.0; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "  :   list_box { label = \"Colour\" ; key = \"imgC\" ; width = 8.0 ; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "    }"
"  : row { "
                "  :   image_button { key = \"img\"; alignment = centered; height = 3.0; fixed_width = false;"
                "                        fixed_height = true; }"
                "    }"
                "  spacer; ok_cancel;"
                "}"
    ))
  
    (if (not (findfile (setq name 
(strcat (substr (setq sup (vla-get-SupportPath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object)))))
  1 (vl-string-search ";" sup)) "\\ATTCOL.DCL"))))
      (progn (setq file (open name "w"))
             (write-line str file)
             (close file))     
    )
    (setq dch (load_dialog name))
    (new_dialog "ATTCOL" dch)
  
 
    (setq l1 (mapcar 'car l)
          l2 (mapcar '(lambda(x) (itoa (cadr x))) l))
       
    (start_list "tags")  (mapcar 'add_list l1)  (end_list)
    (start_list "imgC")  (mapcar 'add_list l2)  (end_list)
    (set_tile "tags" "0") (set_tile "imgC" "0")
       
    (setq *attcolour* (atoi (car l2)))       
    (_dclimg "img" *attcolour*)
  
    (action_tile "tags" "(act1)")
    (action_tile "imgC" "(act2)")
    (start_dialog)        
 
    (if (< 0 dch) (unload_dialog dch))
    (mapcar 'cons l1 l2)
)
  
;;=======================================;;
  
  (setq a   (car (nentsel "\nChon Attribute:"))
tag (dxf 2 a)
ssl (vl-remove-if-not '(lambda(x) (getcolor tag x))
(acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
l  (mapcar '(lambda(x) (getcolor tag x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor tag (car (setq tm (assoc (car (getcolor tag x)) l)))
                   (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 

 

Mình đã thử lisp trên của bạn, CAD đã không còn bị đơ nữa nhưng nếu ấn cancel là thoát lệnh luôn rồi. Mình muốn là khi ấn cancel thì chỉ thoát ra khỏi bảng chọn màu thôi và vẫn ở trong lệnh bình thường. bạn Tot77 sửa lại chút nữa là lisp này ok đó. cám ơn bạn 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

Chắc như vầy là ok rồi.

 


(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (princ)
)
(setq temperr *error*)
 
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
    ))
)
 
(defun getColor(tag v / rt)
  (setq rt nil)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (= tag (vla-get-TagString item)) 
    (setq rt (list (vla-get-TextString item) (vla-get-Color item)))
    ))
  rt
)
 
(defun C:mat1(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
   (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun c:mat3(/ a tag l ssl tm)
  
;;  Author: Lee McDonell, Copyright © 2011 - www.lee-mac.com       ;;
(defun _dclsel ( l / str name sup file dch l1 l2 col col1)
  (defun _dclimg ( k c )
    (start_image k) (fill_image 0 0 (dimx_tile k) (dimy_tile k) c) (end_image)
  )
 
  (defun _unique ( l ) (if l (cons (car l) (_unique (vl-remove (car l) (cdr l))))))
  
  (defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
  )
  
  (defun act1()
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
    (_dclimg "img" (atoi (nth (atoi (get_tile "imgC")) l2)))
  )
  
  (defun act2()
    (set_tile "tags" "") (set_tile "tags" (get_tile "imgC"))
    (setq col (atoi (nth (atoi (get_tile "imgC")) l2)))
    (if (setq col1 (acad_colordlg col))
      (setq col col1))    
    (_dclimg "img" col)
    (start_list "imgC")
    (mapcar 'add_list (setq l2 (LM:SubstNth (itoa col) (atoi (get_tile "imgC")) l2)))
    (end_list)
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
  )  
      
  (setq l (_unique l)
str (strcat
                "ATTCOL : dialog { label = \"Attribute Colour\"; spacer;"
                "  : row { "
                "  :   list_box { label = \"Select Tags\"; key = \"tags\"; width = 20.0; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "  :   list_box { label = \"Colour\" ; key = \"imgC\" ; width = 8.0 ; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "    }"
"  : row { "
                "  :   image_button { key = \"img\"; alignment = centered; height = 3.0; fixed_width = false;"
                "                        fixed_height = true; }"
                "    }"
                "  spacer; ok_cancel;"
                "}"
    ))
  
    (if (not (findfile (setq name 
(strcat (substr (setq sup (vla-get-SupportPath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object)))))
  1 (vl-string-search ";" sup)) "\\ATTCOL.DCL"))))
      (progn (setq file (open name "w"))
             (write-line str file)
             (close file))     
    )
    (setq dch (load_dialog name))
    (new_dialog "ATTCOL" dch)  
 
    (setq l1 (mapcar 'car l)
          l2 (mapcar '(lambda(x) (itoa (cadr x))) l))
       
    (start_list "tags")  (mapcar 'add_list l1)  (end_list)
    (start_list "imgC")  (mapcar 'add_list l2)  (end_list)
    (set_tile "tags" "0") (set_tile "imgC" "0")
       
    (setq col (atoi (car l2)))       
    (_dclimg "img" col)
  
    (action_tile "tags" "(act1)")
    (action_tile "imgC" "(act2)")
    (start_dialog)        
 
    (if (< 0 dch) (unload_dialog dch))
    (mapcar 'cons l1 l2)
)
  
;;=======================================;;
  
  (setq a   (car (nentsel "\nChon Attribute:"))
tag (dxf 2 a)
ssl (vl-remove-if-not '(lambda(x) (getcolor tag x))
(acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
l  (mapcar '(lambda(x) (getcolor tag x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor tag (car (setq tm (assoc (car (getcolor tag x)) l)))
                   (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 

  • 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

Chắc như vầy là ok rồi.

 


(vl-load-com)
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (princ)
)
(setq temperr *error*)
 
(defun setColor(tag tval col v kieu)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (cond ((and (not kieu) (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))
        (vla-put-Color item col))
((and kieu (= tag (vla-get-TagString item)))
        (vla-put-Color item col)
(vla-put-TextString item tval))
    ))
)
 
(defun getColor(tag v / rt)
  (setq rt nil)
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (= tag (vla-get-TagString item)) 
    (setq rt (list (vla-get-TextString item) (vla-get-Color item)))
    ))
  rt
)
 
(defun C:mat1(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (dxf 330 a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil))
 (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun C:mat2(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (dxf 62 a)
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (mapcar '(lambda(x) (setColor tag kt col x t))
   (acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
  (princ)
)
 
(defun c:mat3(/ a tag l ssl tm)
  
;;  Author: Lee McDonell, Copyright © 2011 - www.lee-mac.com       ;;
(defun _dclsel ( l / str name sup file dch l1 l2 col col1)
  (defun _dclimg ( k c )
    (start_image k) (fill_image 0 0 (dimx_tile k) (dimy_tile k) c) (end_image)
  )
 
  (defun _unique ( l ) (if l (cons (car l) (_unique (vl-remove (car l) (cdr l))))))
  
  (defun LM:SubstNth ( a n l / i )
    (setq i -1)
    (mapcar '(lambda ( x ) (if (= (setq i (1+ i)) n) a x)) l)
  )
  
  (defun act1()
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
    (_dclimg "img" (atoi (nth (atoi (get_tile "imgC")) l2)))
  )
  
  (defun act2()
    (set_tile "tags" "") (set_tile "tags" (get_tile "imgC"))
    (setq col (atoi (nth (atoi (get_tile "imgC")) l2)))
    (if (setq col1 (acad_colordlg col))
      (setq col col1))    
    (_dclimg "img" col)
    (start_list "imgC")
    (mapcar 'add_list (setq l2 (LM:SubstNth (itoa col) (atoi (get_tile "imgC")) l2)))
    (end_list)
    (set_tile "imgC" "") (set_tile "imgC" (get_tile "tags"))
  )  
      
  (setq l (_unique l)
str (strcat
                "ATTCOL : dialog { label = \"Attribute Colour\"; spacer;"
                "  : row { "
                "  :   list_box { label = \"Select Tags\"; key = \"tags\"; width = 20.0; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "  :   list_box { label = \"Colour\" ; key = \"imgC\" ; width = 8.0 ; "
"          fixed_width = true; multiple_select = false ; alignment = centered; }"
                "    }"
"  : row { "
                "  :   image_button { key = \"img\"; alignment = centered; height = 3.0; fixed_width = false;"
                "                        fixed_height = true; }"
                "    }"
                "  spacer; ok_cancel;"
                "}"
    ))
  
    (if (not (findfile (setq name 
(strcat (substr (setq sup (vla-get-SupportPath (vla-get-Files (vla-get-Preferences (vlax-get-acad-object)))))
  1 (vl-string-search ";" sup)) "\\ATTCOL.DCL"))))
      (progn (setq file (open name "w"))
             (write-line str file)
             (close file))     
    )
    (setq dch (load_dialog name))
    (new_dialog "ATTCOL" dch)  
 
    (setq l1 (mapcar 'car l)
          l2 (mapcar '(lambda(x) (itoa (cadr x))) l))
       
    (start_list "tags")  (mapcar 'add_list l1)  (end_list)
    (start_list "imgC")  (mapcar 'add_list l2)  (end_list)
    (set_tile "tags" "0") (set_tile "imgC" "0")
       
    (setq col (atoi (car l2)))       
    (_dclimg "img" col)
  
    (action_tile "tags" "(act1)")
    (action_tile "imgC" "(act2)")
    (start_dialog)        
 
    (if (< 0 dch) (unload_dialog dch))
    (mapcar 'cons l1 l2)
)
  
;;=======================================;;
  
  (setq a   (car (nentsel "\nChon Attribute:"))
tag (dxf 2 a)
ssl (vl-remove-if-not '(lambda(x) (getcolor tag x))
(acet-ss-to-list (ssget (list '(0 . "INSERT") (cons 66 1)))))
l  (mapcar '(lambda(x) (getcolor tag x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor tag (car (setq tm (assoc (car (getcolor tag x)) l)))
                   (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 

 

Cám ơn bạn Tot77 nhiều nhé, lisp rất tuyệt, có đầy đủ những thứ mình cần.

chúc bạn công tác tốt và có nhiều cống hiến cho diễn đàn để diễn đàn ngày càng phát triển là nơi giao lưu học hỏi của mọi người.

mình làm ở Bà Triệu, nếu bạn ở hoặc công tác gần đó thì chiều hôm nào đó pm mình, chúng ta uống nước nói chuyện nha

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

Không có chi, tôi ở Saigon.

 

Tiếc quá, bạn lại ở xa quá. vậy khi nào bạn có dịp ra Hà Nội thì pm mình nhé, hi vọng ngày đó gần thôi

 

Bạn Tot77 có thể thêm cho mình 1 lisp nữa được không, lisp kết hợp giữa lệnh mat1 và mat2.

Lisp đó là: 

- chọn attribute cần để đổi màu (cái này giống mat1), sau khi chọn attribute thì hiện lên bảng chọn màu

- chọn dynamic block và đổi tất cả các attribute trong các block đã chọn theo attribute đầu tiên, đổi cả nội dung và màu (giống mat2)

Cám ơn bạn 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

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


×