[Composter]

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

;слияние текста
(defun c:Zod3 ()
(setq z "" zn "" x nil y nil)
(setq x (car(entsel)))
(setq zn (cdr(assoc 1 (entget x))))
(setq z zn)
(while (null y)
(setq y (car(entsel)))
(setq zn (cdr(assoc 1 (entget y))))
(setq z (strcat z " " zn))
);end while
(entmod (subst (cons 1 z) (assoc 1 (entget x)) (entget x)))
);end defun

[Composter]

я все таки за грубую силу.и мне больше нравится вариант с временной разблокировкой слоя.
И хотелось бы узнать как сохранять изменения в xref.

[VVA]

И хотелось бы узнать как сохранять изменения в xref.

Так же как и при работе ручками:
- открыть файл внешней ссылки
- найти тот же самый текст
- внести изменения
- сохранить
- обновить ссылку
Если хочется копать в этом направлении, ищи по слову ObjectDBX

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

И готовься к приличным проблемам. Однозначно идентифицировать модифицируемый объект удается далеко не всегда. По крайней мере мне не всегда удавалось.

[Composter]

вот мой результат,но пока без xref,над этим буду думать.
пока не укажете на исходный текст дальше не пропустит даже ентер и правая клавиша мыши не помогают,тока текст.если исходный текст на блокированном слое то разблокирует.

Код:

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

