[Bamka70]

Привет всем! Месяц назад начал знакомиться с Lisp и пока что я совсем зеленый в данном направлении. Но имеется дикая необходиомасть создания мультивыноски, которая способна вытащить атрибут из блока в виде поля, чтобы содержимое выноски изменялось с изменением абрибута в блоке.
На данный момент, на просторах интрнета нашел такое решение

Код:

[Выделить все]

 
(defun c:мв_атриб (/)
(setq obj (car (entsel "\nВыбирете блок: "))) ;выбираем блок
(setq at1 (entget (entnext obj))) ;извлекаем список первого атрибута
(setq at1_text (cdr (assoc 1 at1))) ;читаем значения атрибута
  

(setq po (getpoint "\nУкажите местоположение стрелки выноски: "))
(setq p1 (getpoint po "\nПоложение полки выноски: "))    
	
(command "_.mleader" po p1 at1_text)
  )

выноска вытигивает первый артибут блока и вставляет его в выноску в виде простого текста. Кто подскажет, как вставить не просто занчение атрибута, а поле атрибута? Может есть какая-либо функция, способная вытащить информацию о формуле поля атрибута?

[Кулик Алексей aka kpblc]

Поставь это дело вручную и проанализируй формулу поля - там обычно показывается все что необходимо.

[Bamka70]

Кулик Алексей aka kpblc, Да я прекрасно понимаю, что хочу вытащить, а именно идентификатор атрибута, если его можно так назвать, некий порядковый номер.
Например, есть блок, шаровой кран и у него есть атрибут "Позиция", формула для поля данного атрибута выглядит следующим образом "%<\AcObjProp Object(%<\_ObjId 4591463040>%).TextString>%", исхидя из формулы, я понимаю, что мне необходимо получить индетификатор 4591463040, вот каким образом его получить, не могу понять, сначала думал, что поможет метод FieldCode, но что-то не получилось, как я понял, он вытягивает поля только из текстовых элементов... пробовал через методы ActiveX, но знаний, видимо, пока не хватает...тоже не вышло получить данную информацию. Методы и функции разбираю по Полещуку.

[AndruxaZ]

вот тут у Алексея почитайте, может поможет - https://autolisp.ru/2010/05/30/field-proceed-2/

[Vladimir_Sergeevich]

ух какая веселая задачка.

Код:

[Выделить все]

 (defun c:atr-ml ( / obj att_lst att_def fild_str obj_ml pt_base pt_ins)
	(defun get-ObjectId ( x / )
		(if (> (vl-string-search "x64" (getvar "platform")) 0)
			(vla-GetObjectIdString (vla-get-utility (vla-get-activeDocument (vlax-get-acad-object))) x :vlax-false)
			(rtos (vla-get-objectId x) 2 0)
		)
    )
	
 (setq obj  (car (entsel)) ;; select insert
	
 )
(if 
	(and 
		(not (null obj)) 		                                    ;;not empty select
		(= (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbBlockReference")		;;is insert
		(= (vla-get-HasAttributes (vlax-ename->vla-object obj)) :vlax-true)				;;has attributes
	 )
	(progn
		(setq 
			att_lst (vlax-safearray->list (vlax-variant-value (vla-GetAttributes (vlax-ename->vla-object obj)))) ;;lst of attr
			att_def (car att_lst)  ;;тут осуществить поиск нужного атрибута если их несколько 
			pt_base (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint (vlax-ename->vla-object obj))))
			pt_ins (polar pt_base 10 10.3)
			fild_str (strcat "%<\\AcObjProp Object(%<\\_ObjId " (get-ObjectId att_def) ">%).TextString>%")
			obj_ml (sad-addMleader nil (list pt_base pt_ins) 	(list (list "TextString" fild_str)) )
		)
		(vla-regen (vla-get-activeDocument (vlax-get-acad-object)) acActiveViewport) ;;for regen filed value
		(sad-parse-ml-line obj_ml)
	)
	(princ "\nIncorrect input")
)
 
 
 (princ)
) 
(defun sad-addMleader (owner pt_list draw_opt / doc index obj pt_variant) ;|Отрисовка мультивыноски ActivX
	(sad-addMleader  nil (list (getpoint) (getpoint)) '( ("TextString" "Text1") ("TextRotation" 0.785) ))
	Аргументы 
	*  Указатель на владельца или nil
	*  Список из точек (не менее двух)
	*  Список кривизны
	*  Cписок опций. По умолчанию - активные настройки (поддерживаются все свойства размера, кроме RO) 
		'("Layer" "Размеры ЭН")
		'("" "")	
	Возвращаемое значение
	*  Указатель на созданный объект
	|;
(if (not owner) (setq owner (sad-get-CurrentSpace))) ;;если не указано другого - активное пространство активного документа	
(if (not index) (setq index 1))
(setq pt_variant 
	(vlax-make-variant
		(vlax-safearray-fill 
			(vlax-make-safearray 
				vlax-vbDouble 
				'(0 . 5) 
			) 
			(append (car pt_list) (cadr pt_list) 	)	
		) 	
	) 
)
(setq obj (vla-addMleader owner pt_variant index))
(sad-change-property obj draw_opt)
)  ;;sad-addLightWeightPolyline  
(defun sad-change-property (obj draw_opt) ;|внутрення функция
	присовение примитиву свойств ActivX
	Аргументы:
	* указатель на объект - vla-object
	* список опций
	Возвращаемое значение 
	* указатель на объект - vla-object
	|;
	(foreach opt draw_opt
		(vl-catch-all-apply 
			'(lambda ()
				(vlax-put-property obj (car opt) (cadr opt))
			)
		)
	)
	;;(vla-update obj)
	obj
);;
(defun sad-get-CurrentSpace ( ) ;|получение активного пространства в активном документе
	*аргументов нет
	*возвращаемое значение указатель на модель или лист
	|;
	(if
		(= (vla-get-ActiveSpace (vla-get-activedocument (vlax-get-acad-object))) 1)
		(vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)))
		(if 
			(= (vla-get-MSpace (vla-get-activedocument (vlax-get-acad-object))) :vlax-false)
			(vla-get-PaperSpace (vla-get-activedocument (vlax-get-acad-object)))
			(vla-get-ModelSpace (vla-get-activedocument (vlax-get-acad-object)))
		)
	) 
);  

