Chuyển đến nội dung
Diễn đàn CADViet
thanhduan2407

Đổ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

Bởi thanhduan2407 , trong AutoLisp

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

thanhduan2407    272

thanhduan2407
Đã đăng

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.com/forum/index.php?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.

  • 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

Thaistreetz    539

Thaistreetz
Đã đăng

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

  • 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

Tue_NV    3.912

Tue_NV
Đã đăng
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.
  • 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

thanhduan2407    272

thanhduan2407
Đã đăng
Đơ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

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

thanhduan2407    272

thanhduan2407
Đã đăng
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

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

phamngoctukts    714

phamngoctukts
Đã đăng
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.com/forum/index.php?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

  • Like 1
  • Vote tăng 5

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

thanhduan2407    272

thanhduan2407
Đã đăng
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

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

ketxu    2.984

ketxu
Đã đăng

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

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

LiveView    5

LiveView
Đã đăng
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 ! :)

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

phuongtran613    1

phuongtran613
Đã đăng

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

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

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

  • 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

thanhduan2407    272

thanhduan2407
Đã đăng

 

 

Ố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. :)

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

lp_hai    225

lp_hai
Đã đăng
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?

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

thanhduan2407    272

thanhduan2407
Đã đăng

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à

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

lp_hai    225

lp_hai
Đã đăng

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?

:)

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

thanhduan2407    272

thanhduan2407
Đã đăng

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

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

nam_ktd    0

nam_ktd
Đã đăng

 

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.

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

Hantinhsaycad    379

Hantinhsaycad
Đã đăng

Vào đây tham khảo : http://www.cadviet.com/forum/topic/32-cach-su-dung-lisp/

                                 http://www.cadviet.com/forum/topic/1787-huong-dan-su-dung-ma-lisp/

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

...............................Và còn  nhiều nữa ... :D  :D  :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

huytung89    0

huytung89
Đã đăng

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

Rồi là dùng sao ? Gõ lệnh gì bác ?

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

hoavienquang    1

hoavienquang
Đã đăng
Vào lúc 6/11/2010 tại 18:09, phamngoctukts đã nói:

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

 

  • colorx_colorxref_colorxl_colorxrefl.lsp
    lisp help
  •   

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

 

anh ơi! em mới tập vẽ điện, nên em muốn chuyển tất cả các đối tượng kể cả block, về layer 0 màu là số 8. em dũng lisp này vẫn ko thể chuyển block đc. anh giúp em với

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

eakarphan    0

eakarphan
Đã đăng
Vào lúc 6/11/2010 tại 18:09, phamngoctukts đã nói:

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

 

  • colorx_colorxref_colorxl_colorxrefl.lsp
    lisp help
  •   

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

 

 

List này quá tuyệt. Chỉ 1 lệnh là tất cả đối tượng (kể cả dim) để chuyển hết về một màu.

 

Nhưng vẫn còn 1 lỗi nhỏ: các đối tượng text sau khi dùng lệnh lại bị lỗi font. Ví dụ: Cổng  sẽ thành C?ng.

 

Bác nào giúp fix được lỗi này nữa thì tuyệt.

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
Về Đầu Trang AutoLisp
×