The Courage Dog Posted November 8, 2009 Share Posted November 8, 2009 hi...i'm working on hundreds of drawings by changing the COLOR contents of all objects (i.e. the text, dimensions, hatches, all xrefs anytihing on the sheet file except the title block & its title block attributes) into grey to make it look as background color. The problem i'm facing is that some layer objects their object color are not "bylayer". is anybody there who has the lisp routine that can run & automatically change all the color of all objects which you have selected? Your reply are highly appreciated. Quote Link to comment Share on other sites More sharing options...
eldon Posted November 8, 2009 Share Posted November 8, 2009 Whilst you are waiting for some good soul to write a lisp for you, you could always do it the manual way at the keyboard:- Command: -ch (Enter) CHANGE Select objects: all (Enter) 2254 found 378 were not in current space. Select objects:(Enter) Specify change point or [Properties]: p (Enter) Enter property to change [Color/Elev/LAyer/LType/ltScale/LWeight/Thickness]: c (Enter) Enter new color : bylayer (Enter) Enter property to change [Color/Elev/LAyer/LType/ltScale/LWeight/Thickness]:(Enter) This does not work for any lines embedded in blocks, which you would have to explode, But it gives you something to do whilst you are waiting. Quote Link to comment Share on other sites More sharing options...
alanjt Posted November 8, 2009 Share Posted November 8, 2009 Something like this? (defun c:ToColor (/ #SS #Color #Layers #Layer #List) (vl-load-com) (cond ((and (setq #Color (acad_colordlg 1)) (setq #SS (ssget)) ) ;_ and (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))) (setq #Layers (vla-get-layers *AcadDoc*)) (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*)) (vl-catch-all-apply 'vla-put-color (list x 256)) (or (vl-position (setq #Layer (vla-get-layer x)) #List) (progn (vla-put-color (vla-item #Layers #Layer) #Color) (setq #List (cons #Layer #List)) ) ;_ progn ) ;_ or ) ;_ vlax-for (vl-catch-all-apply 'vla-delete (list #SS)) ) ) ;_ cond (princ) ) ;_ defun Quote Link to comment Share on other sites More sharing options...
lpseifert Posted November 8, 2009 Share Posted November 8, 2009 http://www.cadtutor.net/forum/showthread.php?t=31017 Quote Link to comment Share on other sites More sharing options...
VVA Posted November 9, 2009 Share Posted November 9, 2009 Lisp colour change for all layers and blocks Quote Link to comment Share on other sites More sharing options...
fixo Posted November 9, 2009 Share Posted November 9, 2009 Lisp colour change for all layers and blocks Ему нужно еще цвет Xref'ов поменять тоже (i.e. the text, dimensions, hatches, all xrefs anytihing on the sheet file except the title block & its title block attributes) ~'J'~ Quote Link to comment Share on other sites More sharing options...
VVA Posted November 9, 2009 Share Posted November 9, 2009 Ему нужно еще цвет Xref'ов поменять тоже(i.e. the text, dimensions, hatches, all xrefs anytihing on the sheet file except the title block & its title block attributes) ColorX - change color all object of drawing. All layer unlock and thaw ColorXREF change color xref only on a current session. All layer unlock and thaw ColorXL - change color all object of drawing. Objects on the locked and frozen layers are ignored ColorXREFL change color xref only on a current session. Objects on the locked and frozen layers are ignored COLORXLAY - change xref layer's color Quote Link to comment Share on other sites More sharing options...
fixo Posted November 9, 2009 Share Posted November 9, 2009 ColorX - change color all object of drawing. All layer unlock and thawColorXREF change color xref only on a current session. All layer unlock and thaw ColorXL - change color all object of drawing. Objects on the locked and frozen layers are ignored ColorXREFL change color xref only on a current session. Objects on the locked and frozen layers are ignored COLORXLAY - change xref layer's color И от меня спасибо Успехов ~'J'~ Quote Link to comment Share on other sites More sharing options...
baijumon Posted November 10, 2009 Share Posted November 10, 2009 hai fizo have u modified this code Code: (defun div-error (msg) (if (vl-position msg '("console break" "Function cancelled" "quit / exit abort" ) ) (princ "Error!") (princ msg) ) (while (> (getvar "cmdactive") 0) (command)) ;;; (command "._undo" "_end") ;;; (command "._u") (setq *error* olderror) (princ) ) (defun divplus (len segm / num lst) (setq num (fix (/ len segm))) (setq cnt 0) (while ( (setq tmp (* cnt segm)) (setq lst (append lst (list tmp))) (setq cnt (1+ cnt)) ) (setq delta (- len (last lst))) (if (not (zerop delta)) (setq lst (append lst (list (+ (last lst) delta)))) lst ) ) (defun divminus (len segm / lst) (while (>= len 0.) (setq lst (append lst (list len))) (setq len (- len segm)) ) (if (not (zerop (last lst))) (setq lst (append lst (list 0.0))) ) lst ) (defun alg-ang (obj pnt) (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt ) ) ) ) (defun answer (quest / wshl ans) (or (vl-load-com)) (setq wshl (vlax-get-or-create-object "WScript.Shell")) (setq ans (vlax-invoke-method wshl 'Popup quest 7 "Answer This Question:" vlax-vbYesNo)) (vlax-release-object wshl) (cond ((= ans 6) (setq opt T)) ((= ans 7) (setq opt nil)) ) opt ) (defun make-station (bname / acsp adoc atprom attag at_obj blk_obj hgt lay line_obj sfar ) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1) ) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc)) ) (vla-startundomark adoc) (if (not (tblsearch "block" bname)) (progn (setq attag "NUMBER" ;(strcase (getstring "\nAttribute tag : \n")) atprom "NUMBER" ;(strcase (getstring T "\nAttribute prompt : \n")) hgt 1.0 ;(getreal "\nAttribute text height : \n") ) (setq lay (getvar "clayer")) (setvar "clayer" "0") (setvar "attreq" 0) (setq line_obj (vlax-invoke acsp 'Addline '(0. 0. 0.) (list 0. (* hgt 12.) 0.))) (vla-put-color line_obj acyellow) (setq blk_obj (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) bname) sfar (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 0)) (list line_obj) ) ) (vla-copyobjects adoc sfar blk_obj) ;;; RetVal = object.AddAttribute(Height, Mode, Prompt, InsertionPoint, Tag, Value) (setq at_obj (vla-addattribute blk_obj hgt acattributemodeverify atprom (vlax-3d-point '(-0.5 1. 0.)) attag "0+00") ) ;;; (vla-put-alignment at_obj acAlignmentBottomCenter) ;;; (vla-put-textalignmentpoint ;;; at_obj ;;; (vlax-3d-point '(0. 1. 0.)) ;;; ) (vla-put-rotation at_obj (/ pi 2)) (vlax-release-object blk_obj) ) (progn (princ "\n\t >> Block does already exist!\n") (princ))) (if (tblsearch "block" bname) T (progn (alert "Impossible to add block"))) (setvar "attreq" 1) (setvar "clayer" lay) (vl-catch-all-apply (function (lambda ()(vla-delete line_obj)))) (vla-regen adoc acactiveviewport) (vla-endundomark adoc) (vlax-release-object acsp) (vlax-release-object adoc) (princ) ) (or (vl-load-com)) (defun C:d10 (/ *error* acsp adoc appd div-error len num olderror pl pt pt_list step util ) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object) ) ) ) (or appd (setq appd (vla-get-application adoc))) (or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc) ) ) ) (or util (setq util (vla-get-utility adoc))) ;;; (command "._undo" "_end") ;;; (command "._undo" "_mark") (setq olderror *error*) (setq *error* div-error) ;;; (setq bname (getstring T "\nStation block name : \n")) ;;; (make-station bname) (if (not (tblsearch "block" "Station")) (make-station "Station")) (vla-getentity util 'pl 'pt "\nSelect line NEAR OF POINT TO START measure: >>> \n" ) (if pl (progn (setq step (getreal "\nEnter step for stationing : \n")) (setq opt (answer "Rotate text perpendicularly to pline?")) (if (not step)(setq step 10.)) (setq len (vlax-curve-getdistatparam pl (vlax-curve-getendparam pl) ) ) (if (list pt) (vlax-curve-getstartpoint pl) ) (distance (vlax-safearray->list pt) (vlax-curve-getendpoint pl) ) ) (setq pt_list (divplus len step)) (setq pt_list (divminus len step)) ) (setq pt_list (vl-remove-if (function not) (mapcar (function (lambda (x) (vlax-curve-getpointatdist pl x) ) ) pt_list ) ) ) (setq num 0) ;;; (setq num (getint "\nEnter initial station number\n")) (mapcar (function (lambda (x / dr ang att_list at blk_obj) (progn (setq ang (alg-ang pl x) ang (cond (( (T ang) ) ) (setq blk_obj (vlax-invoke acsp 'Insertblock x "Station" 1 1 1 ang) ) (setq att_list (vlax-invoke blk_obj 'Getattributes)) (foreach at att_list (if (eq (vlax-get at 'Tagstring) "NUMBER") (progn (vlax-put at 'Textstring (if ( (strcat "sta: 0+" (rtos num 2 2)) (strcat "sta: " (itoa (fix (/ 1200. 1000.))) "+" (rtos (- num (* (fix (/ num 1000.)) 1000)) 2 2) ) )) (if (not opt) (vlax-put at 'Rotation 0)) (vla-update at) ) ) ) (vla-update blk_obj) (vlax-release-object blk_obj) (setq num (+ num step)) ) ) ) pt_list ) (if (not (vlax-object-released-p pl)) (vlax-release-object pl) ) ) (princ "\nNothing selected try again\n") ) (vla-zoomextents appd) (vla-regen adoc acactiveviewport) (setq *error* olderror div-error nil ) ;;; (command "._undo" "_end") (princ) ) (prompt "\n") (prompt "\n *** Type D10 to execute *** \n") (princ)~'J'~ fizo when u modify it can u pls take (sta:) part from the attribute txt and also in this code the cahinage goes upto 1+975 and it again starts with 1+0.00 instead of 2+0.00 can u pls correct th code and post it friend thanks and regards Baiju babumonbaiju@yahoo.co.in Quote Link to comment Share on other sites More sharing options...
fixo Posted November 10, 2009 Share Posted November 10, 2009 hai fizo have u modified this code fizo when u modify it can u pls take (sta:) part from the attribute txt and also in this code the cahinage goes upto 1+975 and it again starts with 1+0.00 instead of 2+0.00 can u pls correct th code and post it friend thanks and regards Baiju babumonbaiju@yahoo.co.in Baiju, I will rewrite it but you need to delete your post from this thread Please, follow to forum rules and start the new thread instead ~'J'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.