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

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

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

Ответ
Поиск в этой теме
Непрочитано 04.06.2018, 09:14
LISP. Помогите с лиспом по переименованию нескольких вхождений динамического блока в значение его атрибута.
kirillwu
 
Регистрация: 01.09.2015
Сообщений: 13

В файле имеются множество вхождений динамического блока. У динамического блока есть атрибут с тэгом "ИМЯ_001", файл с блоком прилагаю. У всех вхождений одно и тоже имя блока "Стойка. Требуется лисп, который переименует каждое вхождение в блока в значение атрибута с тэгом "ИМЯ_001". Нашел в интернете чужой лисп, который позволяет переименовать вхождение блока в значение, вводимое с клавиатуры. Требуется чуть доработать этот лисп, чтобы была возможность блок переименовать в значение атрибута, не вводя ничего с клавиатуры.
Например я имею в чертеже 100 блоков с именем "стойка" Из них 70 с атрибутом "ИМЯ_001" - со значением "СТ-1", И 30 с атрибутом "ИМЯ_001" - со значением "СТ-2", После ввода команды выделяю нужные для изменения блоки, и создается 70 блоков с именем "СТ-1" и 30 блоков "СТ-2", с сохранением их динамических свойств.



Код:
[Выделить все]
 
CopyRenameBlockV1-5.lsp © 2018 Lee Mac
DarkLightVLIDE
;;-----------------=={ Copy/Rename Block Reference }==------------------;;
;;                                                                      ;;
;;  This program allows a user to copy and/or rename a single block     ;;
;;  reference in the working drawing.                                   ;;
;;                                                                      ;;
;;  Many existing programs enable the user to rename the block          ;;
;;  definition for a given block reference, with the new name           ;;
;;  subsequently reflected across all references of the block           ;;
;;  definition in the drawing. However, this program will allow a       ;;
;;  single selected block reference to be renamed (or for the user to   ;;
;;  create a renamed copy of the selected block reference), by          ;;
;;  generating a duplicate renamed block definition for the selected    ;;
;;  block.                                                              ;;
;;                                                                      ;;
;;  The program may be called from the command-line using either 'CB'   ;;
;;  to create a renamed copy of a selected block reference, or 'RB' to  ;;
;;  simply rename the selected block reference.                         ;;
;;                                                                      ;;
;;  Following selection of a block reference, the user is prompted to   ;;
;;  specify a name for the selected/copied block reference; a default   ;;
;;  block name composed of the original block name concatenated with    ;;
;;  both an underscore and the minimum integer required for uniqueness  ;;
;;  within the block collection of the active drawing is offered.       ;;
;;                                                                      ;;
;;  The program will then proceed to duplicate the block definition     ;;
;;  using the new block name. To accomplish this without resulting in   ;;
;;  a duplicate key in the block collection of the active drawing, the  ;;
;;  program utilises an ObjectDBX interface to which the block          ;;
;;  definition of the selected block reference is deep-cloned, renamed, ;;
;;  and then deep-cloned back to the active drawing. This method also   ;;
;;  enables Dynamic Block definitions to be successfully copied         ;;
;;  & renamed.                                                          ;;
;;                                                                      ;;
;;  Finally, this program will perform successfully in all UCS/Views    ;;
;;  and is compatible with Anonymous Blocks, Dynamic Blocks & XRefs.    ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2013  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.5    -    05-07-2013                                      ;;
;;----------------------------------------------------------------------;;
 
(defun c:cb nil (LM:RenameBlockReference   t))
(defun c:rb nil (LM:RenameBlockReference nil))
 
