Bổ sung thêm mã màu True color cho Lisp thay đổi màu

[Chia.se.Hoc.hoi 0]

Nhờ bổ sung thêm cho Lisp đổi màu
Mình tìm được trên diễn đàn có Lisp đổi màu , nhưng khi chọn màu để đổi thì chỉ cho phép chọn màu trong bảng 256 màu(Index Color), mình muốn bổ sung thêm màu True color để có thêm tùy chọn mã màu, nhờ các bạn bổ sung thêm tính năng này vào Lisp giúp .cảm ơn tất cả mọi người!

 

 

(defun C:DMTC ( / doc col)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(mip:layer-status-save)
(if (setq col (acad_colordlg 7 t))
(ChangeAllObjectsColor doc col);_ col ・color number
)
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
)
(princ "\nType ColorX in command line")
(defun mip:layer-status-restore ()
(foreach item *MIP_LAYER_LST*
(if (not (vlax-erased-p (car item)))
(vl-catch-all-apply
'(lambda ()
(vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
(vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *MIP_LAYER_LST* nil)
) ;_ end of defun

(defun mip:layer-status-save ()
(setq *MIP_LAYER_LST* nil)
(vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq *MIP_LAYER_LST* (cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*MIP_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
) ;_ end of vlax-for
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color )
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(vlax-for Obj Blk
(if (vlax-property-available-p Obj 'Color)
(vla-put-Color Obj Color)
)
)
)
)
)

 

 

[tannguyen291 136]

bổ xung thêm màu TrueColor gần bằng viết lại code. thôi bạn dùng cái đó đi :))

[Chia.se.Hoc.hoi 0]

Thank bạn tannguyen291: vì mình cần cái mã màu bên đó nên nhờ mọi người giúp , nếu bạn có thể giúp xin cảm ơn bạn nhiều!

 

[Doan Van Ha 3.196]

24 phút trước, tannguyen291 đã nói:

bổ xung thêm màu TrueColor gần bằng viết lại code. thôi bạn dùng cái đó đi :))

Ủa, nãy thấy em đưa hàm kia lên là đúng rồi mà sao lại xóa?

[tannguyen291 136]

cũng được 

(defun C:DMTC ( / doc col r g b )
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (mip:layer-status-save)
  (cond 
    ((not (setq col (acad_truecolordlg '(62 . 7)))))
    ( (assoc 420 col)
      (setq 
        col (cdr (assoc 420 col))
        r (fix (/ col 65536))
        g (fix (/ (- col (* 65536 r)) 256))
        b (- col (* 65536 r) (* 256 g))
      )
      (ChangeAllObjectsColor doc (list r g b))
    )
    (t (ChangeAllObjectsColor doc (cdar col)))
  )
  (mip:layer-status-restore)
  (vla-endundomark doc)
  (princ)
)
(princ "\nType ColorX in command line")
(defun mip:layer-status-restore ()
  (foreach item *MIP_LAYER_LST*
    (if (not (vlax-erased-p (car item)))
      (vl-catch-all-apply
        '(lambda ()
          (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
          (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
        ) ;_ end of lambda
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of if
  ) ;_ end of foreach
  (setq *MIP_LAYER_LST* nil)
) ;_ end of defun

(defun mip:layer-status-save ()
  (setq *MIP_LAYER_LST* nil)
  (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (setq *MIP_LAYER_LST* (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                ) ;_ end of cons
                            *MIP_LAYER_LST*
                          ) ;_ end of cons
    )  ;_ end of setq
    (vla-put-lock item :vlax-false)
    (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
    )
  ) ;_ end of vlax-for
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color / tc )
  (vlax-for Blk (vla-get-Blocks Doc)
    (if (= (vla-get-IsXref Blk) :vlax-false)
      (vlax-for Obj Blk
        (if (vlax-property-available-p Obj 'Color)
          (if (listp Color)
            (progn
              (setq tc (vla-get-truecolor Obj))
              (apply 'vla-setrgb (cons tc Color))
              (vla-put-truecolor Obj tc)
            )
            (vla-put-Color Obj Color)
          )
        )
      )
    )
  )
)

 

[tannguyen291 136]

2 phút trước, Doan Van Ha đã nói:

 Ủa, nãy thấy em đưa hàm kia lên là đúng rồi mà sao lại xóa?

sửa bên trên nó không chạy bên dưới bác. :))

[tanbqtb03 9]

Cho mình hỏi khi chọn về hệ màu True Color vậy có cách chỉnh plotstyle theo hệ màu True color ko ạh, nhờ bác hướng dẫn giúp ạh

[Chia.se.Hoc.hoi 0]

cảm ơn bạn tannguyen291 rất nhiều, bạn đã giúp đúng ý mình rồi !