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

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


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

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

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

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

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

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