This command copies the color (ACI or RGB) of an object to the clipboard. You can even choose the RGB separator.
I asked for help on the autodesk forum for an utility to copy an entity's color to the clipboard and I had a lot of feedback. Komondormrex wrote this great lisp and agreed to publish it here.
Thanks to everyone!
command: entity_color
;*****************************************************************************************
; komondormrex, may 2023
;*****************************************************************************************
(vl-load-com)
;*****************************************************************************************
(defun c:entity_color (/ dcl_filename_full ec_dcl_id dialog_loop dialog_result)
;*****************************************************************************************
(defun Copy_Text_to_Clipboard ( text / htmlfile result )
; post by XShrimp at theswamp.org.
(setq result
(vlax-invoke
(vlax-get
(vlax-get
(setq htmlfile (vlax-create-object "htmlfile"))
'ParentWindow
)
'ClipBoardData
)
'SetData
"Text"
text
)
)
(vlax-release-object htmlfile)
)
;*****************************************************************************************
(defun write_dialog_file (dialog_strings_list / temp_file_path dcl_filename_full dcl_file_id)
(setq temp_file_path (vla-get-TempFilePath (vla-get-Files (vla-get-preferences (vlax-get-acad-object))))
dcl_filename_full (vl-filename-mktemp "Dialog" temp_file_path ".dcl"])
dcl_file_id (open dcl_filename_full "w")
)
(mapcar '(lambda (dcl_str) (write-line
dcl_str
dcl_file_id
)
)
dialog_strings_list
)
(close dcl_file_id)
dcl_filename_full
)
;*****************************************************************************************
(defun get_object_color (picked_object)
(cond
(
(= accolormethodbyaci (setq color_method (vla-get-colormethod (vla-get-truecolor picked_object))))
(itoa (vla-get-colorindex (vla-get-truecolor picked_object)))
)
(
(= accolormethodbyrgb (setq color_method (vla-get-colormethod (vla-get-truecolor picked_object))))
(setq rgb_list (list (itoa (vla-get-red (vla-get-truecolor picked_object)))
(itoa (vla-get-green (vla-get-truecolor picked_object)))
(itoa (vla-get-blue (vla-get-truecolor picked_object)))
)
)
(substr (apply 'strcat (mapcar '(lambda (value) (strcat delimiter value)) rgb_list)) 2)
)
(
(= accolormethodbylayer (setq color_method (vla-get-colormethod (vla-get-truecolor picked_object))))
(setq rgb_list (list (itoa (vla-get-red (vla-get-truecolor picked_object)))
(itoa (vla-get-green (vla-get-truecolor picked_object)))
(itoa (vla-get-blue (vla-get-truecolor picked_object)))
)
)
(substr (apply 'strcat (mapcar '(lambda (value) (strcat delimiter value)) rgb_list)) 2)
)
(
t
"not applicable"
)
)
)
;*****************************************************************************************
(defun take_entity_color (delimiter / picked_object)
(setq picked_object (vlax-ename->vla-object (car (nentsel "\nPick entitity to get color from: "))))
(cond
(
(= accolormethodbyaci (setq color_method (vla-get-colormethod (vla-get-truecolor picked_object))))
(get_object_color picked_object)
)
(
(= accolormethodbyrgb (setq color_method (vla-get-colormethod (vla-get-truecolor picked_object))))
(get_object_color picked_object)
)
(
(= accolormethodbylayer (setq color_method (vla-get-colormethod (vla-get-truecolor picked_object))))
(get_object_color (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (vla-get-layer picked_object)))
)
(
t
(get_object_color picked_object)
)
)
)
;*****************************************************************************************
(setq main_dcl_strings_list
(list
"Entity_Color: dialog {"
" label = \"Picked entity color\";"
" initial_focus = \"String_to_Find\";"
" spacer_1;"
" : row {"
" :edit_box {"
" key = \"Color_String\";"
" label = \"Color string\";"
" edit_width = 20;"
" value = \"\";"
" allow_accept = true;"
" }"
" :button {"
" key = \"Select_Object\";"
" label = \">\";"
" }"
" }"
" spacer_1;"
" : row {"
" spacer_1;"
" : edit_box {"
" key = \"Delimiter\";"
" label = \"Delimiter\";"
" height = 1;"
" fixed_height = true;"
" edit_width = 1;"
" edit_limit = 1;"
" }"
" : button {"
" key = \"To_Clipboard\";"
" label = \"to Clipboard\";"
" width = 10;"
" fixed_width = true;"
" height = 2;"
" }"
" : button {"
" key = \"�ancel\";"
" label = \"Cancel\";"
" width = 10;"
" fixed_width = true;"
" height = 2;"
" is_default = false;"
" is_cancel = true;"
" }"
" spacer_1;"
" }"
"}"
)
dcl_filename_full (write_dialog_file main_dcl_strings_list)
ec_dcl_id (load_dialog dcl_filename_full)
dialog_loop t
)
(vl-file-delete dcl_filename_full)
(if (or
(null Color_String)
(/= 'str (type Color_String))
)
(setq Color_String "Pick Entity")
)
(if (null delimiter) (setq delimiter ","))
(while dialog_loop
(if ec_dcl_id
(if (new_dialog "Entity_Color" ec_dcl_id)
(progn
(set_tile "Color_String" Color_String)
(set_tile "Delimiter" delimiter)
(action_tile "To_Clipboard" "(setq Color_String (get_tile \"Color_String\")) (done_dialog 1)")
(action_tile "Cancel" "(done_dialog 0)")
(action_tile "Color_String" "(if (and (/= \"\" (setq Color_String $value))
(= 1 $reason)
)
(progn
(setq Color_String (get_tile \"Color_String\"))
(done_dialog 1)
)
)
"
)
(action_tile "Select_Object" "(done_dialog 2)")
(action_tile "Delimiter" "(mode_tile \"Delimiter\" 3) (if (and (= 1 $reason)
(= color_method accolormethodbyrgb)
)
(set_tile \"Color_String\"
(substr (apply 'strcat (mapcar '(lambda (value) (strcat (setq delimiter $value) value)) rgb_list)) 2)
)
(setq delimiter $value)
)
"
)
(setq dialog_result (start_dialog))
(cond
(
(= dialog_result 1)
(copy_text_to_clipboard color_string)
(setq dialog_loop nil)
)
(
(= dialog_result 2)
(if (setq temp_color_string (take_entity_color delimiter))
(setq color_string temp_color_string)
)
)
(
t
(setq dialog_loop nil)
)
)
)
)
)
)
(unload_dialog ec_dcl_id)
(princ)
)