Reactor và các ứng dụng của nó ?

[dovananh.xd 25]

Vào lúc 17/7/2011 tại 22:19, ketxu đã nói:

Tiếp tục 1 ví dụ nữa, áp dụng UnknownCommand cho phép đặt lệnh tắt đổi màu đối tượng. Thay vì tạo hàng loạt hàm c:1,2,3... để đổi sang màu tương ứng, ta sẽ chỉ dùng duy nhất 1 Reactor sau :

 

• cadvietlisp.lsp
  
• [✎]
   

;@ketxu
(vl-load-com)
(if (null dmtd)
(setq dmtd (vlr-command-reactor nil '((:vlr-unknownCommand . doimau)))))
;;*********************************************************************
(defun doimau (calling-reactor endcommandInfo / Layer_Key)
(setq Layer_Key (strcase (nth 0 endcommandInfo)))
(if (and (= (strlen (rtos (atoi Layer_Key) 2 0))(strlen Layer_key))(< (atoi Layer_key) 257))(doimaufunc)(princ "\nChua co lenh nao nhu the nay"))
)
;;*********************************************************************
(defun doimaufunc (/ dis1 ss)
(setq col (atoi Layer_Key)  ss (ssget)) 
(if ss (foreach a (mapcar 'vlax-ename->vla-object (ST:Ss->lstEnt ss ) ) (ST:Ent-PutColor a col))(princ)) 
)
(defun ST:Ent-PutColor  (obj color_use) ;vla-object
(if (wcmatch (getvar "acadver") "16*,17*,18*")
   (setq vla_truecolor
   (vla-getinterfaceobject
     (vlax-get-acad-object)
     (cond
       ((wcmatch (getvar "acadver") "16*")
 "AutoCAD.AcCmColor.16")
       ((wcmatch (getvar "acadver") "17*")
 "AutoCAD.AcCmColor.17")
       ((wcmatch (getvar "acadver") "18*")
 "AutoCAD.AcCmColor.18")))))
(if (wcmatch (getvar "acadver") "16*,17*,18*")
  (progn
     (vla-put-colorindex
vla_truecolor
color_use)
     (if obj
(vla-put-truecolor obj vla_truecolor)))
   (if (wcmatch (getvar "acadver") "15*")
     (vla-put-color obj color_use)))
 (vlax-release-object vla_truecolor)
 (setq vla_truecolor nil))


(defun ST:Ss->lstEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
   (setq l (cons e l))
 )
)

 

 

Bây giờ, muốn đổi màu đối tượng sang màu nào, hãy nhấn số và chọn các đối tượng ^^

Reactor quả có thú vị ^^

bác Ketxu ơi. Cái lisp này sao không sử dụng được cho CAD2019 vậy ạ? Bác sửa lại giúp em với

Em cảm ơn!

[dovananh.xd 25]

@ketxuBác xem giúp em cái lisp này với ạ. Em không dùng được trong CAD 2019. Em cảm ơn.

[dovananh.xd 25]

Trang diễn đàn này dạo này không thấy ai online nữa à Admin ơi?

 

[dovananh.xd 25]

@Doan Van Ha @ketxu @Nguyen Hoanh ... Các pro xem giúp em với ạ!

Trân trọng!

 

[dovananh.xd 25]

@Nguyen Hoanh

[gia_bach 1553]

Vào lúc 12/12/2019 tại 09:02, dovananh.xd đã nói:

bác Ketxu ơi. Cái lisp này sao không sử dụng được cho CAD2019 vậy ạ? Bác sửa lại giúp em với

Em cảm ơn!

Thử lisp này nhé.

;@ketxu
(vl-load-com)
(if (null dmtd)
  (setq dmtd (vlr-command-reactor nil '((:vlr-unknownCommand . doimau)))))
;;*********************************************************************
(defun doimau (calling-reactor endcommandInfo / Layer_Key)
  (setq Layer_Key (strcase (nth 0 endcommandInfo)))
  (if (and (= (strlen (rtos (atoi Layer_Key) 2 0))(strlen Layer_key))(< (atoi Layer_key) 257))(doimaufunc)(princ "\nChua co lenh nao nhu the nay")))
;;*********************************************************************
(defun doimaufunc (/ dis1 ss)
  (setq col (atoi Layer_Key)  ss (ssget))
  (if ss (foreach a (mapcar 'vlax-ename->vla-object (ST:Ss->lstEnt ss ) ) (vla-put-color a col))(princ)) )

(defun ST:Ss->lstEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
   (setq l (cons e l)) ))

 

[dovananh.xd 25]

Vào lúc 15/1/2020 tại 09:28, gia_bach đã nói:

Thử lisp này nhé.

;@ketxu
(vl-load-com)
(if (null dmtd)
  (setq dmtd (vlr-command-reactor nil '((:vlr-unknownCommand . doimau)))))
;;*********************************************************************
(defun doimau (calling-reactor endcommandInfo / Layer_Key)
  (setq Layer_Key (strcase (nth 0 endcommandInfo)))
  (if (and (= (strlen (rtos (atoi Layer_Key) 2 0))(strlen Layer_key))(< (atoi Layer_key) 257))(doimaufunc)(princ "\nChua co lenh nao nhu the nay")))
;;*********************************************************************
(defun doimaufunc (/ dis1 ss)
  (setq col (atoi Layer_Key)  ss (ssget))
  (if ss (foreach a (mapcar 'vlax-ename->vla-object (ST:Ss->lstEnt ss ) ) (vla-put-color a col))(princ)) )

(defun ST:Ss->lstEnt (ss / n e l)
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
   (setq l (cons e l)) ))

 

Vâng. Em cảm ơn nhiều ạ!