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

kirillwu · 04.06.2018, 09:14

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

______________________________________________________________________________________
Вложенный лисп к сожалению работает только с одним вхождением. Нужно чтобы была возможность выбрать несколько вхождений и переименовать их в значение аттрибута, с сохранением их всех динамических парамметров.

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

koMon · 09.07.2018, 12:15

Сергей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)
)

Сергей812 · 09.07.2018, 13:02

Цитата:

Сообщение от koMon

функцию на снятие форматируюших кодов написать по-правильнее

Вот это не подойдет? В .Net это встроенное уже.

Монтажник 80lv ))) · 09.07.2018, 13:23

Здесь программисты или проектировщики

koMon · 09.07.2018, 13:29

Цитата:

Сообщение от Сергей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)
)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Значение атрибута в текстовое поле динамического блока	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

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