подсчет динамических блоков

подсчет динамических блоков · 06.02.2008, 12:38

Всем привет!
Помогите пожалуйста найти решение на такую проблему - в динамическом блоке создано несколько visibility states. Необходимо подсчитать на плане количество блоков с каждым типом отображения.
Пользовался поиском - смог найти только как считатется общее количество динамических блоков.

Кулик Алексей aka kpblc · 06.02.2008, 12:58

http://www.google.ru/search?q=site:d...L_ruRU250RU250

VVA · 06.02.2008, 13:20

Здесь есть фукции для чтения/установки значений динамических блоков
Сквозная нумерация динамических блоков

wetr · 07.02.2008, 07:28

Цитата:

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

bcount галимый. Как и все укоманды экспресс тулза он не знает про дин. блоки и тупо игнорирует их, потому что они физически реализованы как анонимные, т.е. начинающиеся со "*". Так что галимая командочка.

_dataextraction
ИМХО

VVA · 07.02.2008, 10:51

Адаптировал blockcount для подсчета свойств динамических блоков
Это ФУНКЦИЯ. Вызывать
(blockcount nil) - Считать блоки по именам
(blockcount "Видимость") - Считать блоки по именам, а если в динамичсеском блоке есть метка свойства "Видимисть", то группировать по этому значению

Код:

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

;;Возвращает список всех свойст динамического блока в виде списка
;((Имя_свойства Текущее_значение Vla_объект_свойства)...)
;; obj - Vla-указатель дин блока (vla-object)
;;Пример
;;(GetDynamicBlockPropertyList (vlax-ename->vla-object(car(entsel "\nВыбeри дин блок:"))))
;;(("Видимость" "Канализация" #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15246fe4>)
;;   ("Угол" 0.115395 #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15240fe4>) ...)
(defun GetDynamicBlockPropertyList (obj / lstProperties)
 (if (and (vlax-property-available-p obj "IsDynamicBlock")
          (= (vla-get-IsDynamicBlock obj) :vlax-true)
          (setq lstProperties (vlax-safearray->list 
                                           (variant-value 
                                            (vla-GetDynamicBlockProperties obj)))))
  (progn
   (mapcar '(lambda (x)(list (vla-get-propertyname X)
                             (variant-value (vla-get-value X))
                             x
                             )) 
           lstProperties))))
;; obj - Vla-указатель дин блока (vla-object)
;; PropertyName - имя свойства (string)
(defun GetDynamicBlockPropertyNameValue ( obj PropertyName / Plist)
  (and
  (setq PropertyName (strcase PropertyName))
  (setq Plist (GetDynamicBlockPropertyList obj))
  (setq Plist (car(vl-remove-if-not '(lambda (x)
                                   (= (strcase (car x)) PropertyName))
                Plist
                ))
        )
  )
   (cadr Plist)
)
(defun mip-conv-to-str (dat) 
  (cond ((= (type dat) 'INT)(setq dat (itoa dat))) 
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12))) 
        ((null dat)(setq dat "")) 
        (t (setq dat (vl-princ-to-string dat)))))
