[ilka_t]

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

[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...