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ị

Tạm gọi Mat4, nhưng tôi nghĩ bạn thay thành mat2 vì cũng na ná như nhau. Vì nhiều tên lệnh quá đôi khi mình cũng không nhớ.


(defun C:mat4(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (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)
)

 

Tôi chỉ chép thêm thôi chứ không đưa cả file vì file cũng dài rồi.

  • 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ạm gọi Mat4, nhưng tôi nghĩ bạn thay thành mat2 vì cũng na ná như nhau. Vì nhiều tên lệnh quá đôi khi mình cũng không nhớ.


(defun C:mat4(/ a col kt tag)  
  (setq a   (car (nentsel "\nChon Attribute:"))
col (acad_colordlg (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)
)

 

Tôi chỉ chép thêm thôi chứ không đưa cả file vì file cũng dài rồi.

 

Cám ơn bạn nhiều, công nhận là nó cũng hao hao giống với mat 2 nhưng mỗi cái có 1 tác dụng khác nhau, nhiều khi mình chỉ cần giống mat2 thôi, không cần cái chọn màu ban đầu như mat4. 

Mình cứ để hết đó, khi nào cần cái nào thì dùng cái nấy, căn bản mình lập mặt bằng kết cấu nhiều nên sủ dụng nhiều lệnh này, dùng nhiều sẽ nhớ hết thôi mà, không sao hết

Ah nếu được bạn mở rộng cái này ra áp dụng với cả text được không. vì nhiều khi dầm thay đổi tiết diện, đoạn dầm chính mới để dynamic block, còn những đoạn dầm thay đổi tiết diện thì mình dùng text thôi, cho bản vẽ nhẹ. Mình đã làm bản vẽ chỉ dùng dynamic block cả với những đoạn thay đổi tiết diện, bản vẽ lớn nên cực nặng, vẽ rất giật. do đó lisp này dùng được cả với text nữa thì tốt.

Tức là các lệnh mat1, mat2, mat3, mat4 của mình lúc đầu chi chọn attibute và gán cho attribute nhưng giờ có thể chọn cả cho text, gán cho attribute hoặc chọn text gán cho text

Mong bạn giúp đỡ

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ình chủ yếu tìm tag của atrtibute để so sánh, còn text thì làm gì có tag?

 

Mình không hiểu nhiều lắm về lisp nhưng nghe bạn nói chắc là phúc tạp. vậy nếu đơn thuần tạo thêm 1 lisp nữa thế này thì mình nghĩ đơn giản hơn, không cần so sánh tag của attribute và mình chỉ cần thế thôi:

 - chọn atribute (hoặc text) mẫu

 - chọn text cần đổi

 - gán nội dung và mầu của attribute (hoặc text) mẫu cho những text đã chọn

 - kết thúc lệnh

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 phải là khó hay phức tạp gì nhưng 2 đối tượng khác nhau rất dễ lẫn lộn, att thì có tag và text , còn text thì không có tag.

Để từ từ tôi xem và sửa lại, bạn yêu cầu "dồn dập" quá cũng hơi khó làm!!  :wacko:  :wacko:

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 phải là khó hay phức tạp gì nhưng 2 đối tượng khác nhau rất dễ lẫn lộn, att thì có tag và text , còn text thì không có tag.

Để từ từ tôi xem và sửa lại, bạn yêu cầu "dồn dập" quá cũng hơi khó làm!!  :wacko:  :wacko:

 

Xin lỗi có thể cách nói của mình làm bạn hiểu nhầm, khi nào bạn rảnh rỗi, nếu được thì triển khai hộ mình thôi mà

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ạn thử cái này, cả 4 lệnh mat1234. Nhưng lưu ý là text chỉ có thể tác động lên text khác chứ không thể tác động lên att, nhất là ở lệnh mat2 và mat4 (đổi nội dung) vì nó không biết phải đổi nội dung nào (cảu tag SH hay KT).

Tôi chưa test nhiều, bạn test thấy có gì trục trặc thì cho tôi biết.

http://www.mediafire.com/download/3222iia5j83z8a3/attcol_1.lsp

  • 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

Bạn thử cái này, cả 4 lệnh mat1234. Nhưng lưu ý là text chỉ có thể tác động lên text khác chứ không thể tác động lên att, nhất là ở lệnh mat2 và mat4 (đổi nội dung) vì nó không biết phải đổi nội dung nào (cảu tag SH hay KT).

Tôi chưa test nhiều, bạn test thấy có gì trục trặc thì cho tôi biết.

http://www.mediafire.com/download/3222iia5j83z8a3/attcol_1.lsp

 

Mình chỉ lấy màu và giá trị của attribute KT gán cho text và ngược lại thôi

 

Mình đã test lisp sửa của bạn và thấy:

 - Mat1: đã ok, có thể dùng với cả text và att

 - Mat2: chọn text trước thì không gán được cho att, chọn att trước thì có thể gán cho cả text và att

 - Mat3: chọn att trước thì OK nhưng chọn text trước thì sẽ báo lỗi như hình dưới

- Mat4: tương tự vậy,  chọn text trước thì không gán được cho att, chọn att trước thì có thể gán cho cả text và att

 

9928_loi_test_mat3.jpg

Chon Attribute hoac Text:
Select objects:  Backtrace:
[0.52] (VL-BT)
[1.48] (*ERROR* "bad argument type: stringp nil")
[2.43] (_call-err-hook #<SUBR @0000000031bbcd18 *ERROR*> "bad argument type: 
stringp nil")
[3.37] (sys-error "bad argument type: stringp nil")
:ERROR-BREAK.32 nil
[4.29] (ATOI nil)
[5.24] (_DCLSEL nil)
[6.19] (C:MAT3)
[7.15] (#<SUBR @000000002da34ea8 -rts_top->)
[8.12] (#<SUBR @000000002d998700 veval-str-body> "(C:MAT3)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
 
Chon Attribute hoac Text:
Select objects:  Backtrace:
[0.52] (VL-BT)
[1.48] (*ERROR* "bad argument type: stringp nil")
[2.43] (_call-err-hook #<SUBR @0000000031bbcd18 *ERROR*> "bad argument type: 
stringp nil")
[3.37] (sys-error "bad argument type: stringp nil")
:ERROR-BREAK.32 nil
[4.29] (ATOI nil)
[5.24] (_DCLSEL nil)
[6.19] (C:MAT3)
[7.15] (#<SUBR @000000002da34ea8 -rts_top->)
[8.12] (#<SUBR @000000002d998700 veval-str-body> "(C:MAT3)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)

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

Nếu bạn muốn chỉ dùng với att có tag KT thì sẽ hạn chế nhiều lắm. Thí dụ bạn muốn đổi màu cái tag SH thì sẽ không dùng lisp này được nữa. Ngoài ra trước đây tôi nhớ bạn nói còn muốn đổi màu các att khác (không có cả KT và SH) nữa mà.

Như tôi đã nói như trên là chì có 1 chiều Text -> Text hoặc Att -> Text thôi, chứ không có chiều ngược lại Text->Att (đổi nội dung).

Bạn nên suy tính kỹ, chứ nếu chỉ đổi KT thôi thì hơi uổng cái lisp.

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

Nếu bạn muốn chỉ dùng với att có tag KT thì sẽ hạn chế nhiều lắm. Thí dụ bạn muốn đổi màu cái tag SH thì sẽ không dùng lisp này được nữa. Ngoài ra trước đây tôi nhớ bạn nói còn muốn đổi màu các att khác (không có cả KT và SH) nữa mà.

Như tôi đã nói như trên là chì có 1 chiều Text -> Text hoặc Att -> Text thôi, chứ không có chiều ngược lại Text->Att (đổi nội dung).

Bạn nên suy tính kỹ, chứ nếu chỉ đổi KT thôi thì hơi uổng cái lisp.

 

ko biết người khác thế nào nhưng với cái text thì mình chỉ có nhu cầu sử dụng với att KT thôi.

những lisp trước với các loại att là ok rồi nên lisp đó mình sẽ dùng với att.

còn với text thì bạn hộ mình 1 lisp là gán màu và giá trị từ Text -> att và ngược lại được không, lisp này chỉ có tác dụng với att KT thôi

Cái này chỉ cần 1 lisp gán luôn giá trị và màu của Text -> att, Text -> text chứ không cần 4 lệnh như trước đâu

mình cám ơn nhiều

Chỉnh sửa theo proconeng86

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

Đúng rồi, lisp trên của bạn vẫn rất hay, bình thường vẫn dùng được att -> text, chỉ trừ trường hợp text -> att nữa thôi. bạn thêm cho mình 1 lisp này nhé

 - chọn text mẫu

 - chọn att hoặc text cần đổi

 - gán giá trị và mầu của text mẫu cho att và text cần đổi

 - kết thúc lệnh

Cám ơn bạn nhiều nhé

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 thử cái này, cả 4 lệnh mat1234. Nhưng lưu ý là text chỉ có thể tác động lên text khác chứ không thể tác động lên att, nhất là ở lệnh mat2 và mat4 (đổi nội dung) vì nó không biết phải đổi nội dung nào (cảu tag SH hay KT).

......

 

Chào bác Tot77!

Trước tiên, rất cảm ơn bác đã bỏ nhiều thời gian để viết Lisp này, rất có ích!  :)

Thời gian này Tue_NV bận quá, không "mần ăn" chi được.

Và với Trường hợp này, bác có thể chỉ định Tag mẫu, sau khi chọn text nguồn -> Chọn Tag mẫu -> Quét qua các block, cái nào mà giống tag mẫu thì đổi, không thì thôi. Điều này hoàn toàn có thể làm được

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 lisp dưới đây có những cái mới như sau:

1. Lấy att "KT" làm chuẩn. Nếu bạn muốn đổi sang att khác thì đánh lệnh mat0, trong lệnh mat0 nếu bạn không chọn att nào khác thì nó vẫn lấy "KT" làm chuẩn.

2. Vì KT làm chuẩn nên trong lệnh mat3 không cần chọn att hay text, bạn "quơ" bao nhiêu thì nó lên bấy nhiêu.

 

Bạn test thử, tôi thấy cái lisp này giống như đám rừng vì rẽ nhánh nhiều quá, không khéo thì dễ lạc lắm đó.


(vl-load-com)
(defun c:mat0()
  (setq attchuan (car (nentsel "\nChon Attribute de lam chuan:")))
  (if (not attchuan) (setq attchuan "KT"))
)
 
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (vl-bt)
  (princ)
)
(setq temperr *error*)
(if (not attchuan) (setq attchuan "KT"))
 
(defun setColor(tag tval col v kieu / obj)
  (setq obj (vlax-ename->vla-object v))  
  (if (= "AcDbText"  (vla-get-objectname obj))
    (cond ((and (not kieu) (= tval (vla-get-TextString obj)))
   (vla-put-Color obj col))
 
 (kieu (vla-put-Color obj col) (vla-put-TextString obj tval)))
    
    (foreach item (vlax-safearray->list (vlax-variant-value (vla-GetAttributes obj)))          
      (cond ((or (and (not kieu) tag (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))         
        (and (not kieu) (not tag) (= attchuan (vla-get-TagString item)) (= tval (vla-get-TextString item)))
(and (not kieu) (not tag) (= tval (vla-get-TextString item))))     
          (vla-put-Color item col))
   
   ((or (and kieu tag (= tag (vla-get-TagString item)))
        (and kieu (not tag) (= attchuan (vla-get-TagString item))))
          (vla-put-Color item col) (vla-put-TextString item tval)))))
)
 
(defun getColor(tag v / rt obj)
  (setq rt nil
obj (vlax-ename->vla-object v))
  (if (= "AcDbText"  (vla-get-objectname obj))
    (setq rt (list (vla-get-TextString obj) (vla-get-Color obj)))
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (or (and tag (= tag (vla-get-TagString item)))
 (and (not tag) (= attchuan (vla-get-TagString item))))
           (setq rt (list (vla-get-TextString item) (vla-get-Color item))))
  ))
  rt
)
 
;;Doi mau cua att hoac text
(defun C:mat1(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
 
)
 
;;Doi mau va noi dung cua att hoac text
(defun C:mat2(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
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 '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
;;Doi mau va noi dung cua tag hoac text
(defun C:mat4(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x t)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
(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 ssl (acet-ss-to-list (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")
     (0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>"))))
ssl (vl-remove-if '(lambda(x) (and (dxf 66 x) (not (getcolor attchuan x)))) ssl)
l  (mapcar '(lambda(x) (getcolor attchuan x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor attchuan (car (setq tm (assoc (car (getcolor attchuan 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

Cái lisp dưới đây có những cái mới như sau:

1. Lấy att "KT" làm chuẩn. Nếu bạn muốn đổi sang att khác thì đánh lệnh mat0, trong lệnh mat0 nếu bạn không chọn att nào khác thì nó vẫn lấy "KT" làm chuẩn.

2. Vì KT làm chuẩn nên trong lệnh mat3 không cần chọn att hay text, bạn "quơ" bao nhiêu thì nó lên bấy nhiêu.

 

Bạn test thử, tôi thấy cái lisp này giống như đám rừng vì rẽ nhánh nhiều quá, không khéo thì dễ lạc lắm đó.


(vl-load-com)
(defun c:mat0()
  (setq attchuan (car (nentsel "\nChon Attribute de lam chuan:")))
  (if (not attchuan) (setq attchuan "KT"))
)
 
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (vl-bt)
  (princ)
)
(setq temperr *error*)
(if (not attchuan) (setq attchuan "KT"))
 
(defun setColor(tag tval col v kieu / obj)
  (setq obj (vlax-ename->vla-object v))  
  (if (= "AcDbText"  (vla-get-objectname obj))
    (cond ((and (not kieu) (= tval (vla-get-TextString obj)))
   (vla-put-Color obj col))
 
 (kieu (vla-put-Color obj col) (vla-put-TextString obj tval)))
    
    (foreach item (vlax-safearray->list (vlax-variant-value (vla-GetAttributes obj)))          
      (cond ((or (and (not kieu) tag (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))         
        (and (not kieu) (not tag) (= attchuan (vla-get-TagString item)) (= tval (vla-get-TextString item)))
(and (not kieu) (not tag) (= tval (vla-get-TextString item))))     
          (vla-put-Color item col))
   
   ((or (and kieu tag (= tag (vla-get-TagString item)))
        (and kieu (not tag) (= attchuan (vla-get-TagString item))))
          (vla-put-Color item col) (vla-put-TextString item tval)))))
)
 
(defun getColor(tag v / rt obj)
  (setq rt nil
obj (vlax-ename->vla-object v))
  (if (= "AcDbText"  (vla-get-objectname obj))
    (setq rt (list (vla-get-TextString obj) (vla-get-Color obj)))
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (or (and tag (= tag (vla-get-TagString item)))
 (and (not tag) (= attchuan (vla-get-TagString item))))
           (setq rt (list (vla-get-TextString item) (vla-get-Color item))))
  ))
  rt
)
 
;;Doi mau cua att hoac text
(defun C:mat1(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
 
)
 
;;Doi mau va noi dung cua att hoac text
(defun C:mat2(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
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 '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
;;Doi mau va noi dung cua tag hoac text
(defun C:mat4(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x t)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
(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 ssl (acet-ss-to-list (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")
     (0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>"))))
ssl (vl-remove-if '(lambda(x) (and (dxf 66 x) (not (getcolor attchuan x)))) ssl)
l  (mapcar '(lambda(x) (getcolor attchuan x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor attchuan (car (setq tm (assoc (car (getcolor attchuan x)) l)))
                     (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 
 

 

Cám ơn bạn Tot77 nhiều nhé, dạo này bận quá, nay mới test được lisp của bạn

Lisp này là vượt quá mong đợi của mình rồi. mat1, mat2, mat4 đã lựa chọn được cho text -> att

Tuy nhiên mat3 hình như bị lỗi gì đó, mình làm mãi ko được, nó ko hiện lên được bảng màu chọn

Bạn xem lại tại sao nhé

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 thử lại với mat3 xem.


(vl-load-com)
(defun c:mat0()
  (setq attchuan (dxf 2 (car (nentsel "\nChon Attribute de lam chuan:"))))
  (if (not attchuan) (setq attchuan "KT"))
)
 
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (vl-bt)
  (princ)
)
(setq temperr *error*)
(if (not attchuan) (setq attchuan "KT"))
 
(defun setColor(tag tval col v kieu / obj)
  (setq obj (vlax-ename->vla-object v))  
  (if (= "AcDbText"  (vla-get-objectname obj))
    (cond ((and (not kieu) (= tval (vla-get-TextString obj)))
   (vla-put-Color obj col))
 
 (kieu (vla-put-Color obj col) (vla-put-TextString obj tval)))
    
    (foreach item (vlax-safearray->list (vlax-variant-value (vla-GetAttributes obj)))          
      (cond ((or (and (not kieu) tag (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))         
        (and (not kieu) (not tag) (= attchuan (vla-get-TagString item)) (= tval (vla-get-TextString item)))
(and (not kieu) (not tag) (= tval (vla-get-TextString item))))     
          (vla-put-Color item col))
   
   ((or (and kieu tag (= tag (vla-get-TagString item)))
        (and kieu (not tag) (= attchuan (vla-get-TagString item))))
          (vla-put-Color item col) (vla-put-TextString item tval)))))
)
 
(defun getColor(tag v / rt obj)
  (setq rt nil
obj (vlax-ename->vla-object v))
  (if (= "AcDbText"  (vla-get-objectname obj))
    (setq rt (list (vla-get-TextString obj) (vla-get-Color obj)))
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (or (and tag (= tag (vla-get-TagString item)))
 (and (not tag) (= attchuan (vla-get-TagString item))))
           (setq rt (list (vla-get-TextString item) (vla-get-Color item))))
  ))
  rt
)
 
;;Doi mau cua att hoac text
(defun C:mat1(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
 
)
 
;;Doi mau va noi dung cua att hoac text
(defun C:mat2(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
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 '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
;;Doi mau va noi dung cua tag hoac text
(defun C:mat4(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x t)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
(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 ssl (acet-ss-to-list (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")
(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>"))))
ssl (vl-remove-if-not '(lambda(x) (getcolor attchuan x)) ssl)
l  (mapcar '(lambda(x) (getcolor attchuan x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor attchuan (car (setq tm (assoc (car (getcolor attchuan x)) l)))
                     (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 
 

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ó anh nào viết giúp em cái lisp đếm dynamic block được không ạ? em tìm mãi chỉ có cá lisp db.lsp nhưng nó thống kê normal block 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

có anh nào viết giúp em cái lisp đếm dynamic block được không ạ? em tìm mãi chỉ có cá lisp db.lsp nhưng nó thống kê normal block không à.

Đây là chương trình Dynamic Block Counter của LM. Bạn xem có dùng được không nhé.

http://www.cadviet.com/upfiles/3/67029_count_dynamic_block.lsp

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ẳng hiểu sao dạo này forum lại khó down khó up. Thử kiểu này nữa xem sao:


;;-----------------=={ Dynamic Block Counter }==--------------;;
;;                                                            ;;
;;  Program will count all blocks, dynamic blocks and xRefs   ;;
;;  in the current layout, detailing the quantity of blocks   ;;
;;  assuming each visibility state of every dynamic block.    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    28-08-2011                            ;;
;;------------------------------------------------------------;;
 
(defun c:dbcount ( / _Assoc++ _PadBetween lst sel vis vsl )
 
    (defun _Assoc++ ( key lst / pair )
        (if key
            (if (setq pair (assoc (car key) lst))
                (subst (cons (car key) (_Assoc++ (cdr key) (cdr pair))) pair lst)
                (cons  (cons (car key) (_Assoc++ (cdr key) nil)) lst)
            )
            (if lst (list (1+ (car lst))) '(1))
        )
    )
 
    (defun _PadBetween ( s1 s2 ch ln )
        (
            (lambda ( a b c )
                (repeat (- ln (length b) (length c)) (setq c (cons a c)))
                (vl-list->string (append b c))
            )
            (ascii ch)
            (vl-string->list s1)
            (vl-string->list s2)
        )
    )
 
    (if (ssget "_X" (list '(0 . "INSERT") (cons 410 (getvar 'CTAB))))
        (progn
            (vlax-for obj
                (setq sel
                    (vla-get-activeselectionset
                        (vla-get-activedocument (vlax-get-acad-object))
                    )
                )
                (setq lst
                    (_Assoc++
                        (cons
                            (if (vlax-property-available-p obj 'effectivename)
                                (vla-get-effectivename obj)
                                (vla-get-name obj)
                            )
                            (if
                                (and
                                    (vlax-property-available-p obj 'isdynamicblock)
                                    (eq :vlax-true (vla-get-isdynamicblock obj))
                                    (setq vis
                                        (cdr
                                            (cond
                                                (   (assoc (vla-get-effectivename obj) vsl)   )
                                                (   (car
                                                        (setq vsl
                                                            (cons
                                                                (cons
                                                                    (vla-get-effectivename obj)
                                                                    (LM:GetVisibilityParameterName obj)
                                                                )
                                                                vsl
                                                            )
                                                        )
                                                    )
                                                )
                                            )
                                        )
                                    )
                                    (setq vis
                                        (vl-some
                                            (function
                                                (lambda ( prop )
                                                    (if (eq vis (vla-get-propertyname prop))
                                                        (vlax-get prop 'value)
                                                    )
                                                )
                                            )
                                            (vlax-invoke obj 'getdynamicblockproperties)
                                        )
                                    )
                                )
                                (list vis)
                            )
                        )
                        lst
                    )
                )
            )
            (vla-delete sel)
            (princ (_PadBetween "\n" "" "=" 46))
            (princ (_PadBetween "\n Block" "Count" "." 46))
            (princ (_PadBetween "\n" "" "=" 46))
            (foreach blk (vl-sort lst '(lambda ( a b ) (< (car a) (car b))))
                (cond
                    (   (listp (cadr blk))
                        (princ (_PadBetween (strcat "\n " (car blk)) (itoa (apply '+ (mapcar 'cadr (cdr blk)))) "." 46))
                        (foreach vis (cdr blk)
                            (princ (_PadBetween (strcat "\n    " (car vis)) (itoa (cadr vis)) "." 46))
                        )
                    )
                    (   (princ (_PadBetween (strcat "\n " (car blk)) (itoa (cadr blk)) "." 46))   )
                )
                (princ (_PadBetween "\n" "" "-" 46))
            )
            (princ (_PadBetween "\r" "" "=" 46))
            (textpage)
        )
        (princ "\nNo blocks found.")
    )
    (princ)
)
 
;;-----------=={ Get Visibility Parameter Name }==------------;;
;;                                                            ;;
;;  Returns the name of the Visibility Parameter of a         ;;
;;  Dynamic Block (if present).                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  block  -  VLA (Dynamic) Block Reference Object            ;;
;;------------------------------------------------------------;;
;;  Returns:  Name of Visibility Parameter, else nil          ;;
;;------------------------------------------------------------;;
 
(defun LM:GetVisibilityParameterName ( block / visib )  
    (if
        (and
            (vlax-property-available-p block 'effectivename)
            (setq block
                (vla-item
                    (vla-get-blocks (vla-get-document block))
                    (vla-get-effectivename block)
                )
            )
            (eq :vlax-true (vla-get-isdynamicblock block))
            (eq :vlax-true (vla-get-hasextensiondictionary block))
            (setq visib
                (vl-some
                    (function
                        (lambda ( pair )
                            (if
                                (and
                                    (= 360 (car pair))
                                    (eq "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
                                )
                                (cdr pair)
                            )
                        )
                    )
                    (dictsearch
                        (vlax-vla-object->ename (vla-getextensiondictionary block))
                        "ACAD_ENHANCEDBLOCK"
                    )
                )
            )
        )
        (cdr (assoc 301 (entget visib)))
    )
)
 
;;------------------------------------------------------------;;
 
(vl-load-com) (princ)
(princ "\n:: DBCount.lsp | Version 1.0 | © Lee Mac 2011 www.lee-mac.com ::")
(princ "\n:: Type \"DBCount\" to Invoke ::")
(princ)
 
;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

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ám ơn Bạn nhiều nhé. Vãi cả block, hi hi.  Nhân tiện bạn cho mình hỏi có lisp nào cho phép mình công thêm vào Dim một giá trị nhập từ bàn phím không? ví dụ: dim là 1200=> sau khi dung lisp, cộng thêm 100=> Dim thành 1300.

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 thử lại với mat3 xem.


(vl-load-com)
(defun c:mat0()
  (setq attchuan (dxf 2 (car (nentsel "\nChon Attribute de lam chuan:"))))
  (if (not attchuan) (setq attchuan "KT"))
)
 
(defun dxf(id v) (cdr (assoc id (entget v))))
 
(defun *error* ( msg )
  (if (< 0 dch) (unload_dialog dch))
  (setq *error* temperr)
  (vl-bt)
  (princ)
)
(setq temperr *error*)
(if (not attchuan) (setq attchuan "KT"))
 
(defun setColor(tag tval col v kieu / obj)
  (setq obj (vlax-ename->vla-object v))  
  (if (= "AcDbText"  (vla-get-objectname obj))
    (cond ((and (not kieu) (= tval (vla-get-TextString obj)))
   (vla-put-Color obj col))
 
 (kieu (vla-put-Color obj col) (vla-put-TextString obj tval)))
    
    (foreach item (vlax-safearray->list (vlax-variant-value (vla-GetAttributes obj)))          
      (cond ((or (and (not kieu) tag (= tag (vla-get-TagString item)) (= tval (vla-get-TextString item)))         
        (and (not kieu) (not tag) (= attchuan (vla-get-TagString item)) (= tval (vla-get-TextString item)))
(and (not kieu) (not tag) (= tval (vla-get-TextString item))))     
          (vla-put-Color item col))
   
   ((or (and kieu tag (= tag (vla-get-TagString item)))
        (and kieu (not tag) (= attchuan (vla-get-TagString item))))
          (vla-put-Color item col) (vla-put-TextString item tval)))))
)
 
(defun getColor(tag v / rt obj)
  (setq rt nil
obj (vlax-ename->vla-object v))
  (if (= "AcDbText"  (vla-get-objectname obj))
    (setq rt (list (vla-get-TextString obj) (vla-get-Color obj)))
    (foreach item
      (vlax-safearray->list (vlax-variant-value
(vla-GetAttributes (vlax-ename->vla-object v))))          
          (if (or (and tag (= tag (vla-get-TagString item)))
 (and (not tag) (= attchuan (vla-get-TagString item))))
           (setq rt (list (vla-get-TextString item) (vla-get-Color item))))
  ))
  rt
)
 
;;Doi mau cua att hoac text
(defun C:mat1(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x nil)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
 
)
 
;;Doi mau va noi dung cua att hoac text
(defun C:mat2(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
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 '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
;;Doi mau va noi dung cua tag hoac text
(defun C:mat4(/ a col kt tag)
  (command "undo" "be")
  (setq a   (car (nentsel "\nChon Attribute hoac Text:"))
col (acad_colordlg (dxf 62 a))
        kt  (dxf 1 a)
tag (dxf 2 a))  
  (setColor tag kt col (if tag (dxf 330 a) a) nil)
  (mapcar '(lambda(x) (setColor tag kt col x t)) (acet-ss-to-list
    (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>")))))
  (command "undo" "e")
)
 
(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 ssl (acet-ss-to-list (ssget '((-4 . "<or")(0 . "TEXT")(-4 . "<and")
(0 . "INSERT")(66 . 1)(-4 . "and>")(-4 . "or>"))))
ssl (vl-remove-if-not '(lambda(x) (getcolor attchuan x)) ssl)
l  (mapcar '(lambda(x) (getcolor attchuan x)) ssl)
l (_dclsel (vl-sort l '(lambda(x y) (< (car x) (car y))))))
  
  (mapcar '(lambda(x) (setColor attchuan (car (setq tm (assoc (car (getcolor attchuan x)) l)))
                     (atoi (cdr tm)) x nil)) ssl)
  (princ)
)
 
 

 

mình thử rồi nhưng sao vẫn bị lỗi không hiện lên bảng lựa chọn được và thông báo của CAD như ảnh. bạn xem hộ nhé

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

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


×