[ilka_t]

Если блок был создан в одном слое, а потом его пго поместили в другой слой, то у него остается связь с первоночальным слоем, и таже поблема с цветом.
Может есть у кого нибудь Lisp для переопределения блока в текущий слой,и цвет,чтобы он был не зависим от первоначального цвета и слоя

[Star]

Создавай блок на слое 0.

[ilka_t]

ето самый легкий способ, но возьмешь файл у архитекторов и там такое, да и сам иногда забываешь про 0 слой, вот я и спашиваю про LISP

[Torino]

У Startrek'a на страничке видел подобную прогу.

[Startrek]

Можно воспользоваться аутокадовской kоммандой REFEDIT она работает не только с ХREF но и с обычными блоками

[ilka_t]

За REFEDIT зпасибо не знал.но там надо каждый бдок по отдельности редактировать, а сразу все блоки низя.
Может кто Lispik напишет, что бы все блоки сразу можно было поменять

[Vova]

;FixBlock.lsp [December 31, 1997]
;
; Copyright 1996, 1997 ManuSoft Computer Services
;
; Freeware by:
; ManuSoft Computer Services
; http://www.manusoft.com
;
; Load function, then enter FIXBLOCK to redefine selected blocks
; so that all entities are on layer '0', color 'BYBLOCK'.
;


(defun C:FixBlock (/ ss cnt blkname donelist Grp Update)
(defun Grp (gc el) (cdr (assoc gc el)))
(defun Update (bname / ename elist)
(setq ename (tblobjname "BLOCK" bname))
(while ename
(setq elist (entget ename '("*"))
elist (subst '(8 . "0") (assoc 8 elist) elist)
elist (if (assoc 62 elist) (subst '(62 . 0) (assoc 62 elist) elist) (append elist '((62 . 0)))))
(entmake elist)
(setq ename (entnext ename)))
(if (/= "ENDBLK" (Grp 0 elist)) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0))))
)
(if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0)
(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n")
(progn
(if
(progn
(princ "\nPress <Enter> to fix all defined blocks\n")
(setq ss (ssget '((0 . "INSERT")))))
(progn
(setq cnt (sslength ss))
(while (>= (setq cnt (1- cnt)) 0)
(if (not (member (setq blkname (Grp 2 (entget (ssname ss cnt)))) donelist))
(progn
(Update blkname)
(setq donelist (cons blkname donelist)))))
(setq cnt (sslength ss)))
(progn
(setq cnt 0)
(while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname))))
(Update blkname)
(setq cnt (1+ cnt)))))
(princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n"))))
(princ)
)
;End-of-file



После этого команда Regen

[Эдуард]

Код:

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

(defun C:block-v-0 ()
  (vl-load-com)
  (setq	ac_doc (vla-get-ActiveDocument
		 (vlax-get-acad-object
		 )
	       ) ;_ end of vla-get-ActiveDocument
  ) ;_ end of setq
  (vlax-for item (vla-get-layers
		   ac_doc
		 ) ;_ end of vla-get-layers
    (if
      (equal (vla-get-lock item) :vlax-true)
       (vla-put-lock item :vlax-false)
    ) ;_ end of if
  ) ;_ end of vlax-for
  (vla-StartUndoMark
    ac_doc
  ) ;_ end of vla-StartUndoMark

  (vlax-for item
		 (vla-get-blocks
		   ac_doc
		 ) ;_ end of vla-get-blocks

    (if
      (not
	(wcmatch
	  (vla-get-name item)
	  "*Space"
	) ;_ end of wcmatch
      ) ;_ end of not

       (progn
	 (vlax-for item2 item
	   (if
	     (not
	       (equal
		 (vla-get-layer item2)
		 "0"
	       ) ;_ end of equal
	     ) ;_ end of not

	      (progn
		(vla-put-layer item2 "0")
	      ) ;_ end of progn
	   ) ;_ end of if
	 ) ;_ end of vlax-for

       ) ;_ end of progn
    ) ;_ end of if

  ) ;_ end of vlax-for


  (vla-regen ac_doc
	     acAllViewports
  ) ;_ end of vla-regen
  (vla-endUndoMark
    ac_doc
  ) ;_ end of vla-endUndoMark
  (princ)
) ;_ end of defun

[{Smirnoff}]

Функция удалена, по причине того что дальше содержиться усовершенствованный вариант.

[Tech]

У меня тоже есть вопросик касательно блоков: - Создаю значится блок, присваиваю ему имя, аккуратненько заполняю description, сохраняюсь, затем вдруг захотелось поменять или дополнить имя или описание, -так description виден только в DesignCenter, в свойствах даже и не упоминается и ничем другим не читается, refedit позволяет редактировать сам блок, но не имя и описание.
Пока борюсь с этим EXPLODE>EDIT>MAKE BLOCK, может кто подскажет более простой путь, и как оперативно просмотреть DESCRIPTION?

[lee]

Format > Rename
...............
По моим наблюдениям есть глюки с корректностью имен блока. Например, если блок называется типа "Унитаз #1", то Акад фиг даст его переименовать.

Оперативно просмотреть Description:

Код:

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

(defun c:bld (/ block blName Descr)
  (if
    (setq block(car(entsel "\nSelect block ")))
    (progn
   (if(= "INSERT"(cdr(assoc 0(entget block))))
     (progn
       (setq blName(cdr(assoc 2(entget block))))
     (if
       (setq Descr(cdr(assoc 4(tblsearch "block" blName))))
       (princ(strcat "\nBlock name: " blName "\nDesctiption: " Descr))
       (princ(strcat "\nBlock name: " blName
		     "\n*** Haven't description ***"))
       ); end if
     ); end progn
  (princ "\n*** This don't block ***")
  ); end if
    ); end progn
  (princ "\n*** Nothing selected ***")
	 ); end if
    (princ)
  ); end bld

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

[{Smirnoff}]

Если будешь пользоваться убери из листинга фразу:

"Изменть чуть сложнее. Непродуман у них этот вопрос или я чего не знаю..."

. Я незалогинился и теперь немогу подправить. Да видно что сам не дурак, это я на всякий случай предупредил...

[{Smirnoff}]

Пришлось немного усовершенствовать и подправить поскольку сам работаю с архитектурными чертежами и этот ЛИСП мне не лишний. Прога делает блоки "правильными" т. е. 1) все составляющие примитивы в слое "0" 2) цвет "ByBlock". Сами блоки остаются в своем слое и им присваивается цвет "ByLayer". Заблокированные слои на время работы программы разблокируются и потом восстанавливают состояние.

