Автоматическое создание атрибутов блоков в автокад. LISP.

По просьбе подписчика с моего канала на YouTube выкладываю скрипт на языке LISP для создания атрибутов блоков, из поста Демонстрация работы связки AutoCad и MS SQL для создания смет, спецификаций и др.. Для товарищей, которые считают себя гуру LISP : не нравится — не используйте. Я не претендую на звание супер-разработчика. У меня работает и мне этого достаточно. Собственно лисп:

```
(defun begin_activex ( / ) 
```
```
  (vl-load-com) 
```

  (setq acad_application (vlax-get-acad-object))

  (setq active_document (vla-get-ActiveDocument acad_application))

  (setq model_space (vla-get-ModelSpace active_document))

  (setq paper_space (vla-get-PaperSpace active_document))

```
)
```
```
(begin_activex)
```
```
(defun c:attsCreate   ( / )
```

	(defun-q  createLayer (layerName layerColor / )

```
		(entmakex
```
```
			(list
```
```
				(cons 0 "LAYER")
```
```
				(cons 100 "AcDbSymbolTableRecord")
```
```
				(cons 100 "AcDbLayerTableRecord")
```
```
				(cons 2  layerName)
```
```
				(cons 70 0) 
```
```
				(cons 62 layerColor)
```
```
			)		
```
```
		)
```
```
		;------Return---------
```
```
		;
```
```
		;
```
```
		;---Call parametrs----
```
```
		;
```
```
		;
```
```
		;
```
```
		;
```
```
 
```
```
	)
```
```
	; Call example:
```
```
	;
```
```
	(setq
```
```
		defaultAttTag
```
```
		(list
```
```
			"ID"
```
```
			"SQLID"
```
```
			"FULLNAME"
```
```
			"SHORTNAME"
```
```
			"GROUPNAME"
```
```
			"IDENTIFIER"
```
```
			"FACTORYMANUFACTURER"
```
```
			"DESCRIPTION"
```
```
			"POSITION"
```
```
			"NOTES"
```
```
			"MU"
```
```
			"PRICE"
```
```
			"PRICEID"
```
```
		)	
```
```
		cableTag
```
```
		(list
```
```
			"CABLENUM"
```
```
			"CABLETYPE"
```
```
			"CABLELENGTH"
```
```
			"CABLEPURPOSE"
```
```
			"CABLESTART"
```
```
			"CABLEEND"
```
```
		)
```
```
		p_adressTag "PARENTADRESS"
```
```
		s_adressTag "SELFADRESS"
```
```
 
```
```
	)
```
```
 
```
```
 
```
```
 
```
```
	(setq 
```

		vlaBlock (vlax-ename->vla-object (car (entsel "\nУкажите блок: ")))

		adressQuantity (getint  "Укажите количество дочерних адресов:")

		wiresQuantity (getint  "Укажите количество проводов:")

		textHeigth (getreal  "Укажите высоту текста:")

```
	)
```

	(setq vlaBlockReal (vla-item (vla-get-blocks active_document) (vla-get-EffectiveName vlaBlock))) ; Получаем указатель на описание блока

	(setq userLayer (getvar "CLAYER")) ; запоминаем текущий слой

	(setvar  "CLAYER" "0") ; устанавливем слой 0 для вставки обязательных атрибутов

```
	(setq
```

		slideDown 1 ; счетчик для смещения атрибутов

```
	)
```

	; Добавление обязательных атрибутов<<<<<<<<<<<<<<<<<<<<

```
	(foreach AttTag defaultAttTag 
```
```
		(vla-AddAttribute
```

			vlaBlockReal ; объект для вставки атрибута

			textHeigth ; высота текста

			acAttributeModeInvisible ; acAttributeModeInvisible ; тип атрибута

			""  ; Подсказка при вводе

			(vlax-3D-point ; координата точки вставки

```
				(list
```
```
					0.0
```

					(* -1 (+ textHeigth (* 0.5 textHeigth)) slideDown)

```
					0.0
```
```
				)
```
```
			)
```
```
			AttTag ; Имя атрибута
```

			""  ; Значение атрибута

```
		)
```
```
		(setq slideDown (1+ slideDown))
```
```
	) 
```

	; Добавление обязательных атрибутов>>>>>>>>>>>>>>>>>>>>>

	; Добавление атрибутов адресов<<<<<<<<<<<<<<<<<<<<<<<<<

	(if (null (tblsearch "LAYER" (strcat "att." p_adressTag)))

```
		(progn ;true
```

			(createLayer (strcat "att." p_adressTag) 1)

```
		)
```
```
 
```

	);(null (tblsearch "LAYER" "att.PARENTADRESS"))

	(setvar  "CLAYER" (strcat "att." p_adressTag))

	(setq ; задаем точку вставки и точку выравнивания

```
		insertionPoint 
```

		(vlax-3D-point ; координата точки вставки

```
			(list
```
```
				(* -1.0 textHeigth)
```
```
				0.0
```
```
				0.0
```
```
			)
```
```
		)
```
```
	)
```
```
	(setq 
```
```
		att 
```
```
		(vla-AddAttribute
```

			vlaBlockReal ; объект для вставки атрибута

			textHeigth ; высота текста

			acAttributeModeNormal ; acAttributeModeInvisible ; тип атрибута

			""  ; Подсказка при вводе

```
			insertionPoint
```

			p_adressTag ; Имя атрибута

			""  ; Значение атрибута

```
		);(vla-AddAttribute
```
```
	)
```

	(vla-put-Alignment att acAlignmentRight)

	(vla-put-TextAlignmentPoint att insertionPoint)

```
 
```
```
	(setq adressNumber 1)
```
```
	(repeat (1- (1+ adressQuantity))
```

		(if (null (tblsearch "LAYER" (strcat "att.SELFADRESS" (itoa adressNumber))))

```
			(progn ;true
```

				(createLayer (strcat "att.SELFADRESS" (itoa adressNumber)) 5)

```
			)
```
```
 
```

		);(null (tblsearch "LAYER" "att.PARENTADRESS"))

		(setvar  "CLAYER" (strcat "att.SELFADRESS" (itoa adressNumber)))

		(setq ; задаем точку вставки и точку выравнивания

```
			insertionPoint 
```

			(vlax-3D-point ; координата точки вставки

```
				(list
```
```
					(* -1 textHeigth)
```

					(* (+ textHeigth (* 0.5 textHeigth)) adressNumber )

```
					0.0
```
```
				)
```
```
			)
```
```
		)
```
```
		(setq 
```
```
			att 
```
```
			(vla-AddAttribute
```

				vlaBlockReal ; объект для вставки атрибута

				textHeigth ; высота текста

				acAttributeModeNormal ; acAttributeModeInvisible ; тип атрибута

				""  ; Подсказка при вводе

```
				insertionPoint
```

				(strcat "SELFADRESS" (itoa adressNumber)) ; Имя атрибута

				""  ; Значение атрибута

```
			);(vla-AddAttribute
```
```
		)
```

		(vla-put-Alignment att acAlignmentRight)

		(vla-put-TextAlignmentPoint att insertionPoint)

		;счетчик--------------------------------------

		(setq adressNumber (1+ adressNumber));--------

		;---------------------------------------------

```
	)
```
```
 
```

	; Добавление атрибутов адресов>>>>>>>>>>>>>>>>>>>>>>>>>

```
 
```

	; Добавление атрибутов проводов<<<<<<<<<<<<<<<<<<<<<<<<<

```
 
```
```
	(if (< 0 wiresQuantity)
```
```
		(progn ;true
```

			(setvar  "CLAYER" "0") ; устанавливем слой 0 для вставки  атрибутов проводов

			(setq cableNum 1) ; начальный счетчик проводов

```
			(repeat (1- (1+ wiresQuantity))
```
```
				(foreach AttTag cableTag
```
```
					(vla-AddAttribute
```

						vlaBlockReal ; объект для вставки атрибута

						textHeigth ; высота текста

						acAttributeModeInvisible ; acAttributeModeInvisible ; тип атрибута

						""  ; Подсказка при вводе

						(vlax-3D-point ; координата точки вставки

```
							(list
```
```
								0.0
```

								(* -1 (+ textHeigth (* 0.5 textHeigth)) slideDown)

```
								0.0
```
```
							)
```
```
						)
```

						(strcat (itoa cableNum) AttTag) ; Имя атрибута

						""  ; Значение атрибута

```
					);(vla-AddAttribute
```
```
				);(foreach AttTag cableTag
```
```
				(setq slideDown (1+ slideDown))
```
```
				(setq cableNum (1+ cableNum))
```
```
			);(repeat (1- wiresQuantity)
```
```
		)
```
```
		(progn ;false
```
```
 
```
```
		)
```
```
	);if (< 0 wiresQuantity)
```
```
 
```

	; Добавление атрибутов проводов>>>>>>>>>>>>>>>>>>>>>>>>>

```
 
```
```
 
```

	(setvar  "CLAYER" userLayer) ; возвращаем слой

```
 
```
```
 
```
```
 
```

	 (if (not (member "battman.arx" (arx)))

```
	(arxload "battman.arx")
```
```
	) ;_ end of if
```

	(acet-attsync (vla-get-name vlaBlockReal )) ;vlaBlock

```
)
```

Небольшой комментарий. Команда attsCreate выведена на кнопку в рабочем пространстве, для удобства. Атрибуты со значениями адресов — видимые и создаются в своих слоях для возможности их отключения.
Пример работы:

3 Replies to “Автоматическое создание атрибутов блоков в автокад. LISP.”

Андрей:

09.06.2019 в 12:13

Очень интересно…..

Ответить
Михаил:

03.10.2019 в 13:37

Очень интересно, но после ввода высоты текста выдает «ошибка: неверный тип аргумента: VLA-OBJECT nil»

Ответить
1. Александр:
  
  08.10.2019 в 18:42
  
  Михаил, вероятно у вас не подгружен activeX. Просто у меня он подгружается автоматически и, видимо, это я упустил. Я подправил код. Проверьте пожалуйста. Спасибо за наводку.
  
  Ответить

3 Replies to “Автоматическое создание атрибутов блоков в автокад. LISP.”

Добавить комментарий Отменить ответ