Как вставить в таблицу динамический блок с параметром видимости и с атрибутами?

Profan · 23.02.2016, 20:06

Имеется код для вставки блока в таблицу:

Код:

(defun C:Б-Т ( / ent blkid)
;;;http://www.caduser.ru/forum/index.ph...D=23&TID=24393
(setq ent   (vlax-ename->vla-object (car (entsel "\nВыбрать таблицу : ")))
      blkid (vlax-ename->vla-object (car (entsel "\nУказать блок : ")))
      ) ;_ end of setq
(vla-setblocktablerecordid
  ent
  2
  0
  (vla-get-objectid
    (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name blkid))
    ) ;_ end of vla-get-objectid
  :vlax-false
  ) ;_ end of vla-SetBlockTableRecordId
(princ)
)

Программа работает, но если блок - динамический, да еще имеет атрибуты, то вставляется совсем уж коряво.
Вопросы:
Как избавиться от атрибутов в динблоке без нарушения параметра видимости?
Каким образом вставить в таблицу изображение блока с текущим параметром видимости?
Файл приложен, блок создан не мной.

Кулик Алексей aka kpblc · 23.02.2016, 22:34

Без проверки, в качестве идеи:

Цитата:

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

Как избавиться от атрибутов в динблоке без нарушения параметра видимости?

По-моему, только через ename-представление, проходя по вставке блока и удаляя в нем атрибуты. Правда, первая же _.attsync порушит это дело.

Цитата:

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

Каким образом вставить в таблицу изображение блока с текущим параметром видимости?

Вставить дин.блок, поменять в нем параметры, получить его имя через vla-get-name (ни в коем случае не vla-get-effectivename) и вставлять это имя. Вхождение удалить.

Profan · 24.02.2016, 15:07

Привет, Алексей.
Спасибо. Но ведь в твоем коде как раз и используется vla-get-name. У меня программа автоматически подсчитывает и сортирует блоки и определяет их количество по имени.
Без учета параметра видимости получается картинка 1
С помощью разработок Lee Mac ( http://www.lee-mac.com/dynamicblockfunctions.html ) я вытаскиваю имена параметра видимости и получается картинка 2
Если же вставить блок в таблицу с помощью твоего кода, то получается картинка 3. Причем, отменить вставку уже невозможно. Эскиз в картинке 1 идентичен эскизу в картинке 3, просто мелко очень.

VVA · 24.02.2016, 15:59

Как вариант
Пару функций взял отсюда

Код:

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

(defun C:Б2Т ( / acdoc table block row col pt next _Is64Bit _GetObjectID _itemp _celTable)
  (vl-load-com)
;;;http://forum.dwg.ru/showthread.php?t=129465
  ;............................................................;
  (defun _Is64Bit nil (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")))
  ;............................................................;
  (defun _GetObjectID ( doc obj )
    (if (_Is64Bit)
      (vla-get-Objectid32 obj)
      (vla-get-Objectid   obj)
    )
  )
;............................................................;
  (defun _itemp ( collection item )
      (if
        (not
          (vl-catch-all-error-p
            (setq item
              (vl-catch-all-apply 'vla-item (list collection item))
            )
          )
        )
        item
      )
    )
;............................................................;
(defun _celTable ( pt / tblobj tblset lst row col)
(if
  (and ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (progn
        (vl-catch-all-apply '(lambda()
        (mapcar '(lambda (x)
           (or tblobj
               (and
                 (= :vlax-true (vla-HitTest x
                               (vlax-3d-point (trans pt 1 0))
                               (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                               'row 'col))
                 (setq tblobj x)
                 )
               )
           )
        lst)
          )
         )
        tblobj
        )
       row col
      )
  (list row col tblobj)
  nil
  )
  )
;............................................................;
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) next t)
(initget 1)
(while next
 (setq pt (getpoint "\n Укажите ячейку таблицы:"))
 (if  (setq cell (_celTable pt))
   (progn
(setq block (vlax-ename->vla-object (car (entsel "\nУказать блок : ")))
      table (caddr cell)
      next nil
      )
(bg:layer-status-save)  
(bg:DynToStatic (setq block (vla-copy block)) t)
(vl-catch-all-apply
  '(lambda()
     (vlax-map-Collection
       (vla-item (vla-get-Blocks acdoc)(vla-get-name block))
       '(lambda (x)(if(eq(vla-get-ObjectName x) "AcDbAttributeDefinition")
		      (vla-delete x)
		     )
	  )
       )
     )
  )
(vlax-invoke
     table
       (if (_Is64Bit)
          'SetBlockTableRecordId32 
          'SetBlockTableRecordID
        )
       (car cell)(cadr cell)(_GetObjectID acdoc (_itemp (vla-get-blocks acdoc) (vla-get-name block))) :vlax-true
  )
  (vl-catch-all-apply 'vla-delete (list block)) 
  (bg:layer-status-restore)
)
   (alert "\nВ данной точке нет таблицы")
   )
  )
