Jump to content
InfoFile
Tác giả: phamthanhbinh
Bài viết gốc: 291239
Tên lệnh: dsty
đổi chữ thường thành chữ hoa

chào mọi người! mình muốn chỉnh các chữ còn lại có style name giống như chữ "Chốt định vị" và "Bulong cạnh ổ M14". 2 chữ  này có style name là "son". Mình muốn chỉnh các chữ còn lại có style name là "son" thì mình phải làm thế nào để nhanh chóng? Mình mà chỉnh từng chữ một thì lâu lắm. Có cách nào chỉnh...

>>

chào mọi người! mình muốn chỉnh các chữ còn lại có style name giống như chữ "Chốt định vị" và "Bulong cạnh ổ M14". 2 chữ  này có style name là "son". Mình muốn chỉnh các chữ còn lại có style name là "son" thì mình phải làm thế nào để nhanh chóng? Mình mà chỉnh từng chữ một thì lâu lắm. Có cách nào chỉnh cho tất cả các chữ có style name là ''son" nhanh không? Mong mọi người giúp đỡ. thanks!

Hề hề hề,

Dùng thử cái này coi có được không hè.

(defun c:dsty (/ sst el)
(vl-load-com)
(alert "\n Hay chon cac text can doi style")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text")))))
(foreach txt sst
      (setq el (entget txt))
      (entmod (subst (cons 7 "son") (assoc 7 el) el))
)
(princ)
)
 

 

Lưu ý là trên bản vẽ phải có sẵn style tên là son


<<

Filename: 291239_dsty.lsp
Tác giả: Tot77
Bài viết gốc: 291384
Tên lệnh: mat1 mat2 mat3
[Xin] lisp chuyển màu các thuộc tính dynamic block

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

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


<<

Filename: 291384_mat1_mat2_mat3.lsp
Tác giả: Tot77
Bài viết gốc: 291411
Tên lệnh: mat1 mat2 mat3
[Xin] lisp chuyển màu các thuộc tính dynamic block

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

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


<<

Filename: 291411_mat1_mat2_mat3.lsp
Tác giả: Tot77
Bài viết gốc: 291416
Tên lệnh: mat1 mat2 mat3
[Xin] lisp chuyển màu các thuộc tính dynamic block

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

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


<<

Filename: 291416_mat1_mat2_mat3.lsp
Tác giả: Tot77
Bài viết gốc: 291428
Tên lệnh: mat4
[Xin] lisp chuyển màu các thuộc tính dynamic block

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

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.


<<

Filename: 291428_mat4.lsp
Tác giả: Tot77
Bài viết gốc: 291431
Tên lệnh: test
[Yêu cầu] viết Lisp dời text về vị trí điểm point gần nhất

Tôi còn giữ cái lisp đó, nhưng file dwg để test thì không còn.

 

