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

kacugu · 23.02.2019, 19:22

Доброго времени суток.
Возникла необходимость привести к одному виду кучу файлов. При редактировании стилей мультивыносок выяснилось, что у большинства мультивыносок свойства отредактированы вручную. Самым простым способом сбросить свойства таких мультивыносок показалось создание новой мультивыноски на основе старой Offtop: насколько знаю, до сих пор в Autocad нет возможности сбросить свойства мультивынок на свойства по стилю.

Получилось слепить из найденного на просторах следующий код:

Код:

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

 ;; Лисп создаёт мультивыноску, со свойствами выбранной мультивыноски

;;  Добавить:
;; 1 - Обработчик ошибок
;; 2 - vla-StartUndoMark
;; 3 - Возможность обрабатывать сразу несколько мультивыносок (ssget...)
;; 4 - Обработку нескольких вершин выноски
;; 5 - Добавление аннотативных масштабов исходного объекта
;; 6 - Обработку мультивыносок без выносок
;; 7 - Разобраться с положением создаваемого текста

(defun c:Kacugu-Recreate-Mleader
(/ 
ent
entdata
layer
VertexCoord
DogCoord
TextCoord
obj
getLay
getStyle
getTxtRot
getTxtStr
getTxtWidth
getTxtDir
getDoglegDir
lstptslen
newMld
i
points
lst
safe
safe-fill
)

(vl-load-com)

;; Выбор мультивыноски
(while
	(progn
	(setvar 'errno 0)
	(setq ent (car (entsel "\nВыберите мультивыноску <Выход>: "))) 
		(cond
			(
			 	(= 7 (getvar 'errno))
				(princ "\nМимо, попробуйте снова.")
			)
			(
				(null ent)
				nil
			)
			(
				(/= "MULTILEADER" (cdr (assoc 0 (setq entdata (entget ent)))))
				(princ "\nОбъект не является мультивыноской.")
			)
		);; end of cond
	);; end of progn
);; end of while

(setq VertexCoord (MleaderCoordsGet ent)
DogCoord (cdr (assoc 10 (cdr (member '(302 . "LEADER{") entdata))))
TextCoord (cdr (assoc 10 entdata))
obj (vlax-ename->vla-object ent)
getLay (vla-get-Layer obj)
getStyle (vla-get-StyleName obj)
getTxtWidth (vla-get-TextWidth obj)
getTxtStr (vla-get-TextString obj)
getTxtRot (vla-get-TextRotation obj)
getTxtDir (vla-get-TextDirection obj)
getDoglegDir (vla-GetDoglegDirection obj 0)  
lstptslen (length VertexCoord)
i 0)

(progn
	(setq newMld
		(vlax-invoke
			(vlax-get-property (LM:acdoc)
				(if (= 1 (getvar 'cvport))
					'paperspace
					'modelspace
				)
			)
			'addmleader
			(append (nth 0 VertexCoord) DogCoord)
			0
		)
	)

	(if (<= (car DogCoord) (car (trans (nth 0 VertexCoord) ent 1)))
		(progn
			(vla-setdoglegdirection newMld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
			(vlax-invoke newMld 'setleaderlinevertices 0 (append (nth 0 VertexCoord) DogCoord))
		)
		(progn
			(vla-setdoglegdirection newMld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
		)
	);; end of if

 	(vla-put-textstring newMld getTxtStr)
	(vla-put-StyleName newMld getStyle)
	(vla-put-TextRotation newMld getTxtRot)
  	(vla-put-TextDirection newMld getTxtDir)
	(vla-put-Layer newMld getLay)
	(if (/= getTxtWidth 0)
	(vla-put-TextWidth newMld getTxtWidth))
	;;;	(entdel ent)
  
	(repeat (- lstptslen 1)
	  	(setq i (1+ i))
		(setq lst (append (nth i VertexCoord) DogCoord)) ;;http://adn-cis.org/forum/index.php?topic=7529.msg23985#msg23985
		(setq safe (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length lst)))))
		(setq safe-fill (vlax-safearray-fill safe lst))
		(vla-AddLeaderLineEx newMld safe-fill)
	) ;; end of repeat 
);; end of progn

(princ)
  
);; end of defun




;;;https://www.theswamp.org/index.php?topic=48967.msg541497#msg541497
;;; Возвращает список с координатами главных вершин мультивыноски
(defun MleaderCoordsGet ( ename / elist return)
	;; (setq ename (car (entsel)))
	(setq elist (entget ename))
	(while (setq elist (cdr (member '(304 . "LEADER_LINE{") elist)))
		(setq return (cons (cdr (assoc 10 elist)) return))
	)
	(reverse return)
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)

Минимум действий он выполняет. Но не получается разобраться с положением текста: новый текст часто создаётся со смещением (на картинке жёлтым цветом исходная мультивыноска, белым - новая).
Как это можно исправить?

update от 2019-02-28
в общем получилось что-то такое:

Код:

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

 
;; Recreate mleader

;; thanx 3dwannab for idea https://www.cadtutor.net/forum/topic/43221-set-mleader-to-existing-mleader-style-via-lisp/?tab=comments#comment-547617

;;  TODO:
;; - work with mleaders on locked layer (yes/no)

(defun c:kaa-Recreate-Mleader-2D
(/
*error*
acDoc
old_osmode
layer
islock
ss1
sel
cnt
ent
entdata
obj
obj-Last-Leader-Line-Point  
obj-Content-Base-Position
obj-Clusters-Count
obj-Layer
obj-Style
obj-TxtStr
obj-TxtWidth
obj-TxtBackFill
obj-TxtDir
obj-TxtJustify
obj-TxtRot
obj-Dogleg-Length
obj-Clusters
obj-First-Cluster
obj-Dogleg-Dir
obj-First-Leader-Line-Index
obj-First-Leader-Line-Vertex
newMld
obj-Leader-Line-Indexes
obj-Leader-Line-Vertices
obj-All-Leader-Line-Vertices
il
obj-tmp-Coor-X
new-tmp-Coor-X
)

(vl-load-com)

(vla-startundomark
	(setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
  
(defun *error* (errmsg)
	(and errmsg
		(not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*"))
		(princ (strcat "\n<< Error: " errmsg " >>\n"))
	)
	(setvar 'osmode old_osmode)
  	(vla-put-lock layer islock)
);; end of defun

(setq layer (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (getvar "clayer")))
(setq islock (vla-get-lock layer))
(if (eq islock :vlax-true) (vla-put-lock layer :vlax-false))
  
(setq old_osmode (getvar "osmode"))
(setvar "osmode" 0)
(setq ss1 (ssget ":L" '((0 . "MULTILEADER"))))
(setq sel (ssadd))
(setq cnt 0)

(repeat (setq cnt (sslength ss1))

	(setq cnt (1- cnt))
	(setq ent (cdr (assoc -1 (entget (ssname ss1 cnt)))))
  	(setq entdata (entget ent))
	(setq obj (vlax-ename->vla-object ent))
	(setq obj-Clusters-Count (vla-get-LeaderCount obj))
	(setq obj-Layer (vla-get-Layer obj))
	(setq obj-Style (vla-get-StyleName obj))
	(setq obj-TxtWidth (vla-get-TextWidth obj))
	(setq obj-TxtStr (vla-get-TextString obj))
	(setq obj-TxtRot (vla-get-TextRotation obj))
	(setq obj-TxtDir (vla-get-TextDirection obj))
	(setq obj-TxtBackFill (vla-get-TextBackgroundFill obj))
  	(setq obj-TxtJustify (vla-get-textjustify obj))
  	(setq obj-Dogleg-Length (vla-get-dogleglength obj))

	(cond
		(
			(> obj-Clusters-Count 0)
		  	(progn
				(setq obj-Last-Leader-Line-Point   (cdr (assoc 10 (cdr (member '(302 . "LEADER{") entdata)))))
				(setq obj-Content-Base-Position  (cdr (assoc 10 entdata)))
			  	(setq obj-Clusters (MleaderClustersGet ent)) ;; cluster's index list
				(setq obj-First-Cluster (nth 0 obj-Clusters))
			  	(setq obj-Dogleg-Dir (vla-GetDoglegDirection obj obj-First-Cluster))
			  	(setq obj-First-Leader-Line-Index (nth 0 (vl-sort (kaa-var-to-list (vla-getleaderlineindexes obj obj-First-Cluster)) '<)))
				(setq obj-First-Leader-Line-Vertex (vla-getleaderlinevertices obj obj-First-Leader-Line-Index));; all leader line vertices 
				(setq newMld
					(vlax-invoke
						(vlax-get-property (LM:acdoc)
							(if (= 1 (getvar 'cvport))
								'paperspace
								'modelspace
							)
						)
						'addmleader
						(kaa-var-to-list obj-First-Leader-Line-Vertex)
						0
					)
				);; end of setq
			  
			  	(vla-put-Layer newMld obj-Layer)
			  	(vla-put-textstring newMld obj-TxtStr)
			  	(vla-put-TextRotation newMld obj-TxtRot)
				(vla-put-TextDirection newMld obj-TxtDir)
			  	(vla-put-Textjustify newMld obj-TxtJustify)
			  	(if (/= obj-TxtWidth 0) (vla-put-TextWidth newMld obj-TxtWidth))
				(vla-put-TextBackgroundFill newMld obj-TxtBackFill)
			  
				(if (/= obj-First-Cluster 0) (setq obj-Clusters (vl-sort obj-Clusters '<)) (vla-removeleader newmld 0))
				
				(setq obj-All-Leader-Line-Vertices (list 'txt))
				
				(foreach i obj-Clusters
				  	(setq obj-Leader-Line-Indexes (vl-sort (kaa-var-to-list (vla-getleaderlineindexes obj i)) '<))
					(foreach  il obj-Leader-Line-Indexes
				  		(progn
							(setq obj-Leader-Line-Vertices (vla-getleaderlinevertices obj il))
							(if (not (member (kaa-var-to-list obj-Leader-Line-Vertices) obj-All-Leader-Line-Vertices))
								(progn 
									(setq obj-All-Leader-Line-Vertices (cons (kaa-var-to-list obj-Leader-Line-Vertices) obj-All-Leader-Line-Vertices))
									(vla-addleaderlineex newMld obj-Leader-Line-Vertices)
								);; end of progn
							);; end of if
						);; end of progn
					);; end of foreach
				);; end of foreach		  	
			  	
  			  	(vla-setdoglegdirection newMld (nth 0 (MleaderClustersGet (vlax-vla-object->ename newmld))) (vlax-variant-value obj-Dogleg-Dir))
				(vla-setleaderlinevertices newMld
			  				(nth 0 (kaa-var-to-list (vla-getleaderlineindexes newmld (nth 0 (MleaderClustersGet (vlax-vla-object->ename newmld))))))
			  				(vlax-variant-value obj-First-Leader-Line-Vertex))
			  	(if (/= obj-First-Cluster 0) (vla-removeleaderline newmld 0))
			  
			  	(vla-put-StyleName newMld obj-Style)
				(RN_MatchAnntScale (vlax-vla-object->ename obj) (vlax-vla-object->ename newmld))
				(entdel ent)
			);; end of progn
		 )
		(
			(= obj-Clusters-Count 0)
		 	(progn
			  	(setq obj-Content-Base-Position  (cdr (assoc 10 entdata)))
			  	(setq obj-tmp-Coor-X (nth 0 obj-Content-Base-Position ))
			  	(setq new-tmp-Coor-X (+ obj-tmp-Coor-X (* obj-Dogleg-Length -1)))
			  	(setq obj-Content-Base-Position  (list new-tmp-Coor-X (nth 1 obj-Content-Base-Position ) (nth 2 obj-Content-Base-Position )))
			  	(setq newMld
					(vlax-invoke
						(vlax-get-property (LM:acdoc)
							(if (= 1 (getvar 'cvport))
								'paperspace
								'modelspace
							)
						)
						'addmleader
						(append (list 0.0 0.0 0.0) obj-Content-Base-Position )
						0
					)
				)
			  	
			  	(vla-put-Layer newMld obj-Layer)
			  	(vla-put-textstring newMld obj-TxtStr)
			  	(if (/= obj-TxtWidth 0) (vla-put-TextWidth newMld obj-TxtWidth))
				(vla-put-TextRotation newMld obj-TxtRot)
				(vla-put-TextDirection newMld obj-TxtDir)
			  	(vla-put-Textjustify newMld obj-TxtJustify)
				(vla-put-TextBackgroundFill newMld obj-TxtBackFill)
			  	(vla-removeleaderline newmld 0)
			  	(vla-put-StyleName newMld obj-Style)
			  	(RN_MatchAnntScale (vlax-vla-object->ename obj) (vlax-vla-object->ename newmld))
				(entdel ent)
			);; end of progn
		)
	);; end of cond
);; end of repeat

(setvar "osmode" old_osmode)
(vla-put-lock layer islock)
  
(vla-endundomark acDoc) ; undomark bottom mark
(*error* nil) (princ)
  
);; end of defun

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх


;;;https://www.theswamp.org/index.php?topic=48967.msg541497#msg541497
;;; Returns list of mleader's cluster

(defun MleaderClustersGet ( ename / elist return)
	(setq elist (entget ename))
	(while (setq elist (cdr (member '(302 . "LEADER{") elist)))
		(setq return (cons (cdr (assoc 90 elist)) return))
	)
	(reverse return)
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
   (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
   (LM:acdoc)
)
;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; variant to list
 
(defun kaa-var-to-list (source)
   (vlax-safearray->list (vlax-variant-value source))
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

;; http://forum.dwg.ru/showpost.php?p=1573413&postcount=47
;;_RN_MatchAnntScale - Копируем аннотативный масштаб (масштабы)
;;_с одного объекта на другой (другие). По сути это Match Properties,
;;_но только для аннотативных масштабов.
;;; Match Properties for annotative scales

(defun RN_MatchAnntScale ( sourceobj  destinationobj / sourceann sourceannlist pr gr cmd adoc scale)
	(vl-load-com)
	(vla-startundomark
		(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
	) ;_ end of vla-startundomark
	(sssetfirst nil nil)
	(if
		(and
			(setq sourceann sourceobj)
			(IsAnnotative sourceann)
			(setq sourceannlist (GetAnnoScales sourceann))
			(setq destinationobj (ssadd destinationobj))
		)
		(foreach scale sourceannlist
			(progn
				(setq cmd (getvar "CMDECHO"))
				(vl-cmdf "_-objectscale" destinationobj "" "_Add" scale "")
				(command)
			);; end of progn
		);; end foreach
	)
(vla-endundomark adoc) ; undomark bottom mark
(princ)
);defun

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

  (defun GetAnnoScales (e / dict lst rewind res)
;;; Argument: the ename of an annotative object.
;;; Returns the annotative scales associated with the 
;;; ename as a list of strings.
;;; Example: ("1:1" "1:16" "1:20" "1:30")
;;; Returns nil if the ename is not annotative. 
;;; Can be used to test whether ename is annotative or not.
;;; Works with annotative objects: text, mtext, leader, mleader, 
;;; dimension, block reference, tolerance and attribute.
;;; Based on code by Ian Bryant.


;;;Joe Burk
;;;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-do-i-make-hatch-annotative-via-vlisp-almost-there/m-p/2080831    
;; Argument: an ename or vla-object.
;; Return T if object is annotative, otherwise nil.
;;;(defun IsAnnotative (e)
;;;(if (not (eq (type e) 'ENAME))
;;;(setq e (vlax-vla-object->ename e))
;;;)
;;;(if (assoc -3 (entget e '("AcadAnnotative"))) T)
;;;)

;;;(defun IsAnnotative (e)
;;;(and e
;;;(setq e (cdr (assoc 360 (entget e))))
;;;(setq e (dictsearch e "AcDbContextDataManager"))
;;;(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
;;;(assoc 350 e)
;;;)
;;;)
    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq e      (cdr (assoc 340 lst))
                 ;; res    (cons (cdr (assoc 300 (entget e))) res)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
       ) ;_ end of progn
    ) ;_ end of if
    (reverse res)
  ) ;_end

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

(defun IsAnnotative (e)
	(and e
		(setq e (cdr (assoc 360 (entget e))))
		(setq e (dictsearch e "AcDbContextDataManager"))
		(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
		(assoc 350 e)
	)
)

;;;хххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххххх

(princ)
(princ "\n:: команда kaa-Recreate-Mleader-2D - ”Recreate selected mleaders ::")
(princ)

update от 2020-12-18
Offtop: Вспомнилось, обновил код. Что конкретно менял - уже не вспомню.
По-прежнему следует использовать программку на свой риск и страх.

update от 2021-01-18
Версия 4.2. Поля и спецсимволы теперь должны сохраняться Offtop: я надеюсь

Кулик Алексей aka kpblc · 23.02.2019, 19:43

На какой картинке?

----- добавлено через ~2 мин. -----
Также не помешает хотя бы элементарный пример.
И не проще ли будет прочитать настройки стиля для мультивыноски и принудительно назначить соответствующие свойства?

kacugu · 23.02.2019, 20:19

Цитата:

Сообщение от Кулик Алексей aka kpblc

На какой картинке?

добавил

Цитата:

Сообщение от Кулик Алексей aka kpblc

И не проще ли будет прочитать настройки стиля для мультивыноски и принудительно назначить соответствующие свойства?

Если правильно помню, то при ручных изменениях свойств мультивыноски в её описание добавляются новые dxf-коды с описанием этих изменений (проверил сейчас. при изменении указателя мультивыноски добавляется dxf (342 . <Entity name: 243b6fc1f50>). Т.е. помимо принудительного назначения свойств ещё надо удалить и эти dxf.

kacugu · 28.02.2019, 13:08

Обновил код в шапке темы

Barmaley Bubusikin · 18.01.2021, 01:53

А так чтобы не удалялись поля и спецсимволы в тексте мвыноски возможно?

kacugu · 18.01.2021, 03:51

Цитата:

Сообщение от Barmaley Bubusikin

А так чтобы не удалялись поля и спецсимволы в тексте мвыноски возможно?

Попробуйте версию 4.2, вроде работает

berstrider · 27.03.2025, 10:57

Здравствуйте.
Работаю на Autocad Civil 2019

При попытке использовать данный лисп вылезает

Цитата:

Команда: _kaa-RMld-2D
Выберите объекты: найдено: 1

Выберите объекты:

<< Error: Ошибка Automation. Отсутствует описание. >>

Что не так?

kacugu · 27.03.2025, 16:23

berstrider, может в Civil дело. Программку я тестировал только в чистом автокаде - вечером гляну на домашнем компе.
И у вас к выноскам блоки не прикреплены случаем? По возможности приложите проблемный файл.

berstrider · 27.03.2025, 16:27

Цитата:

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

berstrider, может в Civil дело. Программку я тестировал только в чистом автокаде - вечером гляну на домашнем компе.

Civil надстрой над базовым Autocad, базовый функционал так и так должен работать.
Может ещё что то надо для работы lisp.

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

Цитата:

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

berstrider, может в Civil дело. Программку я тестировал только в чистом автокаде - вечером гляну на домашнем компе.
И у вас к выноскам блоки не прикреплены случаем? По возможности приложите проблемный файл.

Да, блоки прикреплены. Увы так нам выводит. Файл выслал в личном сообщении.
Протестировал, ошибка на мультивыносках без блоков не вылезает.

Просто не понятно, из вашего описания, создаётся новая мультивыноска взамен старой, неужели структура стиля так влияет на работу программы?

kacugu · 27.03.2025, 19:42

Цитата:

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

Просто не понятно, из вашего описания, создаётся новая мультивыноска взамен старой, неужели структура стиля так влияет на работу программы?

Влияет. Я в программке считываю значение текста в мультивыноске, потом прописываю его в новой. При попытке же считать блок программка выдаёт ошибку, т.к. считывать ей, собственно, и нечего. Тут только переписывать программку, но на это времени сейчас нет.

berstrider · 27.03.2025, 20:41

Цитата:

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

Влияет. Я в программке считываю значение текста в мультивыноске, потом прописываю его в новой. При попытке же считать блок программка выдаёт ошибку, т.к. считывать ей, собственно, и нечего. Тут только переписывать программку, но на это времени сейчас нет.

Вот этот код

Код:

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

  (setq def (vla-item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
		    (vla-get-ContentBlockName (setq obj (vlax-ename->vla-object (car (entsel)))))))
(if (vlax-for x def (if (eq "AcDbAttributeDefinition" (vla-get-Objectname x)) (setq id (vla-get-ObjectID x))))
  (princ (vla-GetBlockAttributeValue obj id))
)

из это темы https://forum.dwg.ru/showthread.php?t=153001
Возвращает содержимое блока из мультивыноски, я проверил. Просто у меня опыта 0)) Понимаю, надо организовать проверку на блок при выборе.

Нюк · 27.03.2025, 21:19

Цитата:

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

надо организовать проверку на блок при выборе

как раз на днях делал для мультивыносок

Код:

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

 
 ;; Get content type (1 = Block Content, 2 = MText Content)
        (setq contentType (vlax-get vlaMLeader 'ContentType))

        (if (= contentType 1)  ;; Ensure the MLeader has a block
          (progn
            ;; Get the block name from the MultiLeader
            (setq sBlock (vlax-get vlaMLeader 'ContentBlockName))
            (princ (strcat "\nBlock Name: " sBlock))

            ;; Get the Blocks collection from the document
            (setq blkDef (vla-Item (vla-get-Blocks doc) sBlock))

            ;; Retrieve attribute value
            (setq attValue "")
            (vlax-for obj blkDef
              (if (= (vla-get-ObjectName obj) "AcDbAttributeDefinition")
                (setq attValue (vla-GetBlockAttributeValue vlaMLeader (vla-get-ObjectID obj)))
              )
            )
            (princ (strcat "\nAttribute Value: " attValue))
          )
          (if (= contentType 2)  ;; Ensure the MLeader has MText
            (progn
              ;; Get MText value
              (setq attValue (vlax-get vlaMLeader 'TextString))
              (princ (strcat "\nMText Value: " attValue))
            )
          )
        )

kacugu · 29.03.2025, 20:07

berstrider, а вам надо так же перестроить мультивыноску, сохранив блок, или заменить блок на текст?

berstrider · 29.03.2025, 21:45

Цитата:

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

berstrider, а вам надо так же перестроить мультивыноску, сохранив блок, или заменить блок на текст?

Мне показалось ценным именно то в вашей программе, что можно пересоздать мультивыноску с новым стилем и уйти от блока. Внутренний пакет программ для автокада автоматически выводит выноски покрытий с блоком-источником. Они очень не удобные, а переделывать не хотят. Даже одиночный режим мне подойдёт, ну а если можно пакетно обработать, то было бы вообще супер)

kacugu · 29.03.2025, 22:33

Цитата:

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

что можно пересоздать мультивыноску с новым стилем и уйти от блока

Так программа пересоздаёт не с новым стилем, а с тем, с котором мультивыноски были сделаны. Сбрасывая все измененения, сделанные с выноской вручную.

berstrider · 30.03.2025, 09:58

Цитата:

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

Так программа пересоздаёт не с новым стилем, а с тем, с котором мультивыноски были сделаны. Сбрасывая все измененения, сделанные с выноской вручную.

Я понял, что стиль назначается тот, что назначить в свойствах. На обычных выносках я менял стиль, применял ваш скрипт, и вручную сделанные изменения менялись на заданный на данный момент стиль, кроме стиля с блоком-источником. Если то же самое получится сделать с выносками на основе блока-источника, то будет вообще супер.

Заметил, что под стиль меняется только структура выноски, но не текст. Текст под стиль выноски не перестраивается, но тут помогает известный лисп по сбросу пользовательского форматирования текстов.

Я вчера сидел и пытался сделать хотя бы вариант работы только с выносками на основе блока-источника, но пока опыта не хватает. Разбирался, за что отвечают все разделы программы, походу нашёл один два раза повторяющийся блок defun.

kacugu · 30.03.2025, 16:12

Попробовал сейчас за пару часов тоже что-то придумать с исходной программой, но не срослось. Вроде алгоритм простой для мультивыносок с одной выноской должен быть:
1. проверка contenttype
2. считывание первой и второй точки вставки
3. считывание значения атрибута в блоке
4. создание новой мультивыноски - может как-то так (vl-cmdf "_.mleader" "_non" #InsPoint "_non" #LandPoint #Desc)
5. запись значения атрибута в мвыноску
6. удаление оригинальной мвыноски
Пока больше времени нет экспериментировать.

koMon · 02.04.2025, 10:32

berstrider,
не знаю как код будет работать в civil, но идея была привести выбранные мультивыноски к установленному стилю.

berstrider · 02.04.2025, 15:03

Цитата:

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

не знаю как код будет работать в civil, но идея была привести выбранные мультивыноски к установленному стилю.

Спасибо. Всё работает.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Не работает lisp на autocad 2014. Lisp предназначен для изменения порядкового номера листа	vladykinalex	LISP	28	14.07.2023 19:27
Lisp. Не вставляет значения в базу access.	Zaghim	LISP	2	11.07.2012 14:29
Умер разработчик языка программирования Lisp	andr_g	LISP	1	27.10.2011 08:36
{Конкурс} Lisp. Задачки для студентов	gomer	LISP	10	05.01.2011 16:33
загрузка DOS прог через LISP	Gaa	LISP	15	12.08.2005 19:19