(defun LM:RenameBlockReference ( cpy / *error* abc app dbc dbx def doc dxf new old prp src tmp vrs )
 
    (defun *error* ( msg )
        (if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
            (vlax-release-object dbx)
        )
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
    
    (while
        (progn
            (setvar 'errno 0)
            (setq src (car (entsel (strcat "\nSelect block reference to " (if cpy "copy & " "") "rename: "))))
            (cond
                (   (= 7 (getvar 'errno))
                    (princ "\nMissed, try again.")
                )
                (   (= 'ename (type src))
                    (setq dxf (entget src))
                    (cond
                        (   (/= "INSERT" (cdr (assoc 0 dxf)))
                            (princ "\nPlease select a block reference.")
                        )
                        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (cdr (assoc 8 dxf)))))))
                            (princ "\nSelected block is on a locked layer.")
                        )
                    )
                )
            )
        )
    )
    (if (= 'ename (type src))
        (progn
            (setq app (vlax-get-acad-object)
                  doc (vla-get-activedocument app)
                  src (vlax-ename->vla-object src)
                  old (vlax-get-property src (if (vlax-property-available-p src 'effectivename) 'effectivename 'name))
                  tmp 0
            )
            (while (tblsearch "block" (setq def (strcat (vl-string-left-trim "*" old) "_" (itoa (setq tmp (1+ tmp)))))))
            (while
                (and (/= "" (setq new (getstring t (strcat "\nSpecify new block name <" def ">: "))))
                    (or (not (snvalid new))
                        (tblsearch "block" new)
                    )
                )
                (princ "\nBlock name invalid or already exists.")
            )
            (if (= "" new)
                (setq new def)
            )
            (setq dbx
                (vl-catch-all-apply 'vla-getinterfaceobject
                    (list app
                        (if (< (setq vrs (atoi (getvar 'acadver))) 16)
                            "objectdbx.axdbdocument"
                            (strcat "objectdbx.axdbdocument." (itoa vrs))
                        )
                    )
                )
            )
            (if (or (null dbx) (vl-catch-all-error-p dbx))
                (princ "\nUnable to interface with ObjectDBX.")
                (progn
                    (setq abc (vla-get-blocks doc)
                          dbc (vla-get-blocks dbx)
                    )
                    (vlax-invoke doc 'copyobjects (list (vla-item abc old)) dbc)
                    (if (wcmatch old "`**")
                        (vla-put-name (vla-item dbc (1- (vla-get-count dbc))) new)
                        (vla-put-name (vla-item dbc old) new)
                    )
                    (vlax-invoke dbx 'copyobjects (list (vla-item dbc new)) abc)
                    (vlax-release-object dbx)
                    (if cpy (setq src (vla-copy src)))
                    (if
                        (and
                            (vlax-property-available-p src 'isdynamicblock)
                            (= :vlax-true (vla-get-isdynamicblock src))
                        )
                        (progn
                            (setq prp (mapcar 'vla-get-value (vlax-invoke src 'getdynamicblockproperties)))
                            (vla-put-name src new)
                            (mapcar
                               '(lambda ( a b )
                                    (if (/= "ORIGIN" (strcase (vla-get-propertyname a)))
                                        (vla-put-value a b)
                                    )
                                )
                                (vlax-invoke src 'getdynamicblockproperties) prp
                            )
                        )
                        (vla-put-name src new)
                    )
                    (if (= :vlax-true (vla-get-isxref (setq def (vla-item (vla-get-blocks doc) new))))
                        (vla-reload def)
                    )
                    (if cpy (sssetfirst nil (ssadd (vlax-vla-object->ename src))))
                )
            )
        )
    )
    (princ)
)
 
;;----------------------------------------------------------------------;;
 
(vl-load-com)
(princ
    (strcat
        "\n:: CopyRenameBlock.lsp | Version 1.5 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,$(getvar,date),YYYY)")
        " www.lee-mac.com ::"
        "\n:: Available Commands:"
        "\n::    \"CB\"  -  Copy & Rename Block Reference."
        "\n::    \"RB\"  -  Rename Block Reference."
    )
)
(princ)
 
;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;
______________________________________________________________________________________
Вложенный лисп к сожалению работает только с одним вхождением. Нужно чтобы была возможность выбрать несколько вхождений и переименовать их в значение аттрибута, с сохранением их всех динамических парамметров.

Сообщение несколько раз редактировал, извините за первоначальную неграмотность

Вложения
Тип файла: dwg
DWG 2013
Тест.dwg (44.1 Кб, 108 просмотров)


Последний раз редактировалось kirillwu, 04.06.2018 в 16:22.
Просмотров: 10828
 
Непрочитано 29.06.2018, 00:21
#21
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


kirillwu, Тестируй
Вложения
Тип файла: lsp CopyBlockNamefromAttribute-VVA.lsp (19.3 Кб, 19 просмотров)
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 04.07.2018, 09:05
#22
koMon


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


Цитата:
Сообщение от kirillwu Посмотреть сообщение
В файле имеются множество вхождений динамического блока. … атрибут с тэгом "ИМЯ_001" … имя блока "Стойка". … лисп … переименует каждое вхождение в блока в значение атрибута с тэгом "ИМЯ_001"… с сохранением их динамических свойств.
Собственно вариант без dbx.
Выбираем все блоки, обрабатываем только с именем "Стойка". Пишем блок wblock-ом в TEMP, снимаем значения атрибутов, динамические свойства c оригинального блока, копируем блок в TEMP с именем равным значению атрибута "ИМЯ_001", вставялем его в обрабатываемый чертёж, восстанвливаем значения атрибутов, динамические свойства, удаляем оригинальный блок. Далее по циклу для всех выбранных блоков. удаляем файлы из TEMP.

Без обвесов.

Код:
[Выделить все]
 
(defun c:Block_to_NAME001 ()
	(setq acad_Object (vlax-get-acad-object)
		  acad_preferences (vla-get-Preferences acad_object)
		  Temp_File_Path (vla-get-TempFilePath (vla-get-Files acad_preferences))
		  document_object (vla-get-Activedocument acad_Object)
		  modelSpace_object (vla-get-modelSpace document_object)
		  blocks_collection (vla-get-blocks document_object)
		  blocks_pickset (ssget "_X" '((0 . "Insert")))
		  blocks_selected (sslength blocks_pickset)
		  blocks_processed 0
		  temp_blocks_written_list '()
		  renamed_blocks_written_list '()
		  var_set (setvar 'cmdecho 0)
	)
	(while (< 0 (sslength blocks_pickset))
		(setq current_block_object (vlax-ename->vla-object (ssname blocks_pickset 0)))
			(if (member (strcase (vla-get-effectivename current_block_object)) (mapcar 'strcase '("Стойка" "Ригель" "Кронштейн" "Заполнения")))
				(progn
					(setq attribute_values_list '()
						  attribute_values_list (append attribute_values_list (list (cons "Name" (vla-get-effectivename current_block_object))))
						  attribute_values_list (append attribute_values_list (list (cons "Insertion_Point" (vla-get-insertionpoint current_block_object))))
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_object)))
					)
					(foreach attribute_object attributes_objects_list
						(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-tagstring attribute_object) (vla-get-textstring attribute_object)))))
					)
					(if (= :vlax-true (vla-get-isdynamicblock current_block_object))
						(progn
							(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_object))))
							(foreach dynamic_property dynamic_properties_list
								(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							 		(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-PropertyName dynamic_property) (vla-get-value dynamic_property)))))
								)
							)
						)
					)
					(if (or
							(null temp_blocks_written_list)
							(not (member (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list))
						)
							(progn
								(setq temp_blocks_written_list (cons (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list))
								(setq temp_block_name (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list))))
								(command "_-WBLOCK" temp_block_name (cdr (assoc "Name" attribute_values_list)))
							)
					)
					(if (or
							(null renamed_blocks_written_list)
							(not (member (cdr (assoc "ИМЯ_001" attribute_values_list)) renamed_blocks_written_list))
						)
							(progn
								(vl-file-copy (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list)) ".dwg") (strcat Temp_File_Path (cdr (assoc "ИМЯ_001" attribute_values_list)) ".dwg"))
								(setq renamed_blocks_written_list (cons (cdr (assoc "ИМЯ_001" attribute_values_list)) renamed_blocks_written_list))
							)
					)
					(setq current_block_Reference_Object (vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" attribute_values_list)) (strcat Temp_File_Path (cdr (assoc "ИМЯ_001" attribute_values_list)) ".dwg") 1 1 1 0)
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_Reference_Object)))
					)
					(foreach attribute_object attributes_objects_list
						(if (/= "ПОЛОЖЕНИЕ" (vla-get-tagstring attribute_object))
							(vla-put-textstring attribute_object (cdr (assoc (vla-get-tagstring attribute_object) attribute_values_list)))
						)
					)
					(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_Reference_Object))))
					(foreach dynamic_property dynamic_properties_list
						(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							(vla-put-value dynamic_property (cdr (assoc (vla-get-PropertyName dynamic_property) attribute_values_list)))
						)
					)
					(vla-update current_block_Reference_Object)
					(vla-erase current_block_object)
					(setq blocks_processed (1+ blocks_processed))
				)
			)
		(setq blocks_pickset (ssdel (ssname blocks_pickset 0) blocks_pickset))
	)
	(mapcar '(lambda (file_name)
					(vl-file-delete (strcat Temp_File_Path file_name ".dwg"))
			)
			(append temp_blocks_written_list renamed_blocks_written_list)
	)
	(princ (strcat "\nНайдено блоков: " (itoa blocks_selected) ", переименовано блоков: " (itoa blocks_processed)))
	(setvar 'cmdecho 1)
	(princ)
)

