• Иван
  • Восстановленный участник
  • На форуме с 12 марта 2007г.
  • Сообщений: 20
  • Спасибо: 0

Тема: Как подсчитать количество одинаковых текст. строк?

Здраствуйте, кто нибудь встречал программку подсчитывающую количество одинаковых текстовых строк ?
Дайте ссылочку пожалуйста, заранее благодарен.

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 26

Re: Как подсчитать количество одинаковых текст. строк?

How to find duplicate text string ?
Диалоговая функция подсчёта вхождений текстовых символов в файле чертежа

  • На форуме с 12 октября 2005г.
  • Сообщений: 374
  • Спасибо: 11

Re: Как подсчитать количество одинаковых текст. строк?

Использую такой макрос:
^C^C^P(defun C:tmp_Den ()(sssetfirst nil (ssget (list (assoc 1 (entget (car (entsel "Выберите текст - образец")))))))(princ))(princ);tmp_Den
Первый выбор - текст образец
Дальнейший выбор - зона поиска, количество отображается в командной строке
Правый клик - подсветка всех текстов с заданным содержанием и далее в свойствах можно менять, например, цвет, слой, содержание

  • Иван
  • Восстановленный участник
  • На форуме с 12 марта 2007г.
  • Сообщений: 20
  • Спасибо: 0

Re: Как подсчитать количество одинаковых текст. строк?

Спасибо Денис ты гений!!

  • Иван
  • Восстановленный участник
  • На форуме с 12 марта 2007г.
  • Сообщений: 20
  • Спасибо: 0

Re: Как подсчитать количество одинаковых текст. строк?

Хорошо бы увидеть такую прогу, выделил тексты-нажал кнопку, а прога тебе список заголовков с количеством однотипных! Но пока сойдет и такая. Спасибо всем.

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 26

Re: Как подсчитать количество одинаковых текст. строк?

> Иван
Ты ссылки глядел? В частности вот эту How to find duplicate text string ?
Прога оттуда

