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

DmitriyBastr · 03.12.2015, 13:43

Есть вопрос специалистам-программистам:
Ниже код который позволяет сделать выноску с именем блока, на который она указывает.
Имя при этом вставляется в поле.
Возможно ли сделать так, чтобы это была не выноска а мультивыноска?
И ещё, возможно ли выводить не имя блока, а значение атрибута или одного из атрибутов, в том числе и не видимого?

Код:

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

[lisp][/(defun C:BLNM (/ acsp adoc ent mtx p1 p2 pline txt)
  (vl-load-com)
  (or adoc
      (setq adoc
	     (vla-get-activedocument
	       (vlax-get-acad-object)
	     )
      )
  )
  (if (and
	(= (getvar "tilemode") 0)
	(= (getvar "cvport") 1)
      )
    (setq acsp (vla-get-paperspace adoc))
    (setq acsp (vla-get-modelspace adoc))
  )
  (setq
    pline (vlax-ename->vla-object
	    (car (setq ent (entsel "\n >> Выбрать блок >> \n")))
	  )
  )
  (setq	txt
	 (strcat
	   "%<\\AcObjProp Object(%<\\_ObjId "
	   (itoa (vla-get-objectid pline))
	   ">%).EffectiveName >%"
	 )
  )
  (setq	p1 (cadr ent)
	p2 (getpoint p1 "\nВторая точка >> \n")
  )
  (setq	mtx (vlax-invoke
	      acsp 'AddMText p2	0.0 txt)
  )
  (vlax-put mtx
	    'AttachmentPoint
	    (cond ((> (car p1) (car p2))
		   acAttachmentPointMiddleRight
		  )
		  ((< (car p1) (car p2))
		   acAttachmentPointMiddleLeft
		  )
		  (T acAttachmentPointMiddleLeft)
	    )
  )

  (vlax-invoke
    acsp
    'Addleader
    (apply 'append (list p1 p2))
    mtx
    acLineWithArrow
  )
  (vl-catch-all-apply
    (function (lambda ()
		(progn
		  (vlax-release-object mtx)
		  (vlax-release-object pline)
		)
	      )
    )
  )
  (vla-regen adoc acactiveviewport)
  (princ)
)
(prompt "\n")
(prompt "\t\t<<< Ввести LF для старта программы :  >>>  \n")
(princ)
; TesT : (C:LF)LISP]

Alex M · 22.11.2021, 09:52

Цитата:

Сообщение от koMon

Hishnik, моя помощь в вашем вопросе была в виде, так сказать, скорой или оперативной. если вам нужен законченный лисп, то правильнее будет обратится в раздел "поиск исполнителей". в продолжение могу предложить упрощённый вариант формирования мультивыноски. после выбора блоков предупреждающее окно покажет сортированные в алфавитном порядке (без повторений) атрибуты в выбранных блоках с их номерами. затем будет предложено указать номера атрибутов в виде строки, слгласно которым атрибуты будут расставлены в мультивыноске в виде полей. вывод иноформации о количестве блоков закомментирован.
проверок ВООБЩЕ нет.

Код:

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

 
;******************************************************************************************************************************

(defun delete_duplicates (input_list / )
	(setq input_list_index 0
		  output_list '()
		  coincident_elements 0
	)
	(repeat (length input_list)
		(if (equal (car (nth input_list_index input_list)) (car (nth (1+ input_list_index) input_list)))
  			(setq input_list (cdr input_list) coincident_elements (1+ coincident_elements))
  			(progn
  				(setq output_list (cons (nth input_list_index input_list) output_list))
				(setq input_list_index (+ 1 input_list_index))
			)
		)
	)
	(reverse output_list)
)

;******************************************************************************************************************************

(defun c:Attribs_to_MLeader ()
	(setq acad_Object (vlax-get-acad-object)
	      document_object (vla-get-ActiveDocument acad_Object)
		  modelSpace_object (vla-get-modelSpace document_object)
		  blocks_pickset (ssget '((0 . "Insert")))
		  blocks_count (sslength blocks_pickset)
		  attribute_id_list '()
	)
	(while (< 0 (sslength blocks_pickset))
		(setq current_block_entity (ssname blocks_pickset 0))
		(while (/= "SEQEND" (cdr (assoc 0 (entget (setq next_entity (entnext current_block_entity))))))
			(if (= "ATTRIB" (cdr (assoc 0 (entget next_entity))))
	  			(setq attribute_id_list (cons
											(cons (vla-get-textstring (vlax-ename->vla-object next_entity)) (itoa (vla-get-objectid (vlax-ename->vla-object next_entity))))
											attribute_id_list
										)
				)
			)
			(setq current_block_entity next_entity)
		)
		(setq blocks_pickset (ssdel (ssname blocks_pickset 0) blocks_pickset))
	)
	(setq attribute_id_list (delete_duplicates (vl-sort attribute_id_list (function (lambda (le_1 le_2) (< (car le_1) (car le_2))))))
		  list_index 0
		  attribute_list (mapcar '(lambda (list_element) (cons (setq list_index (1+ list_index)) list_element)) (mapcar 'car attribute_id_list))
		  default_attribs_indices (apply 'strcat (mapcar '(lambda (list_element) (strcat (itoa (car list_element)))) attribute_list))
		  lisp_executed	(alert (strcat "Найденные атрибуты\n\n" (apply 'strcat (mapcar '(lambda (list_element) (strcat "    " (itoa (car list_element)) " - " "\"" (cdr list_element) "\"" "\n")) attribute_list))))
		  attribs_numbers_string (if (= "" (setq attribs_numbers_string (getstring (strcat "\nПорядок следования атрибутов в МВыноске <" default_attribs_indices ">: ")))) default_attribs_indices attribs_numbers_string)
		  attribs_indices (mapcar '(lambda (list_element) (- list_element 49)) (vl-string->list attribs_numbers_string))
		  mleader_org_point (getpoint "\nКорневая точка мультивыноски: ")
		  mleader_2nd_point (polar mleader_org_point (* pi 0.25) 40.0)
		  mleader_points_array (vlax-make-safearray vlax-vbDouble '(0 . 5))
		  vlax_executed (vlax-safearray-fill mleader_points_array (list (car mleader_org_point) (cadr mleader_org_point)  (caddr mleader_org_point)
															  			(car mleader_2nd_point) (cadr mleader_2nd_point)  (caddr mleader_2nd_point)
																  )
						)
		  mLeader_object (vla-AddMLeader modelspace_object mleader_points_array 0)
		  mLeader_string ""
	)
	(foreach attribute_index attribs_indices
		(setq mLeader_string (strcat mLeader_string "%<\\AcObjProp Object(%<\\_ObjId " (cdr (nth attribute_index attribute_id_list)) ">%).TextString>%" " "))
	)
	(setq mLeader_string (strcat "Префикс" " " mLeader_string "Суффикс"))
;	(if (> blocks_count 1) (setq mLeader_string (strcat mLeader_string "\\PКоличество: " (itoa blocks_count) " шт.")))
	(vla-put-TextLeftAttachmentType mLeader_object 3)
	(vla-put-TextRightAttachmentType mLeader_object 3)
	(vla-put-ArrowheadBlock mLeader_object "_None")
	(vla-put-DoglegLength mLeader_object 0.5)
	(vla-put-LandingGap mLeader_object 0.5)
	(vla-put-textlinespacingstyle mLeader_object 2)
	(vla-put-textstring mLeader_object mleader_string)
	(vla-regen document_object acActiveViewport)
	(princ)
)

;******************************************************************************************************************************

Добрый день.
Огромное спасибо за скрипт, очень полезный. Это практически то, что я искал.
К сожалению, в программировании не разбираюсь, может кто подскажет какие строки и как изменить в коде:
1. Чтобы при выводе всплывающего окна с идентификаторами и значениями атрибутов отображались не значения атрибутов, а названия (теги) атрибутов.
2. Чтобы при повторном вызове, скрипт по умолчанию запоминал последнюю набраную комбинацию идентификаторов.
Спасибо

koMon · 22.11.2021, 15:39

Цитата:

Сообщение от Alex M

не значения атрибутов

<Тэг> Атрибут

Цитата:

Сообщение от Alex M

скрипт по умолчанию запоминал последнюю набраную комбинацию идентификаторов

запоминает

Код:

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

 
;******************************************************************************************************************************
(defun delete_duplicates (input_list / )
	(setq input_list_index 0
		  output_list '()
		  coincident_elements 0
	)
	(repeat (length input_list)
		(if (equal (car (nth input_list_index input_list)) (car (nth (1+ input_list_index) input_list)))
  			(setq input_list (cdr input_list) coincident_elements (1+ coincident_elements))
  			(progn
  				(setq output_list (cons (nth input_list_index input_list) output_list))
				(setq input_list_index (+ 1 input_list_index))
			)
		)
	)
	(reverse output_list)
)

;******************************************************************************************************************************

(defun c:Attribs_to_MLeader ()
	(setq acad_Object (vlax-get-acad-object)
	      document_object (vla-get-ActiveDocument acad_Object)
		  modelSpace_object (vla-get-modelSpace document_object)
		  blocks_pickset (ssget '((0 . "Insert")))
		  blocks_count (sslength blocks_pickset)
		  attribute_id_list '()
	)
	(while (< 0 (sslength blocks_pickset))
		(setq current_block_entity (ssname blocks_pickset 0))
		(while (/= "SEQEND" (cdr (assoc 0 (entget (setq next_entity (entnext current_block_entity))))))
			(if (= "ATTRIB" (cdr (assoc 0 (entget next_entity))))
	  			(setq attribute_id_list (cons
											(cons (strcat
														"<"
														(vla-get-tagstring (vlax-ename->vla-object next_entity))
														"> "
														(vla-get-textstring (vlax-ename->vla-object next_entity))
												  )
												  (itoa (vla-get-objectid (vlax-ename->vla-object next_entity)))
											)
											attribute_id_list
										)
				)
			)
			(setq current_block_entity next_entity)
		)
		(setq blocks_pickset (ssdel (ssname blocks_pickset 0) blocks_pickset))
	)
	(setq attribute_id_list (delete_duplicates (vl-sort attribute_id_list (function (lambda (le_1 le_2) (< (car le_1) (car le_2))))))
		  list_index 0
		  attribute_list (mapcar '(lambda (list_element) (cons (setq list_index (1+ list_index)) list_element)) (mapcar 'car attribute_id_list))
		  default_attribs_indices (if attribs_numbers_string attribs_numbers_string (apply 'strcat (mapcar '(lambda (list_element) (strcat (itoa (car list_element)))) attribute_list)))
		  lisp_executed	(alert (strcat "Найденные атрибуты\n\n" (apply 'strcat (mapcar '(lambda (list_element) (strcat "    " (itoa (car list_element)) " - " "\"" (cdr list_element) "\"" "\n")) attribute_list))))
		  attribs_numbers_string (if (= "" (setq attribs_numbers_string (getstring (strcat "\nПорядок следования атрибутов в МВыноске <" default_attribs_indices ">: ")))) default_attribs_indices attribs_numbers_string)
		  attribs_indices (mapcar '(lambda (list_element) (- list_element 49)) (vl-string->list attribs_numbers_string))
		  mleader_org_point (getpoint "\nКорневая точка мультивыноски: ")
		  mleader_2nd_point (polar mleader_org_point (* pi 0.25) 40.0)
		  mleader_points_array (vlax-make-safearray vlax-vbDouble '(0 . 5))
		  vlax_executed (vlax-safearray-fill mleader_points_array (list (car mleader_org_point) (cadr mleader_org_point)  (caddr mleader_org_point)
															  			(car mleader_2nd_point) (cadr mleader_2nd_point)  (caddr mleader_2nd_point)
																  )
						)
		  mLeader_object (vla-AddMLeader modelspace_object mleader_points_array 0)
		  mLeader_string ""
	)
	(foreach attribute_index attribs_indices
		(setq mLeader_string (strcat mLeader_string "%<\\AcObjProp Object(%<\\_ObjId " (cdr (nth attribute_index attribute_id_list)) ">%).TextString>%" " "))
	)
	(setq mLeader_string (strcat "Префикс" " " mLeader_string "Суффикс"))
;	(if (> blocks_count 1) (setq mLeader_string (strcat mLeader_string "\\PКоличество: " (itoa blocks_count) " шт.")))
	(vla-put-TextLeftAttachmentType mLeader_object 3)
	(vla-put-TextRightAttachmentType mLeader_object 3)
;	(vla-put-ArrowheadBlock mLeader_object "_None")
	(vla-put-DoglegLength mLeader_object 0.5)
	(vla-put-LandingGap mLeader_object 0.5)
	(vla-put-textlinespacingstyle mLeader_object 2)
	(vla-put-textstring mLeader_object mleader_string)
	(vla-regen document_object acActiveViewport)
	(princ)
)

;******************************************************************************************************************************

Alex M · 22.11.2021, 16:01

Цитата:

Сообщение от koMon

запоминает

Спасибо, все чётко работает!

csi · 29.12.2022, 15:20

Каким должен быть код, чтобы можно было указать необходимые для выноски атрибуты через запятую/пробел/другой разделитель, для случаев когда атрибутов больше 9 (в этом случае происходит затык)?

koMon · 13.01.2023, 10:00

Цитата:

Сообщение от csi

Каким должен быть код

видимо таким
Attribs_to_MLeader

csi · 17.01.2023, 15:13

Почти было обрадовался и полез тестировать в рабочий файл, а там чуда не случилось. Точнее случилось, но с оговоркой...
Опытным путем выяснилось, если в названии тега есть точка (у меня некоторые теги заканчиваются точкой), то выскакивает Ошибка файла диалога (несвязанный символ).
Можно это как-то учесть, чтобы не мешало и продолжало работать?

koMon · 17.01.2023, 16:03

учёл)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Мои динамические блоки [2]	Кулик Алексей aka kpblc	Динамические блоки	4334	22.04.2019 09:16
Проблема с базовой точкой блока и вхождением блока в DXF	nogaems	Программирование	5	29.08.2013 15:46
Создание атрибута для блока	Рyslan	AutoCAD	56	14.10.2011 11:32
Создание блока (проблема)	Малюк	AutoCAD	3	12.09.2008 09:34
Создание блока с свободно вращающимся атрибутом	gizmo_zx	AutoCAD	2	01.09.2008 12:11