(defun sad-parse-ml-line ( mlObj / temp originPt originDl mlBasePt mlDestPoint pt_variant fl) ;|двигаем выноску
	*аргумент - vla-object мультивыноски
	*возвращет - vla-object мультивыноски или nil при нажатии esc
	|;
	(defun dir2pt (ang / ) (list (cos ang) (sin ang) 0)) 
	(defun pt2dir (pt / ang)
	;;; input - 2d vector
	;;; return - direction in rad
		(setq ang (atan (/ (cadr pt) (car pt)))	)
		(cond 
			((< (car pt) 0) (setq ang (+ ang (* pi 1))))
			((and (>= (car pt) 0) (< (cadr pt) 0)) (setq ang (+ ang (* pi 2)))) 
		)
		ang
	)
	(defun 2ptVariant (pt1 pt2 /  )
	;;;input - 2 points
	;;;output - vla-variant
		(vlax-make-variant
			(vlax-safearray-fill 
				(vlax-make-safearray 
					vlax-vbDouble 
					'(0 . 5) 
				) 
				(append pt1 pt2)
			) 	
		) 
	)
	(defun dlDir (obj ptBase ptEnd / dlVec txtVec rez alf)
	;;;
	;;;return - vla-variant - DogLeg's vector
		(setq 
			txtVec (vla-get-TextRotation obj) ;; dirction text
			dlVec (angle ptEnd ptBase)
		)
		(if ;;angle betveen vecs
			(> 	(setq alf (abs (- txtVec dlVec) )) pi	) 
			(setq alf (abs (- dlVec txtVec) )) 
		)
		(if (> alf pi) (setq alf (- (* pi 2) alf)))
		(if (< alf (* pi 0.5 ) )
			(setq rez (dir2pt (+ txtVec pi)))
			(setq rez (dir2pt txtVec))
		)
		(vlax-3d-point rez)
	)
	(setq 
		temp (vlax-safearray->list (vlax-variant-value (vla-GetLeaderLineVertices mlObj 0)))
		mlBasePt (list (car temp) (cadr temp) (caddr temp))
		temp (cdr (cdr (cdr temp)))
		originPt (list (car temp) (cadr temp) (caddr temp))
		originDl (vla-GetDoglegDirection mlObj 0)
		fl t
	)
	(while fl
		(if (vl-catch-all-error-p (setq temp (vl-catch-all-apply 'grread '(t 12 0))))
			(progn ;;ESC
				(vla-SetDoglegDirection mlObj 0 originDl)
				(vla-SetLeaderLineVertices mlObj 0 (2ptVariant mlBasePt originPt))
				(setq fl nil mlObj nil)
			) 
			(progn 
				(if (or (= (car temp) 5) (= (car temp) 3)) 
					(progn
						(vla-SetLeaderLineVertices mlObj 0 (2ptVariant mlBasePt (cadr temp))) 
						(vla-SetDoglegDirection mlObj 0 (dlDir mlObj mlBasePt (cadr temp)))
				))
				(if (or (= (car temp) 3) (= (car temp) 25)) (setq fl nil))
			)
		)
	) ;;while
	mlObj
)

