[trvi]

Помогите с написанием lisp для поиска одинаковых размеров по их значению.
Одинаковых размеров может быть большое количество.
Мне нужен лисп который бы во всех одинаковых значениях размера, устанавливал цвет значения размера, например "синий", чтобы можно было их просмотреть и удалить лишние.

Спасибо! Буду рад за помощь...

[proteirei]

Для ясности. Програмка должна найти размер, сравнить его с другими размерами, если нашлись похожие, то обозначить их одинаковым цветом, далее, перейти к следующему размеру, исключив выделеные цветом (если они были) из дальнейшего поиска и повторить всё с начала.

[trvi]

Программа должная найти все одинаковые, по введенному любому значению, размеры и изменить цвет текста размера на синий.

У меня есть "сырок" этой программы, но он не работает.




;; inspired by MI_ChkDup.lsp
;; www.4d-technologies.com
(defun CELDUPDIMS ( / cnt dd dims dupdims dupes en endata entl matchlist osm pt10 pt11 pt12 pt13 pt14 pt15 pt16 ss)
(setq osm (getvar "osmode"))
(prompt "\nВыбор измерений в текущей вкладке")
(command "_undo" "_be")
(if (setq ss (ssget "_X" (list (cons 0 "dimension")(cons 410 (getvar "ctab")))))
(progn
(alert (strcat "Всего размеров: "(itoa (sslength ss))))
(setq dims (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
;;(setq matchlist nil)
(setq dupes (ssadd))
(setq en (car dims)
entl (entget en))

(setq endata (list
(setq pt10 (cdr (assoc 10 entl)))
(setq pt11 (cdr (assoc 11 entl)))
(setq pt12 (cdr (assoc 12 entl)))
(setq pt13 (cdr (assoc 13 entl)))
(setq pt14 (cdr (assoc 14 entl)))
(setq pt15 (cdr (assoc 15 entl)))
(setq pt16 (cdr (assoc 16 entl)))
(setq dd (cdr (assoc 42 entl)))
)
)
;;(ssadd en dupes)
(setq matchlist (append matchlist (list endata)))
(setq cnt 1)
(while
(setq en (nth cnt dims))
(setq entl (entget en))
(setq endata (list
(setq pt10 (cdr (assoc 10 entl)))
(setq pt11 (cdr (assoc 11 entl)))
(setq pt12 (cdr (assoc 12 entl)))
(setq pt13 (cdr (assoc 13 entl)))
(setq pt14 (cdr (assoc 14 entl)))
(setq pt15 (cdr (assoc 15 entl)))
(setq pt16 (cdr (assoc 16 entl)))
(setq dd (cdr (assoc 42 entl)))
)
)


(if (member endata matchlist)
(ssadd en dupes);(sslength dupes)
(setq matchlist (append matchlist (list endata)))
)
(setq cnt(1+ cnt)))))
(if (> (sslength dupes) 0)
(progn
(alert (strcat "Определено дубликатов размеров: "(itoa (sslength dupes))))
(setq dupdims (vl-remove-if 'listp (mapcar 'cadr (ssnamex dupes))))

(setq cnt 0)
(setvar "cmdecho" 0)
(while
(setq en (nth cnt dupdims))
(setq entl (entget en))

(command "_chprop" en "" "_P" "_COLOR" "5" "")
(command "_draworder" en "" "_F" )
(command "_scale" en "" (cdr (assoc 11 entl)) 1.1 "")
(setq cnt (1+ cnt)))
)
(alert "Дубликатов не найдено.")
)
(setvar "cmdecho" 1)
(setvar "osmode" osm)
(command "_undo" "_end")

(princ)
)
(defun CDUP()(CELDUPDIMS)(princ))
(CDUP);; автозапуск