Код:

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

(defun c:bto (/
	       opMode
	       Block
	       vlaList
	       acApp
	       layerState
	       LayerCol
	       nameList
	       layList
	       blockCol
	       blSet
	       )
  (vl-load-com)
  (initget "S A")
  (setq opMode(getkword "\nSelect operation mode [Selection/All] <S>: "))
  (if (null opMode)(setq opMode "S"))
  (if(= "S" opMode)
    (progn
    (princ "\nSelect block(s) and press Enter ")
      (setq blSet(ssget '((0 . "INSERT"))))
    ); end progn
      (setq blSet(ssget "_X" '((0 . "INSERT"))))
    ); end if
  (if blSet
    (progn
    (setq acApp(vla-get-ActiveDocument
	         (vlax-get-acad-object))
	  LayerCol(vla-get-Layers acApp)
	  layerState '()
          vlaList(mapcar 'vlax-ename->vla-object
		    (vl-remove-if 'listp
		      (mapcar 'cadr(ssnamex blSet))))
	  nameList
		    (mapcar
		    '(lambda (x)(vla-get-Name x))vlaList)
          layList
             (mapcar '(lambda(x)
                (list x(vla-get-Layer x)))vlaList)
          blockCol
              (vla-get-blocks acApp)
	  ); end setq
     (vlax-for l LayerCol
       (setq layerState
            (append layerState
	       (list
		 (list
		   l
		   (vla-get-Lock l)))))
       (vla-put-lock l :vlax-false)
       ); end vlax-for
  (vlax-for i blockCol
    (vlax-for e i
      (cond
	(
	(and
	  (= opMode "S")
	  (member (vla-get-Name i)nameList)
	  ); end and
	 (progn
      (vla-put-Layer e "0")
      (vla-put-Color e 0)
      ); end progn
	 )
	(
	(= opMode "A")
	 (progn
      (vla-put-Layer e "0")
      (vla-put-Color e 0)
      ); end progn
      )
     ); end cond
      ); end vlax-for
    ); end vlax-for
  (foreach i layList
    (vla-put-Layer(car i)(cadr i))
    (vla-put-Color (car i) 256)
    ); end foreach
    (foreach l layerState
      (vla-put-Lock (car l)(cadr l))
	); end foreach
); end progn
    (princ "\nNothing block selected!")
    ); end if
  (vla-regen acApp acAllViewports)
  (princ)
  ); end of bto

[Alaspher]

Сообщение от Lamer У меня тоже есть вопросик касательно блоков: - Создаю значится блок, присваиваю ему имя, аккуратненько заполняю description, сохраняюсь, затем вдруг захотелось поменять или дополнить имя или описание, -так description виден только в DesignCenter, в свойствах даже и не упоминается и ничем другим не читается, refedit позволяет редактировать сам блок, но не имя и описание. Пока борюсь с этим EXPLODE>EDIT>MAKE BLOCK, может кто подскажет более простой путь, и как оперативно просмотреть DESCRIPTION?

Возможность нормального редактирования описаний блоков а ACADе отсутствует, вот так пришлось решать вопрос в ruCAD:
http://www.kurganobl.ru/cad/book.jsp...=272&tn=main#b

[Tech]

Fantomas

Огромное спасибо за помощь, оба LISPa как раз в тему, правда мне приходится работать с элетронными компонентами и библиотека накопилась довольно приличная. Жаль конечно, что разработчики не решили этот вопрос, хотя он напрашивается сам собой :roll:

[{Smirnoff}]

У меня на этот счет есть идея. Можно ведь использоваь атрибуты блоков причем невидимые. Мне несложно написать лиспик который вставил бы в каждый блок ваших библиотек этот невидимый атрибут соответствующий Description блока.

Будет просмотр и редактирование по двойному щелчку ну и соответственно все все остальное с атрибутами связанное 8)

Делаете свои библиотеки по привычке заполняя Description, затем запускаете прогу и она автоматом вставляет во все блоки невидимые атрибуты. Если к примеру вы используете "чужой" блок без Description, то атрибут тоже будет создаваться но к примеру с прочерком "-".

А если в Description использовать по договоренности служебные знаки к примеру $1$Locheed-Martin$1$ $2$Laser Gun$2$ $3$SLG-134$3$ $4$10000000 USD$4$ то в блоке могут создаваться несколько атрибутов:

Manufacturer: Locheed-Martin
Devise: Space Laser Gun
Model: SLG-134
Price: 10000000 USD

Что то я разошелся...

[Tech]

Сообщение от Alaspher Возможность нормального редактирования описаний блоков а ACADе отсутствует, вот так пришлось решать вопрос в ruCAD: http://www.kurganobl.ru/cad/book.jsp...=272&tn=main#b

К величайшему моему сожалению , я пока не настолько хорошо знаю LISP, что бы приспособить этот листинг под AutoCAD. Может кто-то оз уважаемых Гуру попробует это сделать :roll: :?:

[Tech]

Сообщение от Fantomas ...лиспик который вставил бы в каждый блок ваших библиотек этот невидимый атрибут соответствующий Description блока.

А что, идея мне кажется очень даже интересной

Будет просмотр и редактирование по двойному щелчку ...

- тогда прийдется совмещать с REFEDIT, я думаю, что уже многие привыкли к этой функции.

А если в Description использовать по договоренности служебные знаки к примеру $1$Locheed-Martin$1$ $2$Laser Gun$2$ $3$SLG-134$3$ $4$10000000 USD$4$ то в блоке могут создаваться несколько атрибутов: Manufacturer: Locheed-Martin Devise: Space Laser Gun Model: SLG-134 Price: 10000000 USD

А такой вариант вообще позволил бы навести порядок в библиотеках.

[{Smirnoff}]

- тогда прийдется совмещать с REFEDIT, я думаю, что уже многие привыкли к этой функции.

Для вызова REFEDIT можно пользоваться и пунктом Edit Block in-place из контекстного меню по правому клику.

Лиспик "синхронизирующий" Description и соответствующий атрибут блока напишу. Насчет "$1$"тоже не слишком сложно, но хочется знать насколько нужно и если нужно то какие пункты?

К величайшему моему сожалению , я пока не настолько хорошо знаю LISP, что бы приспособить этот листинг под AutoCAD. Может кто-то оз уважаемых Гуру попробует это сделать

В данном конкретном случае для использования надо сделать две вещи: 1) написать лисп в 5 строчек для запуска соответствующей функции (это плевое дело) 2) загрузить библиотеку RU- которая состоит из огромного количества вложенных функций или ее часть "размотав клубок" тех же вложенных функций и выбрав необходимые. Библиотеки у меня нет. Проще такую прогу написать самому.[/code]

[Tech]

Сообщение от Fantomas Для вызова REFEDIT можно пользоваться и пунктом Edit Block in-place из контекстного меню по правому клику.

И это наверное будет оптимально.

Насчет "$1$"тоже не слишком сложно, но хочется знать насколько нужно и если нужно то какие пункты?

Меня лично вполне устроили бы пункты:
Manufacturer:
Model:
Part. N:

[Alaspher]

Сообщение от Fantomas В данном конкретном случае для использования надо сделать две вещи: 1) написать лисп в 5 строчек для запуска соответствующей функции (это плевое дело) 2) загрузить библиотеку RU- которая состоит из огромного количества вложенных функций или ее часть "размотав клубок" тех же вложенных функций и выбрав необходимые. Библиотеки у меня нет. Проще такую прогу написать самому.

Там используется 1 (одна) внешняя функция. Вот как это выглядит в "выковырянном" виде:

Код:

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

(defun ru-block-set-description (block_name
                                 block_description
                                 /
                                 block_begin
                                 block_ent
                                 old_description
                                 is_block_make
                                 block_layer
                                )
  (if (setq block_ent (tblobjname "block" block_name))
    (progn
      (setq block_begin       (entget block_ent)
            block_description (cons 4 block_description)
            block_layer       (assoc 8 block_begin)
            block_begin       (if (setq old_description (assoc 4 block_begin))
                                (subst block_description old_description block_begin)
                                (append block_begin (list block_description))
                              )
            is_block_make     (entmake (ru-ent-dxf-code-clear-list block_begin '(-1 -2 1 5 330 71) nil))
      )
      (if is_block_make
        (progn (while (setq block_ent (entnext block_ent))
                 (entmake (ru-ent-dxf-code-clear-list (entget block_ent) '(-1 5 330 71) nil))
               )
               (entmake
                 (list '(0 . "ENDBLK") '(100 . "AcDbEntity") '(100 . "AcDbBlockEnd") block_layer)
               )
               (if old_description
                 (cdr old_description)
                 ""
               )
        )
      )
    )
  )
)

(defun ru-ent-dxf-code-clear-list (lst list_dxf_codes is_stay_value)
  (cond ((null lst) nil)
        ((/= is_stay_value (= (type (member (caar lst) list_dxf_codes)) 'list))
         (ru-ent-dxf-code-clear-list (cdr lst) list_dxf_codes is_stay_value)
        )
        (t
         (cons (car lst)
               (ru-ent-dxf-code-clear-list (cdr lst) list_dxf_codes is_stay_value)
         )
        )
  )
)

Вызов:
(ru-block-set-description "<имя блока>" "<новое описание>")
По уму, надо делать оболочку с вопросами или диалогом, но для этого надо представлять, что хочется в итоге.

[Vova]

В теме http://dwg.ru/forum/viewtopic.php?t=...c802e4c620efee Startrek уже ответил, как отредактировать/добавить описание к блоку штатными средствами и без LISP. Из списка блоков окна Block Defenition выбери свой и заполни Description
Эдуард> Твой LISP все блоки чертежа одновременно переопределяет так чтобы все его элементы оказались в слое 0, свойства же их сохраняются. Между тем в HELP сказано: If you want.. retain original properties create objects in any layer but 0 (zero). То есть если надо оставить, например, цвет оригинальным, не переноси объект в 0. Несмотря
на это, как будто все работает, даже и если 0. Но HELP недаром так дает. Видимо, что-то есть. (См в HELP на слове bylayer статью Control the color...). Видимо, в лиспе должен быть выбор, по какому варианту из 3-х (см. указанный хелп) чинить блоки. По этой же причине нельзя все сразу блоки ремонтировать, надо поименно или выбором рамкой.
Fantomas> Опция All изменит все блоки в модели и в листе, а это опасно. Чем в таком случае твой лисп отличается от того, что дал я?

[Alaspher]

Сообщение от Vova В теме http://dwg.ru/forum/viewtopic.php?t=...c802e4c620efee Startrek уже ответил, как отредактировать/добавить описание к блоку штатными средствами и без LISP...

...но с "мусором" в виде лишней вставки блока в нулевой точке...

[Tech]

По уму, надо делать оболочку с вопросами или диалогом, но для этого надо представлять, что хочется в итоге.

Я это вижу примерно так: выделяем блок с DESCRIPTION или без, необходимо это увидеть и при необходимости внести изменения или дополнения. Все изменения должны касаться только DESCRIPTION и не затрагивать остальных параметров.

[{Smirnoff}]

>Vova

Чем в таком случае твой лисп отличается от того, что дал я?

Тем что этот ЛИСП в данном виде прекрасно работал в AutoCAD 14 (или ещё раньше) а для 2000-2005 он должен выглядеть так:

Код:

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

(defun C:FixBlock (/ ss cnt blkname donelist)
  
(defun Grp (gcc el) (cdr (assoc gcc el)))
  
(defun Update (bname / ename elist) 
(setq ename (tblobjname "BLOCK" bname)) 
(while ename 
(setq elist (entget ename '("*")) 
elist (subst '(8 . "0") (assoc 8 elist) elist) 
elist (if (assoc 62 elist) (subst '(62 . 0) (assoc 62 elist) elist) (append elist '((62 . 0))))) 
(entmake elist) 
(setq ename (entnext ename))) 
(if (/= "ENDBLK" (Grp 0 elist)) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0)))) 
)

(if (> (logand (Grp 70 (tblsearch "layer" "0")) 1) 0) 
(princ "\nLayer 0 must be thawed before running FIXBLOCK!\n") 
(progn 
(if 
(progn 
(princ "\nPress <Enter> to fix all defined blocks\n") 
(setq ss (ssget '((0 . "INSERT"))))) 
(progn 
(setq cnt (sslength ss)) 
(while (>= (setq cnt (1- cnt)) 0) 
(if (not (member (setq blkname (Grp 2 (entget (ssname ss cnt)))) donelist)) 
(progn 
(Update blkname) 
(setq donelist (cons blkname donelist))))) 
(setq cnt (sslength ss))) 
(progn 
(setq cnt 0) 
(while (setq blkname (Grp 2 (tblnext "BLOCK" (not blkname)))) 
(Update blkname) 
(setq cnt (1+ cnt))))) 
(princ (strcat "\n" (itoa cnt) " block" (if (= cnt 1) "" "s") " redefined\n")))) 
(princ) 
)

Минут 10 пришлось потратить на восстановление работоспособности.Лисп кстати хороший.

Опция All изменит все блоки в модели и в листе, а это опасно.

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

Видимо, в лиспе должен быть выбор, по какому варианту из 3-х (см. указанный хелп) чинить блоки.

Согласен, так на то и пишем чтобы получть отзывы. Спасибо.

Переопределение блока действительно работает "криво".

Vova! Убедительная просьба! Когда вставляете код, польуйтесь тегами . Иначе тяжело читать и сбиваются скобки.

>Lamer
Может завтра а скорее в понедельник постараемся решить проблеммы. Код уже в голову не идет, спать хочется...

[Vova]

Сообщение от "Alaspher ...но с "мусором" в виде лишней вставки блока в нулевой точке...

Ну сразу бы сказал, что за мусор. Если ноль далеко. трудно догагаться. Я практически никогда не пишу description. Придумал вот-что: зашли все блоки, требующие редакции описания, в Wblock. Там отредактируй а затем из design center возьми их с опцией Redefine only.
Fantomas> спасибо, что подправил мой любимый старый лисп. Хотя я не жаловался, в 2004 он работал. Хотя, как будто, что-то замечал. Kак и ты, использую его для перекраски архитектурных чертежей в наши подосновы. В цвет №8, а в плотстиле он еще и 80% яркости. Этот файл не чинит внутренние блоки. Приходится заходить сначала в Refedit. А если еще глубже блок? Можно ли "углубить" программу?

[Alaspher]

Сообщение от Lamer Я это вижу примерно так: выделяем блок с DESCRIPTION или без, необходимо это увидеть и при необходимости внести изменения или дополнения. Все изменения должны касаться только DESCRIPTION и не затрагивать остальных параметров.

Тут есть одна сложность. Приведённое мной решение разрабатывалось для ruCAD, где значительная часть диалогов сделана неавтокадовскими средствами. Если-же делать автономную команду, то надо решить всего одну задачу - как средствами Autolisp/DCL организовать редактирование многострочного текста. Функция: ru-block-set-description его принять может, выдернуть описание блока и отобразить эту мультистроку в DCL - то-ж не сложно, но вот отредактировать...

[{Smirnoff}]

>Vova

А если еще глубже блок? Можно ли "углубить" программу?

Можно. Спасибо за подсказку, хороший повод применить рекурсивный алгоритм.

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

[{Smirnoff}]

По совету Vova улучшил лисп для "исправления" блоков.

1) Убрал опцию All потому что действительно нехорошо что программа обрабатывает все блоки в Модели и Листах. При желании можно все отметить рамкой.
2) Ввел опцию определяющую цвет блоков после обработки: по Слою, по Блоку или Текущий цвет блока.

>Vova Я не стал переделывать твой лисп на предмет обработки вложенных блоков, поскольку мой их и так обрабатывает.

Код:

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

(defun c:btz (/ 
          opMode 
          Block 
          vlaList 
          actDoc 
          layerState 
          LayerCol 
          nameList 
          layList 
          blockCol 
          blSet 
          ) 
  (vl-load-com)
  (initget "L B C")
  (setq opMode
     (getkword "Select output block(s) color [byLayer/byBlock/Current]<L>: "))
  (if(null opMode)(setq opMode "L"))
    (princ "\nSelect block(s) and press Enter ") 
      (setq blSet(ssget '((0 . "INSERT")))) 
  (if blSet 
    (progn 
    (setq actDoc(vla-get-ActiveDocument 
            (vlax-get-acad-object)) 
     	  LayerCol(vla-get-Layers actDoc) 
          layerState '() 
          vlaList(mapcar 'vlax-ename->vla-object 
          (vl-remove-if 'listp 
            (mapcar 'cadr(ssnamex blSet)))) 
          nameList 
          (mapcar 
          '(lambda (x)(vla-get-Name x))vlaList) 
          layList 
             (mapcar '(lambda(x) 
                (list x(vla-get-Layer x)(vla-get-Color x)))vlaList) 
          blockCol 
              (vla-get-blocks actDoc) 
     ); end setq 
     (vlax-for l LayerCol 
       (setq layerState 
            (append layerState 
             (list 
              (list 
                l 
               (vla-get-Lock l))))) 
               (vla-put-lock l :vlax-false) 
       ); end vlax-for 
  (vlax-for i blockCol 
    (vlax-for e i
      (if
	(member (vla-get-Name i)nameList)
	(progn
      (vla-put-Layer e "0") 
      (vla-put-Color e 0)
      ); end progn
	); end if
      ); end vlax-for 
    ); end vlax-for 
  (foreach i layList 
    (vla-put-Layer(car i)(cadr i))
    (cond
    ((= opMode "L")(vla-put-Color(car i)256))
    ((= opMode "B")(vla-put-Color(car i)0))
    ((= opMode "C")(vla-put-Color(car i)(nth 2 i)))
    ); end cond
    ); end foreach 
    (foreach l layerState 
      (vla-put-Lock (car l)(cadr l)) 
   ); end foreach 
); end progn 
    (princ "\nNothing block selected!") 
    ); end if 
  (vla-regen actDoc acAllViewports) 
  (princ) 
  ); end of btz

>Lamer
Перехожу к программе с атрибутами.

[{Smirnoff}]

>Lamer
Написал функцию ВСТАВКИ/УДАЛЕНИЯ невидимых атрибутов. Запускать можно написав небольшие функции:

Код:

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

(defun c:inatt (/ tagList operMode block)
   (setq tagList(list "Manufacturer:" "Model:" "Part. N:"))
  (initget "I D")
   (setq operMode
   (getkword "\nInsert or [Delete] attributes in block [i]: "))
  (if(null operMode)(setq operMode "I"))
   (setq block(car(entsel "\nSelect block to insert/delete attributes ")))
  (InsertIvisAtt tagList operMode block)
  (princ)
  ); end inatt

Я думаю что все понятно. Таких функций можно сделать несколько, под различными названиями и с разными списками тегов для атрибутов. Эта функция если потребуется в дальнейшем может использоваться как мы говорили для $1$, если конечно это потребуется и вы не отойдете от заполнения Description, с атрибутами по моему веселее, вставил и заполнил по пунктам.

Проблемма о которой я спрашивал в другом топике уже снята

Код:

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

  (defun InsertIvisAtt (dataList operMode block / actDoc refSet
		blockCol layerCol refList layerState
		ssgetList refList curBlock)
  
       (vl-load-com)
  	(defun attInsert (dataList block / tagList curAtt)
	  (setq tagList '())
	  (vlax-for entity block
	    (if
	      (= "AcDbAttributeDefinition"
		 (vla-get-ObjectName entity))
	      (setq tagList(append tagList
		(list(vla-get-TagString entity))))
	      ); end if
	    ); end vlax-for
	  (foreach tag dataList
	    (if
	      (not
		(member tag tagList))
	      (progn
    (setq curAtt(vla-addAttribute  block
	      			0.001
	      			acAttributeModePreset
	                        ""
	      			(vlax-3D-point '(0.0 0.0 0.0))
	      			tag
	      			""
	      ); end vla-addAttribute
	     ); end setq
	      (vla-put-Layer curAtt "0")
	      (vla-put-Invisible curAtt :vlax-true)
       );end progn
	     ); end if
	    ); end foreach
	  (princ)
	  ); end attInsert

  (defun refReinsert (blockRef / activeDoc modelSpace layerCol
		      insPoint layer lineType linetypScale lineWeight
		      name normal ownerId rotation trColor visible
		      XScale YScale ZScale vlaLayer newRef )
    (setq activeDoc(vla-get-ActiveDocument
		     (vlax-get-acad-object))
	  layerCol(vla-get-Layers activeDoc)
          insPoint(vla-get-InsertionPoint blockRef)
	  layer(vla-get-Layer blockRef)
	  lineType(vla-get-LineType blockRef)
	  linetypScale(vla-get-LinetypeScale blockRef)
	  lineWeight(vla-get-LineWeight blockRef)
	  name(vla-get-Name blockRef)
	  normal(vla-get-Normal blockRef)
	  ownerId(vla-get-OwnerID blockRef)
	  rotation(vla-get-Rotation blockRef)
	  visible(vla-get-Visible blockRef)
	  XScale(vla-get-XScaleFactor blockRef)
	  YScale(vla-get-YScaleFactor blockRef)
	  ZScale(vla-get-ZScaleFactor blockRef)
	  vlaLayer(vla-item layerCol layer)
	  ); end setq
    
    (vla-delete blockRef)
    (setq newRef
(vla-InsertBlock (vla-objectidtoobject activeDoc ownerId) insPoint name
              XScale YScale ZScale rotation))
    (vla-put-Layer newRef layer)
    (vla-put-LineType newRef lineType)
    (vla-put-LinetypeScale newRef linetypScale)
    (vla-put-LineWeight newRef lineWeight)
    (vla-put-Normal newRef normal)
    (vla-put-Visible newRef visible)
    (princ)
    );end of refReisert
	  
   (setq actDoc(vla-get-ActiveDocument
		     (vlax-get-acad-object))
	 blockCol(vla-get-Blocks actDoc)
	 layerCol(vla-get-Layers actDoc)
	 layerState '()
	 ); end setq
    (if
      (and
	block
	(=(cdr(assoc 0(entget block))) "INSERT")
	); end and
     (progn
       	(setq ssgetList(list '(0 . "INSERT")(assoc 2(entget block)))
	      refSet(ssget "_X" ssgetList)
	      refList
	        (mapcar 'vlax-ename->vla-object 
                  (vl-remove-if 'listp 
                     (mapcar 'cadr(ssnamex refSet))))
	      curBlock(vla-item blockCol
			(cdr(assoc 2(entget block))))
       ); end setq
     (vlax-for l LayerCol 
       (setq layerState 
            (append layerState 
             (list 
              (list 
                l 
               (vla-get-Lock l))))) 
               (vla-put-lock l :vlax-false) 
       ); end vlax-for 
       (if(= "I" operMode)
	 (progn
      (foreach ref refList
	(attInsert dataList curBlock)
	(refReinsert ref)
	); end foreach
      (princ "\nAttributes was inserted ")
      );end progn
	 
	 (progn
	   (foreach  ref refList
	       (vlax-for ent curBlock
		 (if
		   (and
		     (= "AcDbAttributeDefinition"(vla-get-ObjectName ent))
		     (member(vla-get-TagString ent) dataList)
		     ); end end
		   (vla-delete ent)
		    ); end if
		 ); end vlax-for
	       (refReinsert ref)
	       ); end foreach
	   (princ "\nAttributes was deleted ")
	     ); end progn
	   ); end if
           (foreach l layerState 
      (vla-put-Lock (car l)(cadr l)) 
   ); end foreach
       );progn
       (princ "/nNotning block selected!")
      ); end if
      (princ)
      ); end of InsertIvisAtt

[Vova]

Сообщение от Fantomas По совету Vova улучшил лисп для "исправления" блоков. 2) Ввел опцию определяющую цвет блоков после обработки: по Слою, по Блоку или Текущий цвет блока.

Опция byLayer почему-то выдает цвет byBlock. Будут и другие замечания, по-позже. Мы с тобой используем ремонт блоков в узких целях, чтобы перекрасить пестрый чертеж, содержащий цветные блоки, которые не поддаются прямой перекраске, в однотонный, пригодный для подосновы для своих чертежей. Для создания универсальной программы надо бы знать, в каких еще целях требуется ремонт блоков. Какие ошибки сделали создатели блоков, чтобы эти ошибки исправить. Здесь подходящее место чтобы выяснить это.

[{Smirnoff}]

Опция byLayer почему-то выдает цвет byBlock.

Выдает ByLayer. В смысле сам блок ByLayer, а примитивы в нем содержащиеся ByBlock.

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

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

[{Smirnoff}]

Доходит как до жирафа... Понял, надо сделать вариант выбора при котором, цвет примитивов в блоке ByLayer. Будет...

Ждем дальнейших ЦУ, БЦУ и ЕБЦУ

[Tech]

.... с атрибутами по моему веселее, вставил и заполнил по пунктам.

А-а-а-а-грамадное спасибо, мне о-о-очень понравилось, пиво за мной 8), правда не знаю как у вас относятся к контрабанде, а то при легальном ввозе наверняка пошлину сдерут :wink:, или у нас не выпустят пока новый президент не издаст указа :P .

[{Smirnoff}]

А-а-а-а-грамадное спасибо, мне о-о-очень понравилось, пиво за мной , правда не знаю как у вас относятся к контрабанде, а то при легальном ввозе наверняка пошлину сдерут , или у нас не выпустят пока новый президент не издаст указа .

Я рад Пива у нас навалом. А вот водку поганую делают... Как кто в Россию едет, обязательно 1 разрешенный литр привозит.

Изменение Description, тоже напишу, но не сегодня, много работы. Тем более что с функцией подкинутой Alaspher эьо пустяк

[Геннадий aka PG]

Сообщение от Fantomas Я рад Пива у нас навалом. А вот водку поганую делают... Как кто в Россию едет, обязательно 1 разрешенный литр привозит.

Дык, не наездишься в Россию то!
А самогоноварение процветает?

[{Smirnoff}]

Дык, не наездишься в Россию то!

Да я бы ездил и ездил если бы отпускали. Не за водкой конечно. Когда приезжаешь, какой то "напряг" уходит. Все по русски написано, везде льется русская речь, чувствую себя немного счасливым...

А самогоноварение процветает?

На хуторах наверное процветает. Для желающих есть "точки", особенно после того как пивом и водкой после 22:00 торговать запретили. Но мы такого не употребляемс... и вообще достаточно воздержаны.

Все пора работать :?

[{Smirnoff}]

>Lamer
Обещанное изменение Desription:

Код:

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

(defun c:cds (/ block blName Descr operMode newDescr)

  (defun ru-block-set-description (block_name 
                                 block_description 
                                 / 
                                 block_begin 
                                 block_ent 
                                 old_description 
                                 is_block_make 
                                 block_layer 
                                ) 
  (if (setq block_ent (tblobjname "block" block_name)) 
    (progn 
      (setq block_begin       (entget block_ent) 
            block_description (cons 4 block_description) 
            block_layer       (assoc 8 block_begin) 
            block_begin       (if (setq old_description (assoc 4 block_begin)) 
                                (subst block_description old_description block_begin) 
                                (append block_begin (list block_description)) 
                              ) 
            is_block_make     (entmake (ru-ent-dxf-code-clear-list block_begin '(-1 -2 1 5 330 71) nil)) 
      ) 
      (if is_block_make 
        (progn (while (setq block_ent (entnext block_ent)) 
                 (entmake (ru-ent-dxf-code-clear-list (entget block_ent) '(-1 5 330 71) nil)) 
               ) 
               (entmake 
                 (list '(0 . "ENDBLK") '(100 . "AcDbEntity") '(100 . "AcDbBlockEnd") block_layer) 
               ) 
               (if old_description 
                 (cdr old_description) 
                 "" 
               ) 
        ) 
      ) 
    ) 
  ) 
) 

(defun ru-ent-dxf-code-clear-list (lst list_dxf_codes is_stay_value) 
  (cond ((null lst) nil) 
        ((/= is_stay_value (= (type (member (caar lst) list_dxf_codes)) 'list)) 
         (ru-ent-dxf-code-clear-list (cdr lst) list_dxf_codes is_stay_value) 
        ) 
        (t 
         (cons (car lst) 
               (ru-ent-dxf-code-clear-list (cdr lst) list_dxf_codes is_stay_value) 
         ) 
        ) 
  ) 
)

  (if
    (setq block(car(entsel "\nSelect block ")))
    (progn
   (if(= "INSERT"(cdr(assoc 0(entget block))))
     (progn
       (setq blName(cdr(assoc 2(entget block))))
     (if
       (setq Descr(cdr(assoc 4(tblsearch "block" blName))))	 
       (princ(strcat "\nBlock name: " blName "\nDescription: " Descr))
       (princ(strcat "\nBlock name: " blName
		     "\n*** Hasn't description ***"))
	 );end if
        (initget "Y N")
       (setq operMode(getkword "\Do you want to modify the block's description? 
<N>: "))
       (if(null operMode)(setq operMode "N"))
       (if(= operMode "Y")
	 (progn
	   (setq newDescr(getstring "\Enter new description: "))
	   (if(null newDescr)(setq newDescr ""))
	   (ru-block-set-description blName newDescr)
	   (princ(strcat "\nNew description: " newDescr))
       ); end prog
       ); end if
     ); end progn
  (princ "\n*** This isn't a block ***")
  ); end if
    ); end progn
  (princ "\n*** Nothing selected ***")
	 ); end if
    (princ)
  ); end bld

Alasper, спасибо![/code]

[Alaspher]

Пара непрограммных неточностей/опечаток:

"\n*** Haven't description ***"

Скорее, всё же: "...Hasn't description...", а ещё точнее: "There isn't description"

"\nDo you want modify block Descroipion <N>: "

Тут просто опечатка: ...Descroipion...

[{Smirnoff}]

Спасибо, исправлено.

[Tech]

Сообщение от Fantomas >Lamer Обещанное изменение Desription:

:!: :!: :!: Еще раз огромное спасибо, вместе с атрибутами получился отличный набор, теперь смогу навести порядок в своих закромах :wink: .

[{Smirnoff}]

Всегда пожалуйста. Если время конечно есть.

[ambir]

Вопрос такой - про блоки!

Подскажите, пожалуйста, такую весчь - при создании блока в 2004 автокаде. его редактировать можно в самом рабочем поле автокада, при этом все остальное становиться нередактируемым - что очень удобно, ибо виден весь чертеж.. а вопрос в следующем, поставила я себе 2007 автокад, а там - на тебе отдельное окошко... я не вижу чертежа - как следствие не понимаю, что мне редактировать.. выскакивает редактор только самого блока!!! что делать???? есть ли эта опция в 2007 и просто завуалирована, либо в 2007 это нафик убрали?? помогите!!

[Кулик Алексей aka kpblc]

Правый пинок и в конт.меню "Редактировать на месте"

[ambir]

ураааа+))) спасибо огромное!!!!!! вы меня спасли!!

[Vova]

Не так много воды утекло от 2004, и уже в след. версии-06, появились дин. блоки, а вместе с ними новый их редактор. Что-же ты не интересуешься новинками в автокаде? На форумах и в коридорах, наверное, всю плешь проели, перемалывая дин. блоки, и это прошло мимо...
Ах, да, ты новичек на форуме. Будешь регулярно здесь тусоваться, не упустишь очередные новинки. Тебе задание: сделать простой динамический блок. Четырехугольник, который можно растянуть за одну грипсу

[Shoorup]

Вопросики такие есть:
1. Можно ли так сделать чтобы свойства одного д.блока копировались в другой? Если можно то как?
На лисе есть динамический блок (например КБЛОК1) у него есть параметр видимости (например 1,2,3,4,5) На этом же листе есть другой д. блок (например МБЛОК1) с параметром видимости (те же 1,2,3,4,5). Задача такая: я выбираю в блоке КБЛОК1 параметр видимости например "2". потом например тыкаю кнопку которая выполняет лисп и МБЛОК1 меняет автоматом свой параметр видимости (например с 3) на "2" соответственно. КБЛОК1 и МБЛОК1 имеют разную геометрию но суть у них одинаковая.
2. А если этих блоков 500 и больше? (т.е. уже нужно при нажатии кнопки чтобы блоки например начинающиеся (в названии блока) на "К" сверились и изменили если необходимо свои свойства в блоках начинающиеся на букву "М")

[Елпанов Евгений]

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

[Shoorup]

Немного подумал что конкретно хочется... наверно идея немного и не такая... и так не получится...
более подробно в суть:
Есть поле (ПОЛЕ "К") с ячейками(80х90 например) все выглядит как морской бой А4, Б15, К56 и т.д.В каждой ячейке есть какой-то блок со свими свойствами со своими атрибутами (он может повторяться в других ячейках) И есть другое поле (ПОЛЕ "М") по сути с теми же блоками (вид у них другой) поля и ячейки стандартные и заморожены (не редактируются воопсще) . Я заполняю блоками поле "К", редактирую в блоках атрибуты, меняю свойства (только свойство видимости).
А теперь хочеться сделать такую фантастическую штуку: чтобы поле "М" зеркально заполнилось в соответствии с полем "К", причем скопировало все свойства и атрибуты.

[Елпанов Евгений]

Сообщение от Shoorup А теперь хочеться сделать такую фантастическую штуку: чтобы поле "М" зеркально заполнилось в соответствии с полем "К", причем скопировало все свойства и атрибуты.

Когда мне хочется, что нибудь сделать, я обычно делаю...

[Shoorup]

Сообщение от Елпанов Евгений Когда мне хочется, что нибудь сделать, я обычно делаю...

Ну ОЧЕНЬ ценный совет! Огромное тебе спасибо!

[Елпанов Евгений]

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

[Shoorup]

а сцылочку на тему мона?

[Кулик Алексей aka kpblc]

http://dwg.ru/f/showthread.php?t=14519