По просьбе подписчика с моего канала на 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 выведена на кнопку в рабочем пространстве, для удобства. Атрибуты со значениями адресов — видимые и создаются в своих слоях для возможности их отключения.
Пример работы:
Очень интересно…..
Очень интересно, но после ввода высоты текста выдает «ошибка: неверный тип аргумента: VLA-OBJECT nil»
Михаил, вероятно у вас не подгружен activeX. Просто у меня он подгружается автоматически и, видимо, это я упустил. Я подправил код. Проверьте пожалуйста. Спасибо за наводку.