AndruxaZ, жуть какая, век бы сам копал
В целом задача решена, в частностях: надо переписывать указание объекта и прочие взаимодействия с пользователем и проверки корректности ввода.

з.ы. переписал что бы повеселей выглядело, но над обработкой ESC еще нужно поколдовать.

[Bamka70]

AndruxaZ, Спасибо! Посмотрел, но при попытке реализовать у себя рассмотренные коды ActiveX выдает ошибку "ошибка: ActiveX Server возвратил ошибку: неизвестное имя: FieldCode", такое же было, когда пытался применить методы...пробовал примеры из учебника Полещука и из справочной документации по AciveX...но скорее всего я что-то делаю не так...

----- добавлено через ~1 мин. -----
Vladimir_Sergeevich, Спасибо за код, почти то что надо, буду его рабирать, чтобы понять, как это работает. Может добавлю возможность указывать конкретную точку вставки выноски и полочки.

[Vladimir_Sergeevich]

Сообщение от Bamka70 Может добавлю возможность указывать конкретную точку вставки выноски и полочки.

Ну собственно переписывай указание pt_base (строка 22) на интерактивный ввод, а полка сажается и так ручками, что реализуется в строке 28 (sad-parse-ml-line obj_ml). В моем варианте pt_ins высчитывается жестко только потому, что она нужна для создания самой выноски.
По хорошему, надо бы обернуть строку 28 в (if (sad-parse-ml-line... и на ветку else повесить удаление созданной мультивыноски.
Совсем в идеале, надо крепко переписать sad-parse-ml-line что бы она корректно обрабатывала в ПСК.

[Bamka70]

Спасибо всем, кто ответил в теме и давал полезные материалы! Особая балгодарность Vladimir_Sergeevich
С кодом более менее разобрался, для моих целей решение оказалось чуть короче, может конечно я что-то упустил, но вроде как все работает, всего навсего соединил два кода и получил результат.
код оставлю здесь, вдруг кому пригодится...или может опытные пользователи ткнут меня в неверное решение или какое-либо упущение.

Код:

[Выделить все]

 
 (defun c:мва ( / obj att_lst att_def fild_str obj_ml pt_base pt_ins)
	(defun get-ObjectId ( x / )
		(if (> (vl-string-search "x64" (getvar "platform")) 0)
			(vla-GetObjectIdString (vla-get-utility (vla-get-activeDocument (vlax-get-acad-object))) x :vlax-false)
			(rtos (vla-get-objectId x) 2 0)
		)
    )
	
 (setq obj  (car (entsel)) ;; select insert
	
 )
(if 
	(and 
		(not (null obj)) 		                                    ;;not empty select
		(= (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbBlockReference")		;;is insert
		(= (vla-get-HasAttributes (vlax-ename->vla-object obj)) :vlax-true)				;;has attributes
	 )
	(progn
		(setq 
			att_lst (vlax-safearray->list (vlax-variant-value (vla-GetAttributes (vlax-ename->vla-object obj)))) ;;lst of attr
			att_def (car att_lst) 
			fild_str (strcat "%<\\AcObjProp Object(%<\\_ObjId " (get-ObjectId att_def) ">%).TextString>%")
			po (getpoint "\nУкажите местоположение стрелки выноски: ")
			p1 (getpoint po "\nПоложение полки выноски: ")
		)

	  (command "_.mleader" po p1 fild_str)
	)
	(princ "\nIncorrect input")
)
 
 
 (princ)
   
)

[Vladimir_Sergeevich]

Bamka70, код может и короче (по сути вырезаны функции рисовки и интерактивного редактирования реализованные через VisualLisp) и вся красота заменена на (command "_.mleader"...
В своей практике я сталкивался с тем, что быстродействие командных методов оставляет желать лучшего (вот прям до выбешивания). В результате у меня развилось религиозное неприятие командных методов программирования.
С одной стороны понято, что command кушает в более понятном для инженера-непрограммиста виде, с другой моя sad-addMleader не намного сложнее.
До кучи, есть лишний тычок мышкой и не видно как сядет выноска.

з.ы. а где короче? как было 35 строк, так 35 строк и осталось

Код:

[Выделить все]

 (defun c:atr-ml ( / obj att_lst att_def fild_str obj_ml pt_base pt_ins)
	(defun get-ObjectId ( x / )
		(if (> (vl-string-search "x64" (getvar "platform")) 0)
			(vla-GetObjectIdString (vla-get-utility (vla-get-activeDocument (vlax-get-acad-object))) x :vlax-false)
			(rtos (vla-get-objectId x) 2 0)
		)
    )
(setq obj  (entsel) ;; select insert
	pt_base (trans (cadr obj) 1 0)
	obj (car obj)
	) 
(if 
	(and 
		(not (null obj)) 		                                    ;;not empty select
		(= (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbBlockReference")		;;is insert
		(= (vla-get-HasAttributes (vlax-ename->vla-object obj)) :vlax-true)				;;has attributes
	 )
	(progn
		(setq 
			att_lst (vlax-safearray->list (vlax-variant-value (vla-GetAttributes (vlax-ename->vla-object obj)))) ;;lst of attr
			att_def (car att_lst)  ;;тут осуществить поиск нужного атрибута если их несколько 
			pt_ins (polar pt_base 10 0.3)
			fild_str (strcat "%<\\AcObjProp Object(%<\\_ObjId " (get-ObjectId att_def) ">%).TextString>%")
			obj_ml (sad-addMleader nil (list pt_base pt_ins) 	(list (list "TextString" fild_str)) )
		)
		(vla-regen (vla-get-activeDocument (vlax-get-acad-object)) acActiveViewport) ;;for regen filed value
		(if (sad-parse-ml-line obj_ml) t (vla-delete obj_ml))
	)
	(princ "\nIncorrect input")
)
(princ)
) 

Может все таки так (библиотечные функции с предыдущего поста с кодом)

[koMon]

Сообщение от Bamka70 ткнут меня в неверное решение или какое-либо упущение

Bamka70,
зачем вообще циклиться на выборе блока, первом атрибуте... атрибут ведь видимый - почему не тыкнуть сразу в него?

Код:

[Выделить все]

 (defun c:first_attrib_mleader ( / entsel_data field_value mleader_basepoint block_entity)
	(while (and                   
				(or (null (setq entsel_data (vl-catch-all-apply 'entsel (list "\nУкажите блок: ")))) t)
				(cond
					(
						(null entsel_data)
							t
					)
	 
				(
						(vl-catch-all-error-p entsel_data)
							(setq block_entity nil)
					)
					(
						(and
							 (= "INSERT" (cdr (assoc 0 (entget (setq block_entity (car entsel_data))))))
							 (minusp (vlax-get (vlax-ename->vla-object block_entity) 'hasattributes))
						)
							nil
					)
					(
						t
							t
					)
				)
			)
	)
	(if block_entity
		(progn
			(setq field_value (strcat "%<\\AcObjProp Object(%<\\_ObjId "
									   (itoa (vla-get-objectid (car (vlax-safearray->list (vlax-variant-value (vla-getattributes (vlax-ename->vla-object block_entity)))))))
									   ">%).TextString>%"
							  )
			)
			(command "_.mleader" (setq mleader_basepoint (getpoint "\nУкажите местоположение стрелки выноски: "))
								 (getpoint mleader_basepoint "\nПоложение полки выноски: ")
								 field_value
			)
		)
		(princ "\nОтмена")
	)
	(princ)
)

[Bamka70]

koMon, в моем случае атрибуты скрыты и несут лишь информационную ценность, видеть их не надо...а вот вытаскивать в выноски или таблицы переодически надо.

[koMon]

Bamka70,
ну если скрытые, то ↑

[Vladimir_Sergeevich]

Сообщение от koMon (itoa (vla-get-objectid

koMon, посмотри ссылку из поста #4 и описание функции get-ObjectId из #5 или #9
на современной оси vla-get-objectid вернет не то значение, и надо стучаться через vla-GetObjectIdString
я сначала тоже долго думал, почему же оно не хочет работать, пока AndruxaZ не подсказал где списать

[koMon]

Сообщение от Vladimir_Sergeevich на современной оси vla-get-objectid вернет не то значение

Vladimir_Sergeevich, я бы наверное озадачился 100% этой проблемой если бы она, например, у меня возникла) но пока на воду не дую. попробуй загрузить лисп и проверить и напиши что, да как.

[Vladimir_Sergeevich]

koMon, грузить не буду, так отвечу.
vla-GetObjectIdString возвращает 1007938000 и поле нормально работает,
vla-get-ObjectId возвращает 37 и поле не понимает что от него хотят.
з.ы.

Команда: (getvar "platform") "Microsoft Windows NT Version 6.1 (x64)"

[koMon]

Vladimir_Sergeevich,
ну на нет и суда нет!
но как говорится, почувствуй разницу

Код:

[Выделить все]

Command: (vla-get-objectid (vlax-ename->vla-object (car (nentsel))))
Select object: 2372

Command: (itoa (vla-get-objectid (vlax-ename->vla-object (car (nentsel)))))
Select object: "2187135409696"

[Vladimir_Sergeevich]

очешуеть
я, что бы не думать, пытался скормить через vl-princ-to-string... какого-ж лешего itoa работает не как все

[koMon]

думать это полезно, читать мануалы полезней вдвойне

----- добавлено через ~8 мин. -----

Сообщение от Vladimir_Sergeevich какого-ж лешего itoa работает не как все

да потому что vla-get-objectid возвращает не десятичное число а Long_PTR