Jump to content

Need help with slight modification to this lisp


rombi
 Share

Recommended Posts

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

 

Link to comment
Share on other sites

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

  • Thanks 1
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

 Share

×
×
  • Create New...