dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

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

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

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

kirillwu вне форума Вставить имя

В файле имеются множество вхождений динамического блока. У динамического блока есть атрибут с тэгом "ИМЯ_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 Кб, 7 просмотров)


Последний раз редактировалось kirillwu, 04.06.2018 в 16:22.
Просмотров: 4386
 
Непрочитано 09.07.2018, 12:15
#41
koMon


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


Сергей812,
Цитата:
Сообщение от koMon Посмотреть сообщение
мне почему-то кажется, что пора мне говорить "пас")))
А нет, показалось)))
Я тут посмотрел, kirillwu, ещё один тест давал в #20, ну и ещё малёк подшаманил. только вот маску на мтекст, по ходу ручками нужно делать.
надо бы функцию на снятие форматируюших кодов написать по-правильнее. а так в целом заменяет блоки вполне себе прилично, не по тихому поганя цельный чертёх)))

сборный результат теста (DXF->RAR) выкладываю.

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

(defun correct_attribute (in_attribute)

   (if (= 125 (car (reverse (vl-string->list in_attribute)))) (setq in_attribute (vl-list->string (reverse (cdr (reverse (vl-string->list 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 block_values_list '()
						  block_values_list (append block_values_list (list (cons "Layer" (vla-get-layer current_block_object))))
						  block_values_list (append block_values_list (list (cons "Name" (vla-get-effectivename current_block_object))))
						  block_values_list (append block_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 block_values_list (append block_values_list (list (cons (vla-get-tagstring attribute_object) (vla-get-textstring attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "Attribute_Insertion_Point" (vla-get-insertionpoint attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "Scale_Factor" (vla-get-scalefactor attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "TextAlignmentPoint" (vla-get-TextAlignmentPoint attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "Alignment" (vla-get-Alignment attribute_object))))
						)

						(if (= :vlax-true (vla-get-MTextAttribute attribute_object))
							(setq block_values_list (append block_values_list (list (cons "MTextAttribute" t)))
								  block_values_list (append block_values_list (list (cons "MTextAttributeContent" (vla-get-MTextAttributeContent 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 block_values_list (append block_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" block_values_list))) temp_blocks_written_list))
						)
							(progn
								(setq temp_blocks_written_list (cons (correct_attribute (cdr (assoc "Name" block_values_list))) temp_blocks_written_list)
									  temp_block_name (strcat Temp_File_Path (correct_attribute (cdr (assoc "Name" block_values_list))))
								)
								(if (findfile (strcat temp_block_name ".dwg")) (vl-file-delete (strcat temp_block_name ".dwg")))
								(command "_-WBLOCK" temp_block_name (cdr (assoc "Name" block_values_list)))
							)
					)

					(if (or
							(null renamed_blocks_written_list)
							(not (member (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) renamed_blocks_written_list))
						)
							(progn
								(if (findfile (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg")) (vl-file-delete (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg")))
								(vl-file-copy (strcat Temp_File_Path (cdr (assoc "Name" block_values_list)) ".dwg") (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg"))
								(setq renamed_blocks_written_list (cons (correct_attribute (cdr (assoc "ИМЯ_001" block_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" block_values_list)))))))
																(vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" block_values_list)) (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) 1 1 1 0)
																(vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" block_values_list)) (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg") 1 1 1 0)
															)
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_Reference_Object)))
					)
					(vla-put-layer current_block_Reference_Object (cdr (assoc "Layer" block_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) block_values_list)))
						)
					)

					(foreach attribute_object attributes_objects_list
						(if (assoc "MTextAttribute" block_values_list)
							(progn
								(vla-put-MTextAttribute attribute_object :vlax-true)
								(vla-put-MTextAttributeContent attribute_object (cdr (assoc "MTextAttributeContent" block_values_list)))
							)
						)
						(if (/= "ПОЛОЖЕНИЕ" (vla-get-tagstring attribute_object))
							(progn
								(vla-put-TextAlignmentPoint attribute_object (cdr (assoc "TextAlignmentPoint" block_values_list)))
								(vla-put-insertionpoint attribute_object (cdr (assoc "Attribute_Insertion_Point" block_values_list)))
								(vla-put-ScaleFactor attribute_object (cdr (assoc "Scale_Factor" block_values_list)))
								(vla-put-textstring attribute_object (cdr (assoc (vla-get-tagstring attribute_object) block_values_list)))
								(vla-put-Alignment attribute_object (cdr (assoc "Alignment" block_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)
)
Вложения
Тип файла: rar Тест.rar (186.9 Кб, 0 просмотров)
koMon вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.07.2018, 13:02
#42
Сергей812


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


Цитата:
Сообщение от koMon Посмотреть сообщение
функцию на снятие форматируюших кодов написать по-правильнее
Вот это не подойдет? В .Net это встроенное уже.
Сергей812 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.07.2018, 13:23
#43
Монтажник 80lv )))

проектирование конструкций зданий и сооружений
 
Регистрация: 09.07.2018
c ГосДепа )
Сообщений: 1


Здесь программисты или проектировщики
Монтажник 80lv ))) вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 09.07.2018, 13:29
#44
koMon


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
Вот это не подойдет?


----- добавлено через ~2 ч. -----
Цитата:
Сообщение от koMon Посмотреть сообщение
только вот маску на мтекст, по ходу ручками нужно делать.
теперь не нужно

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

(defun correct_attribute (in_attribute)

   (if (= 125 (car (reverse (vl-string->list in_attribute)))) (setq in_attribute (vl-list->string (reverse (cdr (reverse (vl-string->list 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 block_values_list '()
						  block_values_list (append block_values_list (list (cons "Layer" (vla-get-layer current_block_object))))
						  block_values_list (append block_values_list (list (cons "Name" (vla-get-effectivename current_block_object))))
						  block_values_list (append block_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 block_values_list (append block_values_list (list (cons (vla-get-tagstring attribute_object) (vla-get-textstring attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "Attribute_Insertion_Point" (vla-get-insertionpoint attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "Scale_Factor" (vla-get-scalefactor attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "TextAlignmentPoint" (vla-get-TextAlignmentPoint attribute_object))))
						  	  block_values_list (append block_values_list (list (cons "Alignment" (vla-get-Alignment attribute_object))))
						)
						(if (assoc 90 (entget (vlax-vla-object->ename attribute_object))) (setq block_values_list (append block_values_list (list (assoc 90 (entget (vlax-vla-object->ename attribute_object)))))))
						(if (assoc 63 (entget (vlax-vla-object->ename attribute_object))) (setq block_values_list (append block_values_list (list (assoc 63 (entget (vlax-vla-object->ename attribute_object)))))))
						(if (assoc 421 (entget (vlax-vla-object->ename attribute_object))) (setq block_values_list (append block_values_list (list (assoc 421 (entget (vlax-vla-object->ename attribute_object)))))))
						(if (assoc 45 (entget (vlax-vla-object->ename attribute_object))) (setq block_values_list (append block_values_list (list (assoc 45 (entget (vlax-vla-object->ename attribute_object)))))))

						(if (= :vlax-true (vla-get-MTextAttribute attribute_object))
							(setq block_values_list (append block_values_list (list (cons "MTextAttribute" t)))
								  block_values_list (append block_values_list (list (cons "MTextAttributeContent" (vla-get-MTextAttributeContent 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 block_values_list (append block_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" block_values_list))) temp_blocks_written_list))
						)
							(progn
								(setq temp_blocks_written_list (cons (correct_attribute (cdr (assoc "Name" block_values_list))) temp_blocks_written_list)
									  temp_block_name (strcat Temp_File_Path (correct_attribute (cdr (assoc "Name" block_values_list))))
								)
								(if (findfile (strcat temp_block_name ".dwg")) (vl-file-delete (strcat temp_block_name ".dwg")))
								(command "_-WBLOCK" temp_block_name (cdr (assoc "Name" block_values_list)))
							)
					)
					(if (or
							(null renamed_blocks_written_list)
							(not (member (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) renamed_blocks_written_list))
						)
							(progn
								(if (findfile (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg")) (vl-file-delete (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg")))
								(vl-file-copy (strcat Temp_File_Path (cdr (assoc "Name" block_values_list)) ".dwg") (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg"))
								(setq renamed_blocks_written_list (cons (correct_attribute (cdr (assoc "ИМЯ_001" block_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" block_values_list)))))))
																(vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" block_values_list)) (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) 1 1 1 0)
																(vla-InsertBlock modelSpace_object (cdr (assoc "Insertion_Point" block_values_list)) (strcat Temp_File_Path (correct_attribute (cdr (assoc "ИМЯ_001" block_values_list))) ".dwg") 1 1 1 0)
															)
						  attributes_objects_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_block_Reference_Object)))
					)
					(vla-put-layer current_block_Reference_Object (cdr (assoc "Layer" block_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) block_values_list)))
						)
					)
					(foreach attribute_object attributes_objects_list
						(if (assoc "MTextAttribute" block_values_list)
							(progn
								(vla-put-MTextAttribute attribute_object :vlax-true)
								(vla-put-MTextAttributeContent attribute_object (cdr (assoc "MTextAttributeContent" block_values_list)))
							)
						)
						(if (/= "ПОЛОЖЕНИЕ" (vla-get-tagstring attribute_object))
							(progn
								(vla-put-TextAlignmentPoint attribute_object (cdr (assoc "TextAlignmentPoint" block_values_list)))
								(vla-put-insertionpoint attribute_object (cdr (assoc "Attribute_Insertion_Point" block_values_list)))
								(vla-put-ScaleFactor attribute_object (cdr (assoc "Scale_Factor" block_values_list)))
								(vla-put-Alignment attribute_object (cdr (assoc "Alignment" block_values_list)))
								(vla-put-textstring attribute_object (cdr (assoc (vla-get-tagstring attribute_object) block_values_list)))

								(setq attribute_entity (entget (vlax-vla-object->ename attribute_object)))

								(if (assoc 90 block_values_list)
									(if (null (assoc 90 attribute_entity))
										(progn
											(setq attribute_entity (append attribute_entity (list (assoc 90 block_values_list))))
											(entmod attribute_entity)
										)
									)
								)
								(if (assoc 63 block_values_list)
									(if (null (assoc 63 attribute_entity))
										(progn
											(setq attribute_entity (append attribute_entity (list (assoc 63 block_values_list))))
											(entmod attribute_entity)
										)
									)
								)
								(if (assoc 421 block_values_list)
									(if (null (assoc 421 attribute_entity))
										(progn
											(setq attribute_entity (append attribute_entity (list (assoc 421 block_values_list))))
											(entmod attribute_entity)
										)
									)
								)
								(if (assoc 45 block_values_list)
									(if (null (assoc 45 attribute_entity))
										(progn
											(setq attribute_entity (append attribute_entity (list (assoc 45 block_values_list))))
											(entmod attribute_entity)
										)
									)
								)
							)
						)
					)
					(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)
	)
	(alert (strcat "\nНайдено блоков: " (itoa blocks_selected) ", переименовано блоков: " (itoa blocks_processed)))
	(setvar 'cmdecho 1)
	(princ)
)
koMon вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > LISP. Помогите с лиспом по переименованию нескольких вхождений динамического блока в значение его атрибута.

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

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

Быстрый переход

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

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||