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

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

Создать Lisp для расчленения блоков с переносом на слой

Ответ
Поиск в этой теме
Непрочитано 12.11.2018, 13:40 #1
Создать Lisp для расчленения блоков с переносом на слой
AlexKey
 
будущий технолог
 
Регистрация: 27.08.2012
Сообщений: 69

Добрый день. Прошу помощи. У меня есть однотипные блоки, внутри которых примитивы расположены на одинаковых слоях, например "22", "33", "44". Сами блоки раскиданы по разным слоям, в зависимости от принадлежности к той или иной системе. Задача взорвать блоки, чтобы примитивы оказались на том же слое, где были блоки и приняли все свойства "по слою", за исключением примитивов на слое "11". Может кто помочь с написанием программы?
Просмотров: 2075
 
Непрочитано 12.11.2018, 15:55
#2
Громов Владимир

Инженер
 
Регистрация: 24.05.2008
г. Москва
Сообщений: 13


Изменение свойств элементов блока:
Код:
[Выделить все]
(defun C:CHOB ( / bl)
(setq bl (cdr (assoc 2 (entget (car (entsel "\nВыберите блок: "))))))
(vl-cmdf "_-BEDIT" bl "_CHPROP" "_all" "" "_CO" "_ByLayer" "_LT" "_ByLayer" "_LW" "_ByLayer" "_TR" "_ByLayer" "" "_BCLOSE" "_S")
(princ)
)
Громов Владимир вне форума  
 
Автор темы   Непрочитано 12.11.2018, 16:03
#3
AlexKey

будущий технолог
 
Регистрация: 27.08.2012
Сообщений: 69
<phrase 1=


Цитата:
Сообщение от Громов Владимир Посмотреть сообщение
Изменение свойств элементов блока:
Код:
[Выделить все]
(defun C:CHOB ( / bl)
(setq bl (cdr (assoc 2 (entget (car (entsel "\nВыберите блок: "))))))
(vl-cmdf "_-BEDIT" bl "_CHPROP" "_all" "" "_CO" "_ByLayer" "_LT" "_ByLayer" "_LW" "_ByLayer" "_TR" "_ByLayer" "" "_BCLOSE" "_S")
(princ)
)
Не работает
Код:
[Выделить все]
Команда: CHOB
???????? ????:
Недопустимые символы в имени блока.
Символы, не разрешенные в именах блоков:
          <>/\":;?*|,=`
Неизвестная команда "ALL".  Для вызова справки нажмите F1.
Неизвестная команда "CHOB".  Для вызова справки нажмите F1.
Неизвестная команда "CO".  Для вызова справки нажмите F1.
Неизвестная команда "BYLAYER".  Для вызова справки нажмите F1.
Неизвестная команда "LT".  Для вызова справки нажмите F1.
Неизвестная команда "BYLAYER".  Для вызова справки нажмите F1.
Неизвестная команда "LW".  Для вызова справки нажмите F1.
Неизвестная команда "BYLAYER".  Для вызова справки нажмите F1.
Неизвестная команда "TR".  Для вызова справки нажмите F1.
Неизвестная команда "BYLAYER".  Для вызова справки нажмите F1.
Неизвестная команда "CHOB".  Для вызова справки нажмите F1.
Неизвестная команда "S".  Для вызова справки нажмите F1.
AlexKey вне форума  
 
Непрочитано 12.11.2018, 16:16
#4
Кулик Алексей aka kpblc
Moderator

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


В поиск - "Нормализация блоков", "Подготовка подосновы"
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 23.11.2018, 09:30
1 | #5
Maksim7enov


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


В образовательных целях попробовал создать лисп по выдвинутым требованиям. Просьба проверить и тыкнуть на ошибки или на то как можно это сделать более лучше.
Код:
[Выделить все]
 
(defun chance_block_property_object (value /)
;Пример вызова (chance_block_property_object "0")
;(chance_block_property_object "<Имя слоя который необходимо игнорировать>")
  (vl-load-com)
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
		  item (sslength value)
	    ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end_of_defun
  (if
    (= (cdr (assoc 2 (tblsearch "LAYER" value))) value)
     (progn
       (mapcar
	 (function
	   (lambda (x / obj_1)
	     (setq obj_1 (vlax-ename->vla-object x))
	     (foreach item (vlax-safearray->list
			     (vlax-variant-value (vla-explode obj_1))
			   ) ;_ end_of_vlax-safearray->list
	       (cond
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*LINE*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*CIRCLE*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item)) "*ARC*")
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*ELLIPSE*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*BLOCK*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (foreach item_1
			     (vlax-safearray->list
			       (vlax-variant-value (vla-explode item))
			     ) ;_ end_of_vlax-safearray->list
		      (vlax-put-property item_1 'color acbylayer)
		      (vlax-put-property item_1 'lineweight -1)
		      (cond ((/= (vla-get-layer item) value)
			     (vlax-put-property
			       item_1
			       'layer
			       (vla-get-layer obj_1)
			     ) ;_ end_of_vlax-put-property
			    )
		      ) ;_ end_of_COND
		      (vlax-put-property item_1 'linetype "ByLayer")
		    ) ;_ end_of_foreach
		    (vla-delete item)
		  ) ;_ end_of_progn
		 )
	       ) ;_ end_of_cond
	     ) ;_ end_of_foreach
	     (vla-delete obj_1)
	   ) ;_ end_of_lambda
	 ) ;_ end_of_function
	 (_dwgru-conv-pickset-to-list (ssget '((0 . "insert"))))
       ) ;_ end_of_mapcar
     ) ;_ end_of_progn
     (princ "В файле нет такого слоя!")
  ) ;_ end_of_if
)

