Đến nội dung


Hình ảnh
- - - - -

Đổi màu tất cả các đối tượng trên bản vẽ thành một màu duy nhất


  • Please log in to reply
21 replies to this topic

#1 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 November 2010 - 02:12 PM

Thân chào tất cả các anh em trên diễn đàn.
Ngày nào mình cũng ghé thăm và đọc các bài viết trên diễn dàn xem những điều mới, lạ, quen và thường tò mò nghiên cứu. Sau khi đọc bài viết về chuyển tất cả các đối tượng về một layer ( http://www.cadviet.c...showtopic=17070 ) nhưng ở đây họ lại giữ nguyên màu sắc. Xin nhờ các anh chị em có thể viết dùm mình lisp chuyển tất cả các đối tượng trên bản vẽ thành một màu duy nhất do mình lựa chọn (Tất cả các đối tượng giữ nguyên thuộc tính trừ màu sắc, áp dụng với cả các đối tượng block, attribute, hach, ......). Mình nghĩ ý tưởng như vậy chắc cũng có rất nhiều người cần. Rất cảm ơn các anh chị em.
  • 1



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#2 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 06 November 2010 - 03:19 PM

haizzz
Nếu 1 lúc nào đó mình có cái nhu cầu này mình cũng chẳng ngồi lọ mọ viết ra cái lisp để làm việc đó đâu. mình ctrl+A 1 cái, pick chuột thêm 2 nhát nữa vào hộp color trên thanh công cụ hoặc trong hộp thoại properties là xong
  • 1

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#3 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 November 2010 - 03:22 PM

haizzz
Nếu 1 lúc nào đó mình có cái nhu cầu này mình cũng chẳng ngồi lọ mọ viết ra cái lisp để làm việc đó đâu. mình ctrl+A 1 cái, pick chuột thêm 2 nhát nữa vào hộp color trên thanh công cụ hoặc trong hộp thoại properties là xong

Đơn giản vậy sao bạn? Bạn đã thử với Block với các đối tượng của nó có Layer khác Layer 0 chưa?

(Tất cả các đối tượng giữ nguyên thuộc tính trừ màu sắc, áp dụng với cả các đối tượng block, attribute, hach, ......). Mình nghĩ ý tưởng như vậy chắc cũng có rất nhiều người cần. Rất cảm ơn các anh chị em.


  • 1

#4 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 November 2010 - 04:03 PM

Đơn giản vậy sao bạn? Bạn đã thử với Block với các đối tượng của nó có Layer khác Layer 0 chưa?

Cảm ơn các bạn đã quan tâm ủng hộ và cho ý kiến. Đúng như bác Tue_NV đã nói. Nếu thực sự đơn giản như bác Thaistreetz nói thì em không dám hỏi đâu ạ. Cảm ơn bác đã tham gia đóng góp
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#5 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 06 November 2010 - 04:28 PM

Tại sao lại chuyển về cùng 1 màu mần chi vậy bác?
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#6 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 06 November 2010 - 04:53 PM

Tại sao lại chuyển về cùng 1 màu mần chi vậy bác?

Là khi in ấn cho rõ hơn khi in màu khác nhau (Ngại đặt màu). Hi. Nó còn nhiều tác dụng khác nữa. Tiện thể em cũng hỏi các bác luôn. Nếu em quét chọn đối tượng rồi chọn màu cần chuyển sang (đối tượng được chọn có thể gồm cả block, hack, attribute,...). thì các đối tượng đó sẽ chuyển màu, các đối tượng không được chọn giữ nguyên màu thì sao ạ ? Cảm ơn các anh em, các bác
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#7 KS.PhanThanhTu

KS.PhanThanhTu

    biết vẽ point

  • Members
  • PipPip
  • 97 Bài viết
Điểm đánh giá: 76 (tàm tạm)

Đã gửi 06 November 2010 - 05:13 PM

Lệnh này mình nghĩ ko cần thiết lắm
  • 0
KS Phan Thanh Tú.Email: Vansulich@yahoo.com

#8 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 06 November 2010 - 06:09 PM

Thân chào tất cả các anh em trên diễn đàn.
Ngày nào mình cũng ghé thăm và đọc các bài viết trên diễn dàn xem những điều mới, lạ, quen và thường tò mò nghiên cứu. Sau khi đọc bài viết về chuyển tất cả các đối tượng về một layer ( http://www.cadviet.c...showtopic=17070 ) nhưng ở đây họ lại giữ nguyên màu sắc. Xin nhờ các anh chị em có thể viết dùm mình lisp chuyển tất cả các đối tượng trên bản vẽ thành một màu duy nhất do mình lựa chọn (Tất cả các đối tượng giữ nguyên thuộc tính trừ màu sắc, áp dụng với cả các đối tượng block, attribute, hach, ......). Mình nghĩ ý tưởng như vậy chắc cũng có rất nhiều người cần. Rất cảm ơn các anh chị em.

Cái lisp này mình sưu tầm được trên mạng đã lâu. Nay thấy bạn có nhu cầu mình port lên bạn xem có vư ý không nhé.

;;; Posted Vladimir Azarko (VVA)
;;; [url="http://www.cadtutor.net/forum/showthread.php?t=533&page=2"]
;;;;http://www.cadtutor.net/forum/showthread.p...=533&page=2[/url]
(defun C:COLORX (/ 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
) ;_ end of if
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXREF (/ doc col)
(vl-load-com)
(alert
"\This lisp change color xref\nONLY ON A CURRENT SESSION"
) ;_ end of alert
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(mip:layer-status-save)
(if (setq col (acad_colordlg 7 t))
(ChangeXrefAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXL (/ doc col)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (setq col (acad_colordlg 7 t))
(ChangeAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXREFL (/ doc col)
(vl-load-com)
(alert
"\This lisp change color xref\nONLY ON A CURRENT SESSION"
) ;_ end of alert
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (setq col (acad_colordlg 7 t))
(ChangeXrefAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(vla-endundomark doc)
(princ)
) ;_ end of defun
(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 vla-put-freeze
) ;_ 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))
) ;_ end of vla-get-layers
(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 vl-catch-all-apply
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun
(defun ChangeXrefAllObjectsColor (Doc Color / tmp txtstr)
(vlax-for Blk (vla-get-Blocks Doc)
(cond
((or (= (vla-get-IsXref Blk) :vlax-true)
(and (= (vla-get-IsXref Blk) :vlax-false)
(wcmatch (vla-get-name Blk) "*|*")
) ;_ end of and
) ;_ end of or
(vlax-for Obj Blk
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))
(vl-catch-all-apply 'vla-put-TextColor (list Obj Color))
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp Color)
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
)
((= (vla-get-IsLayout Blk) :vlax-true)
(vlax-for Obj Blk
(if
(and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
(vlax-property-available-p Obj 'Path)
(wcmatch (strcase (vla-get-ObjectName Obj)) "*BLOCK*")
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
) ;_ end of vlax-for
)
(t nil)
) ;_cond
) ;_ end of vlax-for
(vl-cmdf "_redrawall")
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color / txtstr tmp txt count)
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(progn
(setq count 0 txt (strcat "Changed " (vla-get-name Blk)))
(grtext -1 txt)
(vlax-for Obj Blk
(setq count (1+ count))
(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))
(vl-catch-all-apply 'vla-put-TextColor (list Obj Color))
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp Color)
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of if
) ;_ end of vlax-for
(vl-cmdf "_redrawall")
) ;_ end of defun
(princ
"\nType ColorX, COLORXREF, ColorXL, COLORXREFL in command line"
) ;_ end of princ

  • 5
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#9 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 08 November 2010 - 09:59 AM

Cái lisp này mình sưu tầm được trên mạng đã lâu. Nay thấy bạn có nhu cầu mình port lên bạn xem có vư ý không nhé.


;;; Posted Vladimir Azarko (VVA)
;;; [url="http://www.cadtutor.net/forum/showthread.php?t=533&page=2"]
;;;;http://www.cadtutor.net/forum/showthread.p...=533&page=2[/url]
(defun C:COLORX (/ 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
) ;_ end of if
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXREF (/ doc col)
(vl-load-com)
(alert
"\This lisp change color xref\nONLY ON A CURRENT SESSION"
) ;_ end of alert
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(mip:layer-status-save)
(if (setq col (acad_colordlg 7 t))
(ChangeXrefAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(mip:layer-status-restore)
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXL (/ doc col)
(vl-load-com)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (setq col (acad_colordlg 7 t))
(ChangeAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(vla-endundomark doc)
(princ)
) ;_ end of defun
(defun C:COLORXREFL (/ doc col)
(vl-load-com)
(alert
"\This lisp change color xref\nONLY ON A CURRENT SESSION"
) ;_ end of alert
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(if (setq col (acad_colordlg 7 t))
(ChangeXrefAllObjectsColor doc col) ;_ col — color number
) ;_ end of if
(vla-endundomark doc)
(princ)
) ;_ end of defun
(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 vla-put-freeze
) ;_ 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))
) ;_ end of vla-get-layers
(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 vl-catch-all-apply
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun
(defun ChangeXrefAllObjectsColor (Doc Color / tmp txtstr)
(vlax-for Blk (vla-get-Blocks Doc)
(cond
((or (= (vla-get-IsXref Blk) :vlax-true)
(and (= (vla-get-IsXref Blk) :vlax-false)
(wcmatch (vla-get-name Blk) "*|*")
) ;_ end of and
) ;_ end of or
(vlax-for Obj Blk
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))
(vl-catch-all-apply 'vla-put-TextColor (list Obj Color))
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp Color)
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
)
((= (vla-get-IsLayout Blk) :vlax-true)
(vlax-for Obj Blk
(if
(and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
(vlax-property-available-p Obj 'Path)
(wcmatch (strcase (vla-get-ObjectName Obj)) "*BLOCK*")
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
) ;_ end of vlax-for
)
(t nil)
) ;_cond
) ;_ end of vlax-for
(vl-cmdf "_redrawall")
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color / txtstr tmp txt count)
(vlax-for Blk (vla-get-Blocks Doc)
(if (= (vla-get-IsXref Blk) :vlax-false)
(progn
(setq count 0 txt (strcat "Changed " (vla-get-name Blk)))
(grtext -1 txt)
(vlax-for Obj Blk
(setq count (1+ count))
(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'Color)
) ;_ end of and
(vla-put-Color Obj Color)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(vlax-property-available-p Obj 'TextString)
) ;_ end of and
(progn
(setq txtstr
(if (vlax-method-applicable-p Obj 'FieldCode)
(vla-FieldCode Obj)
(vlax-get-property Obj 'TextString))
)
(setq tmp 0)
(while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))
(setq txtstr
(vl-string-subst
(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")
(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))
txtstr
tmp)
)
(setq tmp (+ tmp 3))
)
(vla-put-Textstring Obj txtstr)
)
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(= (vla-get-HasAttributes obj) :vlax-true)
) ;_ end of and
(foreach att (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes obj))
) ;_ end of vlax-safearray->list
(if (and (vlax-write-enabled-p att)
(vlax-property-available-p att 'Color)
) ;_ end of and
(vla-put-Color att Color)
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
(if (and (vlax-write-enabled-p Obj)
(wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")
) ;_ end of and
(progn
(vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))
(vl-catch-all-apply 'vla-put-TextColor (list Obj Color))
(vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))
(if (vlax-property-available-p Obj 'LeaderLineColor)
(progn
(setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."
(substr (getvar "ACADVER") 1 2))))
(vla-put-colorindex tmp Color)
(vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))
)
)
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
)
) ;_ end of if
) ;_ end of vlax-for
(vl-cmdf "_redrawall")
) ;_ end of defun
(princ
"\nType ColorX, COLORXREF, ColorXL, COLORXREFL in command line"
) ;_ end of princ

Vâng. Cảm ơn bác phamngoctukts
Không ngờ lisp đổi màu phức tạp đến vậy. Chân thành cảm ơn bác
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#10 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 08 November 2010 - 11:47 AM

Với các đối tượng bình thường thì không sao,bây giờ nó lại trong block,xref...phải bung ra mà vẫn giữ các đối tượng gốc,thật chẳng đơng giản :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#11 LiveView

LiveView

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 15 January 2011 - 01:41 PM

Cái lisp này mình sưu tầm được trên mạng đã lâu. Nay thấy bạn có nhu cầu mình port lên bạn xem có vư ý không nhé.

Tuyệt quá ! Cái này vô cùng hữu dụng, các bản vẽ kiến trúc mình thường có rất nhiều block, màu sắc các đối tượng khác nhau. Khi chuyển cho M&E họ thường phải làm công đoạn là chuyển tất cả về 1 màu ( để sau này họ cho in với màu nhạt) & các hình vẽ của M&E sẽ có màu khác. Công đoạn này thường mất thời gian. Bây giờ chỉ 15s ...! :)

Ps : Mình có gặp 1 chút trục trặc, các text ( mình dùng font Arial) trong bloch thuộc tính thì không sao, nhưng các text bình thường thì sau khi chạy lệnh sẽ bị lỗi ( VD: Công nghệ >>> Công Nhg? ). Nếu giải quyết được cái này nữa thì tuyệt hảo luôn ! :)
  • 0

#12 phuongtran613

phuongtran613

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 21 December 2011 - 11:39 AM

Vâng. Cảm ơn bác phamngoctukts
Không ngờ lisp đổi màu phức tạp đến vậy. Chân thành cảm ơn bác


Nhờ các cao thủ giúp đỡ nếu sau khi mình đã đổi màu file xref và save rồi thì làm sao cho nó lại như cũ hay phải gỡ file xref đó ra và chèn đó lại ??
Thank
  • 0

#13 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 21 December 2011 - 11:55 AM

Vâng. Cảm ơn bác phamngoctukts
Không ngờ lisp đổi màu phức tạp đến vậy. Chân thành cảm ơn bác


Vâng. Cảm ơn bác phamngoctukts
Không ngờ lisp đổi màu phức tạp đến vậy. Chân thành cảm ơn bác

Ối giời ơi!!!
Phí quá phí quá.....
  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#14 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 21 December 2011 - 12:20 PM



Ối giời ơi!!!
Phí quá phí quá.....

Oái trời. Phí gì thế bác Bình. Hiii. Cái này em hỏi lâu roài. Thực ra dùng lệnh laytrans cũng Ok.
P/s: Chỉ sử dụng cho in ấn thui nên làm thế. Có lisp của bác Phanngoctu.kts nên ok luôn. :)
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#15 lp_hai

lp_hai

    biết lệnh measure

  • Members
  • PipPipPipPipPipPip
  • 456 Bài viết
Điểm đánh giá: 202 (khá)

Đã gửi 21 December 2011 - 03:18 PM

Oái trời. Phí gì thế bác Bình. Hiii. Cái này em hỏi lâu roài. Thực ra dùng lệnh laytrans cũng Ok. P/s: Chỉ sử dụng cho in ấn thui nên làm thế. Có lisp của bác Phanngoctu.kts nên ok luôn. :)

nếu chỉ sử dụng in ấn thì sau khi in xong rồi bạn phải undo hoặc close và ko save?
thế thì tui là thế này dc ko hề? tôi vào layer, chọn tất tần tật cho các layer về cùng một màu thì sao?
  • 0
Hình đã gửi

#16 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 21 December 2011 - 03:26 PM

nếu chỉ sử dụng in ấn thì sau khi in xong rồi bạn phải undo hoặc close và ko save?
thế thì tui là thế này dc ko hề? tôi vào layer, chọn tất tần tật cho các layer về cùng một màu thì sao?

Bác không đọc kỹ các bài viết ở trên rồi. Liệu ổn ko bác?? Thực ra vấn đề cũng ko có gì. Chỉ là 1 thao tác trong công việc thôi mà
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#17 lp_hai

lp_hai

    biết lệnh measure

  • Members
  • PipPipPipPipPipPip
  • 456 Bài viết
Điểm đánh giá: 202 (khá)

Đã gửi 21 December 2011 - 03:43 PM

Bác không đọc kỹ các bài viết ở trên rồi. Liệu ổn ko bác?? Thực ra vấn đề cũng ko có gì. Chỉ là 1 thao tác trong công việc thôi mà

:) Đúng là ko có gì! nhưng mình thắc mắc vậy thôi, Vấn đề là ở chổ này: khi bạn cho những dt về một màu, vậy bjờ muốn cho chúng về đúng layer ban đầu thì làm sao? chọn chúng rồi cho về bylayer?? như vậy thì lại vướn phải block.....
Còn nếu chỉ là gửi cho M&E họ chuyển qua màu khác thì mình nghĩ cách chọn tất cả các layer cho về 1 màu cũng ko quá 10s?
Bạn có thể giải thích rõ là mình làm như vậy thì ko dc ở chổ nào?
:)
  • 0
Hình đã gửi

#18 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 21 December 2011 - 04:14 PM

Bác để em xem lại ví dụ
P/s: Nếu đối tượng ko phải là bylayer và để trong block. liệu ổn chứ bác. hiii. Có lẽ ko nên bàn chuyện này nhiều vì em gặp nên mới nhờ viết lisp hoặc kỹ thuận autocad
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#19 nam_ktd

nam_ktd

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 November 2013 - 02:04 PM

Cái lisp này mình sưu tầm được trên mạng đã lâu. Nay thấy bạn có nhu cầu mình port lên bạn xem có vư ý không nhé.

;;; Posted Vladimir Azarko (VVA);;; [url="http://www.cadtutor.net/forum/showthread.php?t=533&page=2"];;;;http://www.cadtutor.net/forum/showthread.p...=533&page=2[/url](defun C:COLORX	(/ 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  ) ;_ end of if  (mip:layer-status-restore)  (vla-endundomark doc)  (princ)) ;_ end of defun(defun C:COLORXREF (/ doc col)  (vl-load-com)  (alert    "\This lisp change color xref\nONLY ON A CURRENT SESSION"  ) ;_ end of alert  (setq doc (vla-get-activedocument (vlax-get-acad-object)))  (vla-startundomark doc)  (mip:layer-status-save)  (if (setq col (acad_colordlg 7 t))    (ChangeXrefAllObjectsColor doc col) ;_ col — color number  ) ;_ end of if  (mip:layer-status-restore)  (vla-endundomark doc)  (princ)) ;_ end of defun(defun C:COLORXL (/ doc col)  (vl-load-com)  (setq doc (vla-get-activedocument (vlax-get-acad-object)))  (vla-startundomark doc)  (if (setq col (acad_colordlg 7 t))    (ChangeAllObjectsColor doc col) ;_ col — color number  ) ;_ end of if  (vla-endundomark doc)  (princ)) ;_ end of defun(defun C:COLORXREFL (/ doc col)  (vl-load-com)  (alert    "\This lisp change color xref\nONLY ON A CURRENT SESSION"  ) ;_ end of alert  (setq doc (vla-get-activedocument (vlax-get-acad-object)))  (vla-startundomark doc)  (if (setq col (acad_colordlg 7 t))    (ChangeXrefAllObjectsColor doc col) ;_ col — color number  ) ;_ end of if  (vla-endundomark doc)  (princ)) ;_ end of defun(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 vla-put-freeze	 ) ;_ 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))		 ) ;_ end of vla-get-layers    (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 vl-catch-all-apply    ) ;_ end of if  ) ;_ end of vlax-for) ;_ end of defun(defun ChangeXrefAllObjectsColor (Doc Color / tmp txtstr)  (vlax-for Blk	(vla-get-Blocks Doc)    (cond      ((or (= (vla-get-IsXref Blk) :vlax-true)	   (and	(= (vla-get-IsXref Blk) :vlax-false)		(wcmatch (vla-get-name Blk) "*|*")	   ) ;_ end of and       ) ;_ end of or       (vlax-for Obj Blk	 (if (and (vlax-write-enabled-p Obj)		  (vlax-property-available-p Obj 'Color)	     ) ;_ end of and	   (vla-put-Color Obj Color)	 ) ;_ end of if	 (if (and (vlax-write-enabled-p Obj)		 (vlax-property-available-p Obj 'TextString)	    ) ;_ end of and	  (progn	    (setq txtstr		   (if (vlax-method-applicable-p Obj 'FieldCode)		       (vla-FieldCode Obj)		       (vlax-get-property Obj 'TextString))		  )	    (setq tmp 0)	     (while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))	      (setq txtstr	      (vl-string-subst		(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")		(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))		txtstr		tmp)		    )	      (setq tmp (+ tmp 3))	      )	    (vla-put-Textstring Obj txtstr)	    )	) ;_ end of if	 (if (and (vlax-write-enabled-p Obj)		  (= (vla-get-ObjectName obj) "AcDbBlockReference")		  (= (vla-get-HasAttributes obj) :vlax-true)	     ) ;_ end of and	   (foreach att	(vlax-safearray->list			  (vlax-variant-value (vla-GetAttributes obj))			) ;_ end of vlax-safearray->list	     (if (and (vlax-write-enabled-p att)		      (vlax-property-available-p att 'Color)		 ) ;_ end of and	       (vla-put-Color att Color)	     ) ;_ end of if	   ) ;_ end of foreach	 ) ;_ end of if	 (if (and (vlax-write-enabled-p Obj)		  (wcmatch (vla-get-Objectname Obj) "*Dimension*,AcDb*Leader")	     ) ;_ end of and	   (progn	     (vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))	     (vl-catch-all-apply 'vla-put-TextColor (list Obj Color))	     (vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))	     (if (vlax-property-available-p Obj 'LeaderLineColor)	       (progn		 (setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."		(substr (getvar "ACADVER") 1 2))))		 (vla-put-colorindex  tmp  Color)		 (vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))		 )	       )	   ) ;_ end of progn	 ) ;_ end of if       ) ;_ end of vlax-for      )      ((= (vla-get-IsLayout Blk) :vlax-true)       (vlax-for Obj Blk	 (if	   (and	(vlax-write-enabled-p Obj)		(vlax-property-available-p Obj 'Color)		(vlax-property-available-p Obj 'Path)		(wcmatch (strcase (vla-get-ObjectName Obj)) "*BLOCK*")	   ) ;_ end of and	    (vla-put-Color Obj Color)	 ) ;_ end of if       ) ;_ end of vlax-for      )      (t nil)    ) ;_cond  ) ;_ end of vlax-for  (vl-cmdf "_redrawall")) ;_ end of defun(defun ChangeAllObjectsColor (Doc Color / txtstr tmp txt count)  (vlax-for Blk	(vla-get-Blocks Doc)    (if	(= (vla-get-IsXref Blk) :vlax-false)      (progn	(setq count 0 txt (strcat "Changed " (vla-get-name Blk)))	(grtext -1 txt)      (vlax-for	Obj Blk	(setq count (1+ count))	(if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count))))	(if (and (vlax-write-enabled-p Obj)		 (vlax-property-available-p Obj 'Color)	    ) ;_ end of and	  (vla-put-Color Obj Color)	) ;_ end of if	(if (and (vlax-write-enabled-p Obj)		 (vlax-property-available-p Obj 'TextString)	    ) ;_ end of and	  (progn	    (setq txtstr		   (if (vlax-method-applicable-p Obj 'FieldCode)		       (vla-FieldCode Obj)		       (vlax-get-property Obj 'TextString))		  )	    (setq tmp 0)	    (while (setq tmp (VL-STRING-SEARCH "\\C" txtstr tmp))	      (setq txtstr	      (vl-string-subst		(strcat (substr txtstr (1+ tmp) 2)(itoa Color) ";")		(substr txtstr (1+ tmp) (- (1+ (VL-STRING-SEARCH ";" txtstr tmp)) tmp))		txtstr		tmp)		    )	      (setq tmp (+ tmp 3))	      )	    (vla-put-Textstring Obj txtstr)	    )	) ;_ end of if	(if (and (vlax-write-enabled-p Obj)		 (= (vla-get-ObjectName obj) "AcDbBlockReference")		 (= (vla-get-HasAttributes obj) :vlax-true)	    ) ;_ end of and	  (foreach att (vlax-safearray->list			 (vlax-variant-value (vla-GetAttributes obj))		       ) ;_ end of vlax-safearray->list	    (if	(and (vlax-write-enabled-p att)		     (vlax-property-available-p att 'Color)		) ;_ end of and	      (vla-put-Color att Color)	    ) ;_ end of if	  ) ;_ end of foreach	) ;_ end of if        (if (and (vlax-write-enabled-p Obj)		  (wcmatch (vla-get-Objectname Obj)  "*Dimension*,AcDb*Leader")	     ) ;_ end of and	   (progn	     (vl-catch-all-apply 'vla-put-ExtensionLineColor (list Obj Color))	     (vl-catch-all-apply 'vla-put-TextColor (list Obj Color))	     (vl-catch-all-apply 'vla-put-DimensionLineColor (list Obj Color))	     (if (vlax-property-available-p Obj 'LeaderLineColor)	       (progn		 (setq tmp (vla-getinterfaceobject(vlax-get-acad-object)(strcat "AutoCAD.AcCmColor."		(substr (getvar "ACADVER") 1 2))))		 (vla-put-colorindex  tmp  Color)		 (vl-catch-all-apply 'vla-put-LeaderLineColor (list Obj tmp))		 )	       )	   ) ;_ end of progn	 ) ;_ end of if      ) ;_ end of vlax-for      )    ) ;_ end of if  ) ;_ end of vlax-for (vl-cmdf "_redrawall")) ;_ end of defun(princ  "\nType ColorX, COLORXREF, ColorXL, COLORXREFL  in command line") ;_ end of princ

Bác cho hỏi câu lệnh sử dụng cái lip "Colorx_colorxref_colorxl_colorxrefl.lsp" này như thế nào vậy, em load về ap về cad mà không biết sử dụng như thế nào? Thanks.


  • 0

#20 Hantinhsaycad

Hantinhsaycad

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 1073 Bài viết
Điểm đánh giá: 376 (khá)

Đã gửi 12 November 2013 - 02:45 PM

Vào đây tham khảo : http://www.cadviet.c...h-su-dung-lisp/

                                 http://www.cadviet.c...u-dung-ma-lisp/

                                .....................................

...............................Và còn  nhiều nữa ... :D  :D  :D


  • 0

Đừng để một ai chẳng nhận được gì khi rời chỗ bạn, cho dù bạn biết rằng không bao giờ gặp lại.

Ngạn ngữ Pháp