(defun c:color-name (color)
(cond
((= color 1) "Rojo")
((= color 2) "Amarillo")
((= color 3) "Verde")
((= color 4) "Cyan")
((= color 5) "Azul")
((= color 6) "Magenta")
((= color 7) "Blanco")
((= color 8) "Gris obscuro")
((= color 8) "Gris claro")
((= color 30) "Naranja")
;; Agrega más colores si es necesario
((= color 256) "Por Capa") ; Color por capa
(t (strcat "Color " (itoa color))) ; Para otros colores
)
)
(defun c:count_obj_colorname (/ ent i ss lst lsta str color nombre xyz)
(if (setq ss (ssget '((0 . "LINE,*POLYLINE,CIRCLE"))))
(progn
(setq lst (list)) ; Inicializar la lista
(setq lsta (list)) ; Inicializar la lista de tipos
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
color (cdr (assoc 62 ent)) ; Obtener el color del objeto
typ (cdr (assoc 0 ent))
)
;; Contar por color
(if (assoc color lst)
(setq lst (subst (cons color (1+ (cdr (assoc color lst)))) (assoc color lst) lst))
(setq lst (cons (cons color 1) lst))
)
;; Contar por tipo (modificación original)
(if (assoc typ lsta)
(setq lsta (subst (cons typ (1+ (cdr (assoc typ lsta)))) (assoc typ lsta) lsta))
(setq lsta (cons (cons typ 1) lsta))
)
)
;; Generar cadena de resultados para tipos
(setq str (vl-string-right-trim
", "
(apply
'strcat
(mapcar (function (lambda (x) (strcat (itoa (cdr x)) " " (car x) ", "))) lsta)
)
)
)
;; Crear una nueva capa para la lista de conteo
(command "_.layer" "new" "FV-TEXTOS VOLUMETRIAS" "color" "4" "FV-TEXTOS VOLUMETRIAS" "PLOT" "NO" "FV-TEXTOS VOLUMETRIAS" "SET" "FV-TEXTOS VOLUMETRIAS" "")
(setq nombre (getstring T "\nIngrese un nombre: "))
(setq xyz (getpoint "Presiona el botón del ratón: ")) ; obtiene posición del puntero
(command "_.text" "ML" xyz 1 0 (strcat "Lista de conteo de objetos: " nombre))
(setq vertical-offset 1.0) ; Separación vertical entre textos
(setq original-xyz xyz)
(setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
(setq lst (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
;; Imprimir resultados por color
(foreach color-count lst
(setq color (car color-count))
(setq cantidad (cdr color-count))
(setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
(command "_.text" "ML" xyz 1 0 (strcat (itoa cantidad) " u : " (c:color-name color))) ; Mostrar nombre del color
(setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
)
(setq xyz (trans (list (car original-xyz) (- (cadr xyz) vertical-offset) 1.0) 1 0))
(command "_.text" "ML" xyz 1 0 (strcat "## :" str ": Totales "))
)
(princ "\nNo se seleccionaron objetos... ")
)
(princ)
)