;;Tony Tanzillo
;;http://discussion.autodesk.com/thread.jspa?threadID=582410
;; Given the list (1 2 1 1 3 2 5 3 4 5 3),
;;
;; (combine (1 2 1 1 3 2 5 3 4 5 3) '> '= )
;;
;; returns ((1 1 1) (2 2) (3 3 3) (4) (5 5))
;;
;; The input list does not need to be atoms,
(defun combine (inlist is-greater is-equal / sorted current result)
  (setq sorted (sort inlist is-greater))
  (setq current (list (car sorted)))
  (foreach item (cdr sorted)
    (if (apply is-equal (list item (car current)))
      (setq current (cons item current))
      (progn
        (setq result (cons current result))
        (setq current (list item))
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach
  (cons current result)
) ;_ end of defun
;; can be used for list of most kinds of atoms:
(defun atomic-combine (lst)
  (combine lst '> 'eq)
) ;_ end of defun
(defun sort (lst predicate)
  (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
) ;_ end of defun
;; simplified example for TEXT only (no MTEXT)
(defun REPORT-DUPLICATE-TEXT (/ ss items i e)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq items
               (cons
                 (cons
                   e
                   (strcase (vl-string-trim " " (cdr (assoc 1 (entget e)))))
                 ) ;_ end of cons
                 items
               ) ;_ end of cons
        ) ;_ end of setq
      ) ;_ end of repeat
      (setq items
             (combine items
                      '(lambda (a b)
                         (> (cdr a) (cdr b))
                       ) ;_ end of lambda
                      '(lambda (a b)
                         (eq (cdr a) (cdr b))
                       ) ;_ end of lambda
             ) ;_ end of combine
      ) ;_ end of setq
      (textscr)
      (princ "\n\n")
      (foreach item items
        (if (> (length item) 1)
          (princ
            (strcat
              "\nЗначение: "
              (cdar item)
              " - количество="
              (itoa (length item))
            ) ;_ end of strcat
          ) ;_ end of princ
        ) ;_ end of if
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(defun C:RDT () (REPORT-DUPLICATE-TEXT))
(princ "\nНаберите RDT в командной строке")

  • Иван
  • Восстановленный участник
  • На форуме с 12 марта 2007г.
  • Сообщений: 20
  • Спасибо: 0

Re: Как подсчитать количество одинаковых текст. строк?

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

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 26

Re: Как подсчитать количество одинаковых текст. строк?

> Иван

;;Tony Tanzillo
;;http://discussion.autodesk.com/thread.jspa?threadID=582410
;;Edited by VVA
;;https://www.caduser.ru/forum/topic36426.html
;; Given the list (1 2 1 1 3 2 5 3 4 5 3),
;;
;; (combine (1 2 1 1 3 2 5 3 4 5 3) '> '= )
;;
;; returns ((1 1 1) (2 2) (3 3 3) (4) (5 5))
;;
;; The input list does not need to be atoms,
(defun C:RDT ( / combine sort REPORT-DUPLICATE-TEXT)
(defun combine (inlist is-greater is-equal / sorted current result)
  (setq sorted (sort inlist is-greater))
  (setq current (list (car sorted)))
  (foreach item (cdr sorted)
    (if (apply is-equal (list item (car current)))
      (setq current (cons item current))
      (progn
        (setq result (cons current result))
        (setq current (list item))
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach
  (cons current result)
) ;_ end of defun
(defun sort (lst predicate)
  (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
) ;_ end of defun
;; simplified example for TEXT only (no MTEXT)
(defun REPORT-DUPLICATE-TEXT (/ ss items i e)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq items
               (cons
                 (cons
                   e
                   (strcase (vl-string-trim " " (cdr (assoc 1 (entget e)))))
                 ) ;_ end of cons
                 items
               ) ;_ end of cons
        ) ;_ end of setq
      ) ;_ end of repeat
      (setq items
             (combine items
                      '(lambda (a b)
                         (> (cdr a) (cdr b))
                       ) ;_ end of lambda
                      '(lambda (a b)
                         (eq (cdr a) (cdr b))
                       ) ;_ end of lambda
             ) ;_ end of combine
      ) ;_ end of setq
      (textscr)
      (princ "\n\n")
      (foreach item items
          (princ
            (strcat
              "\nЗначение: "
              (cdar item)
              " — количество="
              (itoa (length item))
            ) ;_ end of strcat
          ) ;_ end of princ
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
 (REPORT-DUPLICATE-TEXT)
)
(princ "\nНаберите RDT в командной строке")

  • Иван
  • Восстановленный участник
  • На форуме с 12 марта 2007г.
  • Сообщений: 20
  • Спасибо: 0

Re: Как подсчитать количество одинаковых текст. строк?

Еще раз спасибо теперь спецификации как семечки ....

  • VVA
  • Активный участник
  • Откуда: Беларусь / Минск
  • На форуме с 29 марта 2006г.
  • Сообщений: 1,859
  • Спасибо: 26

Re: Как подсчитать количество одинаковых текст. строк?

> Иван
Еще вариант. Делает то же самое + результат копирует в clipboard. Открываешь Word/Excel и жмешь вставить

;;Tony Tanzillo
;;http://discussion.autodesk.com/thread.jspa?threadID=582410
;;Edited by VVA
;;https://www.caduser.ru/forum/topic36426.html
;; Given the list (1 2 1 1 3 2 5 3 4 5 3),
;;
;; (combine (1 2 1 1 3 2 5 3 4 5 3) '> '= )
;;
;; returns ((1 1 1) (2 2) (3 3 3) (4) (5 5))
;;
;; The input list does not need to be atoms,
(defun C:RDT ( / combine sort REPORT-DUPLICATE-TEXT)
(defun copyToclipboard ( str / ieobj)
  (setq ieobj (vlax-get-or-create-object
                      "InternetExplorer.Application"
                      )
             )
 (vlax-invoke ieobj 'navigate2 "about:blank")
 (vlax-invoke
(vlax-get (vlax-get (vlax-get ieobj 'document) 'parentwindow)
'clipboarddata
)
'setdata
"text"
str
)
(vlax-release-object ieobj)
  )
(defun combine (inlist is-greater is-equal / sorted current result)
  (setq sorted (sort inlist is-greater))
  (setq current (list (car sorted)))
  (foreach item (cdr sorted)
    (if (apply is-equal (list item (car current)))
      (setq current (cons item current))
      (progn
        (setq result (cons current result))
        (setq current (list item))
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of foreach
  (cons current result)
) ;_ end of defun
(defun sort (lst predicate)
  (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst predicate))
) ;_ end of defun
;; simplified example for TEXT only (no MTEXT)
(defun REPORT-DUPLICATE-TEXT (/ ss items i e)
  (if (setq ss (ssget '((0 . "TEXT"))))
    (progn
      (repeat (setq i (sslength ss))
        (setq e (ssname ss (setq i (1- i))))
        (setq items
               (cons
                 (cons
                   e
                   (strcase (vl-string-trim " " (cdr (assoc 1 (entget e)))))
                 ) ;_ end of cons
                 items
               ) ;_ end of cons
        ) ;_ end of setq
      ) ;_ end of repeat
      (setq items
             (combine items
                      '(lambda (a b)
                         (> (cdr a) (cdr b))
                       ) ;_ end of lambda
                      '(lambda (a b)
                         (eq (cdr a) (cdr b))
                       ) ;_ end of lambda
             ) ;_ end of combine
      ) ;_ end of setq
      (textscr)
      (princ "\n\n")
      (setq e (mapcar '(lambda(item)(strcat "\nЗначение: " (cdar item) " — количество=" (itoa (length item)))) items))
      (mapcar 'princ e)        
      (setq e (apply 'strcat e))
      (copyToclipboard e)
      (princ "\nСкопирвоано в clipboard")
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(vl-load-com)
 (REPORT-DUPLICATE-TEXT)
)
(princ "\nНаберите RDT в командной строке")
Спасибо сказали: Ln_Ing1