Последний раз редактировалось koMon, 05.07.2018 в 10:35.
koMon вне форума  
 
Непрочитано 04.07.2018, 09:53
#23
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Код:
[Выделить все]
 vl-file-delete (strcat Temp_File_Path file_name ".dwg")
как показывает опыт, если стоит антивирус - то удаление файла порою приходиться делать несколько раз, пока операция не окажется успешной. Или смириться с "мусором".
Сергей812 вне форума  
 
Непрочитано 04.07.2018, 10:01
#24
koMon


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Или смириться с "мусором".
ну так TEMP и есть сборщик мусора) его нужно периодически прочищать, а то он может распухнуть так. что
koMon вне форума  
 
Автор темы   Непрочитано 05.07.2018, 09:13
#25
kirillwu


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Собственно вариант без dbx.
Выбираем все блоки, обрабатываем только с именем "Стойка". Пишем блок wblock-ом в TEMP, снимаем значения атрибутов, динамические свойства c оригинального блока, копируем блок в TEMP с именем равным значению атрибута "ИМЯ_001", вставялем его в обрабатываемый чертёж, восстанвливаем значения атрибутов, динамические свойства, удаляем оригинальный блок. Далее по циклу для всех выбранных блоков. удаляем файлы из TEMP.

Без обвесов.

Код:
[Выделить все]
 
