LISP. Кликать по тексту и поворачивать его на 180 градусов.

Джаз · 09.11.2009, 19:30

Уважаемые форумчане.
Часто приходится переворачивать текстовые надписи в чертеже на 180 градусов.
Захожу в свойства и там к углу поворота прибавляю или вычитаю 180 градусов.
Надо автоматизировать.
Может у кого готовая мулька есть.
Или подскажите, какой функцией определяется текущий угол поворота текста (по клику).

Vova · 09.11.2009, 20:13

Всегда относительно одной и той-же базовой точки, или по-разному? Имеют-ли все тексты одну и ту-же Justification? Находятся-ли все тексты в одном слое?
Видно, чертеж незагруженный, иначе только вручную можно сделать

Do$ · 09.11.2009, 20:20

Код:

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

(defun c:txtupsd (/ ent)
  (while (not (vl-catch-all-error-p
		(setq ent (vl-catch-all-apply
			    (function car)
			    (list (entsel "\nУкажите текст:"))
			  ) ;_ end of vl-catch-all-apply
		) ;_ end of setq
	      ) ;_ end of vl-catch-all-error-p
	 ) ;_ end of not
    (cond
      ((not ent) (princ "\nНичего не выбрано!"))
      ((and (= (type ent) 'ENAME)
	    (= (cdr (assoc 0 (entget ent))) "TEXT")
       ) ;_ end of and
       (progn
	 (entmod (list (cons -1 ent)
		       (cons 50 (+ (cdr (assoc 50 (entget ent))) pi))
		 ) ;_ end of list
	 ) ;_ end of entmod
	 (entupd ent)
       ) ;_ end of progn
      )
      (T (princ "\nВыбранное не является текстом!"))
    ) ;_ end of cond
  ) ;_ end of while
  (princ)
) ;_ end of defun

Profan · 09.11.2009, 20:41

Простейший макрос для однострочного текста:

Код:

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

 
^C^C_change;\;;;;;180;;

Do$ · 09.11.2009, 20:48

С перевернутым текстом не работает

Profan · 09.11.2009, 21:18

Конечно, ведь текст уже повернут на 180 градусов.
Для возврата нужен другой макрос:

Код:

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

 
^C^C_change;\;;;;;0;;

Можно и так попробовать:

Код:

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

 
^C^C_change;\;;;;;\;;

Не проверял.

Do$ · 09.11.2009, 21:38

Цитата:

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

^C^C_change;\;;;;;\;;

не работает

Цитата:

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

Конечно, ведь текст уже повернут на 180 градусов.
Для возврата нужен другой макрос:

А если начальный угол 90 градусов? Еще один макрос?

Profan · 09.11.2009, 21:57

Я же написал, что не проверял. Все-таки уточнил последний макрос. У меня работет такой вариант:

Код:

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

 
^C^C_change;\;;;;;\;

Можно задать любой угол.

Цитата:

А если начальный угол 90 градусов? Еще один макрос?

А если начальный угол 90 градусов? Еще один Лисп?
Лучше, если бы выравнивание текста было "Середина"...

Do$ · 10.11.2009, 09:19

То же самое, что и #3, для любого выравнивания текста:

Код:

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

(defun c:txtupsd (/ ent pt)
  (vl-load-com)
  (while (not (vl-catch-all-error-p
		(setq ent
		       (vl-catch-all-apply
			 (function
			   (lambda () (car (entsel "\nУкажите текст:<Esc-выход>")))
			 ) ;_ end of function
		       ) ;_ end of vl-catch-all-apply
		) ;_ end of setq
	      ) ;_ end of vl-catch-all-error-p
	 ) ;_ end of not
    (cond
      ((not ent) (princ "\nНичего не выбрано!"))
      ((and (= (type ent) 'ENAME)
	    (= (cdr (assoc 0 (entget ent))) "TEXT")
       ) ;_ end of and
       (setq ent (vlax-ename->vla-object ent)
	     pt	 (vlax-3d-point
		   ((lambda (/ minpt maxpt)
		      (vla-GetBoundingBox ent 'minpt 'maxpt)
		      (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2))
			      (vlax-safearray->list minpt)
			      (vlax-safearray->list maxpt)
		      ) ;_ end of mapcar
		    ) ;_ end of lambda
		   )
		 ) ;_ end of vlax-3d-point
       ) ;_ end of setq
       (vla-StartUndoMark
	 (vla-get-ActiveDocument (vlax-get-acad-object))
       ) ;_ end of vla-StartUndoMark
       (vla-rotate ent pt pi)
       (vla-EndUndoMark
	 (vla-get-ActiveDocument (vlax-get-acad-object))
       ) ;_ end of vla-EndUndoMark
      )
      (T (princ "\nВыбранное не является текстом!"))
    ) ;_ end of cond
  ) ;_ end of while
  (princ)
) ;_ end of defun

