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

04.04.201912.02.2023 Александр 13

По просьбе подписчика с моего канала на 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 выведена на кнопку в рабочем пространстве, для удобства. Атрибуты со значениями адресов — видимые и создаются в своих слоях для возможности их отключения.
Пример работы:

Оцените пожалуйста статью:

4 оценок.

Загрузка...

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

Андрей:

09.06.2019 в 12:13

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

Войдите, чтобы ответить
Михаил:

03.10.2019 в 13:37

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

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

18.03.2021 в 09:31

Вот мой пример блока с атрибутами «Пример блока с атрибутами.dwg» (два раза нажимаем и попадаем в блок). Мне кажется что атрибуты не должны быть видимыми (пускай даже при печати их не видно но когда оборудования стоят один возле одного одно налазит на другое — не разберёшься. Лучше блок сделать с гиперссылкой с описанием, наводишь на блок мышкой показывается его название). Как добиться автоматической сортировки, нумерования и подсчёта блоков. — необходимо сделать блок динамическим с линией выноски для позиции (позиция атрибут, динамический блок чтобы можно было двигать линию выноски). Надо предусмотреть чтобы при значении «0» какого-то атрибута (добавить ещё один атрибут) линия выноски и номера позиции попадала бы в невидимый слой. — необходимо сделать lisp (можно макрос) который после его запуска сортировал бы значения атрибутов всех блоков в чертеже (можно сделать чтоб сортировал только выделенные) и считал их количество. После сортировки выдавал бы результат в сплывающем окне. В этом окне нужно предусмотреть такую возможность ставить приоритет (смысл такой — сортировка по умолчанию идёт по названию оборудования, если ставим приоритет какую-то цифру (чем меньше цифра тем выше приоритет) напротив какой-то графы (результат сортировке в виде разграфленной таблицы — как в спецификации) то она занимает место в таблице в соответствии с её приоритетом (если нету значения приоритета значит самый последний). После того как результат сортировки в сплывающем окне нас устраиваем,даём команду и результат сортировки, подсчёта пишется в «таблицу» показанную в файле «Спецификация.dwg» запись идёт однострочным текстом (надо придумать как переносить текст по строчкам) + к этому в сплывающем окне после устраивающей сортировки каждому оборудованию присваивается номер (автоматически по порядку), значения передаются в соответствующий блок как порядковый номер (номер на полке). — чтобы написать такую программу нужно либо очень поизучать lisp или макрос. Или же обратится к специалисту — но это будет стоить денег. Ну если вкратце то приблизительно так.

Войдите, чтобы ответить
1. Александр:
  
  18.03.2021 в 12:02
  
  Предлагаю вам этим заняться и поделиться с нами результатами.
  
  Войдите, чтобы ответить
Виталий:

01.08.2021 в 14:17

Добрый день, Александр.
Спасибо за lisp!
Скажите, не сложно ли на его основе сделать более простой lisp, который бы имя выделенного блока в текстовую выноску?

Войдите, чтобы ответить
1. Александр:
  
  02.08.2021 в 10:05
  
  Виталий, если честно — давно уже этим не занимался, но могу подсказать в каком направлении думать. Запускаем лисп >> вопрос в окне : «Укажите блок» >> выбираем блок >> получаем его имя. Далее 2 пути : если выноска уже есть >> выбираем выноску >> меняем ее текст. Если выноски еще нет : вопрос в окне «Укажите точку вставки» >> создаем выноску с нужным текстом (ее стиль должен быть определен) >> вставляем выноску в указанную точку.
  
  Войдите, чтобы ответить
Igor:

01.09.2021 в 10:04

Долго искал лисп по автоматической установке атрибутов и нашел Ваш, но можно ли его упростить?
мне нужно лишь 4-5 тегов атрибутов, пробовал сам и «упирался» в parentadress, зачистить его в самом лиспе не удалось — лисп потом не запускался а удалять вручную занимает столько же времени как и вручную же прописывание атрибутов в Автокаде, а уж такие сложности как «Укажите количество дочерних адресов» вообще не пойму как применять 🙂

Войдите, чтобы ответить
1. Александр:
  
  01.09.2021 в 11:50
  
  Игорь, это нужно для указания адресов извещателей в АУПС)
  
  Войдите, чтобы ответить
  1. Igor:
    
    05.09.2021 в 15:06
    
    у нас пока все проще — ляпаем рядом с извещателем адрес а потом лиспом-нумератором его)
    посмотрел большой ролик по связке с SQL — впечатляет, отключенные визуальные эффекты Винды — импонируют)
    нет ли в Ваших закромах этого самого лиспа с атрибутами только упрощенного, чтоб только теги ставил? я сам пробовал подчистить но увы…
    
    Войдите, чтобы ответить
    1. Александр:
      
      06.09.2021 в 12:17
      
      Игорь, здравствуйте, могу для вас сделать.
      
      Войдите, чтобы ответить
      1. Igor:
        
        09.09.2021 в 21:36
        
        Александр, приветствую. Сделайте пожалуйста, на основе Вашего лиспа, в сторону упрощения конечно же 🙂
      2. Александр:
        
        13.09.2021 в 12:29
        
        Игорь, здравствуйте. Подписывайтесь на группы в соцсетях, скину вам ATTSCREATELITE — лисп без проводов и адресов.

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

Для отправки комментария вам необходимо авторизоваться.