(defun c:Block_to_NAME001 ()
	(setq acad_Object (vlax-get-acad-object)
		  acad_preferences (vla-get-Preferences acad_object)
		  Temp_File_Path (vla-get-TempFilePath (vla-get-Files acad_preferences))
		  document_object (vla-get-Activedocument acad_Object)
		  modelSpace_object (vla-get-modelSpace document_object)
		  blocks_collection (vla-get-blocks document_object)
		  blocks_pickset (ssget "_X" '((0 . "Insert")))
		  blocks_selected (sslength blocks_pickset)
		  blocks_processed 0
		  temp_blocks_written_list '()
		  renamed_blocks_written_list '()
		  var_set (setvar 'cmdecho 0)
	)
	(while (< 0 (sslength blocks_pickset))
		(setq current_block_object (vlax-ename->vla-object (ssname blocks_pickset 0)))
			(if (member (strcase (vla-get-effectivename current_block_object)) (mapcar 'strcase '("Стойка")))
				(progn
					(setq attribute_values_list '()
						  attribute_values_list (append attribute_values_list (list (cons "Name" (vla-get-effectivename current_block_object))))
						  attribute_values_list (append attribute_values_list (list (cons "Insertion_Point" (vla-get-insertionpoint current_block_object))))
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_object)))
					)
					(foreach attribute_object attributes_objects_list
						(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-tagstring attribute_object) (vla-get-textstring attribute_object)))))
					)
					(if (= :vlax-true (vla-get-isdynamicblock current_block_object))
						(progn
							(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_object))))
							(foreach dynamic_property dynamic_properties_list
								(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							 		(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-PropertyName dynamic_property) (vla-get-value dynamic_property)))))
								)
							)
						)
					)
					(if (or
							(null temp_blocks_written_list)
							(not (member (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list))
						)
							(progn
								(setq temp_blocks_written_list (cons (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list))
								(setq temp_block_name (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list))))
								(command "_-WBLOCK" temp_block_name (cdr (assoc "Name" attribute_values_list)))
							)
					)
					(if (or
							(null renamed_blocks_written_list)
							(not (member (cdr (assoc "ИМЯ_001" attribute_values_list)) renamed_blocks_written_list))
						)
							(progn
								(vl-file-copy (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list)) ".dwg") (strcat Temp_File_Path (cdr (assoc "ИМЯ_001" attribute_values_list)) ".dwg"))
								(setq renamed_blocks_written_list (cons (cdr (assoc "ИМЯ_001" attribute_values_list)) renamed_blocks_written_list))
							)
					)
					(setq current_block_Reference_Object (vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" attribute_values_list)) (strcat Temp_File_Path (cdr (assoc "ИМЯ_001" attribute_values_list)) ".dwg") 1 1 1 0)
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_Reference_Object)))
					)
					(foreach attribute_object attributes_objects_list
						(if (/= "ПОЛОЖЕНИЕ" (vla-get-tagstring attribute_object))
							(vla-put-textstring attribute_object (cdr (assoc (vla-get-tagstring attribute_object) attribute_values_list)))
						)
					)
					(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_Reference_Object))))
					(foreach dynamic_property dynamic_properties_list
						(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							(vla-put-value dynamic_property (cdr (assoc (vla-get-PropertyName dynamic_property) attribute_values_list)))
						)
					)
					(vla-update current_block_Reference_Object)
					(vla-erase current_block_object)
					(setq blocks_processed (1+ blocks_processed))
				)
			)
		(setq blocks_pickset (ssdel (ssname blocks_pickset 0) blocks_pickset))
	)
	(mapcar '(lambda (file_name)
					(vl-file-delete (strcat Temp_File_Path file_name ".dwg"))
			)
			(append temp_blocks_written_list renamed_blocks_written_list)
	)
	(princ (strcat "\nНайдено блоков: " (itoa blocks_selected) ", переименовано блоков: " (itoa blocks_processed)))
	(setvar 'cmdecho 1)
	(princ)
)
Спасибо, но у меня в файле есть не только блоки с именем "Стойка", есть блоки с именем "Ригель", "Кронштейн", "Заполнения"

Последний раз редактировалось kirillwu, 05.07.2018 в 09:33.
kirillwu вне форума  
 
Автор темы   Непрочитано 05.07.2018, 09:32
#26
kirillwu


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


Цитата:
Сообщение от VVA Посмотреть сообщение
kirillwu, Тестируй
Приветствую. В этом файле не работает. Не понимаю почему именно с этими блоками команда не срабатывает.
Вложения
Тип файла: dwg
DWG 2013
Тест кронштейнов.dwg (151.8 Кб, 11 просмотров)
kirillwu вне форума  
 
Непрочитано 05.07.2018, 10:37
#27
koMon


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


Цитата:
Сообщение от kirillwu Посмотреть сообщение
Спасибо, но у меня в файле есть не только блоки с именем "Стойка", есть блоки с именем "Ригель", "Кронштейн", "Заполнения"
В список добавляются имена требуемых блоков), скорректировал #22

Код:
[Выделить все]
 (if (member (strcase (vla-get-effectivename current_block_object)) (mapcar 'strcase '("Стойка" "Ригель" "Кронштейн" "Заполнения")))
----- добавлено через ~20 мин. -----
имя_001 содержит управляющие коды, нужно корректировать обработку этого атрибута, иначе обрушение автокада!

закостылил) если конечно оно надо

Код:
[Выделить все]
 
