Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
96 replies to this topic

#61 proconeng86

proconeng86

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 05 May 2014 - 11:48 PM

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


  • 0

#62 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 06 May 2014 - 02:56 AM

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


  • 0

#63 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 07 May 2014 - 08:15 PM

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


  • 1

#64 proconeng86

proconeng86

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 08 May 2014 - 03:44 PM

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é


  • 0

#65 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 08 May 2014 - 06:25 PM

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


  • 0

#66 anh.tuan

anh.tuan

    biết lệnh extend

  • Members
  • PipPipPip
  • 196 Bài viết
Điểm đánh giá: 35 (tàm tạm)

Đã gửi 08 May 2014 - 07:51 PM

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


  • 0

#67 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 08 May 2014 - 08:42 PM

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.c...namic_block.lsp


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#68 anh.tuan

anh.tuan

    biết lệnh extend

  • Members
  • PipPipPip
  • 196 Bài viết
Điểm đánh giá: 35 (tàm tạm)

Đã gửi 08 May 2014 - 10:05 PM

sao down khong duoc ban


  • 0

#69 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 08 May 2014 - 10:07 PM

Hỏi BQT í.


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#70 anh.tuan

anh.tuan

    biết lệnh extend

  • Members
  • PipPipPip
  • 196 Bài viết
Điểm đánh giá: 35 (tàm tạm)

Đã gửi 08 May 2014 - 10:12 PM

mình vào đường dẫn trên nhưng down không được. Có ai sửa link được không, giúp mình với.


  • 0

#71 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 09 May 2014 - 06:39 AM

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


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#72 anh.tuan

anh.tuan

    biết lệnh extend

  • Members
  • PipPipPip
  • 196 Bài viết
Điểm đánh giá: 35 (tàm tạm)

Đã gửi 09 May 2014 - 07:58 AM

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.


  • 0

#73 proconeng86

proconeng86

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 10 May 2014 - 08:38 AM

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


  • 0

#74 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 10 May 2014 - 09:58 AM

Thử 1 lần nữa xem sao.

http://www.mediafire...10/attcol_2.lsp


  • 1

#75 proconeng86

proconeng86

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 10 May 2014 - 04:51 PM

Thử 1 lần nữa xem sao.

http://www.mediafire...10/attcol_2.lsp

 

OK, lisp này là quá ngon rồi. cám ơn bạn nhiều nhé. Khi nào có dịp ra hà nội chúng ta đi giao lưu nha


  • 0

#76 proconeng86

proconeng86

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 10 May 2014 - 11:47 PM

Trong CAD có phần chèn field rất là hay, mình chỉ cần đổi cái FIELD gốc là các cái khác tự động đổi theo. Mình có tìm được 1 lisp có thể chèn field trong block nhưng chỉ trong block thường thôi, còn dynamic block thì bó tay

Cái chèn field này mình cũng rất hay dùng trong các dynamic block ghi chú cốt thép như trong field đính kèm nên mình mong các bạn chỉnh sửa lại lisp giúp mình để có thể sử dụng được với dynamic block thì tốt quá.

nội dung lisp như sau:

 - đưa ra lựa chọn dynamic block mẫu

 - hiện lên bảng lựa chọn tên các attribute trong dynamic block mẫu để chọn gán giá trị (như trong file đính kèm)

 - đưa ra lựa chọn những dynamic block sẽ gán theo attribute đã lựa chọn

 - hiện bảng lựa chọn tên attribute để gán giá trị (hoặc nếu cùng 1 loại dynamic block thì gán giá trị luôn, ko phải hiện)

 - gán giá trị của attribute mẫu cho attribute đã lựa chọn

 - kết thúc lệnh

Lưu ý: lisp cũng dùng được với text thì tốt quá. Các bạn có ý nào hay hơn mình cho lisp thì cho ý kiến nhé

Mong các bạn giúp đỡ nhất là bạn @Tot77 nhé  :)

Mình cám ơn nhiều

http://www.cadviet.c..._chen_field.lsp

http://www.cadviet.c...mic_block_5.dwg


  • -1

#77 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 11 May 2014 - 02:40 PM

File lisp không down được.


  • 0

#78 proconeng86

proconeng86

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 11 May 2014 - 05:06 PM

File lisp không down được.

 

Mình gửi lại link mediafire

http://www.mediafire.../CHEN_FIELD.lsp

http://www.mediafire...namic_block.dwg

Bạn giúp mình nhé


  • -1

#79 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 12 May 2014 - 05:43 PM

Gửi bạn lisp link field giữa dynamic block.

 
;;;===========chen field 1 dynamic block vao dynamic block khac ======================
 
(defun C:FFL (/ blk_name ent field i obj obj1 ss ss1)
;|  By : Gia Bach, gia_bach@www.CadViet.com   |;
  (princ "\nChon Block thuoc tinh nguon :")
  (if (setq ss1 (ssget "+.:S:N" (list (cons 0 "INSERT") (cons 66 1))))
      (setq obj1 (vlax-Ename->Vla-Object (ssname ss1 0))
   blk_name (vla-get-effectivename obj1)
   field (mapcar '(lambda(x) (list (vla-get-TagString x) x)) (vlax-invoke Obj1 'GetAttributes))
      )
  )
  (princ "\nChon Block thuoc tinh can Link :")
  (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
    (progn
      (setq i -1)
      (while (setq ent (ssname ss (setq i (1+ i))))
(setq obj (vlax-Ename->Vla-Object ent))
(if (= (vla-get-effectivename obj) blk_name)
 (foreach v (vlax-invoke Obj 'GetAttributes)
   (if (setq tm (assoc (vla-get-TagString v) field))
     (vla-put-TextString v (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid (cadr tm)))
      ">%).TextString>%")))))
     ))
  )
  (vl-cmdf "regen")
  (princ)
)


  • 1

#80 proconeng86

proconeng86

    biết lệnh break

  • Members
  • PipPipPipPip
  • 221 Bài viết
Điểm đánh giá: -9 (bình thường)

Đã gửi 12 May 2014 - 05:58 PM

Gửi bạn lisp link field giữa dynamic block.

 
;;;===========chen field 1 dynamic block vao dynamic block khac ======================
 
(defun C:FFL (/ blk_name ent field i obj obj1 ss ss1)
;|  By : Gia Bach, gia_bach@www.CadViet.com   |;
  (princ "\nChon Block thuoc tinh nguon :")
  (if (setq ss1 (ssget "+.:S:N" (list (cons 0 "INSERT") (cons 66 1))))
      (setq obj1 (vlax-Ename->Vla-Object (ssname ss1 0))
   blk_name (vla-get-effectivename obj1)
   field (mapcar '(lambda(x) (list (vla-get-TagString x) x)) (vlax-invoke Obj1 'GetAttributes))
      )
  )
  (princ "\nChon Block thuoc tinh can Link :")
  (if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
    (progn
      (setq i -1)
      (while (setq ent (ssname ss (setq i (1+ i))))
(setq obj (vlax-Ename->Vla-Object ent))
(if (= (vla-get-effectivename obj1) blk_name)
 (foreach v (vlax-invoke Obj 'GetAttributes)
   (if (setq tm (assoc (vla-get-TagString v) field))
     (vla-put-TextString v (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-Objectid (cadr tm)))
      ">%).TextString>%")))))
     ))
  )
  (vl-cmdf "regen")
  (princ)
)

 

Bạn xem lại hộ mình nhé, nó bị lỗi gì đó không dùng được

9928_5122014_55631_pm_loi_lisp_chen_fiel


  • 0