Подсчет количества блоков

Подсчет количества блоков · 17.07.2008, 12:16

Знаю что таких тем уже хватает, но изучив их, то что нужно найти не смог. Нашел по ссылке в этой теме лисп:

Код:

(defun c:bcount (/ curEnt dxfList blName Count)
  (if
  (setq curEnt(entsel "*** Select sample block "))
  (progn
   (setq dxfList(entget(car curEnt)))
  (terpri)
  (if(= "INSERT"(cdr(assoc 0 dxfList)))
    (progn
    (setq blName(cdr(assoc 2 dxfList))
          Count(sslength(ssget "_X"
    (list(assoc 2 dxfList))))
    ); end setq
    (princ(strcat "*** Block name: " blName
      "\n*** Blocks in drawing: "(itoa Count)))
    );end progn
    (princ "\n*** This don't block!\n ")
    ); end if
  ); end progn
  (princ "\n*** Nothing selected!\n ")
  ); end if
  (princ)
  ); end bstat

Может кто-нить подкорректировать его так, чтобы при тыканьи в блок не только подсчитывалось количество блоков данного типа, но и еще они бы выделялись. Буду очень признателен

Елпанов Евгений · 17.07.2008, 12:37

Код:

[Выделить все]

(defun c:bcount (/ a b)
 (print "*** Select sample block ")
 (if (setq a (ssget "_+.:S" '((0 . "INSERT"))))
  (progn (sssetfirst
          nil
          (setq
           b (ssget "_x"
                    (list (setq a (assoc 2 (entget (cadar (ssnamex a))))))
             ) ;_  ssget
          ) ;_  setq
         ) ;_  sssetfirst
         (princ (strcat "*** Block name: \""
                        (cdr a)
                        "\"\n*** Blocks in drawing: "
                        (itoa (sslength b))
                ) ;_  strcat
         ) ;_  princ
  ) ;_  progn
 ) ;_  if
 (princ)
)

Кулик Алексей aka kpblc · 17.07.2008, 12:52

Оба лиспа не совсем правильно будут обрабатывать дин.блоки - там методика получения имени другая.

Елпанов Евгений · 17.07.2008, 13:00

Цитата:

Сообщение от Кулик Алексей aka kpblc

Оба лиспа не совсем правильно будут обрабатывать дин.блоки - там методика получения имени другая.

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

Кулик Алексей aka kpblc · 17.07.2008, 13:09

Вариант не гонял вообще:<...> Код удален как нерабочий
P.S. Не обрабатывает вложенные блоки; исключает внешние ссылки; должна проверять дин.блоки независимо от их состояния. Работает только в том пространстве (модели / листа), в котором лежит "тыкнутый" объект.

Seryj_Wolk · 17.07.2008, 13:28

Благодарю всех кто отозвался.
2 Елпанов Евгений: именно то что нужно, еще раз блогадарю
2 Кулик Алексей aka kpblc: У меня в основном простые блоки, не динамические и лисп поэтому простенький. А вот твой чего то у меня не работает или он только для динамических?

Кулик Алексей aka kpblc · 17.07.2008, 13:36

Seryj_Wolk, прошу прощения, исправил код.

Seryj_Wolk · 17.07.2008, 13:40

2 Елпанов Евгений
Можешь еще подправить чтобы результат выводился немного в другом виде.
Сейчас выводится так:
Блок: "Штепсельная розетка двухполюсная с защитным контактом скрытой установки"
Всего блоков: 29
А хотелось бы так:
Штепсельная розетка двухполюсная с защитным контактом скрытой установки: 29

Seryj_Wolk · 17.07.2008, 13:42

Цитата:

Сообщение от Кулик Алексей aka kpblc

Seryj_Wolk, прошу прощения, исправил код.

Тоже самое.
Вот что пишет.
Команда: bcount-by-pick
Укажите блок <Отмена> : ; ошибка: слишком мало фактических параметров
Команда:

Кулик Алексей aka kpblc · 17.07.2008, 13:53

Тот код снес. Исправленный вариант:

Код:

[Выделить все]

(defun c:bcount-by-pick (/ ent selset name fun_get-name def)

  (defun fun_get-name (ent)
    (cond
      ((vlax-property-available-p ent 'effectivename)
       (vla-get-effectivename ent)
       )
      ((vlax-property-available-p ent 'name) (vla-get-name ent))
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)
  (if
    (and
      (= (type (setq
                 ent (vl-catch-all-apply
                       '(lambda () (car (entsel "\nУкажите блок <Отмена> : ")))
                       ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of type
         'ename
         ) ;_ end of =
      (= (cdr (assoc 0 (entget ent))) "INSERT")
      (setq ent (vlax-ename->vla-object ent))
      (setq
        def
         (vla-item
           (vla-get-blocks
             (vla-get-activedocument (vlax-get-acad-object))
             ) ;_ end of vla-get-blocks
           (fun_get-name ent)
           ) ;_ end of vla-item
        ) ;_ end of setq
      (setq name (fun_get-name ent))
      (equal (vla-get-isxref def) :vlax-false)
      ) ;_ end of and
     (progn
       (setq selset (ssadd))
       (vlax-for sub (vla-objectidtoobject
                       (vla-get-activedocument (vlax-get-acad-object))
                       (vla-get-ownerid ent)
                       ) ;_ end of vla-ObjectIDToObject
         (if (= (strcase (fun_get-name sub)) (strcase name))
           (setq selset (ssadd (vlax-vla-object->ename sub) selset))
           ) ;_ end of if
         ) ;_ end of vlax-for
       (if selset
         (progn
           (princ (strcat "\nНормальное имя блока : "
                          (fun_get-name ent)
                          "\nКоличество блоков в текущем пространстве : "
                          (vl-princ-to-string (sslength selset))
                          ) ;_ end of strcat
                  ) ;_ end of princ
           (sssetfirst selset selset)
           ) ;_ end of progn
         ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
  (princ)
  ) ;_ end of defun

Seryj_Wolk · 17.07.2008, 13:56

А ты их сам не проверяешь чтоли?
Команда: bcount-by-pick
Укажите блок <Отмена> : ; ошибка: неверный тип аргумента: stringp nil
Команда:

VVA · 17.07.2008, 13:58

Есть еще тема подсчет динамических блоков (простые считаются тоже)

Кулик Алексей aka kpblc · 17.07.2008, 13:59

Seryj_Wolk, последний код я прогнал раз 20, наверное - считал все что надо и выделял. AutoCAD 2006 Eng + SP1 (из состава ADT 2006).

Seryj_Wolk · 17.07.2008, 14:20

У меня тоже 2006, но видишь какой результат...

Кулик Алексей aka kpblc · 17.07.2008, 14:26

Все, ясно. Я, блин, добрая душа, проверял только на файлах, где были только блоки. Поэтому там все работало. Такой вариант прогони.

Код:

[Выделить все]

(defun c:bcount-by-pick (/ ent selset name fun_get-name def)

  (defun fun_get-name (ent)
    (cond
      ((vlax-property-available-p ent 'effectivename)
       (vla-get-effectivename ent)
       )
      ((vlax-property-available-p ent 'name) (vla-get-name ent))
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (vl-load-com)
  (if
    (and
      (= (type (setq
                 ent (vl-catch-all-apply
                       '(lambda () (car (entsel "\nУкажите блок <Отмена> : ")))
                       ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of type
         'ename
         ) ;_ end of =
      (= (cdr (assoc 0 (entget ent))) "INSERT")
      (setq ent (vlax-ename->vla-object ent))
      (setq
        def
         (vla-item
           (vla-get-blocks
             (vla-get-activedocument (vlax-get-acad-object))
             ) ;_ end of vla-get-blocks
           (fun_get-name ent)
           ) ;_ end of vla-item
        ) ;_ end of setq
      (setq name (fun_get-name ent))
      (equal (vla-get-isxref def) :vlax-false)
      ) ;_ end of and
     (progn
       (setq selset (ssadd))
       (vlax-for sub (vla-objectidtoobject
                       (vla-get-activedocument (vlax-get-acad-object))
                       (vla-get-ownerid ent)
                       ) ;_ end of vla-ObjectIDToObject
         (if (and (fun_get-name sub)
                  (= (strcase (fun_get-name sub)) (strcase name))
                  ) ;_ end of and
           (setq selset (ssadd (vlax-vla-object->ename sub) selset))
           ) ;_ end of if
         ) ;_ end of vlax-for
       (if selset
         (progn
           (princ (strcat "\nНормальное имя блока : "
                          (fun_get-name ent)
                          "\nКоличество блоков в текущем пространстве : "
                          (vl-princ-to-string (sslength selset))
                          ) ;_ end of strcat
                  ) ;_ end of princ
           (sssetfirst selset selset)
           ) ;_ end of progn
         ) ;_ end of if
       ) ;_ end of progn
     ) ;_ end of if
  (princ)
  ) ;_ end of defun

Aragorn · 17.07.2008, 14:34

Частая ошибка при подсчете блоков - это подсчет дублирующихся блоков (2 или больше блоков в одной или близкой точке, которые визуально не отличишь). Вроде комманда overkill долэна с этим справляться, но иногда не получается. Поэтому я бы в лисп добавил проверку на дублирование блоков в одной точке и их удаление.

Кулик Алексей aka kpblc · 17.07.2008, 14:39

С какой точностью сравнивать?
P.S. И что делать с дубликатами? И проверять атрибуты или нет? А слои, которым принадлежат блоки? А если блоки сделаны "не по слою 0, остальные настройки не ByBlock"?

Seryj_Wolk · 17.07.2008, 14:45

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

)он работает медленнее, секунду-две где-то думает, а так все отлично.
А этот лисп будет считать любые блоки?

Кулик Алексей aka kpblc · 17.07.2008, 14:53

Любые. Тормоза обусловлены лишним контролем. Код можно ускорить. Евгений мне в личке уже на массу лишнего указал.

Елпанов Евгений · 17.07.2008, 15:16

пример моей программы, с обработкой дин блоков...
Код вычисления имени, позаимствовал из кода Алексея
(с меня

при встрече)

Код:

[Выделить все]

(defun c:bcount (/ a b)
 (print "*** Select sample block ")
 (if (setq a (ssget "_+.:S" '((0 . "INSERT"))))
  (progn (sssetfirst
          nil
          (setq b
                (ssget
                 "_x"
                 (list
                  (cons 2
                        (setq
                         a (cond
                            ((vlax-property-available-p
                              (setq a (vlax-ename->vla-object (ssname a 0)))
                              'effectivename
                             ) ;_  vlax-property-available-p
                             (vla-get-effectivename a)
                            )
                            ((vlax-property-available-p a 'name) (vla-get-name a))
                            (t nil)
                           ) ;_  cond
                        ) ;_  setq
                  ) ;_  cons
                 ) ;_  list
                ) ;_  ssget
          ) ;_  setq
         ) ;_  sssetfirst
         (princ (strcat "*** Block name: \""
                        a
                        "\"\n*** Blocks in drawing: "
                        (itoa (sslength b))
                ) ;_  strcat
         ) ;_  princ
  ) ;_  progn
 ) ;_  if
 (princ)
)

Seryj_Wolk · 17.07.2008, 15:23

Елпанов Евгений, работает шустро, но как и в предыдущей версии есть косяк.
Если выбран какой то элемент то команда не работает. И если не сбросить выделения после использования команды, то опять же лисп перестает работать. До тех пор пока не выберешь какой-либо элемент и не сбросишь с него выделение или не используешь какую-либо другую команду. Вот, как смог, объяснил..

Елпанов Евгений · 17.07.2008, 15:26

Цитата:

Сообщение от Seryj_Wolk

Елпанов Евгений, работает шустро, но как и в предыдущей версии есть косяк.
Если выбран какой то элемент то команда не работает. И если не сбросить выделения после использования команды, то опять же лисп перестает работать. До тех пор пока не выберешь какой-либо элемент и не сбросишь с него выделение или не используешь какую-либо другую команду. Вот, как смог, объяснил..

пожалуйста, убрал выделение, а заодно лишнюю переменную...

Код:

[Выделить все]

(defun c:bcount (/ a)
 (sssetfirst nil)
 (print "*** Select sample block ")
 (if (setq a (ssget "_+.:S" '((0 . "INSERT"))))
  (princ (strcat (itoa (sslength (cadr (sssetfirst
                                        nil
                                        (ssget "_x"
                                               (list (cons 2
                                                           (setq a
                                                                 (cond
                                                                  ((vlax-property-available-p
                                                                    (setq a (vlax-ename->vla-object (ssname a 0)))
                                                                    'effectivename
                                                                   ) ;_  vlax-property-available-p
                                                                   (vla-get-effectivename a)
                                                                  )
                                                                  ((vlax-property-available-p a 'name) (vla-get-name a))
                                                                  (t nil)
                                                                 ) ;_  cond
                                                           ) ;_  setq
                                                     ) ;_  cons
                                               ) ;_  list
                                        ) ;_  ssget
                                       ) ;_  sssetfirst
                                 ) ;_  cadr
                       ) ;_  sslength
                 ) ;_  itoa
                 " : "
                 a
         ) ;_  strcat
  ) ;_  princ
 ) ;_  if
 (princ)
)

Seryj_Wolk · 17.07.2008, 15:38

Елпанов Евгений
вот теперь все отлично.
Только результат немного криво выводиться
2 : Ящик с понижающим трансформатором
Переделай пожалуйста чтобы было так
Ящик с понижающим трансформатором: 2

Елпанов Евгений · 17.07.2008, 15:41

Цитата:

Сообщение от Seryj_Wolk

Елпанов Евгений
вот теперь все отлично.
Только результат немного криво выводиться
2 : Ящик с понижающим трансформатором
Переделай пожалуйста чтобы было так
Ящик с понижающим трансформатором: 2

не, переделывать не буду, даже добавлю, код не работает на динамических блоках

Seryj_Wolk · 17.07.2008, 16:14

Цитата:

Сообщение от Елпанов Евгений

не, переделывать не буду, даже добавлю, код не работает на динамических блоках

жаль, хороший лисп был...

Елпанов Евгений · 17.07.2008, 16:27

Цитата:

Сообщение от Seryj_Wolk

жаль, хороший лисп был...

тестируй...

Код:

[Выделить все]

(defun c:bcount (/ A S)
 (sssetfirst nil)
 (print "*** Select sample block ")
 (if (setq s (ssget "_+.:S" '((0 . "INSERT"))))
  (progn
   (cond
    ((vlax-property-available-p
      (setq a (vlax-ename->vla-object (ssname s 0)))
      'effectivename
     )
     (princ
      (strcat
       "\""
       (setq a (vla-get-effectivename a))
       "\" : "
       (itoa
        (sslength
         (cadr
          (sssetfirst
           nil
           (foreach x
                    (vl-remove-if-not
                     '(lambda (x)
                       (and
                        (vlax-property-available-p x 'effectivename)
                        (= (vla-get-effectivename x) a)
                       ) ;_  and
                      ) ;_  lambda
                     (mapcar
                      'vlax-ename->vla-object
                      (mapcar 'cadr
                              (ssnamex (ssget "_x" '((0 . "INSERT"))))
                      ) ;_  mapcar
                     ) ;_  mapcar
                    ) ;_  vl-remove-if-not
            (ssadd (vlax-vla-object->ename x) s)
           ) ;_  foreach
          ) ;_  sssetfirst
         ) ;_  cadr
        ) ;_  sslength
       ) ;_  itoa
      ) ;_  strcat
     ) ;_  princ
    )
    ((vlax-property-available-p a 'name)
     (princ
      (strcat
       (vla-get-name a)
       " : "
       (itoa
        (sslength (cadr (sssetfirst
                         nil
                         (ssget "_x" (list (cons 2 (vla-get-name a))))
                        ) ;_  sssetfirst
                  ) ;_  cadr
        ) ;_  sslength
       ) ;_  itoa
      ) ;_  strcat
     ) ;_  princ
    )
    (t nil)
   ) ;_  cond
  ) ;_  progn
 ) ;_  if
 (princ)
)

Seryj_Wolk · 17.07.2008, 16:43

В принципе все работает, но скорость потерялась.

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

Rainbow.dgw · 12.01.2012, 11:26

Очень полезная программа, жалко только, что динамические блоки разных размеров не разделяет.(((

VVA · 12.01.2012, 12:37

Цитата:

Сообщение от Rainbow.dgw

жалко только, что динамические блоки разных размеров не разделяет.(((

Это видел?
как выбрать динамические блоки по состоянию видимости?
Подсчет простых и динамических блоков
подсчет динамических блоков

17.07.2008, 12:16		#1
Подсчет количества блоков Seryj_Wolk Инженер-электрик Псков Регистрация: 04.03.2008 Сообщений: 59 Знаю что таких тем уже хватает, но изучив их, то что нужно найти не смог. Нашел по ссылке в этой теме лисп: Код: [Выделить все] (defun c:bcount (/ curEnt dxfList blName Count) (if (setq curEnt(entsel "* Select sample block ")) (progn (setq dxfList(entget(car curEnt))) (terpri) (if(= "INSERT"(cdr(assoc 0 dxfList))) (progn (setq blName(cdr(assoc 2 dxfList)) Count(sslength(ssget "_X" (list(assoc 2 dxfList)))) ); end setq (princ(strcat "* Block name: " blName "\n* Blocks in drawing: "(itoa Count))) );end progn (princ "\n* This don't block!\n ") ); end if ); end progn (princ "\n*** Nothing selected!\n ") ); end if (princ) ); end bstat Может кто-нить подкорректировать его так, чтобы при тыканьи в блок не только подсчитывалось количество блоков данного типа, но и еще они бы выделялись. Буду очень признателен
Просмотров: 12407

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Подсчет блоков в AutoCad2006	Natan	AutoCAD	44	02.10.2019 12:32
подсчет динамических блоков	AAI	Программирование	37	25.06.2012 15:05
Изменить параметры у всех объектов внутри блоков	800x600	AutoCAD	5	25.03.2008 14:21
Подсчет количества блоков	juri	AutoCAD	9	10.10.2004 20:06

	Реклама i