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

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

Помогите обработать штриховку, входящую в блок

Ответ
Поиск в этой теме
Непрочитано 20.01.2021, 11:05 #1
Помогите обработать штриховку, входящую в блок
Петр-и-Алекс
 
Регистрация: 18.01.2021
Сообщений: 404

Потребовалось команда смены слоев штриховок по определенному алгоритму. Собственно с этим проблем нет, реализация в прилагаемом файле.
Проблема в обработке штриховок, входящих в блоки... Они, понятно, этим текстом не обрабатываются.
Если бы сообщество показало пример текста, позволяющего дотянуться до штриховок блока , то это было бы что надо!
В реале блоки используются не динамические... хотя бы только для них...

Последний раз редактировалось Петр-и-Алекс, 09.02.2021 в 18:26.
Просмотров: 2720
 
Непрочитано 20.01.2021, 11:34
#2
Кулик Алексей aka kpblc
Moderator

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


В первом приближении (времени писать код сейчас нет):
1. в набор поместить также INSERT
2. в цикле проверять имя примитива. Если INSERT - то входить в описание блока и проходить по его примитивам.

----- добавлено через ~18 мин. -----
Как вариант, на коленке и без особых проверок. Код очень грязный, учти!
Код:
[Выделить все]
 (vl-load-com)