(defun c:test(/ os ss ss1 ss2 cd) 
  (defun layxy(a) (list (car a) (cadr a)))
  (defun leftL(L n / l1 i) (setq l1 nil i -1) (while (and (< (setq i (1+ i)) n) (nth i L)) (setq l1 (append l1 (list (nth i L))))))
  (defun doi (id tri v)   (entmod (subst (cons id tri) (assoc id (entget v)) (entget v))))
  
  ;;;chuong trinh...
>>

Tôi còn giữ cái lisp đó, nhưng file dwg để test thì không còn.

 

(defun c:test(/ os ss ss1 ss2 cd) 
  (defun layxy(a) (list (car a) (cadr a)))
  (defun leftL(L n / l1 i) (setq l1 nil i -1) (while (and (< (setq i (1+ i)) n) (nth i L)) (setq l1 (append l1 (list (nth i L))))))
  (defun doi (id tri v)   (entmod (subst (cons id tri) (assoc id (entget v)) (entget v))))
  
  ;;;chuong trinh chinh
  (setq ss (ssget '((0 . "TEXT,POINT")))
ss1 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "TEXT") (cons (layxy (acet-dxf 11 (entget x))) x) nil)) (acet-ss-to-list ss)))
ss1 (vl-sort (vl-sort ss1 '(lambda(x y) (< (cadar x) (cadar y)))) '(lambda(x y) (< (caar x) (caar y))))
ss2 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "POINT") (layxy (acet-dxf 10 (entget x))) nil)) (acet-ss-to-list ss)))
ss2 (vl-sort (vl-sort ss2 '(lambda(x y) (< (cadr x) (cadr y)))) '(lambda(x y) (< (car x) (car y))))
  )
  (foreach v ss1    
    (doi 11 (setq cd (car (vl-sort (leftL ss2 10) '(lambda(x y) (< (distance x (car v)) (distance y (car v))))))) (cdr v))
    (setq ss2 (vl-remove cd  ss2))
  )
)


<<

Filename: 291431_test.lsp
Tác giả: duy782006
Bài viết gốc: 16397
Tên lệnh: molenhdi khoalenhdi
TẠO MỘT MENU THƯ VIỆN


Filename: 16397_molenhdi_khoalenhdi.lsp
Tác giả: proconeng86
Bài viết gốc: 291403
Tên lệnh: mat1 mat2 mat3
[Xin] lisp chuyển màu các thuộc tính dynamic block

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

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


<<

Filename: 291403_mat1_mat2_mat3.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 291714
Tên lệnh: lbl
xin gúp đỡ lisp ve đường tâm

Forum dạo này bị sao ấy. Thử down thừ đây xem:

;; free lisp from cadviet.com
; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
(defun c:LBL ( / foo AT:GetSel _pnts _pline _lwpline _dist e1 e2 xx...
>>

Forum dạo này bị sao ấy. Thử down thừ đây xem:

;; free lisp from cadviet.com
; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
(defun c:LBL ( / foo AT:GetSel _pnts _pline _lwpline _dist e1 e2 xx yy)
 (vl-load-com)
 (defun foo (e)
  (and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
   (not (vlax-curve-isClosed (car e)))))
 (defun AT:GetSel (meth msg fnc / ent)
  (while
   (progn
    (setvar 'ERRNO 0)
    (setq ent (meth (cond (msg) ("\nSelect object: "))))
    (cond
   ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
     ((eq (type (car ent)) 'ENAME)
      (if (and fnc (not (fnc ent)))
       (princ "\nInvalid object!"))))))
  ent)
 (defun _pnts (e / p l)
  (if e
   (cond
    ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
     (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e)))
    ((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
     (repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
      (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l)))))))
 (defun _pline (lst)
  (if
   (and
    (> (length lst) 1)
    (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . 8)))
    (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32)))))
   (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))))
 (defun _lwpline (lst)
  (if (> (length lst) 1)
   (entmakex (append
     (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst)) (cons 70 (* (getvar 'plinegen) 128)))
     (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)))))
 (defun _dist (a b)
  (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
 (if
  (and
   (setq e1 (_pnts (setq xx (car (AT:GetSel entsel "\nSelect first open curve: " foo)))))
   (setq e2 (_pnts (setq yy (car (AT:GetSel entsel "\nSelect next open curve: " foo)))))
   (not (initget 0 "Lwpolyline Polyline"))
   (setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: <" (cond (*LBL:Opt*) ((setq *LBL:Opt* "Lwpolyline"))) ">: "))) (*LBL:Opt*))))
  ((if (eq *LBL:Opt* "Lwpolyline") _lwpline _pline)
   (vl-remove nil
    (mapcar (function (lambda(a b)
       (if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
        (mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b))))
      e1
     (if (< (_dist (car e1) (car e2)) (_dist (car e1) (last e2))) e2 (reverse e2))))))
 (if (and xx yy) (progn (entdel xx) (entdel yy)))
 (princ))
 


<<

Filename: 291714_lbl.lsp
Tác giả: Tot77
Bài viết gốc: 291749
Tên lệnh: lap ofs
I"m training to be an engineer lisinopril-hydrochlorothiazide oral tablet 20-12.5 mg LSD is one of the most potent known psychoactive drugs and was used in the 1950s and 1960s as an aid to psychothera
cataflam dose per day Kelsey Hibberd, from Southend, remembers her years at secondary school as being miserable

Filename: 291749_lap_ofs.lsp
Tác giả: Tot77
Bài viết gốc: 291762
Tên lệnh: lap ofs
I"ll send you a text can i buy research papers The New York Times is selling The Boston Globe to theprincipal owner of the Boston Red Sox baseball team for $70million in cash, a small

Filename: 291762_lap_ofs.lsp
Tác giả: Tue_NV
Bài viết gốc: 86403
Tên lệnh: tthe
Nhờ các bác sửa giùm em file cao độ này với

Anh Duy xem lại chứ không được rồi :
Giải pháp đưa ra phải chọn hết -> Không biết anh đã xem bản vẽ của bạn dieptit upload lên chưa?
Nếu theo cách của anh mà Nhớ chọn cho đúng mấy anh bị dư nhé. thì có đến .... Tết cônggô cũng chưa xong :undecided:

Giải pháp đưa ra như...
>>

Anh Duy xem lại chứ không được rồi :
Giải pháp đưa ra phải chọn hết -> Không biết anh đã xem bản vẽ của bạn dieptit upload lên chưa?
Nếu theo cách của anh mà Nhớ chọn cho đúng mấy anh bị dư nhé. thì có đến .... Tết cônggô cũng chưa xong :undecided:

Giải pháp đưa ra như sau :
1./ dùng lệnh Find : thay hết dấu , thành dấu chấm . -> lệnh CAD
2.Chọn toàn bộ Text
- Những anh nào có dấu - đằng trước thì bớt kí tự thứ 2 tính từ vị trí đàu tiên
- Những anh nào không có dấu - đằng trước thì bớt kí tự đàu tiên
(Kí tự bớt đó là kí tự dấu .)
(Cái này đưa ra giải quyết bằng Lisp)
Viết luôn cho dieptit code này luôn :
đánh lệnh tthe -> Chờ 1 chút -> kết quả

<<

Filename: 86403_tthe.lsp
Tác giả: Tot77
Bài viết gốc: 291959
Tên lệnh: tmp
[Yêu cầu] Lisp tính diện tích chữ cái.

Bạn thử cái này, máy phải cài express.

(vl-load-com)
(defun c:tmp (/ v0 el en l tong oe)
  (setq oe (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
nd (acet-dxf 1 (entget v0)))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
l nil)
  (sssetfirst nil...
>>

Bạn thử cái này, máy phải cài express.

(vl-load-com)
(defun c:tmp (/ v0 el en l tong oe)
  (setq oe (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (command "undo" "be")
  
  (setq v0 (car (entsel "\nChon text de tinh dien tich:"))
nd (acet-dxf 1 (entget v0)))
  (command "copy" v0 "" "" "")  
  (setq el (entlast)
l nil)
  (sssetfirst nil (ssadd v0 (ssadd)))
  (C:Txtexp)
  
  (setq tong 0)
  (while (setq en (entnext el)) (setq l (cons en l) el en))
  (foreach v (vl-remove-if-not '(lambda(x) (= "POLYLINE" (acet-dxf 0 (entget x)))) l)
    (setq tong (+ tong (vla-get-Area (vlax-ename->vla-object v))))
    (entdel v))
  
  (command "undo" "e")  
  (setvar 'cmdecho oe)
  (princ (strcat "\nDien tich cua chu \"" nd "\" la: " (rtos tong))) (textscr) (princ)
)


<<

Filename: 291959_tmp.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 292059
Tên lệnh: ha
[Đã xong] Lisp xác định nhanh màu sắc đối tượng để đặt nét in.

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để phục vụ forum. Ai có nhu cầu thì down về dùng.

Ưu điểm của lisp này là xác định rất nhanh chỉ số màu của các đối tượng con: di mouse tới đâu thì hiện lên tới đó.

Nhược điểm: có một số hạn chế chưa khắc phục được + đang chờ mọi người test và...

>>

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để phục vụ forum. Ai có nhu cầu thì down về dùng.

Ưu điểm của lisp này là xác định rất nhanh chỉ số màu của các đối tượng con: di mouse tới đâu thì hiện lên tới đó.

Nhược điểm: có một số hạn chế chưa khắc phục được + đang chờ mọi người test và góp ý.

;Doan Van Ha - CADViet.com - Ngay 08/05/2014.
;Chuc nang: Xac dinh nhanh mau sac cua doi tuong bang cach di chuyen chuot tren man hinh.
(defun C:HA( / rad gr code pt ent1 ent2 col)
 (vl-load-com)
 (setq rad (/ (* (getvar "Viewsize") (getvar "Pickbox")) (cadr (getvar "Screensize")))
       ent2 (entmakex (list (cons 0 "Point") (cons 10 '(0 0)))))
 (princ "\nDi chuy\U+1EC3n Mouse \U+0111\U+1EBFn t\U+1EEBng \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EC3 xem m\U+00E0u...")
 (while (and (setq gr (grread 't 15 1) code (car gr) pt (cadr gr)) (/= code 3) (/= code 25) (not (equal gr '(2 13))))
  (redraw) (entdel ent2)
  (Draw_Grvecs pt rad 3)
  (if (setq ent1 (car (nentselp pt)))
   (setq ent2 (MakeMtext (strcat "Color  " (itoa (setq col (Get_Color ent1)))) (polar pt (/ pi -4) (* 3 rad)) col))
   (setq ent2 (MakeMtext "Object ?" (polar pt (/ pi -4) (* 3 rad)) 1))))
 (redraw) (entdel ent2) (princ))
(defun *error* (msg)
 (redraw)
 (if ent2 (entdel ent2))
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
 (princ))
(defun Get_Color (ent / col)
 (setq col (vla-get-ColorIndex (vla-get-TrueColor (vlax-ename->vla-object ent))))
 (cond
  ((= col 256) (setq col (Get_Color_Layer (cdr (assoc 8 (entget ent))))))
  ((= col 0)
   (if (setq ss (Select_SS pt rad))
    (if (= (cdr (assoc 0 (setq elst (entget (ssname ss 0))))) "DIMENSION")
     (if (not (setq col (cdr (assoc 62 elst))))
 (setq col (Get_Color_Layer (cdr (assoc 8 elst)))))))))
 col)
(defun Select_SS(pt rad / p0 p1 p2 p3)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)))
 (ssget "c" p1 p3))
(defun Get_Color_Layer(name)
 (cdr (assoc 62 (entget (Tblobjname "Layer" name)))))
(defun Draw_Grvecs(pt rad col / p0 p1 p2 p3 p4)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)) p4 (polar p3 (/ pi -2) (* 2 rad)))
 (grvecs (list col p1 p2 p2 p3 p3 p4 p4 p1)))
(defun MakeMtext(txt pt col) 
 (entmakex (list (cons 0 "Mtext") (cons 100 "AcDbEntity") (cons 100 "AcDbMText")
   (cons 8 "0") (cons 1 (_Text txt)) (cons 10 pt) (cons 40 (/ (getvar 'Viewsize) 40)) (cons 62 col) (cons 71 1) (cons 90 3) (cons 63 256) (cons 45 1.5))))
(defun _Text (txt)
 (strcat "{\\fTimes New Roman|b1|i0|c0|p34;" txt "}")) ;(strcat "{\\fArial|b1|i0|c0|p34;" txt "}"))
 


<<

Filename: 292059_ha.lsp
Tác giả: Tot77
Bài viết gốc: 291965
Tên lệnh: mat0 mat1 mat2 mat4 mat3
lisp chuyển màu các thuộc tính dynamic block

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

>>

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


<<

Filename: 291965_mat0_mat1_mat2_mat4_mat3.lsp
Tác giả: npham
Bài viết gốc: 122246
Tên lệnh: llt
Chon đối tượng theo dang đường linetype !

Không biết thế này đúng ý của bác chưa? bạn dùng select p để xem lại chọn lựa nhé. Cái này chỉ chọn với *LINE, nếu muốn chọn đối tượng khác thì bạn thêm vào nhé.


Filename: 122246_llt.lsp
Tác giả: Tot77
Bài viết gốc: 292167
Tên lệnh: dan
[Yêu cầu] lisp dãn text trùng nhau trên mặt cắt ngang

Bạn thử dùng cái này. Nếu chạy 1 lần mà vẫn còn có text bị chạm nhau là do trước đó nó cách xa nhau nên nó không nằm trong tập chọn, nhưng sau khi di chuyển tập chọn nó lại đè lên text bên ngoài. Nếu vậy bạn chạy thêm 1 lần nữa là được.

Đây là đề tài không đơn giản, tôi phải nhờ vào hàm express, do đó bạn phải cài express mới chạy được.

 
(defun c:dan...
>>

Bạn thử dùng cái này. Nếu chạy 1 lần mà vẫn còn có text bị chạm nhau là do trước đó nó cách xa nhau nên nó không nằm trong tập chọn, nhưng sau khi di chuyển tập chọn nó lại đè lên text bên ngoài. Nếu vậy bạn chạy thêm 1 lần nữa là được.

Đây là đề tài không đơn giản, tôi phải nhờ vào hàm express, do đó bạn phải cài express mới chạy được.

 
(defun c:dan (/ )
  (defun tach(l / n l1 l2)
    (setq n 0 l2 nil)
    (repeat (1- (length l))
      (if (not l1) (setq l1 (list (nth n l))))
      (if (< (width (acet-geom-ss-extents (acet-list-to-ss
(mapcar 'cadr (append l1 (list (nth (setq n (1+ n)) l) )))) nil)) (* kcach (1+ (length l1))))
(setq l1 (append l1 (list (nth n l))))
(progn (if (> (length l1) 1) (setq l2 (append l2 (list l1)))) (setq l1 nil))
)
    )
    (if l1 (setq l2 (append l2 (list l1))))
    l2
  )
  (defun width(l) (distance (car l) (list (caadr l) (cadar l) )))
  (defun doi(b kc)
    (vla-put-TextAlignmentPoint (vlax-ename->vla-object b)
(vlax-3d-point (polar ll 0 kc))))
 
  (defun getIP(v)
    (vlax-safearray->list (vlax-variant-value
(vla-get-TextAlignmentPoint (vlax-ename->vla-object v))))
  )
  ;;====================================;;
  
  (vl-load-com)
  (setvar 'dimzin 8)
  
  (setq kcach1 (getreal (strcat "\nNhap khoang cach dan <"
(if kcach (rtos kcach 2 3) (rtos (setq kcach 1) 2 3)) ">:" )))
  (if kcach1 (setq kcach kcach1))
 
  (prompt "\nChon nhom text can sap xep")
  (setq lt (vl-remove-if-not '(lambda(x) (equal (* 0.5 pi)
    (vla-get-rotation (vlax-ename->vla-object x )) 0.001))
(acet-ss-to-list (ssget '((0 . "text"))))))
  (acet-tjust (setq ss (acet-list-to-ss lt)) (acet-tjust-keyword (entget (ssname ss 0))))
  
  (setq lt (mapcar '(lambda(x) (list (getIP x) x)) lt)
lt (vl-sort lt '(lambda (x y) (>= (cadar x) (cadar y))))
  )  
  
  (while lt
    (setq lt1 (vl-sort (vl-remove-if-not '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
  '(lambda (x y) (< (caar x) (caar y))))
 lt  (vl-remove-if '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
 lt1 (tach lt1)
    )
    
    (foreach lv lt1
      (setq slv (mapcar 'cadr lv)
   n0 (fix (* 0.5 (length slv)))
   ll (getIP (nth n0 slv))
            k 0)
      (while (>= (setq n (- n0 (setq k (1+ k)))) 0)
(doi (nth n slv) (* k (- kcach))))
      (setq k 0)
      (while (< (setq n (+ n0 (setq k (1+ k)))) (length slv))
(doi (nth n slv) (* k kcach))) 
    )
  )
  (princ)
)
 


<<

Filename: 292167_dan.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 38715
Tên lệnh: t1 t2
Viết Lisp theo yêu cầu

Lệnh T1 và T2 của bạn đây:

Filename: 38715_t1_t2.lsp
Tác giả: thanhduan2407
Bài viết gốc: 292484
Tên lệnh: itt
Lisp Zoom và in trong Layout theo tọa độ Text

Chào các bác trên diễn đàn Cadviet.com

Lọ mọ mấy ngày nay mà em chưa tìm được cách để chương trình nó chạy.

Trong bản vẽ  Model có các Text nằm trong từng 1 vùng kín.

Trong Layout  đã tạo Mview

Mục đích của em là chui vào trong cửa sổ Mview đó, quét chọn các Text.

Từ mỗi Text quét chọn được tìm ra được tọa độ của nó

Từ Tọa độ đó tiến hành Boundary...

>>

Chào các bác trên diễn đàn Cadviet.com

Lọ mọ mấy ngày nay mà em chưa tìm được cách để chương trình nó chạy.

Trong bản vẽ  Model có các Text nằm trong từng 1 vùng kín.

Trong Layout  đã tạo Mview

Mục đích của em là chui vào trong cửa sổ Mview đó, quét chọn các Text.

Từ mỗi Text quét chọn được tìm ra được tọa độ của nó

Từ Tọa độ đó tiến hành Boundary để tạo 1 Pline khép kín

Tìm được  Max và Min của Pline này => Tâm của hình chữ nhật bao quanh Pline đó

Từ đó cũng dễ dàng tìm ra được 4 đỉnh hình chữ nhật to hơn (em cho lớn hơn 1.5 lần) hình chữ nhật bao quanh Pline đó.

Tiến hành Zoom Window theo hình chữ nhật đó

Thoát khỏi cửa sổ Mview (Lệnh “PSpace”) và tiến hành in  

Sau khi in xong thì lại tiếp tục chui vào Mview (Lệnh MSpace) duyệt Text tiếp theo để Zoom và in.

Nhưng sao nó chỉ cho in thằng Text cuối cùng thôi các bác ạ

Mong các bác chỉ cho cách.

Chân thành cảm ơn

 

Link file mẫu: https://www.mediafire.com/?rm015me8nxvpb2f

 

 

(defun c:ITT ( / olmode  i ss item  temp  Tdo minp maxp  pt a2 b2 P1 P2 P3 P4     )
(vl-load-com)
(setvar "CMDECHO" 0)
(setq olmode (getvar "OSMODE"))
(setq i 0)
(setvar "tilemode" 0)
(setvar "OSMODE" 0)
(command "MSPACE")
(setq ss (ssget (list (cons 0 "TEXT"))))
(foreach item (acet-ss-to-list ss)
	(setq temp  (entget item))
	(setq   Tdo (TD:Text-Base item ))
	(vl-cmdf  "-boundary" Tdo "")
	(setq e (entlast))
	(vla-getboundingbox (vlax-ename->vla-object e) 'minp 'maxp)
	(setq minp (safearray-value minp))
	(setq maxp (safearray-value maxp))
	(setq pt (list (/ (+ (car minp) (car maxp)) 2) (/ (+ (cadr minp) (cadr maxp)) 2)))
	(setq a2 (* (/ (- (car maxp) (car minp)) 2) 1.5))
	(setq b2 (* (/ (- (cadr maxp) (cadr minp)) 2) 1.5))
	(setq	P1 (list (- (car pt) a2) (- (cadr pt) b2))
		P2 (list (- (car pt) a2) (+ (cadr pt) b2))
		P3 (list (+ (car pt) a2) (+ (cadr pt) b2))
		P4 (list (+ (car pt) a2) (- (cadr pt) b2))
	)
  	(entdel e)
	(command "._zoom" "_w" "_non" P2 "_non" P4)
	(command "PSPACE")
	(command "_plot" "" "" "" "" "" "" "")
  	(command "MSPACE")
)
(command "PSPACE")
(setvar "OSMODE" olmode)
(setvar "tilemode" 0)
(princ)
)


(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
	  (and (= Ma71 0) (= Ma72 3) )
	  (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)

 

(vl-load-com)
(setvar "CMDECHO" 0)
(setq olmode (getvar "OSMODE"))
(setq i 0)
(setvar "tilemode" 0)
(setvar "OSMODE" 0)
(command "MSPACE")
(setq ss (ssget (list (cons 0 "TEXT"))))
(foreach item (acet-ss-to-list ss)
(setq temp  (entget item))
(setq   Tdo (TD:Text-Base item ))
(vl-cmdf  "-boundary" Tdo "")
(setq e (entlast))
(vla-getboundingbox (vlax-ename->vla-object e) 'minp 'maxp)
(setq minp (safearray-value minp))
(setq maxp (safearray-value maxp))
(setq pt (list (/ (+ (car minp) (car maxp)) 2) (/ (+ (cadr minp) (cadr maxp)) 2)))
(setq a2 (* (/ (- (car maxp) (car minp)) 2) 1.5))
(setq b2 (* (/ (- (cadr maxp) (cadr minp)) 2) 1.5))
(setq P1 (list (- (car pt) a2) (- (cadr pt) b2))
P2 (list (- (car pt) a2) (+ (cadr pt) b2))
P3 (list (+ (car pt) a2) (+ (cadr pt) b2))
P4 (list (+ (car pt) a2) (- (cadr pt) b2))
)
  (entdel e)
(command "._zoom" "_w" "_non" P2 "_non" P4)
(command "PSPACE")
(command "_plot" "" "" "" "" "" "" "")
  (command "MSPACE")
)
(command "PSPACE")
(setvar "OSMODE" olmode)
(setvar "tilemode" 0)
(princ)
)
 
 
(defun TD:Text-Base (ent)
  (setq Ma10  (cdr (assoc 10 (entget ent))))
  (setq Ma11  (cdr (assoc 11 (entget ent))))
  (setq X11 (car Ma11))
  (setq Ma71  (cdr (assoc 71 (entget ent))))
  (setq Ma72  (cdr (assoc 72 (entget ent))))
  (if (or (and (= Ma71 0) (= Ma72 0) (= X11 0))
 (and (= Ma71 0) (= Ma72 3) )
 (and (= Ma71 0) (= Ma72 5) )
      )
    Ma10
    Ma11
   )
)

<<

Filename: 292484_itt.lsp
Tác giả: Tot77
Bài viết gốc: 292171
Tên lệnh: mat0 mat1 mat2 mat4 mat3
[Xin] lisp chuyển màu các thuộc tính dynamic block

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

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


<<

Filename: 292171_mat0_mat1_mat2_mat4_mat3.lsp

Trang 157/304

157