(defun c:Block_to_NAME001 ()
	(setq acad_Object (vlax-get-acad-object)
		  acad_preferences (vla-get-Preferences acad_object)
		  Temp_File_Path (vla-get-TempFilePath (vla-get-Files acad_preferences))
		  document_object (vla-get-Activedocument acad_Object)
		  modelSpace_object (vla-get-modelSpace document_object)
		  blocks_collection (vla-get-blocks document_object)
		  blocks_pickset (ssget "_X" '((0 . "Insert")))
		  blocks_selected (sslength blocks_pickset)
		  blocks_processed 0
		  temp_blocks_written_list '()
		  renamed_blocks_written_list '()
		  var_set (setvar 'cmdecho 0)
	)
	(while (< 0 (sslength blocks_pickset))
		(setq current_block_object (vlax-ename->vla-object (ssname blocks_pickset 0)))
			(if (member (strcase (vla-get-effectivename current_block_object)) (mapcar 'strcase '("Стойка" "Ригель" "Кронштейн" "Заполнения")))
				(progn
					(setq attribute_values_list '()
						  attribute_values_list (append attribute_values_list (list (cons "Name" (vla-get-effectivename current_block_object))))
						  attribute_values_list (append attribute_values_list (list (cons "Insertion_Point" (vla-get-insertionpoint current_block_object))))
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_object)))
					)
					(foreach attribute_object attributes_objects_list
						(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-tagstring attribute_object) (vla-get-textstring attribute_object)))))
					)
					(if (= :vlax-true (vla-get-isdynamicblock current_block_object))
						(progn
							(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_object))))
							(foreach dynamic_property dynamic_properties_list
								(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							 		(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-PropertyName dynamic_property) (vla-get-value dynamic_property)))))
								)
							)
						)
					)
					(if (or
							(null temp_blocks_written_list)
							(not (member (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list))
						)
							(progn
								(setq temp_blocks_written_list (cons (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list)
									  temp_block_name (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list)))
								)
								(command "_-WBLOCK" temp_block_name (cdr (assoc "Name" attribute_values_list)))
							)
					)
					(if (or
							(null renamed_blocks_written_list)
							(not (member (cdr (assoc "ИМЯ_001" attribute_values_list)) renamed_blocks_written_list))
						)
							(progn
								(vl-file-copy (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list)) ".dwg") (setq block_name_corrected (strcat Temp_File_Path
																																						   (if (member 59 (reverse (vl-string->list (cdr (assoc "ИМЯ_001" attribute_values_list)))))
																																								(substr (cdr (assoc "ИМЯ_001" attribute_values_list)) (- (length (vl-string->list (cdr (assoc "ИМЯ_001" attribute_values_list)))) (vl-position 59 (reverse (vl-string->list (cdr (assoc "ИМЯ_001" attribute_values_list))))) -1))
																																								(cdr (assoc "ИМЯ_001" attribute_values_list))
																																						   )
																																						   ".dwg"
																																					)
																														)
								)
								(setq renamed_blocks_written_list (cons block_name_corrected renamed_blocks_written_list))
							)
					)
					(setq current_block_Reference_Object (vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" attribute_values_list)) block_name_corrected 1 1 1 0)
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_Reference_Object)))
					)
					(foreach attribute_object attributes_objects_list
						(if (/= "ПОЛОЖЕНИЕ" (vla-get-tagstring attribute_object))
							(vla-put-textstring attribute_object (cdr (assoc (vla-get-tagstring attribute_object) attribute_values_list)))
						)
					)
					(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_Reference_Object))))
					(foreach dynamic_property dynamic_properties_list
						(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							(vla-put-value dynamic_property (cdr (assoc (vla-get-PropertyName dynamic_property) attribute_values_list)))
						)
					)
					(vla-update current_block_Reference_Object)
					(vla-erase current_block_object)
					(setq blocks_processed (1+ blocks_processed))
				)
			)
		(setq blocks_pickset (ssdel (ssname blocks_pickset 0) blocks_pickset))
	)
	(mapcar '(lambda (file_name)
					(vl-file-delete (strcat Temp_File_Path file_name ".dwg"))
			)
			(append temp_blocks_written_list renamed_blocks_written_list)
	)
	(princ (strcat "\nНайдено блоков: " (itoa blocks_selected) ", переименовано блоков: " (itoa blocks_processed)))
	(setvar 'cmdecho 1)
	(princ)
)
----- добавлено через ~11 мин. -----
с name_001 проблема восстановления(

----- добавлено через ~17 мин. -----
хотя видимости отслеживает…

Последний раз редактировалось koMon, 05.07.2018 в 11:29.
koMon вне форума  
 
Непрочитано 05.07.2018, 12:56
#28
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от koMon Посмотреть сообщение
В список добавляются имена требуемых блоков), скорректировал #22
а как же просканировать чертеж и найдя все определения блоков с тэгом "ИМЯ_001" - а потом вывести в чеклист для выбора пользователем?)
Сергей812 вне форума  
 
Автор темы   Непрочитано 05.07.2018, 13:00
#29
kirillwu


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


Цитата:
Сообщение от koMon Посмотреть сообщение
В список добавляются имена требуемых блоков), скорректировал #22

Код:
[Выделить все]
 (if (member (strcase (vla-get-effectivename current_block_object)) (mapcar 'strcase '("Стойка" "Ригель" "Кронштейн" "Заполнения")))
----- добавлено через ~20 мин. -----
имя_001 содержит управляющие коды, нужно корректировать обработку этого атрибута, иначе обрушение автокада!

закостылил) если конечно оно надо

Код:
[Выделить все]
 
