;;-------------------=={ Attribute Colour }==-----------------;;
;;                                                            ;;
;;  Prompts for a selection of attributed blocks and displays ;;
;;  a dialog interface enabling the user to change the colour ;;
;;  of specific attribute tags.                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright ?2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    24-02-2011                            ;;
;;                                                            ;;
;;  First Release.                                            ;;
;;------------------------------------------------------------;;

(defun c:lm_AttCol ( / old_cmd _dclsel lst s ss obj att pair )
(defun _dclsel ( lst / file tmp dch xreturn )
	(setq tmp
		(mai_make_dcl
			(list "attcol : dialog { label = \"调整块属性颜色\"; spacer;"
					"  : list_box { label = \"选择标签\"; key = \"tags\"; fixed_width = false; multiple_select = true ; alignment = centered; }"
					"  : boxed_column { label = \"颜色\";"
					"    : row { spacer;"
					"      : button { key = \"but\"; width = 12; fixed_width = true; label = \"选择颜色\"; }"
					"      : image_button { key = \"img\"; alignment = centered; height = 1.5; width = 4.0;"
					"                       fixed_width = true; fixed_height = true; color = 2; }"
					"      spacer;}spacer;}spacer; ok_cancel;}"
			)
		)
		dch (load_dialog tmp)
	)
	(new_dialog "attcol" dch)
	(mai_filldcl_list "tags" lst)
	(setq xreturn (set_tile "tags" "0"))
	(mai_filldcl_image "img" *attcolour* nil)
	(action_tile "img" "(mai_filldcl_image\"img\"(setq *attcolour*(cond((acad_colordlg *attcolour*))(*attcolour*)))nil)")
	(action_tile "but" "(mai_filldcl_image\"img\"(setq *attcolour*(cond((acad_colordlg *attcolour*))(*attcolour*)))nil)")
	(action_tile "tags" "(setq xreturn $value)")
	(setq xreturn
		(if (= 1 (start_dialog))
			(mapcar '(lambda(x)(nth x lst))(read (strcat "(" xreturn ")")))
		)
	)
	(unload_dialog dch)
	(mai_dos_delete tmp)
	xreturn
)

	; (mini_start nil)
	; (mai_last_com "lm_AttCol")
	; (or *attcolour* (setq *attcolour* 3)) ;; First time default colour
	; (setq ss (vlax-get (vlax-get (vlax-get-acad-object) 'ActiveDocument) 'ActiveSelectionSet))
	; (and
		; (princ "\n选择要修改颜色的块属性:")
		; (ssget "_:L" '((0 . "INSERT") (66 . 1)))
		; (progn
			; (vlax-for obj ss
				; (foreach att
					; (append (vlax-invoke obj 'GetAttributes) (vlax-invoke obj 'GetConstantAttributes))
					; (setq lst (cons (cons (vlax-get att 'TagString) att) lst))
				; )
			; )
			; (vla-delete ss)
			; (setq s (_dclsel (acad_strlsort (mai_remove_same (mapcar 'car lst)))))
		; )
		; (foreach pair lst (if (vl-position (car pair) s) (vlax-put (cdr pair) 'color *attcolour*)))
	; )
	; (mai_end)
	(mini_start nil)
	(mai_last_com "lm_AttCol")
	(or *attcolour* (setq *attcolour* 3)) ;; First time default colour
	(and
		(princ "\n选择要修改颜色的块属性:")
		(setq ss (ssget "_:L" '((0 . "INSERT") (66 . 1))))
		(setq ss (mai_ssget_2_list ss))
		(setq lst (apply 'append (mapcar '(lambda(x)(mai_get_blk_atts x T)) ss)))
		(setq s (_dclsel (acad_strlsort (mai_remove_same (mapcar 'cadr lst)))))
		(foreach pair lst (if (vl-position (cadr pair) s) (vlax-put (vlax-ename->vla-object (car pair)) 'color *attcolour*)))
	)
	(mai_end)
)