Последний раз редактировалось Maksim7enov, 23.11.2018 в 11:29.
Maksim7enov вне форума  
 
Непрочитано 23.11.2018, 11:17
1 | 1 #6
RrRR


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


Maksim7enov, не вдаваясь в код сразу бросилось в глаза "*ELLIPCE*".
Может ELLIPSE имелся в виду?
RrRR вне форума  
 
Автор темы   Непрочитано 23.11.2018, 13:10
#7
AlexKey

будущий технолог
 
Регистрация: 27.08.2012
Сообщений: 69
<phrase 1=


Цитата:
Сообщение от Maksim7enov Посмотреть сообщение
В образовательных целях попробовал создать лисп по выдвинутым требованиям. Просьба проверить и тыкнуть на ошибки или на то как можно это сделать более лучше.
Код:
[Выделить все]
 
(defun chance_block_property_object (value /)
;Пример вызова (chance_block_property_object "0")
;(chance_block_property_object "<Имя слоя который необходимо игнорировать>")
  (vl-load-com)
  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
		  item (sslength value)
	    ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end_of_defun
  (if
    (= (cdr (assoc 2 (tblsearch "LAYER" value))) value)
     (progn
       (mapcar
	 (function
	   (lambda (x / obj_1)
	     (setq obj_1 (vlax-ename->vla-object x))
	     (foreach item (vlax-safearray->list
			     (vlax-variant-value (vla-explode obj_1))
			   ) ;_ end_of_vlax-safearray->list
	       (cond
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*LINE*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*CIRCLE*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item)) "*ARC*")
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*ELLIPSE*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (vlax-put-property item 'color acbylayer)
		    (vlax-put-property item 'lineweight -1)
		    (cond ((/= (vla-get-layer item) value)
			   (vlax-put-property
			     item
			     'layer
			     (vla-get-layer obj_1)
			   ) ;_ end_of_vlax-put-property
			  )
		    ) ;_ end_of_COND
		    (vlax-put-property item 'linetype "ByLayer")
		  ) ;_ end_of_progn
		 )
		 ((= (wcmatch (strcase (vla-get-objectname item))
			      "*BLOCK*"
		     ) ;_ end_of_wcmatch
		     t
		  ) ;_ end_of_=
		  (progn
		    (foreach item_1
			     (vlax-safearray->list
			       (vlax-variant-value (vla-explode item))
			     ) ;_ end_of_vlax-safearray->list
		      (vlax-put-property item_1 'color acbylayer)
		      (vlax-put-property item_1 'lineweight -1)
		      (cond ((/= (vla-get-layer item) value)
			     (vlax-put-property
			       item_1
			       'layer
			       (vla-get-layer obj_1)
			     ) ;_ end_of_vlax-put-property
			    )
		      ) ;_ end_of_COND
		      (vlax-put-property item_1 'linetype "ByLayer")
		    ) ;_ end_of_foreach
		    (vla-delete item)
		  ) ;_ end_of_progn
		 )
	       ) ;_ end_of_cond
	     ) ;_ end_of_foreach
	     (vla-delete obj_1)
	   ) ;_ end_of_lambda
	 ) ;_ end_of_function
	 (_dwgru-conv-pickset-to-list (ssget '((0 . "insert"))))
       ) ;_ end_of_mapcar
     ) ;_ end_of_progn
     (princ "В файле нет такого слоя!")
  ) ;_ end_of_if
)
Огромное вам спасибо за проделанную работу. По первому тесту программа работает так, как надо. Сейчас еще погоняю на разных файлах и отпишусь.
AlexKey вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Создать Lisp для расчленения блоков с переносом на слой

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Может есть lisp для копирования объектов из разных блоков в пространство чертежа ? Куинбус Флестрин LISP 6 30.12.2016 15:24
LISP. Нормализация блоков текущего файла. Кулик Алексей aka kpblc Готовые программы 82 06.07.2016 20:38
Не могу создать слой( новенькийновый AutoCAD 2 20.10.2015 20:22
Можно ли создать замену (дополнение) блоков для AutoCAD? Elgoritm AutoCAD 27 06.04.2012 17:46
lisp для автоматического переноса размеров в отдельный слой phantom_l LISP 7 08.07.2008 11:27