changing color object automatically

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.

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.

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

http://www.cadtutor.net/forum/showthread.php?t=31017

Lisp colour change for all layers and blocks

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'~

Ему нужно еще цвет 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

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

 

И от меня спасибо

Успехов

 

~'J'~

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

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'~