Schöck
Показать сообщение отдельно
 
Непрочитано 20.03.2008, 14:34
#10
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,888
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Следующая редакция 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
Вложения
Тип файла: dwg Test blockcount.dwg (113.7 Кб, 5115 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 11.10.2010 в 17:34.
VVA вне форума  
 
Размещение рекламы