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

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


  1. (defun begin_activex ( / ) 
  2.   (vl-load-com) 
  3.   (setq acad_application (vlax-get-acad-object)) 
  4.   (setq active_document (vla-get-ActiveDocument acad_application)) 
  5.   (setq model_space (vla-get-ModelSpace active_document)) 
  6.   (setq paper_space (vla-get-PaperSpace active_document)) 
  7. )
  8. (begin_activex)
  9. (defun c:attsCreate   ( / )
  10. 	(defun-q  createLayer (layerName layerColor / )
  11. 		(entmakex
  12. 			(list
  13. 				(cons 0 "LAYER")
  14. 				(cons 100 "AcDbSymbolTableRecord")
  15. 				(cons 100 "AcDbLayerTableRecord")
  16. 				(cons 2  layerName)
  17. 				(cons 70 0) 
  18. 				(cons 62 layerColor)
  19. 			)		
  20. 		)
  21. 		;------Return---------
  22. 		;
  23. 		;
  24. 		;---Call parametrs----
  25. 		;
  26. 		;
  27. 		;
  28. 		;
  29.  
  30. 	)
  31. 	; Call example:
  32. 	;
  33. 	(setq
  34. 		defaultAttTag
  35. 		(list
  36. 			"ID"
  37. 			"SQLID"
  38. 			"FULLNAME"
  39. 			"SHORTNAME"
  40. 			"GROUPNAME"
  41. 			"IDENTIFIER"
  42. 			"FACTORYMANUFACTURER"
  43. 			"DESCRIPTION"
  44. 			"POSITION"
  45. 			"NOTES"
  46. 			"MU"
  47. 			"PRICE"
  48. 			"PRICEID"
  49. 		)	
  50. 		cableTag
  51. 		(list
  52. 			"CABLENUM"
  53. 			"CABLETYPE"
  54. 			"CABLELENGTH"
  55. 			"CABLEPURPOSE"
  56. 			"CABLESTART"
  57. 			"CABLEEND"
  58. 		)
  59. 		p_adressTag "PARENTADRESS"
  60. 		s_adressTag "SELFADRESS"
  61.  
  62. 	)
  63.  
  64.  
  65.  
  66. 	(setq 
  67. 		vlaBlock (vlax-ename->vla-object (car (entsel "\nУкажите блок: ")))
  68. 		adressQuantity (getint  "Укажите количество дочерних адресов:")
  69. 		wiresQuantity (getint  "Укажите количество проводов:")
  70. 		textHeigth (getreal  "Укажите высоту текста:")
  71. 	)
  72. 	(setq vlaBlockReal (vla-item (vla-get-blocks active_document) (vla-get-EffectiveName vlaBlock))) ; Получаем указатель на описание блока
  73. 	(setq userLayer (getvar "CLAYER")) ; запоминаем текущий слой
  74. 	(setvar  "CLAYER" "0") ; устанавливем слой 0 для вставки обязательных атрибутов 
  75. 	(setq
  76. 		slideDown 1 ; счетчик для смещения атрибутов
  77. 	)
  78. 	; Добавление обязательных атрибутов<<<<<<<<<<<<<<<<<<<<
  79. 	(foreach AttTag defaultAttTag 
  80. 		(vla-AddAttribute
  81. 			vlaBlockReal ; объект для вставки атрибута
  82. 			textHeigth ; высота текста
  83. 			acAttributeModeInvisible ; acAttributeModeInvisible ; тип атрибута
  84. 			""  ; Подсказка при вводе
  85. 			(vlax-3D-point ; координата точки вставки
  86. 				(list
  87. 					0.0
  88. 					(* -1 (+ textHeigth (* 0.5 textHeigth)) slideDown)
  89. 					0.0
  90. 				)
  91. 			)
  92. 			AttTag ; Имя атрибута
  93. 			""  ; Значение атрибута
  94. 		)
  95. 		(setq slideDown (1+ slideDown))
  96. 	) 
  97. 	; Добавление обязательных атрибутов>>>>>>>>>>>>>>>>>>>>>
  98. 	; Добавление атрибутов адресов<<<<<<<<<<<<<<<<<<<<<<<<<
  99. 	(if (null (tblsearch "LAYER" (strcat "att." p_adressTag)))
  100. 		(progn ;true
  101. 			(createLayer (strcat "att." p_adressTag) 1)
  102. 		)
  103.  
  104. 	);(null (tblsearch "LAYER" "att.PARENTADRESS"))
  105. 	(setvar  "CLAYER" (strcat "att." p_adressTag))
  106. 	(setq ; задаем точку вставки и точку выравнивания
  107. 		insertionPoint 
  108. 		(vlax-3D-point ; координата точки вставки
  109. 			(list
  110. 				(* -1.0 textHeigth)
  111. 				0.0
  112. 				0.0
  113. 			)
  114. 		)
  115. 	)
  116. 	(setq 
  117. 		att 
  118. 		(vla-AddAttribute
  119. 			vlaBlockReal ; объект для вставки атрибута
  120. 			textHeigth ; высота текста
  121. 			acAttributeModeNormal ; acAttributeModeInvisible ; тип атрибута
  122. 			""  ; Подсказка при вводе
  123. 			insertionPoint
  124. 			p_adressTag ; Имя атрибута
  125. 			""  ; Значение атрибута
  126. 		);(vla-AddAttribute
  127. 	)
  128. 	(vla-put-Alignment att acAlignmentRight)
  129. 	(vla-put-TextAlignmentPoint att insertionPoint)
  130.  
  131. 	(setq adressNumber 1)
  132. 	(repeat (1- (1+ adressQuantity))
  133. 		(if (null (tblsearch "LAYER" (strcat "att.SELFADRESS" (itoa adressNumber))))
  134. 			(progn ;true
  135. 				(createLayer (strcat "att.SELFADRESS" (itoa adressNumber)) 5)
  136. 			)
  137.  
  138. 		);(null (tblsearch "LAYER" "att.PARENTADRESS"))
  139. 		(setvar  "CLAYER" (strcat "att.SELFADRESS" (itoa adressNumber)))
  140. 		(setq ; задаем точку вставки и точку выравнивания
  141. 			insertionPoint 
  142. 			(vlax-3D-point ; координата точки вставки
  143. 				(list
  144. 					(* -1 textHeigth)
  145. 					(* (+ textHeigth (* 0.5 textHeigth)) adressNumber )
  146. 					0.0
  147. 				)
  148. 			)
  149. 		)
  150. 		(setq 
  151. 			att 
  152. 			(vla-AddAttribute
  153. 				vlaBlockReal ; объект для вставки атрибута
  154. 				textHeigth ; высота текста
  155. 				acAttributeModeNormal ; acAttributeModeInvisible ; тип атрибута
  156. 				""  ; Подсказка при вводе
  157. 				insertionPoint
  158. 				(strcat "SELFADRESS" (itoa adressNumber)) ; Имя атрибута
  159. 				""  ; Значение атрибута
  160. 			);(vla-AddAttribute
  161. 		)
  162. 		(vla-put-Alignment att acAlignmentRight)
  163. 		(vla-put-TextAlignmentPoint att insertionPoint)
  164. 		;счетчик--------------------------------------
  165. 		(setq adressNumber (1+ adressNumber));--------
  166. 		;---------------------------------------------
  167. 	)
  168.  
  169. 	; Добавление атрибутов адресов>>>>>>>>>>>>>>>>>>>>>>>>>
  170.  
  171. 	; Добавление атрибутов проводов<<<<<<<<<<<<<<<<<<<<<<<<<
  172.  
  173. 	(if (< 0 wiresQuantity)
  174. 		(progn ;true
  175. 			(setvar  "CLAYER" "0") ; устанавливем слой 0 для вставки  атрибутов проводов
  176. 			(setq cableNum 1) ; начальный счетчик проводов
  177. 			(repeat (1- (1+ wiresQuantity))
  178. 				(foreach AttTag cableTag
  179. 					(vla-AddAttribute
  180. 						vlaBlockReal ; объект для вставки атрибута
  181. 						textHeigth ; высота текста
  182. 						acAttributeModeInvisible ; acAttributeModeInvisible ; тип атрибута
  183. 						""  ; Подсказка при вводе
  184. 						(vlax-3D-point ; координата точки вставки
  185. 							(list
  186. 								0.0
  187. 								(* -1 (+ textHeigth (* 0.5 textHeigth)) slideDown)
  188. 								0.0
  189. 							)
  190. 						)
  191. 						(strcat (itoa cableNum) AttTag) ; Имя атрибута
  192. 						""  ; Значение атрибута
  193. 					);(vla-AddAttribute
  194. 				);(foreach AttTag cableTag
  195. 				(setq slideDown (1+ slideDown))
  196. 				(setq cableNum (1+ cableNum))
  197. 			);(repeat (1- wiresQuantity)
  198. 		)
  199. 		(progn ;false
  200.  
  201. 		)
  202. 	);if (< 0 wiresQuantity)
  203.  
  204. 	; Добавление атрибутов проводов>>>>>>>>>>>>>>>>>>>>>>>>>
  205.  
  206.  
  207. 	(setvar  "CLAYER" userLayer) ; возвращаем слой
  208.  
  209.  
  210.  
  211. 	 (if (not (member "battman.arx" (arx)))
  212. 	(arxload "battman.arx")
  213. 	) ;_ end of if
  214. 	(acet-attsync (vla-get-name vlaBlockReal )) ;vlaBlock
  215. )

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

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

ПечальноТак себеНе плохоХорошоОтличная статья! 2 оценок.
Загрузка...

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

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

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

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

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

Ваш e-mail не будет опубликован. Обязательные поля помечены *