Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
proconeng86

[YÊU CẦU] sửa lisp đổi màu đối tượng

Các bài được khuyến nghị

Trước mình có down trên cadviet 1 lisp đổi mầu đối tượng nhưng lisp không áp dụng được cho đường kích thước nên giờ muốn nhờ các bạn chỉnh lại để có thể áp dụng được với dim (chỉ đổi mầu text của dim lựa chọn thôi)

   Do down lâu rồi nên mình tìm mãi không được topic cũ đâu, đành phải tạo topic mới, mong mọi người thông cảm

Mình cám ơn nhiều

 

 http://www.mediafire.com/download/46souwzcw96038n/doi_mau_doi_tuong.lsp

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

- nhoc thì ko rành về dim, viết lsp đơn giản nhưng cũng hơi thủ công bạn xem thừ ^^

p/s: up hộ bạn ^^

(defun c:dmd(/ mau kdim)
(vl-load-com)
(setvar 'cmdecho 0)
(setq mau (getint "\nNh\U+1EADp m\U+00E3 m\U+00E0u mu\U+1ED1n \U+0111\U+1ED5i:"))
(setq kdim (entget (car (nentsel "\nCh\U+1ECDn \U+0111\U+00FAng text dim:"))))
(entmod (subst (cons 62 mau) (assoc 62 kdim) kdim))
(vl-cmdf "regen")
(setvar 'cmdecho 1)
(princ)
)

 

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Lsp của nhoc phải nhấp ngay cái dimtext thì nó mới làm.

Sửa cái lsp của chủ thớt.

 

(defun changecolor (en col)
  (if (= (cdr (assoc 0 (entget en))) "DIMENSION")
    (vlax-for item (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
  (cdr (assoc 2 (entget en))))
      (if (= "AcDbMText" (vla-get-ObjectName item)) (vla-put-Color item col))
    )
    (command "change" en "" "P" "c" col "")
  )
)
 
(defun c:cl (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (princ "\nChon mau muon doi :") (setq m (acad_colordlg 7))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 
(defun c:ck (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (setq m (getint "\nChon mau muon doi: "))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")  
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

- nhoc thì ko rành về dim, viết lsp đơn giản nhưng cũng hơi thủ công bạn xem thừ ^^

p/s: up hộ bạn ^^

(defun c:dmd(/ mau kdim)
(vl-load-com)
(setvar 'cmdecho 0)
(setq mau (getint "\nNh\U+1EADp m\U+00E3 m\U+00E0u mu\U+1ED1n \U+0111\U+1ED5i:"))
(setq kdim (entget (car (nentsel "\nCh\U+1ECDn \U+0111\U+00FAng text dim:"))))
(entmod (subst (cons 62 mau) (assoc 62 kdim) kdim))
(vl-cmdf "regen")
(setvar 'cmdecho 1)
(princ)
)

 

 

Lisp của ban cũng rất hay nhưng sao mình có cảm giác nó làm máy mình giật giật nhỉ, máy mình yếu quá chăng.

Bạn có thể ghép vào lisp trên của mình được không vì cùng 1 lisp áp dụng cho nhiều đối tượng sẽ hay hơn, đỡ phải nhớ nhiểu, ngoài ra lisp trên của mình nó hiện lên được cái bảng màu sẽ trực quan chọn màu hơn

Mình cám ơn nhiều

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Lsp của nhoc phải nhấp ngay cái dimtext thì nó mới làm.

Sửa cái lsp của chủ thớt.

 

(defun changecolor (en col)
  (if (= (cdr (assoc 0 (entget en))) "DIMENSION")
    (vlax-for item (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
  (cdr (assoc 2 (entget en))))
      (if (= "AcDbMText" (vla-get-ObjectName item)) (vla-put-Color item col))
    )
    (command "change" en "" "P" "c" col "")
  )
)
 
(defun c:cl (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (princ "\nChon mau muon doi :") (setq m (acad_colordlg 7))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 
(defun c:ck (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (setq m (getint "\nChon mau muon doi: "))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")  
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 

 

Cám ơn bạn nhoclangbat nhiệt tình giúp đỡ

Lisp này là được rồi :D

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Lisp của ban cũng rất hay nhưng sao mình có cảm giác nó làm máy mình giật giật nhỉ, máy mình yếu quá chăng.

........

 

Do các bác viết Lisp sử dụng Regen nên với bản vẽ lớn sẽ thấy chậm đó

Nếu là mình thì mình viết kiểu khác, không sử dụng Regen...........

Cơ mà cái này chỉ cần chọn đối tượng -> Ctrol+1 -> hiệu chỉnh là được mà..........

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Do các bác viết Lisp sử dụng Regen nên với bản vẽ lớn sẽ thấy chậm đó

Nếu là mình thì mình viết kiểu khác, không sử dụng Regen...........

Cơ mà cái này chỉ cần chọn đối tượng -> Ctrol+1 -> hiệu chỉnh là được mà..........

 

Ctrl+1 lâu lắm, không biết do mình yếu hay ko mà Ctrl+1 rất giật, hiện lên cũng chậm nhất là khi chỉnh kích thước leader, ngoài ra tìm được phần hiệu chỉnh mất nhiều thời gian

Bạn Tue_NV thử viết lại không dùng Regen như bạn nói xem có nhanh được hơn nhiều không.

Mình cám ơn

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Lsp của nhoc phải nhấp ngay cái dimtext thì nó mới làm.

Sửa cái lsp của chủ thớt.

 

(defun changecolor (en col)
  (if (= (cdr (assoc 0 (entget en))) "DIMENSION")
    (vlax-for item (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
  (cdr (assoc 2 (entget en))))
      (if (= "AcDbMText" (vla-get-ObjectName item)) (vla-put-Color item col))
    )
    (command "change" en "" "P" "c" col "")
  )
)
 
(defun c:cl (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (princ "\nChon mau muon doi :") (setq m (acad_colordlg 7))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 
(defun c:ck (/ m ss)
  (command "undo" "be") (setvar 'cmdecho 0)
  (princ "\nChon doi tuong muon doi mau:")
  (setq ss (ssget))
  (setq m (getint "\nChon mau muon doi: "))
  (mapcar '(lambda (x) (changecolor x m)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
  (vl-cmdf "regen")  
  (command "undo" "end") (setvar 'cmdecho 1)
  (setvar "MODEMACRO" "**KTS_DUY**")
  (princ)
)
 
mình không hiểu biến hệ thống modemacro là gì

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Ctrl+1 lâu lắm, không biết do mình yếu hay ko mà Ctrl+1 rất giật, hiện lên cũng chậm nhất là khi chỉnh kích thước leader, ngoài ra tìm được phần hiệu chỉnh mất nhiều thời gian

Bạn Tue_NV thử viết lại không dùng Regen như bạn nói xem có nhanh được hơn nhiều không.

Mình cám ơn

Code như vầy :

 

(defun c:dmau(/ mau)
  (setq mau (ACAD_COLORDLG 7))
  (command "._DIMOVERRIDE" "dimclrt" mau "" )
 )
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Code như vầy :

 

(defun c:dmau(/ mau)
  (setq mau (ACAD_COLORDLG 7))
  (command "._DIMOVERRIDE" "dimclrt" mau "" )
 )

 

Lisp này đúng là rất nhanh, không bị lag máy nhưng bạn có thể ghép chung vào lisp của mình được không, khi đó nó đổi được cả cho đối tượng text sẽ hay hơn. Ngoài ra còn có cái này nhỏ thôi, ko quan trọng lắm, bạn sửa cũng được là đa phần các lisp đều chọn đối tượng trước rồi mới thực hiện lệnh, lisp của bạn lại ngược lại, hiện bảng màu trước rồi mới chọn đối tượng, do đó không quen cho lắm, nhưng cái này ko quan trọng, bạn gộp lại với lisp của mình là ngon rồi

Mình cám ơn nhiều

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Viết mới sướng hơn nhiều

Code nhanh cho bạn 

 

(defun c:dmau(/ mau)
  (if (setq ss (ssget '((0 . "*TEXT,DIMENSION")))) (progn
            (setq mau (ACAD_COLORDLG 7))
            (command "._DIMOVERRIDE" "dimclrt" mau "" ss "")
        (command "._chprop" (ssget "P" '((0 . "*TEXT"))) "" "c" mau "")
  ))
 )
(defun c:dmau(/ mau)
  (if (setq ss (ssget '((0 . "*TEXT,DIMENSION")))) (progn
(setq mau (ACAD_COLORDLG 7))     
        (command "._chprop" (ssget "P" '((0 . "*TEXT"))) "" "c" mau "")
  (command "._DIMOVERRIDE" "dimclrt" mau "" (ssget "P" '((0 . "DIMENSION"))) )
  ))
 )
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Viết mới sướng hơn nhiều

Code nhanh cho bạn 

 

(defun c:dmau(/ mau)
  (if (setq ss (ssget '((0 . "*TEXT,DIMENSION")))) (progn
            (setq mau (ACAD_COLORDLG 7))
            (command "._DIMOVERRIDE" "dimclrt" mau "" ss "")
        (command "._chprop" (ssget "P" '((0 . "*TEXT"))) "" "c" mau "")
  ))
 )
(defun c:dmau(/ mau)
  (if (setq ss (ssget '((0 . "*TEXT,DIMENSION")))) (progn
(setq mau (ACAD_COLORDLG 7))     
        (command "._chprop" (ssget "P" '((0 . "*TEXT"))) "" "c" mau "")
  (command "._DIMOVERRIDE" "dimclrt" mau "" (ssget "P" '((0 . "DIMENSION"))) )
  ))
 )

 

Bạn Tue_NV siêu thật đó, li sp nhìn ngắn ghê mà dùng rất tốt, chuyển màu nhanh không bị lag. Tuy nhiên có 1 lỗi nhỏ đó là khi chuyển màu dim xong nó hiện "nil" và dòng lệnh thấy lại báo có vẻ như là lỗi mặc dù đã đổi màu thành công. Mình không hiểu vì sao, mình chụp ảnh lại đây, bạn xem lại chút nhé

Mình cám ơn

9928_loi_lisp_doi_mau_dim.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Sửa chút :

(defun c:cl (/ ss m)
(command "undo" "be")
(if (setq ss (ssget)) 
(progn            (setq m (acad_colordlg 7))                                                     
        (command "change" ss "" "P" "c" m "")
        (command "._DIMOVERRIDE" "dimclrt" m "" (ssget "P" '((0 . "DIMENSION"))) "" )
  ))
(command "undo" "end")
(princ))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Sửa chút :

(defun c:cl (/ ss m)
(command "undo" "be")
(if (setq ss (ssget)) 
(progn            (setq m (acad_colordlg 7))                                                     
        (command "change" ss "" "P" "c" m "")
        (command "._DIMOVERRIDE" "dimclrt" m "" (ssget "P" '((0 . "DIMENSION"))) "" )
  ))
(command "undo" "end")
(princ))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Sửa chút :

(defun c:cl (/ ss m)
(command "undo" "be")
(if (setq ss (ssget)) 
(progn            (setq m (acad_colordlg 7))                                                     
        (command "change" ss "" "P" "c" m "")
        (command "._DIMOVERRIDE" "dimclrt" m "" (ssget "P" '((0 . "DIMENSION"))) "" )
  ))
(command "undo" "end")
(princ))

 

Li sp này ngon rồi. Mình cám ơn nhiều nhé :D

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Sửa vậy nó đổi màu hết các item của Dim mất.

 

Bạn Ha nói mình mới để ý, đúng là nó đổi cả dim thành màu mình chọn nhỉ, tuy nhiên đường các đường gióng vẫn là màu dim của mình vì đường gióng là mình chọn màu cho nó trong dim là by layer mà, chỉ có dấu chấm chân dim bị đổi màu nhỉ. nói chung không ảnh hưởng lắm nhưng các bạn sửa lại chỉ đổi màu text trong dim thì lisp sẽ hoàn thiện hơn

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cách khác : 

(defun c:cl (/ m ss)
  (if (and (setq ss (ssget))
	   (setq m (acad_colordlg 7)))
    (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (if (wcmatch (vla-get-objectname obj) "*Dimension")
	(progn(vla-put-TextColor obj m)(vla-update obj))
	(vla-put-Color obj m)  )  )    )
  (princ))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Cách khác : 

(defun c:cl (/ m ss)
  (if (and (setq ss (ssget))
	   (setq m (acad_colordlg 7)))
    (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (if (wcmatch (vla-get-objectname obj) "*Dimension")
	(progn(vla-put-TextColor obj m)(vla-update obj))
	(vla-put-Color obj m)  )  )    )
  (princ))

 

Lisp này là ngon lành rồi. 

Mình cám ơn nhiều nhé

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×