;;;Подсчет динамических блоков по имени и значению динамического свойства
;;;DynPropetyName - метка свойства (видимость и т.п.), строка или nil - считать по именам блоков
;;;Пример вызова:
;;; (blockcount nil)
;;; (blockcount "Видимость")
(defun blockcount (DynPropetyName / adoc selset res name dynProp lst)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (setq selset (ssget '((0 . "INSERT"))))
    (progn
      (foreach blk
        (mapcar
   'vlax-ename->vla-object
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
        ) ;_ end of mapcar 
 (setq
   name (cond
   ((and (vlax-property-available-p blk 'isdynamicblock)
         (= (vla-get-isdynamicblock blk) :vlax-true)
    ) ;_ end of and
    (if (= (type DynPropetyName) 'STR)
      (setq DynProp (GetDynamicBlockPropertyNameValue
        blk
        DynPropetyName
      )
      )
      (setq DynProp "дин. блок")
    )
    (vla-get-effectivename blk)
   )
   (t (setq DynProp "обычный блок") (vla-get-name blk))
        ) ;_ end of cond 
 ) ;_ end of setq
 (setq name (strcat name "|" (mip-conv-to-str DynProp)))
 (if (member name (mapcar 'car res))
   (setq res (subst (cons name (1+ (cdr (assoc name res))))
      (assoc name res)
      res
      ) ;_ end of subst 
   ) ;_ end of setq 
   (setq res (append res (list (cons name 1))))
 ) ;_ end of if 
      ) ;_ end of foreach 
      (setq RR res)
      (setq
 name (mapcar '(lambda (x / p1 txt)
   (list
     (setq p1 (substr (setq txt (car x))
        1
        (vl-string-position 124 txt)
       )
     )
     (substr (VL-STRING-LEFT-TRIM p1 txt) 2)
     (itoa (cdr x))
   )
        )
       res
      )
      )
      (setq name (cons (list "Имя" "Значение" "Количество") name))
      (setq lst (mapcar '(lambda (a) (apply 'max (mapcar 'strlen a)))
   (apply 'mapcar (cons 'list name))
  )
      )
      (setq name (mapcar '(lambda (zz)
       (mapcar '(lambda (txt cnt)
           (setq cnt (+ cnt 3))
           (while (< (strlen txt) cnt)
      (setq txt (strcat txt " "))
           )
         )
        zz
        lst
       )
     )
    name
   )
      )
      (foreach item name
 (terpri)
 (mapcar 'princ item)
      ) ;_ end of foreach 
      (terpri)
      (princ)
    ) ;_ end of progn 
  ) ;_ end of if 
) ;_ end of defun

Пример
Для приведенно ниже файла вызывать
(blockcount "ТипКолодца")
Результат

Цитата:

Имя Значение Количество
Блок обычный блок 4
MIP_WELL_DYN_P Демонтаж 7
MIP_WELL_DYN_P РЗС 6
MIP_WELL_DYN_P Пожарный гидрант 5
MIP_WELL_DYN_P Колодец 4

(blockcount nil)
Результат

Цитата:

Имя Значение Количество
Блок обычный блок 4
MIP_WELL_DYN_P дин. блок 22

AAI · 08.02.2008, 12:29

Всем спасибо, особенно VVA.
То что и нужно было

Ander822 · 08.02.2008, 12:51

Я лично пользуюсь _eattext - извлечение атрибутов
Начиная с AutoCAD 2006
В итоге имеем файлик в екселе:
Имя Свойство1 Свойство2 ... Количество

Свойство - значение какого-либо атрибута, динамического свойсва, любого свойство блока (слой, координаты, цвет...) Есть возможность выбирать, какие именно свойства учитывать.

Kostinok · 15.02.2008, 12:34

Действительно отличная программа, то что нужно!!!

Kostinok · 20.03.2008, 09:51

VVA, а можно ли, что бы конечный результат выводился на чертеж, таблицей, и еще что бы шла проверка блоков на "безграмотность", т.е. отссеивались все блоки с подобными названиями A$C613A5AE4 ?

VVA · 20.03.2008, 14:34

Следующая редакция blockcount для подсчета свойств динамических блоков
Это по прежнему ФУНКЦИЯ. Добавился параметр игнорирования имен блоков, если нужно подсчитать с несколькими параметрами, то свойства нужно передавать ввиде списка строк
Вызывать

(blockcount nil nil) - Считать блоки по именам
(blockcount "Видимость" nil) - Считать блоки по именам, а если в динамическом блоке есть метка свойства "Видимисть", то группировать по этому значению
(blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*,#*") - Игнорировать блоки, начинающиеся с A$C и с цифры, группировать по меткам свойств "Марка балки" "Обозначение" "Профиль"
(blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*") - Игнорировать блоки, начинающиеся с A$C, группировать по меткам свойств "Марка балки" "Обозначение" "Профиль"

Код:

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

;;; подсчет динамических блоков
;;;Опубликовано  http://dwg.ru/f/showthread.php?t=17333
;;Возвращает список всех свойст динамического блока в виде списка
;((Имя_свойства Текущее_значение Vla_объект_свойства)...)

(defun GetDynamicBlockPropertyList (obj / lstProperties tmp)
;;; obj - vla-object  
;;; Returns a list of all the properties of a dynamic block in a list
;;; ((Property_name current_value Vla_object_of_properties )...)  
  
;;Возвращает список всех свойст динамического блока в виде списка 
;((Имя_свойства Текущее_значение Vla_объект_свойства)...) 
;; obj - Vla-указатель дин блока (vla-object) 
;;Пример 
;;(GetDynamicBlockPropertyList (vlax-ename->vla-object(car(entsel "\nВыбeри дин блок:")))) 
;;(("Видимость" "Канализация" #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15246fe4>) 
;;   ("Угол" 0.115395 #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15240fe4>) ...) 
  
(if (and (vlax-property-available-p obj "IsDynamicBlock") 
          (= (vla-get-IsDynamicBlock obj) :vlax-true)
         (setq tmp (vlax-variant-value (vla-GetDynamicBlockProperties obj)))
         (>= (vlax-safearray-get-u-bound tmp 1) 0)
          (setq lstProperties (vlax-safearray->list tmp))
         )
  (progn 
   (mapcar '(lambda (x)(list (vla-get-propertyname X) 
                             (vlax-variant-value (vla-get-value X)) 
                             x 
                             )) 
           lstProperties))))
;; obj - Vla-указатель дин блока (vla-object)
;; PropertyName - имя свойства (string)
(defun GetDynamicBlockPropertyNameValue ( obj PropertyName / Plist)
  (and
  (setq PropertyName (strcase PropertyName))
  (setq Plist (GetDynamicBlockPropertyList obj))
  (setq Plist (car(vl-remove-if-not '(lambda (x)
                                   (= (strcase (car x)) PropertyName))
                Plist
                ))
        )
  )
   (cadr Plist)
)
(defun mip-conv-to-str (dat) 
  (cond ((= (type dat) 'INT)(setq dat (itoa dat))) 
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12))) 
        ((null dat)(setq dat "")) 
        (t (setq dat (vl-princ-to-string dat)))))
;;;Подсчет динамических блоков по имени и значению динамического свойства
;;; http://dwg.ru/f/showthread.php?t=17333
;;;DynPropetyName - метка свойства (видимость и т.п.), строка - "Видимость"
;;;             или nil - считать по именам блоков
;;;             или список строк, если свойств несколько  - ("Марка балки" "Обозначение" "Профиль")
;;; IgnoreBlockNamePattern - строка, шаблон игнорируемых имен блоков или nil - все блоки
;;;                   Шаблон задается строкой, аналогично шаблону функции wcmatch
;;;                   Несколько шаблонов разделяются запятой
;;;                   Безразлична к регистру букв
;;;                   "A$C*,*НЕТ*,МАР*" - будут пропущены блоки с именами, начинающимися на A$C и МАР
;;;                   а тек же блоки, в имени которых есть сочетание НЕТ
;;;                  Шаблон для динамических блоков применяется к эффективному имени!!!
;;                   Примеры нескольких шаблонов
;;;                 "#* - исключить блоки, начинающиеся с цифры
;;;                 "#Бл* - исключить блоки, начинающиеся с цифры и следующие буквы которых БЛ (1Блок 2БЛОК и т.п.)
;;;                 "Формат" - исключить блок с именем формат
;;;                Возвращает список списков точечных пар, состоящих из
;;;                -  Имени блока и имени свойства, разделенных символом "|"
;;;                - количества
;;;                Пример
;;;               (("1Двутавр Широкополочный|25Ш1" . 2) ("Уголок равнополочный|50x5" . 3) ("Швеллер П|10П" . 1))
;; Или список нескольких свойств
;;;Пример вызова:
;;; (blockcount nil nil)
;;; (blockcount "Видимость" nil)
;;; (blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*,#*") ;_Игнорировать блоки, начинающиеся с A$C и цифры
;;; (blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*")  ;_Игнорировать блоки, начинающиеся с A$C
(defun blockcount (DynPropetyName IgnoreBlockNamePattern / adoc selset res name dynProp lst nameX)
  (vl-load-com)
  (setq IgnoreBlockNamePattern (strcase(mip-conv-to-str IgnoreBlockNamePattern)))
  (if (= (type DynPropetyName) 'STR)(setq DynPropetyName (list DynPropetyName)))
  (setq DynPropetyName (mapcar 'mip-conv-to-str DynPropetyName))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (setq selset (ssget '((0 . "INSERT"))))
    (progn
      (foreach blk
        (mapcar
   'vlax-ename->vla-object
   (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
        ) ;_ end of mapcar 
 (setq
   name (cond
   ((and (vlax-property-available-p blk 'isdynamicblock)
         (= (vla-get-isdynamicblock blk) :vlax-true)
    ) ;_ end of and
    (if (and DynPropetyName
             (listp DynPropetyName)
             )
      (setq DynProp (mapcar '(lambda (X)
             (GetDynamicBlockPropertyNameValue blk X)
                               )
                    DynPropetyName
                            )
      )
      (setq DynProp '("дин. блок"))
    )
    (vla-get-effectivename blk)
   )
   (t (setq DynProp '("обычный блок"))(vla-get-name blk))
        ) ;_ end of cond 
 ) ;_ end of setq
 (setq DynProp (vl-remove-if 'null DynProp))
 (if (not (wcmatch (strcase name) IgnoreBlockNamePattern))      
 (foreach DynP DynProp
   (setq nameX (strcat name "|" (mip-conv-to-str DynP)))
   (if (member nameX (mapcar 'car res))
     (setq res (subst (cons nameX (1+ (cdr (assoc nameX res))))
                      (assoc nameX res)
                      res
                      ) ;_ end of subst
           ) ;_ end of setq
     (setq res (append res (list (cons nameX 1))))
     ) ;_ end of if
   ) ;_ end of foreach DynP
   )
        ) ;_ end of foreach Blk
 
      (setq RR res)
      (setq
 name (mapcar '(lambda (x / p1 txt)
   (list
     (setq p1 (substr (setq txt (car x))
        1
        (vl-string-position 124 txt)
       )
     )
     (substr (VL-STRING-LEFT-TRIM p1 txt) 2)
     (itoa (cdr x))
   )
        )
       res
      )
      )
      (setq name (cons (list "Имя" "Значение" "Количество") name))
      (setq lst (mapcar '(lambda (a) (apply 'max (mapcar 'strlen a)))
   (apply 'mapcar (cons 'list name))
  )
      )
      (setq name (mapcar '(lambda (zz)
       (mapcar '(lambda (txt cnt)
           (setq cnt (+ cnt 3))
           (while (< (strlen txt) cnt)
      (setq txt (strcat txt " "))
           )
         )
        zz
        lst
       )
     )
    name
   )
      )
      (foreach item name
 (terpri)
 (mapcar 'princ item)
      ) ;_ end of foreach 
      (terpri)
      (princ)
    ) ;_ end of progn 
  ) ;_ end of if
(terpri)
  res
) ;_ end of defun

Пример. Для приведенного ниже файла вызвать
(blockcount nil nil)
Результат

Цитата:

Имя Значение Количество
A$C1342267E обычный блок 1
1Двутавр Широкополочный дин. блок 1
Уголок равнополочный дин. блок 3
Швеллер П дин. блок 3
трубы квадратные ГОСТ 30245-94 дин. блок 3
Двутавр Широкополочный дин. блок 3
Двутавр Балочный дин. блок 3

(blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*,#*")
Нет блоков с именем 1Двутавр Широкополочный и A$C1342267E

Цитата:

Имя Значение Количество
Уголок равнополочный 50x5 1
Швеллер П 10П 1
трубы квадратные ГОСТ 30245-94 100x100x6 1
Двутавр Широкополочный 25Ш1 1
Двутавр Балочный 18Б1 1
Уголок равнополочный 45x6 2
Швеллер П 20П 2
трубы квадратные ГОСТ 30245-94 180x180x7 2
Двутавр Широкополочный 20Ш1 2
Двутавр Балочный 20Б1 2

(blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*")
Нет блока с именем A$C1342267E

Цитата:

Имя Значение Количество
1Двутавр Широкополочный 25Ш1 1
Уголок равнополочный 50x5 1
Швеллер П 10П 1
трубы квадратные ГОСТ 30245-94 100x100x6 1
Двутавр Широкополочный 25Ш1 1
Двутавр Балочный 18Б1 1
Уголок равнополочный 45x6 2
Швеллер П 20П 2
трубы квадратные ГОСТ 30245-94 180x180x7 2
Двутавр Широкополочный 20Ш1 2
Двутавр Балочный 20Б1 2

Kostinok · 20.03.2008, 14:55

VVA, а можно еще добавить, что бы весь конечный результат выводился в таблицу AutoCADа? в текущем табличном стиле?

VVA · 20.03.2008, 15:01

Я забыл сказать, что ф-ция возвращает результат подсчета ввиде списка
(см пояснения к ф-ции blockcount) для того, чтобы можно было "прикрутить" к ней вывод в таблицу Автокада, Excel и т.п. Пока у меня нет на это времени.

Kostinok · 20.03.2008, 15:07

Я имел ввиду не Excel, а AutoCAD сразу. Еще у меня вопрос личного характера, я отослал Вам его через ICQ, посмотрите пожалуйста. Заранее благодарен.

VVA · 20.03.2008, 15:15

Быстро могу в Excell вывести. Необходимы ВСЕ функции их поста #10.
Команда BNC
Красную строчку изменить в соответствии со своими предпочтениями по примерам вызова blockcount из поста #10

Код:

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

(defun C:BNC ( / lst )
  (and
    (setq lst
           (blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*")  ;_Игнорировать блоки, начинающиеся с A$C
          )
    (setq lst (mapcar '(lambda (x)(append (str-str-lst (car x) "|")(list(cdr x)))) lst))
    (xls lst '("Имя" "Свойство" "Количество") nil nil)
    )
  )
 
;|================== XLS ========================================
* Опубликовано http://www.caduser.ru/cgi-bin/f1/boa...19833nl&page=2
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31371zf
               http://www.autocad.ru/cgi-bin/f1/board.cgi?t=31596eW
* Автор: Владимир Азарко aka VVA
* Назначение: Печать списка данных Data-list в Excell
*             Для вывода создается новый лист активной книги или
              создается новая книга.
              
* Аргументы:
              Data-list — список списков данных (LIST) вида
                            ((Value1 Value2 ... VlalueN)(Value1 Value2 ... VlalueN)...)
                            Каждый список вида (Value1 Value2 ... VlalueN) записывается
                            в отдельную строку в соответствующие столбцы (Value1-A Value2-B и .т.д.)
                  header —  список (LIST) заголовков или nil вида ("Подпись A" "Подпись B" ...)
                            Если header nil, принимается ("X" "Y" "Z")
                 Colhide —  список буквенных названий стоблцов для скрытия или nil — не скрывать
                            ("A" "C" "D") — скрыть столбцы A, C, D
                 Name_list — имя нового листа активной книги или nil — нет ("")
Имя получается как конкатенация Имя_рисунка + Name_list + счетчик для уникальности
* Возврат: nil
* TIPS!!! : При передачи функции xls числовых вещественных данных нет необходимости проверять текущий системный
            разделитель целой и дробной части ("HKEY_CURRENT_USER\\Control Panel\\International" "sDecimal")
            Функцией на время вывода отключается использование в Excele системного разделителя, разделителем
            целой и дробной части устанавливается точка. После завершения ф-ции все восстанавливается.
Пример вызова
(xls '((1.1 1.2 1.3 1.4)(2.1 2.2 2.3 2.4)(3.1 3.2 3.3 3.4)) '("Столбец1" "Столбец2" "Столбец3" "Столбец4") '("B") nil)
подробнее http://dwg.ru/f/showthread.php?p=183912
пример http://dwg.ru/f/showthread.php?p=201021
|;
(vl-load-com)
(defun xls ( Data-list header Colhide Name_list / *aplexcel* *books-colection* Currsep
*excell-cells* *new-book* *sheet#1* *sheet-collection* col iz_listo row cell cols)
(defun Letter (N / Res TMP)(setq Res "")(while (> N 0)(setq TMP (rem N 26)
  TMP (if (zerop TMP)(setq N (1- N) TMP 26) TMP)
  Res (strcat (chr (+ 64 TMP)) Res)  N   (/ N 26))) Res)
(if (null Name_list)(setq Name_list ""))
  (setq  *AplExcel*     (vlax-get-or-create-object "Excel.Application"))
  (if (setq *New-Book*  (vlax-get-property *AplExcel* "ActiveWorkbook"))
    (setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-invoke-method *Sheet-Collection* "Add"))
(setq *Books-Colection*  (vlax-get-property *AplExcel* "Workbooks")
              *New-Book*     (vlax-invoke-method *Books-Colection* "Add")
          *Sheet-Collection* (vlax-get-property *New-Book* "Sheets")
               *Sheet#1*     (vlax-get-property *Sheet-Collection* "Item" 1)))
(setq *excell-cells*     (vlax-get-property *Sheet#1* "Cells"))
(setq Name_list (if (= Name_list "")
                  (vl-filename-base(getvar "DWGNAME"))
                  (strcat (vl-filename-base(getvar "DWGNAME")) "&" Name_list))
   col 0 cols nil)
(if (> (strlen Name_list) 26)
(setq Name_list (strcat (substr Name_list 1 10) "..." (substr Name_list (- (strlen Name_list) 13) 14))))  
(vlax-for sh *Sheet-Collection* (setq cols (cons (strcase(vlax-get-property sh 'Name)) cols)))
(setq row Name_list)
(while (member (strcase row) cols)(setq row (strcat Name_list " (" (itoa(setq col (1+ col)))")")))
(setq Name_list row)
(vlax-put-property *Sheet#1* 'Name Name_list)
(setq Currsep (vlax-get-property *AplExcel* "UseSystemSeparators"))
(vlax-put-property *AplExcel* "UseSystemSeparators" :vlax-false) ;_не использовать системные установки
(vlax-put-property *AplExcel* "DecimalSeparator" ".")            ;_разделитель дробной и целой части
(vlax-put-property *AplExcel* "ThousandsSeparator" " ")          ;_разделитель тысячей
(vla-put-visible *AplExcel* :vlax-true)(setq row 1 col 1)
(if (null header)(setq header '("X" "Y" "Z")))
(repeat (length header)(vlax-put-property *excell-cells* "Item" row col
(vl-princ-to-string (nth (1- col) header)))(setq col (1+ col)))(setq  row 2 col 1)
(repeat (length Data-list)(setq iz_listo (car Data-list))(repeat (length iz_listo)
(vlax-put-property *excell-cells* "Item" row col (vl-princ-to-string (car iz_listo)))
(setq iz_listo (cdr iz_listo) col (1+ col)))(setq Data-list (cdr Data-list))(setq col 1 row (1+ row)))
(setq col (1+(length header)) row (1+ row))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
    (strcat "A1:" (letter col)(itoa row))))) ;_ end of setq
(setq cols (vlax-get-property cell  'Columns))
(vlax-invoke-method cols 'Autofit)
(vlax-release-object cols)(vlax-release-object cell)
(foreach item ColHide (if (numberp item)(setq item (letter item)))
(setq cell (vlax-variant-value (vlax-invoke-method *Sheet#1* "Evaluate"
    (strcat item "1:" item "1"))))
(setq cols (vlax-get-property cell  'Columns))
(vlax-put-property cols 'hidden 1)
(vlax-release-object cols)(vlax-release-object cell))
(vlax-put-property *AplExcel* "UseSystemSeparators" Currsep)
(mapcar 'vlax-release-object (list *excell-cells* *Sheet#1* *Sheet-Collection* *New-Book* *Books-Colection*
*AplExcel*))(setq *AplExcel* nil)(gc)(gc)(princ))
;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun

Kostinok · 21.03.2008, 07:20

VVA, Большое спасибо, все заработало! Очень хотел бы иметь возможность связаться с Вами если Вас устроит мое предложение по ICQ.

VVA · 21.03.2008, 09:25

Пиши в ПМ, т.к. я не всегда в ICQ

Kostinok · 26.03.2008, 06:25

VVA, проверте пожалуйста личные сообщения.

К вопросам по этой теме, а можно добавить извлечение аттрибута из блока с параметрами видимости "vis" и названием аттрибута "ДЛИНА", и осуществить такой же быстрый вывод в Excel.

VVA · 26.03.2008, 11:29

В принципе возможно. А ты _eattext пробовал?

Kostinok · 26.03.2008, 12:43

VVA, да, конечно, все получаеться, просто так было бы удобнее и быстрее

Electric · 09.06.2008, 16:09 **_eattext**

попробовал команду _eattext
шикарно конечно, понравилось, bcount отдыхает
только вот 2008 Акад просит создать новую таблицу извлечения данных или загрузить откуда нить??
как ее создать??

wetr · 16.06.2008, 02:23

Выбери стиль таблицы Стандарт, и она создастся сама. Кстати команда _eattext (Извлечение атрибутов) была до 2007 када. С 2008 команда выросла до _dataextraction (Извлечение данных). В 2009 стал работать корректно. Это особенно заметно, если создете доп. столбцы и производите математические операции с извлекаемыми параметрами.

Kostalom · 11.10.2010, 15:32

Добрый день. У меня есть просьба, если конечно вы сможете помочь.
Как можно организовать подсчет дин. блоков. При условии что блок имеет несколько видимостей, и каждая из видимостей может маркироватся соответственно по заданной шкале (например С6, С10,.... С6/2, 10/2,...6/3, 10/3....). Для наглядности прикладываю файл, данное решение схем подойдет с небольшими оформленчискими изменениями всем электрикам проектантам (необходимые параметры обозначены красным). Также если вообще есть возможность делать автоматический подчет типа и длин кабелей (по параметру 3х2,5 и тп..).

VVA · 11.10.2010, 17:40

Kostalom, Твои динамические блоки считаются так: (blockcount "Видимость" nil) Функции брать из поста #10. Кабели считали здесь: Нужно посчитать кабель

Kostalom · 12.10.2010, 10:55

2 VVA да спасибо прога работает, но у меня стоит более сложная задача. Каждая видимость блока имеет еще один параметр по которому впринцепе и нужно производить подсчет. Етот параметр (например С6, С10,.... С6/2, 10/2,...6/3, 10/3....) в файле написан как Мтехт, но можна его добавить и как атрибут в дин блок. Либо же несчитать дин блоки а считать количество С6, С10.... в самом Мтехт. Я просто незнаю что проще организовать на Лиспе????

VVA · 12.10.2010, 13:09

Удобнее, когда параметр будет добавлен как атрибут блока. У тебя есть текст: С60N-C10 Его нужно считать как С60 или С10 ?

Kostalom · 12.10.2010, 13:55

нет интересует только С10, причем етот текст может менятся в зависимости от модели автомата соответственно первая буква может быть (В, С, D,), а цифра после буквы может быть (6, 10, 16, 20, 25, 32, 40, 50, 63, 80, 100, 125) после етой цифры возможен префикс /2 или /3. Пример: С6, С6/2, С6/3 или так В16, В16/2 и тд. Но суть что там может быть много вариантов. Былобы хорошо еслибы подсчет велся по видимости + по тому что написано в атрибуте конкретной видимости, тоисть сверялся текст с атрибута и количество одинаковых записей в атрибуте выводилось ввиде списка типа: 1) видимость; 2) текст в атрибуте; 3) количество. Ну и космос былбы еслиб все ето записывалось в текстовый файл например. Но так как команду будут использовать несколько раз подряд то чтоб все данные записывались в один и тотже файл, какбы продолжая запись, и перед каждым таким отчетом спрашивало как его (отчет) назвать. А ну и чтоб етот подсчет производился в заданой области чертежа.

Во хотелки какие

, извените уж, просто действительно очень нужно по работе

VVA · 12.10.2010, 15:14

Цитата:

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

Былобы хорошо еслибы подсчет велся по видимости + по тому что написано в атрибуте конкретной видимости

пример в студию

Kostalom · 12.10.2010, 16:53

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

Да и еще может таким путем:
был бы очень признателен если подскажете как сделать следущее
у меня есть 10 (15 или 20) строчек мультитекста (в каждом мультитексте есть хоть один "enter"). Я специально вставляю перед необходимыми мне фрагментами какойнибудь редко встречающийся символ, к примеру собачку перед началом марки кабеля, значок долара перед длиной
выделяю к примеру 10 строк мультитекста (кол-во строк может быть разным

). Преобразую это в 10 строковых переменых. Далее работаем с каждой переменной. Ищем собачку, после нахождения таковой считываем следущие 5 символов и проводим проверку на макру кабеля (наример "*****"="ВВГнд") если да то прибавляем к сумме ВВГнд то что находиться за значком"$".
Конечно нужно ещё делать проверку на совпадение сечения кабеля, ну это я думаю смогу сам сделать, мне главное подать начало, так как лисп очень большоооой а времени на разборку нету

VVA · 18.10.2010, 09:59

Kostalom, Посмотри эту тему посты #106 #108

VVA · 11.02.2011, 14:02

Вариант функции подсчета свойств динамических блоков с группировкой по указанному динамическому свойству

Код:

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

(defun blockcount1 (DynPropetyName              IgnoreBlockNamePattern
                    CountProp     /             adoc
                    selset        res           name
                    dynProp       lst           nameX
                   )
;;;Подсчет динамических блоков по имени и значению динамического свойства
;;; http://dwg.ru/f/showthread.php?t=17333
;;;DynPropetyName - метка свойства (видимость и т.п.), строка - "Видимость"
;;;             или nil - считать по именам блоков
;;;             или список строк, если свойств несколько  - ("Марка балки" "Обозначение" "Профиль")
;;; IgnoreBlockNamePattern - строка, шаблон игнорируемых имен блоков или nil - все блоки
;;;                   Шаблон задается строкой, аналогично шаблону функции wcmatch
;;;                   Несколько шаблонов разделяются запятой
;;;                   Безразлична к регистру букв
;;;                   "A$C*,*НЕТ*,МАР*" - будут пропущены блоки с именами, начинающимися на A$C и МАР
;;;                   а тек же блоки, в имени которых есть сочетание НЕТ
;;;                  Шаблон для динамических блоков применяется к эффективному имени!!!
  ;;                   Примеры нескольких шаблонов
;;;                 "#* - исключить блоки, начинающиеся с цифры
;;;                 "#Бл* - исключить блоки, начинающиеся с цифры и следующие буквы которых БЛ (1Блок 2БЛОК и т.п.)
;;;                 "Формат" - исключить блок с именем формат
;;;                Возвращает список списков точечных пар, состоящих из
;;;                -  Имени блока и имени свойства, разделенных символом "|"
;;;                - количества
;;;                Пример
;;;               (("1Двутавр Широкополочный|25Ш1" . 2) ("Уголок равнополочный|50x5" . 3) ("Швеллер П|10П" . 1))
;;;  CountProp - динамическое свойство для суммирования или nil - счетчик  
  ;; Или список нескольких свойств
;;;Пример вызова:
;;; (blockcount1 nil nil nil)
;;; (blockcount1 "Видимость" nil nil)
;;; (blockcount1 '("Марка балки" "Обозначение" "Профиль") "A$C*,#*" nil) ;_Игнорировать блоки, начинающиеся с A$C и цифры
;;; (blockcount1 '("Марка балки" "Обозначение" "Профиль") "A$C*" nil)  ;_Игнорировать блоки, начинающиеся с A$C

  (defun _getvalue ()
    (cond
      ((and
         (= (type CountProp) 'Str)
         (numberp (GetDynamicBlockPropertyNameValue blk Countprop))
       ) ;_ end of and
       (GetDynamicBlockPropertyNameValue blk Countprop)
      )
      (1)
    ) ;_ end of cond
  ) ;_ end of defun
  (vl-load-com)
  (setq IgnoreBlockNamePattern
         (strcase
           (mip-conv-to-str IgnoreBlockNamePattern)
         ) ;_ end of strcase
  ) ;_ end of setq
  (if (= (type DynPropetyName) 'STR)
    (setq DynPropetyName (list DynPropetyName))
  ) ;_ end of if
  (setq DynPropetyName (mapcar 'mip-conv-to-str DynPropetyName))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if (setq selset (ssget '((0 . "INSERT"))))
    (progn
      (foreach blk
               (mapcar
                 'vlax-ename->vla-object
                 (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
               ) ;_ end of mapcar 
        (setq
          name (cond
                 ((and (vlax-property-available-p blk 'isdynamicblock)
                       (= (vla-get-isdynamicblock blk) :vlax-true)
                  ) ;_ end of and
                  (if (and DynPropetyName
                           (listp DynPropetyName)
                      ) ;_ end of and
                    (setq
                      DynProp (mapcar
                                '(lambda (X)
                                   (GetDynamicBlockPropertyNameValue
                                     blk
                                     X
                                   ) ;_ end of GetDynamicBlockPropertyNameValue
                                 ) ;_ end of lambda
                                DynPropetyName
                              ) ;_ end of mapcar
                    ) ;_ end of setq
                    (setq DynProp '("дин. блок"))
                  ) ;_ end of if
                  (vla-get-effectivename blk)
                 )
                 (t
                  (setq DynProp '("обычный блок"))
                  (vla-get-name blk)
                 )
               ) ;_ end of cond 
        ) ;_ end of setq
        (setq DynProp (vl-remove-if 'null DynProp))
        (if (not (wcmatch (strcase name) IgnoreBlockNamePattern))
          (foreach DynP DynProp
            (setq nameX (strcat name "|" (mip-conv-to-str DynP)))
            (if (member nameX (mapcar 'car res))
              (setq res
                     (subst (cons nameX
                                  (+ (_getvalue) (cdr (assoc nameX res)))
                            ) ;_ end of cons
                            (assoc nameX res)
                            res
                     ) ;_ end of subst
              ) ;_ end of setq
              (setq res (append res (list (cons nameX (_getvalue)))))
            ) ;_ end of if
          ) ;_ end of foreach DynP
        ) ;_ end of if
      ) ;_ end of foreach Blk
      (setq
        name (mapcar '(lambda (x / p1 txt)
                        (list
                          (setq p1 (substr (setq txt (car x))
                                           1
                                           (vl-string-position 124 txt)
                                   ) ;_ end of substr
                          ) ;_ end of setq
                          (substr (vl-string-left-trim p1 txt) 2)
                          (mip-conv-to-str (cdr x))
                        ) ;_ end of list
                      ) ;_ end of lambda
                     res
             ) ;_ end of mapcar
      ) ;_ end of setq
      (setq name (cons (list "Имя" "Значение" "Количество") name))
      (setq lst (mapcar '(lambda (a) (apply 'max (mapcar 'strlen a)))
                        (apply 'mapcar (cons 'list name))
                ) ;_ end of mapcar
      ) ;_ end of setq
      (setq name (mapcar '(lambda (zz)
                            (mapcar '(lambda (txt cnt)
                                       (setq cnt (+ cnt 3))
                                       (while (< (strlen txt) cnt)
                                         (setq txt (strcat txt " "))
                                       ) ;_ end of while
                                     ) ;_ end of lambda
                                    zz
                                    lst
                            ) ;_ end of mapcar
                          ) ;_ end of lambda
                         name
                 ) ;_ end of mapcar
      ) ;_ end of setq
      (foreach item name
        (terpri)
        (mapcar 'princ item)
      ) ;_ end of foreach 
      (terpri)
      (princ)
    ) ;_ end of progn 
  ) ;_ end of if
  (terpri)
  res
) ;_ end of defun
;;; подсчет динамических блоков
;;;Опубликовано  http://dwg.ru/f/showthread.php?t=17333
;;;Возвращает список всех свойст динамического блока в виде списка
;;;((Имя_свойства Текущее_значение Vla_объект_свойства)...)

(defun GetDynamicBlockPropertyList (obj / lstProperties tmp)
;;; obj - vla-object  
;;; Returns a list of all the properties of a dynamic block in a list
;;; ((Property_name current_value Vla_object_of_properties )...)  

  ;;Возвращает список всех свойст динамического блока в виде списка 
                                                  ;((Имя_свойства Текущее_значение Vla_объект_свойства)...) 
  ;; obj - Vla-указатель дин блока (vla-object) 
  ;;Пример 
  ;;(GetDynamicBlockPropertyList (vlax-ename->vla-object(car(entsel "\nВыбeри дин блок:")))) 
  ;;(("Видимость" "Канализация" #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15246fe4>) 
  ;;   ("Угол" 0.115395 #<VLA-OBJECT IAcadDynamicBlockReferenceProperty 15240fe4>) ...) 

  (if (and (vlax-property-available-p obj "IsDynamicBlock")
           (= (vla-get-isdynamicblock obj) :vlax-true)
           (setq
             tmp (vlax-variant-value (vla-getdynamicblockproperties obj))
           ) ;_ end of setq
           (>= (vlax-safearray-get-u-bound tmp 1) 0)
           (setq lstProperties (vlax-safearray->list tmp))
      ) ;_ end of and
    (progn
      (mapcar '(lambda (x)
                 (list (vla-get-propertyname X)
                       (vlax-variant-value (vla-get-value X))
                       x
                 ) ;_ end of list
               ) ;_ end of lambda
              lstProperties
      ) ;_ end of mapcar
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
;; obj - Vla-указатель дин блока (vla-object)
;; PropertyName - имя свойства (string)
(defun GetDynamicBlockPropertyNameValue (obj PropertyName / Plist)
  (and
    (setq PropertyName (strcase PropertyName))
    (setq Plist (GetDynamicBlockPropertyList obj))
    (setq Plist (car (vl-remove-if-not
                       '(lambda (x)
                          (= (strcase (car x)) PropertyName)
                        ) ;_ end of lambda
                       Plist
                     ) ;_ end of vl-remove-if-not
                ) ;_ end of car
    ) ;_ end of setq
  ) ;_ end of and
  (cadr Plist)
) ;_ end of defun
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT) (setq dat (itoa dat)))
        ((= (type dat) 'REAL) (setq dat (rtos dat 2 12)))
        ((null dat) (setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))
  ) ;_ end of cond
) ;_ end of defun

Для файла примера, приведенном в этом посте
вызов функции будет выглядеть так

Код:

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

(blockcount1
 "Distance"    ;_группировать по дин свойству "Distance"
  nil              ;_ включая все блоки
 "Distance1") ;_суммировать значение дин свойства "Distance1"

Пример ввиде команды c выводом в excell

Код:

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

 
(defun C:TEST (/ lst)
  (and
    (setq lst
           (blockcount1 "Distance" nil "Distance1") 
    ) ;_ end of setq
    (setq
      lst (mapcar '(lambda (x)
                     (append (str-str-lst (car x) "|") (list (cdr x)))
                   ) ;_ end of lambda
                  lst
          ) ;_ end of mapcar
    ) ;_ end of setq
    (xls lst '("Имя" "Свойство" "Количество") nil nil)
  ) ;_ end of and
) ;_ end of defun

Функцию xls брать из поста #14

Rainbow.dgw · 16.01.2012, 13:43

VVA, почему-то после отработки программы дублируется результат еще и в строчку. Как это убрать, подскажите, пожалуйста.

VVA · 16.01.2012, 19:42

Rainbow.dgw,
1. Программу из какого поста используешь?
2. Ищи строчку

Код:

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

(mapcar 'princ item)

и закоментарь ее (поставь в начале строки ; (точка с запятой))

Rainbow.dgw · 17.01.2012, 12:24

VVA, использую программу выложенную 20.03.2008, 14:34.
Строчку нашла и закомментировала, правда результат не тот. Мне наоборот хотелось, чтоб данные остались, которые выводятся в виде таблички, а не в строчку.
И еще один вопрос, для вызова комманды (blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*") есть какая-то более короткая запись вызывающей функции?

VVA · 17.01.2012, 14:40

Цитата:

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

чтоб данные остались, которые выводятся в виде таблички, а не в строчку

В строчку выводится возврат функции (для дальнейшего использования)

Цитата:

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

есть какая-то более короткая запись вызывающей функции?

Ее нетрудно самому написать
В виде функции

Код:

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

(defun myblockcount ()(blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*")(princ))

Вызывать (myblockcount)
В виде команды

Код:

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

(defun C:myblockcount ()(blockcount '("Марка балки" "Обозначение" "Профиль") "A$C*")(princ))

Здесь же и решена проблема №1 (обрати внимание на (princ) )

Rainbow.dgw · 24.01.2012, 10:40

VVA, покажите, пожалуйста, как и куда добавить.
Я добавляю сама работает через командрую строку, но когда вызываю через кнопку на панели выдает ошибу "Команда: (myblockcount) ; ошибка: no function definition: BLOCKCOUNT"

VVA · 24.01.2012, 11:55

1. Функции myblockcount и blockcount должны быть описаны в одном файле lsp. Пусть для примера его имя будет myblockcount.lsp
2. Файл должен находится в путях доступа Автокада
3. Кнопка:

Код:

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

^C^C(if (null myblockcount)(load "myblockcount.lsp"))(myblockcount)

PS. пишу по памяти без проверки, но должно работать

Rainbow.dgw · 24.01.2012, 14:31

VVA, спасибо большое.

AAI · 25.06.2012, 15:05

Кодом из #10 не считается блок. Выдает общее количество блоков без разделение на видимости.
Что не так, подскажите пожалуйста.

Проблема локализована. В блоке переименован visibility на visibility1.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Сквозная нумерация динамических блоков	zenon	Программирование	214	28.08.2020 08:45
Руководство по созданию динамических блоков	tanushka_ch	Динамические блоки	20	25.11.2015 20:46
Проблема вставки Динамических блоков	Владимир М	Программирование	11	12.09.2007 15:42
Игра -Пятнашки- С использованием динамических блоков	Gig	Динамические блоки	1	11.12.2006 10:32
Библиотека динамических блоков	Коробейников Алексей	Динамические блоки	2	05.04.2005 16:08

06.02.2008, 12:38		#1
подсчет динамических блоков AAI Регистрация: 06.02.2008 Сообщений: 23 Всем привет! Помогите пожалуйста найти решение на такую проблему - в динамическом блоке создано несколько visibility states. Необходимо подсчитать на плане количество блоков с каждым типом отображения. Пользовался поиском - смог найти только как считатется общее количество динамических блоков.
Просмотров: 29720