(princ)
)
(defun bg:DynToStatic ( obj ConvertMode / i name ret attlist)
;;; obj - vla object
;;; ConvertMode - nil ConvertToAnonymousBlock
;;;             - t   ConvertToStaticBlock
;;; Return - t - if converted or nil if error  
;;;"ConvertToStaticBlock" or "ConvertToAnonymousBlock"
  (if (= (type obj) 'ENAME)
      (setq obj (vlax-ename->vla-object obj))
    )
;;;  (setq attlist (bg:get-all-atts obj))
  (cond
    ((and ConvertMode
          (vlax-write-enabled-p obj)
          (vlax-method-applicable-p obj "ConvertToStaticBlock")
          )
     (setq name (strcat "$BG$_" (substr (rtos (getvar "CDATE") 2 9) 10) "_"))
     (setq i 1)
     (while (tblsearch "Block" (strcat name (itoa i)))(setq i (1+ i)))
     (setq name (strcat name (itoa i)))
     (setq ret
            (not
              (VL-CATCH-ALL-ERROR-P
                (vl-catch-all-apply 'vlax-invoke (list obj "ConvertToStaticBlock" name))
                )
              )
           )
     )
    ((and (not ConvertMode)
          (vlax-write-enabled-p obj)
          (vlax-method-applicable-p obj  "ConvertToAnonymousBlock")
          )
     (setq ret
            (not
              (VL-CATCH-ALL-ERROR-P
                (vl-catch-all-apply 'vlax-invoke (list obj  "ConvertToAnonymousBlock"))
                )
              )
           )
     )
    (t nil)
    )
  ;;; Add VVA 2014-10-08 v.2.28
(vl-catch-all-apply
  '(lambda()
     (vlax-map-Collection
       (vla-item (vla-get-Blocks(vla-get-activedocument (vlax-get-acad-object)))(vla-get-name obj))
       '(lambda (x)(if(eq(vla-get-Visible x) :vlax-false)(vla-delete x)))
       )
     )
  )                         
  ret
  )
(defun bg:layer-status-restore ()
    (foreach item *BG_LAYER_LST*
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
             (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
             (vla-put-LayerOn (car item) (cdr (assoc "onoff" (cdr item))))
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    (setq *BG_LAYER_LST* nil)
    ) ;_ end of defun

  (defun bg:layer-status-save ()
    (setq *BG_LAYER_LST* nil)
    (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      (setq *BG_LAYER_LST* (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  (cons "onoff" (vla-get-LayerOn item))
                                  ) ;_ end of cons
                            *BG_LAYER_LST*
                            ) ;_ end of cons
            ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
      ) ;_ end of vlax-for
    ) ;_ end of defun

Profan · 24.02.2016, 17:50

Все, вроде бы, хорошо, но:
изображение в таблице отличается от исходного изображения по цвету и по толщине линий. А для некоторых значений видимости и по размеру.
Неплохо было бы указывать не таблицу, а ячейку таблицы, поскольку в реальности таблица может содержать много строк.

VVA · 24.02.2016, 18:23

Цитата:

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

Неплохо было бы указывать не таблицу, а ячейку таблицы

Обновил #4

Цитата:

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

изображение в таблице отличается от исходного изображения по цвету и по толщине линий

Когда блок вставляется в ячейку таблицы, то он вставляется на слой таблицы со всеми вытекающими

Profan · 24.02.2016, 19:43

Цитата:

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

Обновил #4

Спасибо.

Цитата:

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

Когда блок вставляется в ячейку таблицы, то он вставляется на слой таблицы со всеми вытекающими

Понятно.

VVA · 25.02.2016, 11:00

Цитата:

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

изображение в таблице отличается от исходного изображения по цвету и по толщине линий.

Взял идею из Properties From Layer

Цитата:

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

А для некоторых значений видимости и по размеру

При вставке блока в таблицу он вставляется по габариту. Т.е если есть примитивы на отключенных и замороженных слоях, то они все равно участвуют в определении габаритов
Добавил удаление примитивов блока на выключенных и замороженных слоях

Код:

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

(defun C:Б2ТФ ( / acdoc table block row col pt next _Is64Bit _GetObjectID _itemp _celTable)
  ;;;Block to Table. Fix properties
  (vl-load-com)
;;;http://forum.dwg.ru/showthread.php?t=129465
  ;............................................................;
  (defun _Is64Bit nil (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE")))
  ;............................................................;
  (defun _GetObjectID ( doc obj )
    (if (_Is64Bit)
      (vla-get-Objectid32 obj)
      (vla-get-Objectid   obj)
    )
  )
;............................................................;
  (defun _itemp ( collection item )
      (if
        (not
          (vl-catch-all-error-p
            (setq item
              (vl-catch-all-apply 'vla-item (list collection item))
            )
          )
        )
        item
      )
    )
;............................................................;
(defun _celTable ( pt / tblobj tblset lst row col)
(if
  (and ;_Проверяем, попала ли точка в ячейку таблицы
      (setq  tblobj nil tblset (ssget "_X" (list '(0 . "ACAD_TABLE")(cons 410 (getvar "CTAB")))))
      (setq lst (mapcar 'vlax-ename->vla-object(vl-remove-if 'listp (mapcar 'cadr (ssnamex tblset)))))
      (progn
        (vl-catch-all-apply '(lambda()
        (mapcar '(lambda (x)
           (or tblobj
               (and
                 (= :vlax-true (vla-HitTest x
                               (vlax-3d-point (trans pt 1 0))
                               (vlax-3d-point (trans (getvar "VIEWDIR") 1 0))
                               'row 'col))
                 (setq tblobj x)
                 )
               )
           )
        lst)
          )
         )
        tblobj
        )
       row col
      )
  (list row col tblobj)
  nil
  )
  )
;............................................................;
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) next t)
(initget 1)
(while next
 (setq pt (getpoint "\n Укажите ячейку таблицы:"))
 (if  (setq cell (_celTable pt))
   (progn
(setq block (vlax-ename->vla-object (car (entsel "\nУказать блок : ")))
      table (caddr cell)
      next nil
      )
(bg:layer-status-save)  
(bg:DynToStatic (setq block (vla-copy block)) t)
(vl-catch-all-apply
  '(lambda()
     (vlax-map-Collection
       (vla-item (vla-get-Blocks acdoc)(vla-get-name block))
       '(lambda (x / blay lay bcolor blt blw)
	  (setq lay   (vla-item (vla-get-layers acdoc)(vla-get-layer x))
		blay  (vla-item (vla-get-layers acdoc)(vla-get-layer block))
                 bcolor (if (eq (vla-get-color block) acByLayer)(vla-get-color blay)(vla-get-color block))
                 blt   (if (eq (vla-get-linetype block) "ByLayer")(vla-get-linetype blay)(vla-get-linetype block))
                 blw  (if (eq (vla-get-lineweight block) acLnWtByLayer)(vla-get-lineweight blay)(vla-get-lineweight block))
           ) ;_ end of setq
	  (cond
	    ((eq(vla-get-ObjectName x) "AcDbAttributeDefinition")
	     (vl-catch-all-apply 'vla-delete (list x))
	     )
	    ((eq (cdr(assoc "onoff" (cdr(assoc lay *BG_LAYER_LST*)))) :vlax-false)
	     (vl-catch-all-apply 'vla-delete (list x))
	     )
	    ((eq (cdr(assoc "freeze" (cdr(assoc lay *BG_LAYER_LST*)))) :vlax-true)
	     (vl-catch-all-apply 'vla-delete (list x))
	     )
	    ((eq (vla-get-layer x) "0") ;_Правильный блок
	     (vl-catch-all-apply
             '(lambda ()
                (if (eq (vla-get-color x) acByLayer)(vla-put-color x (vla-get-color blay)))
                (if (eq (vla-get-linetype x) "ByLayer")(vla-put-linetype x (vla-get-linetype blay)))
                (if (eq (vla-get-lineweight x) acLnWtByLayer)(vla-put-lineweight x (vla-get-lineweight blay)))
                (if (eq (vla-get-color x) acByBlock)(vla-put-color x bcolor))
                (if (eq (vla-get-linetype x) "ByBlock")(vla-put-linetype x blt))
                (if (eq (vla-get-lineweight x) acLnWtByBlock)(vla-put-lineweight x blw))
		(vla-put-Layer x (vla-get-name blay))
              ) ;_ end of lambda
	     )
	     )
	    (t ;_Не Правильный блок
	     (vl-catch-all-apply
             '(lambda ()
                (if (eq (vla-get-color x) acByLayer)(vla-put-color x (vla-get-Color lay)))
                (if (eq (vla-get-linetype x) "ByLayer")(vla-put-linetype x (vla-get-Linetype lay)))
                (if (eq (vla-get-lineweight x) acLnWtByLayer)(vla-put-lineweight x (vla-get-lineweight lay)))
                (if (eq (vla-get-color x) acByBlock)(vla-put-color x bcolor))
                (if (eq (vla-get-linetype x) "ByBlock")(vla-put-linetype x blt))
                (if (eq (vla-get-lineweight x) acLnWtByBlock)(vla-put-lineweight x blw))
         	(vla-put-Layer x (vla-get-name blay))
              ) ;_ end of lambda
	     )
	     )
	    )
	  )
       )
     )
  )
(vlax-invoke
     table
       (if (_Is64Bit)
          'SetBlockTableRecordId32 
          'SetBlockTableRecordID
        )
       (car cell)(cadr cell)(_GetObjectID acdoc (_itemp (vla-get-blocks acdoc) (vla-get-name block))) :vlax-true
  )
 ; (vl-catch-all-apply 'vla-delete (list block)) 
  (bg:layer-status-restore)
)
   (alert "\nВ данной точке нет таблицы")
   )
  )
(princ)
)
(defun bg:DynToStatic ( obj ConvertMode / i name ret attlist)
;;; obj - vla object
;;; ConvertMode - nil ConvertToAnonymousBlock
;;;             - t   ConvertToStaticBlock
;;; Return - t - if converted or nil if error  
;;;"ConvertToStaticBlock" or "ConvertToAnonymousBlock"
  (if (= (type obj) 'ENAME)
      (setq obj (vlax-ename->vla-object obj))
    )
;;;  (setq attlist (bg:get-all-atts obj))
  (cond
    ((and ConvertMode
          (vlax-write-enabled-p obj)
          (vlax-method-applicable-p obj "ConvertToStaticBlock")
          )
     (setq name (strcat "$BG$_" (substr (rtos (getvar "CDATE") 2 9) 10) "_"))
     (setq i 1)
     (while (tblsearch "Block" (strcat name (itoa i)))(setq i (1+ i)))
     (setq name (strcat name (itoa i)))
     (setq ret
            (not
              (VL-CATCH-ALL-ERROR-P
                (vl-catch-all-apply 'vlax-invoke (list obj "ConvertToStaticBlock" name))
                )
              )
           )
     )
    ((and (not ConvertMode)
          (vlax-write-enabled-p obj)
          (vlax-method-applicable-p obj  "ConvertToAnonymousBlock")
          )
     (setq ret
            (not
              (VL-CATCH-ALL-ERROR-P
                (vl-catch-all-apply 'vlax-invoke (list obj  "ConvertToAnonymousBlock"))
                )
              )
           )
     )
    (t nil)
    )
  ;;; Add VVA 2014-10-08 v.2.28
(vl-catch-all-apply
  '(lambda()
     (vlax-map-Collection
       (vla-item (vla-get-Blocks(vla-get-activedocument (vlax-get-acad-object)))(vla-get-name obj))
       '(lambda (x)(if(eq(vla-get-Visible x) :vlax-false)(vla-delete x)))
       )
     )
  )                         
  ret
  )
(defun bg:layer-status-restore ()
    (foreach item *BG_LAYER_LST*
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply
          '(lambda ()
             (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
             (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
             (vla-put-LayerOn (car item) (cdr (assoc "onoff" (cdr item))))
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    (setq *BG_LAYER_LST* nil)
    ) ;_ end of defun

  (defun bg:layer-status-save ()
    (setq *BG_LAYER_LST* nil)
    (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      (setq *BG_LAYER_LST* (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  (cons "onoff" (vla-get-LayerOn item))
                                  ) ;_ end of cons
                            *BG_LAYER_LST*
                            ) ;_ end of cons
            ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
      ) ;_ end of vlax-for
    ) ;_ end of defun

Profan · 27.02.2016, 11:59

Спасибо, буду пробовать. Однако, это только часть проблемы.

kp+ · 28.02.2016, 21:00

Рассматривался ли вариант разработки двух разных блоков с похожими названиями по каждому виду УГО:
1) собственно для чертежа - динамический со сложными атрибутами;
2) для таблицы условных обозначений - упрощенный, возможно вообще без атрибутов, с обезличенными надписями типа xBTHn.m в виде статических текстовых объектов (с примечанием о том, что x - номер ППК, n - номер шлейфа, m - номер извещателя).
Код уважаемого VVA в #8, в принципе, делает то же самое автоматически, но зачастую удобнее и правильнее прорисовать блок для таблицы условных обозначений отдельно и особо (да что я рассказываю, Вы наверняка лучше меня все это знаете)

Profan · 29.02.2016, 08:32

У меня работает собственная программа, которая автоматически проставляет выноску-нумератор типа СС 1 к блокам условных обозначений и автоматически формирует таблицу, показанную в сообщении #3. Если в чертеже присутствуют динамические блоки с атрибутами, то вместо эскиза для соответствующего имени блока с текущей видимостью типа "Извещатель_АПС Ручной извещатель" вставляется фигня. Я подумал, что может потом, после формирования таблицы, изменить эскиз вручную, но получается так, что программы достаточно сложные, а эскизы в силу своей анонимности не являются точной копией по свойствам отображению самих блоков в чертеже.
При разработке своей программы я использовал в том числе и разработки Lee Mac. У него есть программа Block Counter (http://www.lee-mac.com/blockcounter.html) для подсчета обычных блоков с формированием таблицы и программа Dynamic Block Counter (http://www.lee-mac.com/dynamicblockcounter.html) для подсчета динамических блоков, но без формирования таблицы. Такой подсчет у меня тоже выполняется, но как достать эскиз с учетом параметра видимости для автоматической вставки в таблицу (и при этом избавиться от атрибута) - я пока не знаю. Методика преобразования динамического блока в анонимный в данном случае, как мне представляется, не подходит.

VVA · 29.02.2016, 10:33

Цитата:

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

но как достать эскиз с учетом параметра видимости для автоматической вставки в таблицу (и при этом избавиться от атрибута) - я пока не знаю. Методика преобразования динамического блока в анонимный в данном случае, как мне представляется, не подходит.

А методика преобразования в именованный блок подходит? (см. #8).
Но я бы поступил как посоветовал kp+ в #10. Имел бы 2 блока - для чертежа и спецификации.
Помимо видимости есть еще один нюанс при вставки блока в таблицу. Он вставляется по габариту. При определении габарита участвуют все примитивы, входящие в описание блока не зависимо от того, видимы ли они сейчас или нет, отключены ли их слои или нет. Именно поэтому при вставке блока в таблицу получается

Цитата:

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

Все, вроде бы, хорошо, но:
изображение в таблице отличается от исходного изображения по цвету и по толщине линий. А для некоторых значений видимости и по размеру.

Поэтому я считаю, что

Цитата:

Сообщение от kp+

правильнее прорисовать блок для таблицы условных обозначений отдельно и особо

Profan · 29.02.2016, 11:44

VVA, это все верно. Для своего пакета программ для СС я и блоки условных обозначений создавал сам и проблем не было. Но в данном случае некий главспец СС навставлял в чертеж кучу взятых из неизвестного источника динблоков с атрибутами, (которые, кстати говоря, и не нужны совсем, поэтому этот инженер очистил значение атрибута, но сам атрибут остался) и возникли проблемы. А этих блоков в чертеже сотни. И таблица у меня - не просто таблица условных обозначений, а именно таблица подсчета однотипных блоков. При изменении количества блоков на чертеже (добавлении новых или удалении существующих) таблица автоматически пересчитывается. И выноски тоже перечерчиваются.
Вариант твой из сообщения #8 вставляет в таблицу вроде правильные картинки, но одновременно разрушается параметр видимости.

Profan · 01.03.2016, 09:15

Вот сильно упрощенный вариант моей программы:

Код:

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

(defun C:ДБВТ ( / obj nam line column tbl blkid)
;;; Дин Блок В Таблицу
(setq obj (car (entsel "\nУкажите блок: ")))
(if obj
    (progn
    (setvar "CLAYER" "СС-текст")
    (setq nam (vlax-get-property (vlax-ename->vla-object obj) 'EffectiveName))
    (setq column  2 line 2 tbl  
          (vla-addtable 
          (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object))) 
          (vlax-3d-point (setq ptt (getpoint "\nУкажите точку вставки таблицы: ")))
          line
          column 
          400     ;  высота строки
          2000    ;  ширина строки 
          ) ; vla-addtable
    ) ; setq
    (vla-SetTextHeight tbl (+ acDataRow acTitleRow acHeaderRow) 200)
    (vla-SetAlignment tbl acDataRow acMiddleCenter)
    (vla-SetTextStyle tbl (+ acDataRow acTitleRow acHeaderRow) "СС-текст")
    (vla-settext  tbl
          0 ; строка
          0 ; столбец
          "Блок СС на слое CC_Пожар"
    ) 
    (vla-SetColumnWidth tbl 0 2000)
    (vla-SetColumnWidth tbl 1 3500)
    (vla-settext tbl 1 0 "Эскиз") 
    (vla-settext tbl 1 1 "Имя блока") 
    (setq blkid (vla-get-name (vlax-ename->vla-object obj)))
    (vla-InsertRows tbl 2 300 1)
    (vla-SetTextHeight tbl acDataRow 200)
    (vla-SetColumnWidth tbl 0 2000)
    (vla-SetColumnWidth tbl 1 3500)
    (vla-SetRowHeight tbl 2 400)
    (vla-SetAlignment tbl acDataRow acMiddleCenter)
    (vla-SetTextStyle tbl acDataRow "СС-текст")
    (if blkid
        (progn
        (vla-setblocktablerecordid tbl 2 0 
        (vla-get-objectid (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 
        blkid))
        :vlax-true)
        ) ; progn
    ) ; if
    (vla-settext  tbl 2 1 nam)   ;; Имя блока
;;    (vla-settext  tbl 2 1 blkid)   ;; Имя блока
    ) ; progn
) ; if
(princ)
)

И файл с примерами работы этой программы.
Как в этот код добавить возможность учета параметра видимости в эскизе и в имени блока?
Примечание:
Не стОит эту программу пробовать с другими чертежами, она работает исключительно с приложенным файлом.

Tonic · 06.03.2016, 04:03

Цитата:

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

При вставке блока в таблицу он вставляется по габариту.

Если заменить :vlax-true на :vlax-false, всё равно вставляется вписанным по габариту ячейки.

Profan · 06.03.2016, 21:34

Вот код программы вставки блоков и динамических блоков в таблицу. Пока вариант не универсальный, расчитанный на прилагаемый файл.
Атрибут удален вручную в редакторе блоков.
Теперь бы приспособить сюда подсчет количества однотипных блоков.

Код:

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

;;; Дин Блок В Таблицу
(defun C:ДБВТ ( / obj nam line column tbl blkid ss n blo blko vidm)
;;; Начало. Текущее значение параметра "Видимость" динамического блока
(defun ТЗПВ ( / blk vis prv namb)
;;; Переработка функций Lee Mac
    (if
        (and
            (vlax-property-available-p blko 'effectivename)
            (setq blk
                (vla-item
                    (vla-get-blocks (vla-get-document blko))
                    (vla-get-effectivename blko)
                ) 
            ) ; setq
            (= :vlax-true (vla-get-isdynamicblock blk))
            (= :vlax-true (vla-get-hasextensiondictionary blk))
            (setq vis
                (vl-some
                   '(lambda ( pair )
                        (if
                            (and
                                (= 360 (car pair))
                                (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair)))))
                            )
                            (cdr pair)
                        )
                    )
                    (dictsearch
                        (vlax-vla-object->ename (vla-getextensiondictionary blk))
                        "ACAD_ENHANCEDBLOCK"
                    )
                )
            )
        )
       (setq prv (cdr (assoc 301 (entget vis))))
    ) ; if
    (princ "\nИмя параметра 'Видимость': ") (princ prv)
    (if prv
        (progn
        (setq prv (strcase prv))
        (setq vidm (vl-some '(lambda ( x ) (if (= prv (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
            (vlax-invoke blko 'getdynamicblockproperties)
        ))
        (princ "\nТекущее значение параметра 'Видимость': ") (prin1 vidm)
        (setq namb (vlax-get-property blko 'effectivename))
        (setq nam (strcat namb ": " vidm))
        (princ "\nПолное имя блока: ") (prin1 nam)
        (princ)
        ) ; progn
        (princ "\nПараметр 'Видимость' отсутствует.")
    ) ; if
(princ)
)
;;; Конец. Текущее значение параметра "Видимость" динамического блока
;;; ******************************************************************
(princ "\nРамка - р; Мнногоугольник - рмн")
(setq ss (ssget (list (cons 0 "INSERT") (cons 8 "СС_пожар"))))
(if ss
    (progn
    (setvar "CLAYER" "СС-текст")
    (setq column  2 line 2 tbl  
          (vla-addtable 
          (vla-get-modelspace(vla-get-activedocument (vlax-get-acad-object))) 
          (vlax-3d-point (setq ptt (getpoint "\nУкажите точку вставки таблицы: ")))
          line
          column 
          400     ;  высота строки
          2000    ;  ширина строки 
          ) ; vla-addtable
    ) ; setq
    (vla-put-regeneratetablesuppressed tbl :vlax-true)
    (vla-SetTextHeight tbl (+ acDataRow acTitleRow acHeaderRow) 200)
    (vla-SetAlignment tbl acDataRow acMiddleCenter)
    (vla-SetTextStyle tbl (+ acDataRow acTitleRow acHeaderRow) "СС-текст")
    (vla-settext  tbl
          0 ; строка
          0 ; столбец
          "Блок СС на слое CC_Пожар"
    ) 
    (vla-SetColumnWidth tbl 0 2000)
    (vla-SetColumnWidth tbl 1 6000)
    (vla-settext tbl 1 0 "Эскиз") 
    (vla-settext tbl 1 1 "Имя блока") 
    (setq sslen (sslength ss) n 0 nst 0 nkol 0)
    (repeat sslen
        (setq blo (ssname ss n))
        (setq blko  (vlax-ename->vla-object blo))
        (if (= (vl-string-search "*U" (cdr (assoc 2 (entget blo)))) nil)
            (progn
            (princ "\n ") (princ (cdr (assoc 2 (entget blo))))
            (setq nam (vlax-get-property (vlax-ename->vla-object blo) 'EffectiveName))
            (setq blkid (vla-get-name (vlax-ename->vla-object blo)))
            (vla-InsertRows tbl (+ nst 2) 300 1)
            (vla-SetTextHeight tbl acDataRow 200)
            (vla-SetColumnWidth tbl nkol 2000)
            (vla-SetColumnWidth tbl (+ nkol 1) 6000)
            (vla-SetRowHeight tbl (+ nst 2) 400)
            (vla-SetAlignment tbl acDataRow acMiddleCenter)
            (vla-SetTextStyle tbl acDataRow "СС-текст")
            (if blkid
                (progn
                (vla-setblocktablerecordid tbl (+ nst 2) nkol 
                (vla-get-objectid (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 
                blkid))
                :vlax-true)
                ) ; progn
            ) ; if
            ) ; progn
        ) ; if
        (if (/= (vl-string-search "*U" (cdr (assoc 2 (entget blo)))) nil)
            (progn
            (princ "\n ") (princ (cdr (assoc 2 (entget blo))))
;;; **************************
(ТЗПВ)
;;; **************************
            (if (null vidm)
                 (setq nam (vlax-get-property (vlax-ename->vla-object blo) 'EffectiveName))
            ) ; if
            (setq blkid (vla-get-name (vlax-ename->vla-object blo)))
            (vla-InsertRows tbl (+ nst 2) 300 1)
            (vla-SetTextHeight tbl acDataRow 200)
            (vla-SetColumnWidth tbl nkol 2000)
            (vla-SetColumnWidth tbl (+ nkol 1) 6000)
            (vla-SetRowHeight tbl (+ nst 2) 400)
            (vla-SetAlignment tbl acDataRow acMiddleCenter)
            (vla-SetTextStyle tbl acDataRow "СС-текст")
            (if blkid
                (progn
                (vla-setblocktablerecordid tbl (+ nst 2) nkol 
                (vla-get-objectid (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 
                blkid))
                :vlax-true)
                ) ; progn
            ) ; if
            ) ; progn
        ) ; if
        (vla-settext  tbl (+ nst 2) (+ nkol 1) nam)   ;; Имя блока
        (setq n (+ n 1) nst (+ nst 1))
    ) ; repeat
        (vla-put-regeneratetablesuppressed tbl :vlax-false) 
    ) ; progn
) ; if
(princ)
)

Tonic · 08.03.2016, 21:53

Цитата:

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

(vla-setblocktablerecordid tbl (+ nst 2) nkol
(vla-get-objectid (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blkid))
:vlax-true)

:vlax-false пробовали? У меня никак не реагирует: свойство остаётся "вписанным".

Profan · 09.03.2016, 08:17

Пробовал. Масштаб вставки блока в ячейку изменяется на значение 1. В результате увеличивается размер таблицы по вертикали.

Profan · 06.07.2016, 16:41

Если использовать :vlax-false, то можно задать масштаб блока в ячейке с помощью vla-SetBlockScale.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Динамический блок. Параметр видимости.	Shoorup	Динамические блоки	14	30.10.2019 10:23
Программная вставка блока с атрибутами в таблицу. Как сохранить установленные значения атрибутов?	Кулик Алексей aka kpblc	Программирование	8	22.07.2010 15:01
Динамический блок с вложенным динамическим блоком?	Sync02	Динамические блоки	17	18.05.2009 17:51
Динамический блок и коммандная строка	Сергей Дубина	Динамические блоки	30	24.04.2009 09:16
Динамический блок с атрибутами не масштабируется?	X-DeViL	Динамические блоки	7	24.11.2005 11:59

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск