Need help with slight modification to this lisp

[rombi]

I found this lisp on this forum, and it is almost perfect for my use case. The one thing i would like it changed about it is that instead of asking for my input for a color, it changes it for a certain one that we set in the code. 

 

The thing i would like this code to do: after entering the command and selecting the objects, the color of the object changes right away, without asking for a any input.  

 

Appreciate your help in advance! 

(defun C:CHC (/ ColorObjects CurrColorOrg NewColor CmdEchoOrg)
 (prompt "\nSelect objects to color...")
 (cond
   ( (setq ColorObjects (ssget))
     (setq CurrColorOrg (getvar 'CECOLOR)
           CmdEchoOrg   (getvar 'CMDECHO)
     )
     (setvar 'CMDECHO 0)    
     (while
       (not (cond
       ( (initget 6) )   
           ( (setq NewColor (getint
               "\nEnter object color (1-255) <dialog>: "
             )              )
             (if (< NewColor 256) (setvar 'CECOLOR (itoa NewColor)))
           )
           (T(initdia)
             (command "_.COLOR")
             (numberp (read (getvar 'CECOLOR)))
           )                                  
       )    )
       (prompt "\nCannot set color to that value.\n*Invalid.*")  
     )  
     (command "_.CHANGE" ColorObjects "" "_P" "_C" (getvar 'CECOLOR) "") 
 ) )
 (setvar 'CECOLOR CurrColorOrg)
 (setvar 'CMDECHO CmdEchoOrg)      
 (princ)
)

 

[dlanorh]

Try this :

 

;; Change Objects Color
(vl-load-com)
(defun C:COC (/ *error* cme c_doc ss clr obj cnt)

  (defun *error* ( msg ) 
    (if cme (setvar 'cmdecho cme))
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg)))
    (princ)
  );end_defun *error*

  (cond ( (/= (getvar 'cmdecho) 0) (setq cme (getvar 'cmdecho)) (setvar 'cmdecho 0)))

  (prompt "\nSelect Objects to Color : ")
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        clr 1 ;0 = Byblock , 256 = Bylayer
        ss (ssget)
  );end_setq

 (cond  (ss
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
          (vla-startundomark c_doc)
          
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
            (if (vlax-property-available-p obj 'color T) (vlax-put-property obj 'color clr))
          );end_repeat
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))          
        )
  );end_cond
  (if cme (setvar 'cmdecho cme))
  (princ)
);end_defun
  

The hard coded integer color value is variable "clr" currently set to 1, and found in the first multi (setq) statement

[rombi]

15 minutes ago, dlanorh said:

Try this :

 

;; Change Objects Color
(vl-load-com)
(defun C:COC (/ *error* cme c_doc ss clr obj cnt)

  (defun *error* ( msg ) 
    (if cme (setvar 'cmdecho cme))
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg)))
    (princ)
  );end_defun *error*

  (cond ( (/= (getvar 'cmdecho) 0) (setq cme (getvar 'cmdecho)) (setvar 'cmdecho 0)))

  (prompt "\nSelect Objects to Color : ")
  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        clr 1 ;0 = Byblock , 256 = Bylayer
        ss (ssget)
  );end_setq

 (cond  (ss
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
          (vla-startundomark c_doc)
          
          (repeat (setq cnt (sslength ss))
            (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))))
            (if (vlax-property-available-p obj 'color T) (vlax-put-property obj 'color clr))
          );end_repeat
          (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))          
        )
  );end_cond
  (if cme (setvar 'cmdecho cme))
  (princ)
);end_defun
  

 

You are a legend! Works great! Wish i knew more about autolisp programming!  

[dlanorh]

2 hours ago, rombi said:

 

Wish i knew more about autolisp programming!  

 

Every journey starts with a single step. https://www.afralisp.net/index.php