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

#21 tquang1976vn

tquang1976vn

    biết pan

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

Đã gửi 04 October 2014 - 04:51 PM

ĐỔI TẤT CẢ ĐỐI TƯỢNG VỀ MỘT MÀU KỂ CẢ NHIỀU BLOCK LỒNG NHAU, KỂ CẢ LAYER KHÓA.---> TIỆN LÀM KEYPLAN , VẼ ME ...http://www.cadviet.c..._ra_mot_mau.lsp


  • 1

#22 huytung89

huytung89

    biết pan

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

Đã gửi 26 February 2015 - 04:56 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

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


  • 0