(defun c:Block_to_NAME001 ()
	(setq acad_Object (vlax-get-acad-object)
		  acad_preferences (vla-get-Preferences acad_object)
		  Temp_File_Path (vla-get-TempFilePath (vla-get-Files acad_preferences))
		  document_object (vla-get-Activedocument acad_Object)
		  modelSpace_object (vla-get-modelSpace document_object)
		  blocks_collection (vla-get-blocks document_object)
		  blocks_pickset (ssget "_X" '((0 . "Insert")))
		  blocks_selected (sslength blocks_pickset)
		  blocks_processed 0
		  temp_blocks_written_list '()
		  renamed_blocks_written_list '()
		  var_set (setvar 'cmdecho 0)
	)
	(while (< 0 (sslength blocks_pickset))
		(setq current_block_object (vlax-ename->vla-object (ssname blocks_pickset 0)))
			(if (member (strcase (vla-get-effectivename current_block_object)) (mapcar 'strcase '("Стойка" "Ригель" "Кронштейн" "Заполнения")))
				(progn
					(setq attribute_values_list '()
						  attribute_values_list (append attribute_values_list (list (cons "Name" (vla-get-effectivename current_block_object))))
						  attribute_values_list (append attribute_values_list (list (cons "Insertion_Point" (vla-get-insertionpoint current_block_object))))
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_object)))
					)
					(foreach attribute_object attributes_objects_list
						(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-tagstring attribute_object) (vla-get-textstring attribute_object)))))
					)
					(if (= :vlax-true (vla-get-isdynamicblock current_block_object))
						(progn
							(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_object))))
							(foreach dynamic_property dynamic_properties_list
								(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							 		(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-PropertyName dynamic_property) (vla-get-value dynamic_property)))))
								)
							)
						)
					)
					(if (or
							(null temp_blocks_written_list)
							(not (member (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list))
						)
							(progn
								(setq temp_blocks_written_list (cons (cdr (assoc "Name" attribute_values_list)) temp_blocks_written_list)
									  temp_block_name (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list)))
								)
								(command "_-WBLOCK" temp_block_name (cdr (assoc "Name" attribute_values_list)))
							)
					)
					(if (or
							(null renamed_blocks_written_list)
							(not (member (cdr (assoc "ИМЯ_001" attribute_values_list)) renamed_blocks_written_list))
						)
							(progn
								(vl-file-copy (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list)) ".dwg") (setq block_name_corrected (strcat Temp_File_Path
																																						   (if (member 59 (reverse (vl-string->list (cdr (assoc "ИМЯ_001" attribute_values_list)))))
																																								(substr (cdr (assoc "ИМЯ_001" attribute_values_list)) (- (length (vl-string->list (cdr (assoc "ИМЯ_001" attribute_values_list)))) (vl-position 59 (reverse (vl-string->list (cdr (assoc "ИМЯ_001" attribute_values_list))))) -1))
																																								(cdr (assoc "ИМЯ_001" attribute_values_list))
																																						   )
																																						   ".dwg"
																																					)
																														)
								)
								(setq renamed_blocks_written_list (cons block_name_corrected renamed_blocks_written_list))
							)
					)
					(setq current_block_Reference_Object (vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" attribute_values_list)) block_name_corrected 1 1 1 0)
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_Reference_Object)))
					)
					(foreach attribute_object attributes_objects_list
						(if (/= "ПОЛОЖЕНИЕ" (vla-get-tagstring attribute_object))
							(vla-put-textstring attribute_object (cdr (assoc (vla-get-tagstring attribute_object) attribute_values_list)))
						)
					)
					(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_Reference_Object))))
					(foreach dynamic_property dynamic_properties_list
						(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							(vla-put-value dynamic_property (cdr (assoc (vla-get-PropertyName dynamic_property) attribute_values_list)))
						)
					)
					(vla-update current_block_Reference_Object)
					(vla-erase current_block_object)
					(setq blocks_processed (1+ blocks_processed))
				)
			)
		(setq blocks_pickset (ssdel (ssname blocks_pickset 0) blocks_pickset))
	)
	(mapcar '(lambda (file_name)
					(vl-file-delete (strcat Temp_File_Path file_name ".dwg"))
			)
			(append temp_blocks_written_list renamed_blocks_written_list)
	)
	(princ (strcat "\nНайдено блоков: " (itoa blocks_selected) ", переименовано блоков: " (itoa blocks_processed)))
	(setvar 'cmdecho 1)
	(princ)
)
----- добавлено через ~11 мин. -----
с name_001 проблема восстановления(

----- добавлено через ~17 мин. -----
хотя видимости отслеживает…
А еще попробуйте в блоках в файле, который содержится в посте #26 - и выскочит ошибка

Последний раз редактировалось kirillwu, 05.07.2018 в 13:52.
kirillwu вне форума  
 
Непрочитано 05.07.2018, 15:08
#30
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


В лиспе есть подобная функция?
Сергей812 вне форума  
 
Непрочитано 05.07.2018, 17:56
#31
koMon


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
В лиспе есть подобная функция?
я не знаю о такой функции, но её написать вообще не проблема, вопрос - что делать, когда имя будет содержать спецсимволы?

Цитата:
Сообщение от kirillwu Посмотреть сообщение
А еще попробуйте в блоках в файле, который содержится в посте #26 - и выскочит ошибка
да нет ошибка не выскакивает, файл отрабатывается весь, но акад ругается на наличие дублируемых блоков, которые вложены в блок кронштейн и тупо их игнорит.
Миниатюры
Нажмите на изображение для увеличения
Название: Untitled-1.jpg
Просмотров: 30
Размер:	176.4 Кб
ID:	204212  
koMon вне форума  
 
Непрочитано 05.07.2018, 18:22
1 | #32
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от koMon Посмотреть сообщение
я не знаю о такой функции
snvalid ?
Цитата:
Сообщение от koMon Посмотреть сообщение
вопрос - что делать, когда имя будет содержать спецсимволы?
Форматирование удалить, а потом вступать в диалог с пользователем скорее всего в случае невалидности имени.
Сергей812 вне форума  
 
Непрочитано 05.07.2018, 20:50
#33
koMon


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
snvalid ?
а что так скромно)?
так-то поинтересней будет snvalid
день прожит не зря!)))

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
а потом вступать в диалог с пользователем
ну здесь-то это излишнее) задача тупо переименовать, для удобовыбираемости вышестоящим специалистом), а принципиально - да.
вот я даже не ставил проверку на уже наличие в базе вставляемого блока из-за чего выскакивают highly likely сообщения о наличии описания блока.
koMon вне форума  
 
