| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > подсчет динамических блоков

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

Ответ
Поиск в этой теме
Непрочитано 06.02.2008, 12:38 #1
подсчет динамических блоков
AAI
 
Регистрация: 06.02.2008
Сообщений: 23

Всем привет!
Помогите пожалуйста найти решение на такую проблему - в динамическом блоке создано несколько visibility states. Необходимо подсчитать на плане количество блоков с каждым типом отображения.
Пользовался поиском - смог найти только как считатется общее количество динамических блоков.
Просмотров: 27119
 
Непрочитано 06.02.2008, 12:58
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 38,695


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 06.02.2008, 13:20
#3
VVA

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


Здесь есть фукции для чтения/установки значений динамических блоков
Сквозная нумерация динамических блоков
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 07.02.2008, 07:28
#4
wetr

инженер
 
Регистрация: 09.08.2006
Владивосток
Сообщений: 1,555
<phrase 1= Отправить сообщение для wetr с помощью Skype™


Цитата:
Сообщение от maestro Посмотреть сообщение
bcount галимый. Как и все укоманды экспресс тулза он не знает про дин. блоки и тупо игнорирует их, потому что они физически реализованы как анонимные, т.е. начинающиеся со "*". Так что галимая командочка.
_dataextraction
ИМХО
__________________
14 Ибо если вы будете прощать людям согрешения их, то простит и вам Отец ваш Небесный (Мф 6, 14)
wetr вне форума  
 
Непрочитано 07.02.2008, 10:51
#5
VVA

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


Адаптировал 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
Вложения
Тип файла: dwg
DWG 2004
Пример.dwg (54.2 Кб, 5390 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 20.03.2008 в 10:18. Причина: Орфография
VVA вне форума  
 
Автор темы   Непрочитано 08.02.2008, 12:29
#6
AAI


 
Регистрация: 06.02.2008
Сообщений: 23


Всем спасибо, особенно VVA.
То что и нужно было
AAI вне форума  
 
Непрочитано 08.02.2008, 12:51
#7
Ander822


 
Регистрация: 16.07.2007
Minsk
Сообщений: 84


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

Свойство - значение какого-либо атрибута, динамического свойсва, любого свойство блока (слой, координаты, цвет...) Есть возможность выбирать, какие именно свойства учитывать.
Ander822 вне форума  
 
Непрочитано 15.02.2008, 12:34
#8
Kostinok

Инженер-электрик
 
Регистрация: 13.10.2007
Калининград
Сообщений: 151


Действительно отличная программа, то что нужно!!!
__________________
Можно сопротивляться вторжению армий, вторжению идей сопротивляться невозможно. /В. Гюго/

Последний раз редактировалось Kostinok, 20.03.2008 в 09:51.
Kostinok вне форума  
 
Непрочитано 20.03.2008, 09:51
#9
Kostinok

Инженер-электрик
 
Регистрация: 13.10.2007
Калининград
Сообщений: 151


VVA, а можно ли, что бы конечный результат выводился на чертеж, таблицей, и еще что бы шла проверка блоков на "безграмотность", т.е. отссеивались все блоки с подобными названиями A$C613A5AE4 ?
__________________
Можно сопротивляться вторжению армий, вторжению идей сопротивляться невозможно. /В. Гюго/
Kostinok вне форума  
 
Непрочитано 20.03.2008, 14:34
#10
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,906
<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
DWG 2004
Test blockcount.dwg (113.7 Кб, 5118 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 11.10.2010 в 17:34.
VVA вне форума  
 
Непрочитано 20.03.2008, 14:55
#11
Kostinok

Инженер-электрик
 
Регистрация: 13.10.2007
Калининград
Сообщений: 151


VVA, а можно еще добавить, что бы весь конечный результат выводился в таблицу AutoCADа? в текущем табличном стиле?
__________________
Можно сопротивляться вторжению армий, вторжению идей сопротивляться невозможно. /В. Гюго/
Kostinok вне форума  
 
Непрочитано 20.03.2008, 15:01
#12
VVA

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


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

Последний раз редактировалось VVA, 20.03.2008 в 15:24.
VVA вне форума  
 
Непрочитано 20.03.2008, 15:07
#13
Kostinok

Инженер-электрик
 
Регистрация: 13.10.2007
Калининград
Сообщений: 151


Я имел ввиду не Excel, а AutoCAD сразу. Еще у меня вопрос личного характера, я отослал Вам его через ICQ, посмотрите пожалуйста. Заранее благодарен.
__________________
Можно сопротивляться вторжению армий, вторжению идей сопротивляться невозможно. /В. Гюго/
Kostinok вне форума  
 
Непрочитано 20.03.2008, 15:15
#14
VVA

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


Быстро могу в 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
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 16.05.2008 в 12:38. Причина: соответвие названия команды
VVA вне форума  
 
Непрочитано 21.03.2008, 07:20
#15
Kostinok

Инженер-электрик
 
Регистрация: 13.10.2007
Калининград
Сообщений: 151


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

Последний раз редактировалось Kostinok, 21.03.2008 в 09:18.
Kostinok вне форума  
 
Непрочитано 21.03.2008, 09:25
#16
VVA

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


Пиши в ПМ, т.к. я не всегда в ICQ
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 26.03.2008, 06:25
#17
Kostinok

Инженер-электрик
 
Регистрация: 13.10.2007
Калининград
Сообщений: 151


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

К вопросам по этой теме, а можно добавить извлечение аттрибута из блока с параметрами видимости "vis" и названием аттрибута "ДЛИНА", и осуществить такой же быстрый вывод в Excel.
__________________
Можно сопротивляться вторжению армий, вторжению идей сопротивляться невозможно. /В. Гюго/
Kostinok вне форума  
 
Непрочитано 26.03.2008, 11:29
#18
VVA

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


В принципе возможно. А ты _eattext пробовал?
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 26.03.2008, 12:43
#19
Kostinok

Инженер-электрик
 
Регистрация: 13.10.2007
Калининград
Сообщений: 151


VVA, да, конечно, все получаеться, просто так было бы удобнее и быстрее
__________________
Можно сопротивляться вторжению армий, вторжению идей сопротивляться невозможно. /В. Гюго/
Kostinok вне форума  
 
Непрочитано 09.06.2008, 16:09 _eattext
#20
Electric


 
Регистрация: 30.05.2008
Сообщений: 26


попробовал команду _eattext
шикарно конечно, понравилось, bcount отдыхает
только вот 2008 Акад просит создать новую таблицу извлечения данных или загрузить откуда нить??
как ее создать??
Electric вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > подсчет динамических блоков

Система Техэксперт дает уверенность в правильности и эффективности принимаемых инженерных решений!
Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сквозная нумерация динамических блоков 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