VVA · 10.11.2009, 09:29

Джаз, Предлагаю вращать текст (мтекст или что-нибудь еще) вокруг центра описанного прямоугольника (BoundingBox)
Rotate нескольких объектов вокруг своей оси
По крайней мере я вращаю при необходимости тексты этим лиспом

*** Добавлено ***
В приципе Do$ чуть выше и предложил этот способ.

Do$ · 10.11.2009, 09:53

Offtop: Не знал, что уже готовая программа есть

Джаз · 11.11.2009, 18:05

Спасибо, Do$!
Не программа, а мечта! Жаль, что работает только с однострочным текстом. Ещё бы мультитекст ворочала...

Попробовал лисп VVA. Отлично ворочает и мультитекст. Только надо выделять по одному и жать Ентер. Если выбрать несколько, то он вращает всю группу вокруг центра группы.
Вариант от Profan не смог проверить, так как не знаю, как запустить. Набирал в командной строке, ничего не выходит.

P.S. Может ещё у кого-нибудь есть готовое решение на поворот цифр в размерах?

Profan · 11.11.2009, 18:18

То, что я сочинил, является макросом для кнопки. Сам я тоже сторонник AutoLisp'а, но вот в AutoCAD LT, например, AutoLisp'а нет...

Do$ · 11.11.2009, 20:08

Цитата:

Сообщение от Джаз

Ещё бы мультитекст ворочала...

Строчку:

Код:

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

(= (cdr (assoc 0 (entget ent))) "TEXT")

Заменить на:

Код:

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

(wcmatch (cdr (assoc 0 (entget ent))) "*TEXT")

Будет и мультитекст ворочать, но не обещаю что всегда корректно

Джаз · 11.11.2009, 20:22

Попробовал макрос. Работает. Но неудобно совсем.

Я тут в теме "Rotate нескольких объектов вокруг своей оси"

http://forum.dwg.ru/showpost.php?p=92371&postcount=15

нашёл этот лисп. (Спасибо Dym и Лентяю.)
Немного перелопатил, чтоб "лишнего" не спрашивало. Вращает всё вокруг своих центров.