(defun c:Zod3 (/ flag x1 x x_txt la_x old_lock y y_txt)

(while (null flag)
	(if (and (setq x1 (nentsel "\nИсходный текст"))
		(vlax-property-available-p (vlax-ename->vla-object(car x1)) 'textstring)
  	    ) ;_ end of and
		(progn
			(setq 	x (car x1)
				flag T
				x_txt (vla-get-textstring(vlax-ename->vla-object x))
				la_x (tblobjname "layer" (cdr(assoc 8(entget(car x1)))))
				old_lock (assoc 70 (entget la_x))
			) ;_ end of setq
			(if (= (cdr(assoc 70 (entget la_x))) 4)
				(entmod(subst '(70 . 0)(assoc 70 (entget la_x)) (entget la_x))) 
			) ;_ end of if
		) ;_ end of progn
	) ;_ end of if
) ;_ end of while

(setvar "errno" 0)
(while (not (equal (getvar "errno") 52))
	
	(setq y (car (nentsel "\nТекст для слияния...")))
	(if (and 
		y
		(not(equal x y))
		(vlax-property-available-p (vlax-ename->vla-object y) 'textstring)
	     )
		(progn
			(setq y_txt (vla-get-textstring(vlax-ename->vla-object y)))
			(entdel y)
       			(vla-put-textstring(vlax-ename->vla-object x)(strcat x_txt " " y_txt))
       			(setq x_txt (vla-get-textstring(vlax-ename->vla-object x)))
			(if (= (length x1) 4) (entupd (car(cadddr x1))))
		);_ end of progn
	);_ end of if
) ;_ end of while
	

(entmod(subst old_lock (assoc 70 (entget la_x)) (entget la_x)))
(entupd (car x1))
(princ)
) ;_ end of defun

пара вопросов по xref.правильный ли алгоритм действий.вначале проверяю не защищен ли файл внешней ссылки от записи,открываю если нет защиты,потом по 5 dxf паре нахожу нужный мне текст,заменяю,и сохраняю.подскажите как можно открыть файл с помощью лиспа, желательно в фоновом режиме.

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

Метка объекта в данном случае не является 100% гарантией получения этого объекта.
Объясняется достаточно просто: метка (хендл) объекта уникальна только в файле, которому принадлежит объект. Допустим, в файле Рис1.dwg некий объект получает метку "12FC6". Рис1.dwg вставляется внешней ссылкой в Рис2.dwg, где уже есть объект с меткой "12FC6". Чего получится в результате? Два объекта с одинаковой меткой? Или все же какие-то объекты получат новые, временные хендлы?

[Composter]

понятно, на счет метки (хендл).еще возник вопрос, существует ли какой нить указатель у примитва, содержащего текст,показывающий какой текст в нем находится многострочный или однострочный.так как хочется еще организоваться форматирование от лишних символов если мульти текст вставляется в однострочный, ведь атрибут блока может быть как однострочным так и многострочный.

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

см.группу 0

[Composter]

я же не зря упомянул атрибут блока потому что метка (0 . "ATTRIB") одинакова как для однострочного атрибута так и для многосторчного.но в многосторчном не отображаются сиволы форматирования ,а в от в односторчном вылазят.
и еще вопрос, а нет аналога команды refedit в лиспе?

[Composter]

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

Код:

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

;слияние текста
(defun c:Zod3 (/ flag x1 x x_txt la_x old_lock y y_txt x_txt_s y_txt_m)
(setq actdoc (vla-get-activedocument(vlax-get-acad-object)))
(vla-startUndoMark actdoc)
(setq 	my_error	*error*
	*error*		Zoderror
)

(while (null flag)
	(if (and (setq x1 (nentsel "\nИсходный текст"))
		(vlax-property-available-p (vlax-ename->vla-object(car x1)) 'textstring)
  	    ) ;_ end of and
	     (if (= (vl-catch-all-apply 'vla-get-isxref (list(vl-catch-all-apply 'vla-item (list(vla-get-blocks (vla-get-activedocument(vlax-get-acad-object))) (vl-catch-all-apply 'vla-get-EffectiveName (list(vl-catch-all-apply 'vlax-ename->vla-object (list(last(last x1)))))))))) :vlax-true)
		(progn		
			(alert "Выбрана внешняя ссылка. Выберете текст, не лежащий во внешней ссылке.")
			(setq flag nil)
		)
		(progn
			(setq 	x (car x1)
				flag T
				x_txt (vla-get-textstring(vlax-ename->vla-object x))
				la_x (tblobjname "layer" (cdr(assoc 8(entget(car x1)))))
			) ;_ end of setq
			(cond 
				(	(member (cdr(assoc 0(entget x))) '("TEXT"))															(setq x_txt_s T)	)
				(	(and (member (cdr(assoc 0(entget x))) '("ATTRIB" "ATTDEF")) (= (vl-catch-all-apply 'vla-get-MTextAttribute(list(vlax-ename->vla-object x))) :vlax-false))	(setq x_txt_s T)	)
			) ;_ end of cond
			(if (= (cdr(assoc 70 (entget la_x))) 4)
				(progn
					(setq old_lock (assoc 70 (entget la_x))
					) ;_ end of setq
					(entmod(subst '(70 . 0)(assoc 70 (entget la_x)) (entget la_x)))
				) ;_ end of progn
			) ;_ end of if
		) ;_ end of progn
	      ) ;_ end of if
	) ;_ end of if
) ;_ end of while

(setvar "errno" 0)
(while (not (equal (getvar "errno") 52))
	
	(setq y (car (nentsel "\nТекст для слияния...")))
	(if (and 
		y
		(not(equal x y))
		(vlax-property-available-p (vlax-ename->vla-object y) 'textstring)
	     )
		(progn
			(setq y_txt (vla-get-textstring(vlax-ename->vla-object y)))
			(cond 
				(	(member (cdr(assoc 0(entget y))) '("MTEXT" "MULTILEADER"))													(setq y_txt_m T)	)
				(	(and (member (cdr(assoc 0(entget y))) '("ATTRIB" "ATTDEF"))(= (vl-catch-all-apply 'vla-get-MTextAttribute(list(vlax-ename->vla-object y)))) :vlax-true)		(setq y_txt_m T)	)
			) ;_ end of cond
			(entdel y)
			(if (and x_txt_s y_txt_m)
			    (setq y_txt (mip_MTEXT_Unformat y_txt))
			) ;_ end of if
       			(vla-put-textstring(vlax-ename->vla-object x)(strcat x_txt " " y_txt))
       			(setq x_txt (vla-get-textstring(vlax-ename->vla-object x)))
			;(if y_txt_m (setq y_txt_m nil))
			(cond
				(	(= (length x1) 2)	(entupd (car x1))		)
				(	(= (length x1) 4)	(entupd (last(last x1)))	)
			) ;_ end of cond
		) ;_ end of progn
	) ;_ end of if
) ;_ end of while
	
(if old_lock
	(progn
		(entmod(subst old_lock (assoc 70 (entget la_x)) (entget la_x)))
		(cond
			(	(= (length x1) 2)	(entupd (car x1))		)
			(	(= (length x1) 4)	(entupd (last(last x1)))	)
		) ;_ end of cond
	) ;_ end of progn
) ;_ end of if
(vla-EndUndoMark actdoc)
(setq *error* my_error)
(princ)
) ;_ end of defun


;функция mip_MTEXT_Unformat взята http://forum.dwg.ru/showthread.php?t=24790
(defun mip_MTEXT_Unformat ( Mtext / text Str )
  (setq MM Mtext)
  (setq Text "")
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
	  ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PXQ")  ;;;Add by KPblC
	   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
	   )
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or
		   (zerop (strlen Text))
		   (= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
  Text
) ;_ end of defun mip_MTEXT_Unformat



(defun Zoderror (msg)
(vl-cmdf)
(vla-EndUndoMark actdoc)
(setq *error* my_error)
(vl-cmdf "Undo" "" )
) ;_ end of defun