Непрочитано 05.07.2018, 21:26
#34
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Если просто стоит задача выделить блоки с одинаковым значением атрибута - то можно с другой стороны: просто перехватывать команду "выбрать подобные" в обработчике событий и если выделен блок с тэгом "ИМЯ_001" - найти и выделить все другие с тем же значением атрибута. А если нет - пропускать исходную команду дальше. Но это тоже надо "ломать" традиции - ставить всем программу в автозагрузку.

Цитата:
Сообщение от koMon Посмотреть сообщение
ну здесь-то это излишнее) задача тупо переименовать
Ну-ну. Во вставках двух разных блоков будет одинаковое значение указанного атрибута (просто человеческий фактор) - как создать два определения блока с одним и там же именем?
Сергей812 вне форума  
 
Непрочитано 06.07.2018, 09:17
#35
koMon


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
как создать два определения блока с одним и там же именем
никак), останется только один.
отлавливать человеческий фактор
koMon вне форума  
 
Непрочитано 06.07.2018, 10:46
#36
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Если просто стоит задача выделить блоки с одинаковым значением атрибута
Выбор вхождений блока по фильтру на свойства и значения атрибутов
Выбор блоков по значению атрибутов
Выбор блоков по значениям динамических параметров
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.07.2018, 15:29
#37
koMon


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


Цитата:
Сообщение от koMon Посмотреть сообщение
но акад ругается на наличие дублируемых блоков
добавил проверку на наличие в базе уже определённого блока, но вложенных блоков тьма, поэтому акад при кажом вставлении такого блока всё равно мило ругается)

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

(defun correct_attribute (in_attribute)

   (if (member 59 (reverse (vl-string->list in_attribute)))
			(substr in_attribute (- (length (vl-string->list in_attribute)) (vl-position 59 (reverse (vl-string->list in_attribute))) -1))
			in_attribute
   )
)

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

(defun c:Block_to_NAME001 ()
	(setq acad_Object (vlax-get-acad-object)
		  acad_preferences (vla-get-Preferences acad_object)
		  Temp_File_Path (vla-get-TempFilePath (vla-get-Files acad_preferences))
		  document_object (vla-get-Activedocument acad_Object)
		  dwg_blocks_collection (vla-get-blocks document_object)
		  modelSpace_object (vla-get-modelSpace document_object)
		  blocks_collection (vla-get-blocks document_object)
		  blocks_pickset (ssget "_X" '((0 . "Insert")))
		  blocks_selected (sslength blocks_pickset)
		  blocks_processed 0
		  temp_blocks_written_list '()
		  renamed_blocks_written_list '()
		  var_set (setvar 'cmdecho 0)
	)
	(while (< 0 (sslength blocks_pickset))
		(setq current_block_object (vlax-ename->vla-object (ssname blocks_pickset 0)))
			(if (member (strcase (vla-get-effectivename current_block_object)) (mapcar 'strcase '("Стойка" "Ригель" "Кронштейн" "Заполнения")))
				(progn
					(setq attribute_values_list '()
						  attribute_values_list (append attribute_values_list (list (cons "Name" (vla-get-effectivename current_block_object))))
						  attribute_values_list (append attribute_values_list (list (cons "Insertion_Point" (vla-get-insertionpoint current_block_object))))
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_object)))
					)
					(foreach attribute_object attributes_objects_list
						(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-tagstring attribute_object) (vla-get-textstring attribute_object)))))
					)
					(if (= :vlax-true (vla-get-isdynamicblock current_block_object))
						(progn
							(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_object))))
							(foreach dynamic_property dynamic_properties_list
								(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							 		(setq attribute_values_list (append attribute_values_list (list (cons (vla-get-PropertyName dynamic_property) (vla-get-value dynamic_property)))))
								)
							)
						)
					)
					(if (or
							(null temp_blocks_written_list)
							(not (member (correct_attribute (cdr (assoc "Name" attribute_values_list))) temp_blocks_written_list))
						)
							(progn
								(setq temp_blocks_written_list (cons (correct_attribute (cdr (assoc "Name" attribute_values_list))) temp_blocks_written_list)
									  temp_block_name (strcat Temp_File_Path (correct_attribute (cdr (assoc "Name" attribute_values_list))))
								)
								(command "_-WBLOCK" temp_block_name (cdr (assoc "Name" attribute_values_list)))
							)
					)
					(if (or
							(null renamed_blocks_written_list)
							(not (member (correct_attribute (cdr (assoc "ИМЯ_001" attribute_values_list))) renamed_blocks_written_list))
						)
							(progn
								(vl-file-copy (strcat Temp_File_Path (cdr (assoc "Name" attribute_values_list)) ".dwg") (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" attribute_values_list))) ".dwg"))
								(setq renamed_blocks_written_list (cons (correct_attribute (cdr (assoc "ИМЯ_001" attribute_values_list))) renamed_blocks_written_list))
							)
					)
					(setq current_block_Reference_Object
															(if (/= 'VL-CATCH-ALL-APPLY-ERROR (type (vl-catch-all-apply 'vla-item (list dwg_blocks_collection (correct_attribute (cdr (assoc "ИМЯ_001" attribute_values_list)))))))
																(vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" attribute_values_list)) (correct_attribute (cdr (assoc "ИМЯ_001" attribute_values_list))) 1 1 1 0)
																(vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" attribute_values_list)) (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" attribute_values_list))) ".dwg") 1 1 1 0)
															)
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_Reference_Object)))
					)
					(foreach attribute_object attributes_objects_list
						(if (/= "ПОЛОЖЕНИЕ" (vla-get-tagstring attribute_object))
							(vla-put-textstring attribute_object (cdr (assoc (vla-get-tagstring attribute_object) attribute_values_list)))
						)
					)
					(setq dynamic_properties_list (vlax-safearray->list (vlax-variant-value (vla-getdynamicblockproperties current_block_Reference_Object))))
					(foreach dynamic_property dynamic_properties_list
						(if (/= "Origin" (vla-get-PropertyName dynamic_property))
							(vla-put-value dynamic_property (cdr (assoc (vla-get-PropertyName dynamic_property) attribute_values_list)))
						)
					)
					(vla-update current_block_Reference_Object)
					(vla-erase current_block_object)
					(setq blocks_processed (1+ blocks_processed))
				)
			)
		(setq blocks_pickset (ssdel (ssname blocks_pickset 0) blocks_pickset))
	)
	(mapcar '(lambda (file_name)
					(vl-file-delete (strcat Temp_File_Path file_name ".dwg"))
			)
			(append temp_blocks_written_list renamed_blocks_written_list)
	)
	(princ (strcat "\nНайдено блоков: " (itoa blocks_selected) ", переименовано блоков: " (itoa blocks_processed)))
	(setvar 'cmdecho 1)
	(princ)
)
----- добавлено через ~5 мин. -----
kirillwu, давайте уже попробуем "Ригель", "Заполнения" и что там ещё у вас есть!-)
Миниатюры
Нажмите на изображение для увеличения
Название: Capture.JPG
Просмотров: 23
Размер:	148.4 Кб
ID:	204234  
koMon вне форума  
 