Код:

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

 
(defun c:mrot (/ ass ra rp pn pt dst pts om) 
(ssget)
  (vl-load-com) 
(setq adoc (vla-get-activedocument (vlax-get-acad-object)) 
ass (vla-get-ActiveSelectionset adoc) 
om (getvar "OSMODE"));setq 
(initget "Point Center") 
(setq kw "Center")
(if (= kw "Point") 
(progn (setq obj (vla-item ass 0)) 
(vla-highlight obj :vlax-true) 
(vla-getboundingbox obj 'pn 'px) 
(setq pn (vlax-safearray->list pn) 
pt (getpoint pt "\nEnter Rotation Point: ") 
dst (distance pn pt) ang (angle pn pt)) 
(vla-update obj)));if 
(setq ra 180)
(vla-startundomark adoc) 
(vlax-for ent ass 
(vla-getboundingbox ent 'mn 'mx) 
(setq pts (mapcar 'vlax-safearray->list (list mn mx)) 
rp (vlax-3d-point (if (= kw "Point") (polar (car pts) ang dst) 
(mapcar '(lambda (x y) (/ (+ x y) 2)) (car pts) (cadr pts)))));setq 
(vla-rotate ent rp (* (/ ra 180) pi)));vlax-for 
(setvar "OSMODE" om) 
(vla-endundomark adoc) 
);end

(Добавлено)
To Do$.
Попробую заменить. Ваша лиспина нравится в плане работы. Щёлкнул по объекту, тот перевернулся. Не надо выделять группу, потом ворочать, отменять, если чего не получилось.

Dym · 11.11.2009, 22:23

Джаз> я там не приделах, только использовал

Vova · 12.11.2009, 01:41

Странно, что бросились помогать советами не дождавшись ответа на мой вопрос н-р 2. И только к посту 8 обнаружили, что это важно

VVA · 12.11.2009, 09:49

Цитата:

Сообщение от Джаз

Попробовал лисп VVA. Отлично ворочает и мультитекст. Только надо выделять по одному и жать Ентер. Если выбрать несколько, то он вращает всю группу вокруг центра группы.

Лисп тем и хорош, что небольшими изменениями можно заточить под свои нужды. Отличия от #10 выделил красным

Код:

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

(defun c:Trot (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT 
OBJSET VLAOBJ PTLST XLST YLST) 
(vl-load-com) 
(if(not srot:ang)(setq srot:ang (* pi 0.5))) 
(setq oldAng srot:ang 
srot:ang(getangle 
(strcat"\nSpecify rotation angle <"(angtos srot:ang)">: ")) 
); end setq 
(if(null srot:ang)(setq srot:ang oldAng)) 
(setq errCount 0 
ptLst '() 
); en setq
(princ "\n§§§ Select TEXT objects or press Enter to Quit. §§§")
(if 
(not(setq objSet(ssget "_I"))) 
(setq objSet(ssget "_:L" '((0 . "*TEXT")))) 
); end if
(sssetfirst) 
(while objSet
(setq objSet 
(mapcar 'vlax-ename->vla-object 
(vl-remove-if 'listp 
(mapcar 'cadr(ssnamex objSet))))) 
(foreach obj objSet 
(vla-GetBoundingBox obj 'MinPt 'MaxPt) 
(setq mnPt(vlax-safearray->list MinPt) 
mxPt(vlax-safearray->list MaxPt)
miPt (polar mnPt (angle mnPt mxPt)(* 0.5 (distance mnPt mxPt))) 
)
(if 
(vl-catch-all-error-p 
(vl-catch-all-apply 'vla-rotate 
(list obj(vlax-3D-Point miPt)srot:ang))) 
(setq errCount(1+ errCount)) 
) 
); end foreach 
(if(/= 0 errCount) 
(princ(strcat "\n" (itoa errCount) " objects were on locked layer! ")) 
); end if
(princ "\n§§§ Select TEXT objects or press Enter to Quit. §§§")
(setq objSet(ssget)) 
); end while 
(princ) 
); end of c:srot

PS. Он обрабатывает предварительный выбор. Его можно совместить с SelSIM

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Как можно из LISP создать КОМ объект и передать его методу BSTR строку?	lexluther	LISP	2	01.08.2009 00:27

09.11.2009, 19:30		#1
LISP. Кликать по тексту и поворачивать его на 180 градусов. Джаз Регистрация: 16.06.2009 Сообщений: 39 Уважаемые форумчане. Часто приходится переворачивать текстовые надписи в чертеже на 180 градусов. Захожу в свойства и там к углу поворота прибавляю или вычитаю 180 градусов. Надо автоматизировать. Может у кого готовая мулька есть. Или подскажите, какой функцией определяется текущий угол поворота текста (по клику).
Просмотров: 7861