(defun change-hatch-layer (/ fun_set-layer fun_inside_block adoc layer_status selset block_name_list)
  (defun fun_inside_block (ref / def)
    (vlax-for ent (vla-item (vla-get-blocks adoc) (vla-get-name ref))
      (cond ((wcmatch (strcase (vla-get-objectname ent)) "*HATCH") (fun_set-layer ent))
            ((wcmatch (strcase (vla-get-objectname ent)) "*BLOCKREF*") (fun_inside_block ent))
      ) ;_ end of cond
    ) ;_ end of vlax-for
  ) ;_ end of defun
  (defun fun_set-layer (ent / layer new)
    (setq layer (vla-get-layer ent)
          new   (cond ((member layer '(("ГР_" "ГР-" "GR_"))) "ГР_штриховка")
                      ((not (member (strcase layer) '("ШТРИХОВКА" "ГР_ШТРИХОВКА" "ТХ_" "ГП_")))
                       (strcat "штриховка_" layer)
                      )
                ) ;_ end of cond
    ) ;_ end of setq
    (if new
      (progn (if (not (tblobjname "layer" new))
               (vla-add (vla-get-layers adoc) new)
             ) ;_ end of if
             (vla-put-layer ent new)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
  (if (setq selset (ssget "_X" '((0 . "INSERT,HATCH"))))
    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (setq layer_status ((lambda (/ res)
                                 (vlax-for item (vla-get-layers adoc)
                                   (setq res (cons (cons item
                                                         (mapcar (function (lambda (pr / val)
                                                                             (setq val (vlax-get-property item pr))
                                                                             (vl-catch-all-apply (function (lambda () (vlax-put-property item pr :vlax-false))))
                                                                             (cons pr val)
                                                                           ) ;_ end of lambda
                                                                 ) ;_ end of function
                                                                 '("freeze" "lock")
                                                         ) ;_ end of mapcar
                                                   ) ;_ end of cons
                                                   res
                                             ) ;_ end of cons
                                   ) ;_ end of setq
                                 ) ;_ end of vlax-for
                                 res
                               ) ;_ end of lambda
                              )
           ) ;_ end of setq
           (foreach ent ((lambda (/ tab item)
                           (repeat (setq tab  nil
                                         item (sslength selset)
                                   ) ;_ end setq
                             (setq tab (cons (ssname selset (setq item (1- item))) tab))
                           ) ;_ end of repeat
                         ) ;_ end of lambda
                        )
             (cond ((= (cdr (assoc 0 (entget ent))) "HATCH") (fun_set-layer (vlax-ename->vla-object ent)))
                   ((= (cdr (assoc 0 (entget ent))) "INSERT") (fun_inside_block (vlax-ename->vla-object ent)))
             ) ;_ end of cond
           ) ;_ end of foreach
           (foreach item layer_status
             (foreach pr (cdr item)
               (vl-catch-all-apply (function (lambda () (vlax-put-property (car item) (car pr) (cdr pr)))))
             ) ;_ end of foreach
           ) ;_ end of foreach
           (vla-endundomark adoc)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 20.01.2021, 12:13
#3
Alex.gomel


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


Или так:
(
Код:
[Выделить все]
 vlax-for Obj (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
			(vla-get-Name (vlax-ename->vla-object (car(entsel)))))
  (if (eq (vla-get-ObjectName Obj) "AcDbHatch") 
    (princ "Штриховка"))
)
Alex.gomel вне форума  
 
Автор темы   Непрочитано 20.01.2021, 12:37
#4
Петр-и-Алекс


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


спасибо!
будем смотреть

----- добавлено через ~23 ч. -----
пробовал второй вариант
читал описание системы vla- в попытках заменить ручной выбор объекта (entsel ) автоматическим перебором по всей базе чертежа...
за один вечер не справился. но утомился сильно...
но надежды не теряю. продолжу штурм позже
второй вариант видится более "изящным", потому начал с этой технологии
есть еще одно соображение: про INSERT идеологически понятно. но ведь есть еще определения самих блоков... на случай последующих вставок их же тоже надо переопределять...
Петр-и-Алекс вне форума  
 
Непрочитано 27.01.2021, 17:22
#5
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от Петр-и-Алекс Посмотреть сообщение
В реале блоки используются не динамические
штриховке блока всё равно на его динамичность, поскольку она является статическим объектом и всегда находится в описании блока
Цитата:
Сообщение от Петр-и-Алекс Посмотреть сообщение
про INSERT идеологически понятно. но ведь есть еще определения самих блоков
для смены слоя штриховки 1-го уровня и нужно менять его именно в определении блока (не в его вхождении)

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

Код:
[Выделить все]
 
;*******************************************************************************************

;;; переннос штриховок со слоев:
;;; имеющих префикс имени по списку ("ГР_" "ГР-" "GR_") на слой "ГР_штриховка"
;;; имеющих префикс имени по списку ("ТХ_" "ГП_" ) должны остаться на прежнем слое
;;; имеющих любое иное имя - на слой  "штриховка_прежнее имя слоя"

;*******************************************************************************************

(defun c:change_hatch_layer ( / block_processed_list hatches_processed)

	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(setq hatches_processed 0)

	;*******************************************************************************************

	(defun change_object_layer (object / )
		(cond
			(
				(vl-some '(lambda (pattern) (vl-string-search pattern (vla-get-layer object)))
						 '("ГР_" "ГР-" "GR_")
				)
					(vla-put-layer object "ГР_штриховка")
			)
			(
				(vl-some '(lambda (pattern) (vl-string-search pattern (vla-get-layer object)))
						 '("ТХ_" "ГП_")
				)
			)
			(
				t
					(vla-put-layer object "штриховка_прежнее имя слоя")
			)
		)
	)

	;*******************************************************************************************

	(vlax-for every_db_entry (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
		(cond
			(
				(= "AcDbHatch" (vla-get-objectname every_db_entry))
					(change_object_layer every_db_entry)
					(setq hatches_processed (1+ hatches_processed))
			)
			(
				(and
					 (= "AcDbBlockReference" (vla-get-objectname every_db_entry))
					 (not (member (vla-get-effectivename every_db_entry) block_processed_list))
				)
					(setq block_processed_list (append block_processed_list (list (vla-get-effectivename every_db_entry))))
					(vlax-for every_block_entry (vla-item (vla-get-blocks (vla-get-Activedocument (vlax-get-acad-object))) (vla-get-effectivename every_db_entry))
						(if (= "AcDbHatch" (vla-get-objectname every_block_entry))
							(progn
								(change_object_layer every_block_entry)
								(setq hatches_processed (1+ hatches_processed))
							)
						)
					)
			)
			(
				t
			)
		)
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ (strcat "\nОбработано штриховок: " (itoa hatches_processed)))
	(princ)
)

;*******************************************************************************************
koMon вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите обработать штриховку, входящую в блок

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как заменить (redefine) один блок вторым с сохранением выбора (visibility)? Unfamous Динамические блоки 13 27.09.2011 13:25
Помогите импортировать блок frz73 Динамические блоки 2 08.04.2011 16:02
Помогите доделать программу добавления объектов в блок МишаVBA Программирование 1 20.05.2006 01:04
Помогите обработать кучу MText'a Nikolay_N AutoCAD 1 31.03.2006 20:16
ПОМОГИТЕ, ГОРЮ! как внешний блок преобразовать в обычный вид Соня Динамические блоки 4 11.10.2004 20:23