Непрочитано 06.07.2018, 15:54
#38
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от koMon Посмотреть сообщение
никак), останется только один.
отлавливать человеческий фактор
т.е. вступать в диалог с пользователем, а не поганить чертеж по тихому)

----- добавлено через ~6 мин. -----
по нормальному надо сначала проанализировать чертеж, найти все конфликты (по именам, по одинаковым значениям атрибутов в блоках с разными "родителями", блоки на заблокированных слоях и т.д.), запросить реакцию пользователя (причем желательно, в удобоваримом варианте типа выбора очередного конфликта на палитре с автопозиционированием чертежа на "проблемном" блоке) и лишь при отсутствии неразрешимых конфликтов запустить саму обработку чертежа.
Сергей812 вне форума  
 
Непрочитано 06.07.2018, 16:55
#39
koMon


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
поганить
как это совсем не GOOD!^)

Цитата:
Сообщение от Сергей812 Посмотреть сообщение
по нормальному надо сначала … и лишь при отсутствии неразрешимых конфликтов запустить саму обработку чертежа
если у ТС использованных блоков по пальцам двух рук пересчитать, то "неразрешимиые конфликты" можно отследить уже до запуска обработки, да и собственно принять оперативные меры для устранения этой самой неразрешимости. и потом разве несколько предсказуемых действий обработки могут безвозвратно ис******** чертёж?^)
но вот ежели их у него сотни, тогда ДА, тогда КОНЕЧНО!

мне почему-то кажется, что пора мне говорить "пас")))
koMon вне форума  
 
Непрочитано 06.07.2018, 17:09
#40
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Offtop:
Цитата:
Сообщение от koMon Посмотреть сообщение
мне почему-то кажется, что пора мне говорить "пас")))
чем смогли - тем и помогли..) проще главного конструктора научиться пользоваться извлечением данных тем же, имхо.. или уже в раздел исполнителей для полноценной программы с развитыми диалогами
Сергей812 вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > LISP. Помогите с лиспом по переименованию нескольких вхождений динамического блока в значение его атрибута.

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Значение атрибута в текстовое поле динамического блока zekatyumen Динамические блоки 19 28.01.2023 09:26
Мои динамические блоки [2] Кулик Алексей aka kpblc Динамические блоки 4334 22.04.2019 09:16
C# .net переопределение динамического блока из внешнего файла bargool .NET 35 18.10.2011 16:03
Редактирование вхождения динамического блока из командной строки. Alexey_BH Динамические блоки 2 26.09.2010 13:13
При растягивании/поворачивании грисп динамического блока перестало показывать значение параметра Red Nova Динамические блоки 2 02.10.2008 14:57