| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Поворот текста в пространстве

Поворот текста в пространстве

Ответ
Поиск в этой теме
Непрочитано 19.08.2010, 14:26 #1
Поворот текста в пространстве
katm___
 
Регистрация: 19.08.2010
Сообщений: 6

Нужен макрос для поворота текста из горизонтальной плоскости в вертикальную. Поворот должен осуществляться сразу для всего текста. Координаты текста не меняются. Причем должна быть возможность поворота текста не только вокруг оси Х но и вокруг оси Y, ось Z - вертикальная. Все что нашел на форуме не подходит, или криво сделано.
Исходный файл внизу. Если нет готового решения, то цену и сроки за работу мне на почту. Вопросы вниз.

Вложения
Тип файла: dwg
DWG 2004
A.dwg (34.5 Кб, 2829 просмотров)


Последний раз редактировалось katm___, 19.08.2010 в 15:41.
Просмотров: 11769
 
Непрочитано 19.08.2010, 20:07
#2
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Код:
[Выделить все]
(if (setq ss (ssget "_a" (list' (0 . "TEXT"))))
  (progn
    (setvar 'osmode 0) (command "_undo" "_be")
    (setq i 0)
    (repeat (sslength ss)
      (command "_rotate3d" (ssadd (setq en (ssname ss i))) "" (setq pt10 (cdr (assoc 10 (entget en)))) (polar pt10 (* 0.5 pi) 1.0) 90)
      (setq i (1+ i))
    )
    (command "_undo" "_e")
  )
)
лови, дальше сам думай
gomer вне форума  
 
Непрочитано 19.08.2010, 20:29
#3
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Вариант без командных методов (работает чуть-чуть быстрее)
Код:
[Выделить все]
(defun c:txt_3d_rot_x (/ B MTS SS PT2_MTS PT_MTS VL_MTS pt2_mts PT1_MTS)
  (setq ss (ssget "_X" '((0 . "*TEXT"))));
  (setq mts (ssnamex ss))
  (setq ss nil)
  (setq mts (mapcar 'cadr mts));
  (setq mts (vl-remove-if-not '(lambda (x) (eq (type x) 'ENAME)) mts))
  (setq vl_mts (mapcar 'vlax-ename->vla-object mts))
  
  (setq pt2_mts nil)

  (foreach mt vl_mts
    (setq pt1_mts (vla-get-InsertionPoint mt))
    (setq pt2_mts (vlax-safearray->list (vlax-variant-value pt1_mts)))
    (setq pt2_mts (list
		    (+ 0.0 (car pt2_mts))
		    (+ 1.0 (cadr pt2_mts))
		    (+ 0.0 (caddr pt2_mts))
    		  )
    )
    (setq pt2_mts (vlax-3D-point pt2_mts))
    (vla-rotate3d mt pt1_mts pt2_mts (* pi 0.5))
  )
)
для поворота вокруг оси x заменить в первой выделенной строке 0.0 на 1.0, а во второй - наоборот
угол поворота выделен синим (радианы)
kp+ вне форума  
 
Автор темы   Непрочитано 20.08.2010, 10:45
#4
katm___


 
Регистрация: 19.08.2010
Сообщений: 6


gomer, и kp+ спасибо большое, но,
gomer, код ставит только вертикально, конечно можно разбить на разные файлы в каждом будет своя плоскость потом это все собрать, например на ссылках , а нельзя ли чтоб было 2 функции одна вокрух Х, другая вокруг Y, так удобнее, или как я понимаю этот код не может это делать?

kp+,
Не работает что-то, может не так делаю но пищет:

Command:
; error: LOAD failed: "txt_3d_rot_x"

Command: nil

или

Command: txt_3d_rot_x
nil

Последний раз редактировалось katm___, 20.08.2010 в 11:08.
katm___ вне форума  
 
Непрочитано 20.08.2010, 15:11
#5
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от katm___ Посмотреть сообщение
gomer, и kp+ спасибо большое, но,
gomer, код ставит только вертикально, конечно можно разбить на разные файлы в каждом будет своя плоскость потом это все собрать, например на ссылках , а нельзя ли чтоб было 2 функции одна вокрух Х, другая вокруг Y, так удобнее, или как я понимаю этот код не может это делать?

kp+,
Не работает что-то, может не так делаю но пищет:

Command:
; error: LOAD failed: "txt_3d_rot_x"

Command: nil

или

Command: txt_3d_rot_x
nil
Если относительно осей попробуй:

Код:
[Выделить все]
(defun C:demo(/ ang direction elist en ent inspt vector)

(initget 3)
(setq ang (getreal "nSpecify rotation angle in degerees: "))
(initget 1 "X Y Z")
(setq direction (getkword "\n Choose an axis of the rotation [X/Y/Z] <X>: "))
(setq vector
(cond ((eq "X" direction)(list 1000. 0. 0.))
      ((eq "Y" direction)(list 0. 1000. 0.))
      ((eq "Z" direction)(list 0. 0. 1000.))
      )
)
(setq ent (entsel "\n  >>  Select text  >>"))
  (if ent
    (progn
    (setq
      en (car ent)
      elist (entget en))

(setq inspt (cdr (assoc 10 elist)))

(command "._rotate3d" en "" "_non" inspt "_non" (mapcar '+ inspt vector) (rtos ang))
)
    (alert "Nothing selected> Try again!")
  )
  (princ)
  )
Если относительно произвольных осей вместо вектора
используй вторую точку

~'J'~
Олег (jr.) вне форума  
 
Автор темы   Непрочитано 20.08.2010, 15:26
#6
katm___


 
Регистрация: 19.08.2010
Сообщений: 6


Олег (jr.), иногда работает, иногда меняет координаты привязки текста. Весь текст не переворачивает, только по одному.
katm___ вне форума  
 
Непрочитано 20.08.2010, 17:02
#7
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Для писавших код - даю информацию к размышлению
(mapcar '(lambda (ent) (entmod (subst (cons 210 ...) (assoc 210...) ...))) (ss->list(ssget ...))).
Так я думаю будет практичней.
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 20.08.2010, 17:22
#8
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Озвучь версию CAD'а
Цитата:
kp+,
Не работает что-то, может не так делаю но пищет:

Command:
; error: LOAD failed: "txt_3d_rot_x"

Command: nil

или

Command: txt_3d_rot_x
nil
Эти сообщения наводят на мысль, что у тебя не Autocad.
В моем коде, в отличие от двух других, используются vla-функции. Если у тебя BricsCad или ZwCAD - работать не будет

Последний раз редактировалось kp+, 20.08.2010 в 17:40.
kp+ вне форума  
 
Непрочитано 20.08.2010, 18:12
#9
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от katm___ Посмотреть сообщение
Олег (jr.), иногда работает, иногда меняет координаты привязки текста. Весь текст не переворачивает, только по одному.
Зайдем с другого конца:


Код:
[Выделить все]
(defun c:demo(/ alg en ipt obj p q sp ss tp vpt xp xpt)
  
(defun dtr (a)
  (* pi (/ a 180.0))
)
  
  (if (setq ss (ssget (list (cons 0 "*TEXT"))))

    (progn

      (vl-load-com)
(initget 3)
(setq q (getreal "\nSpecify rotation angle in degerees around X axis: "))
(initget 3)
(setq p (getreal "\nSpecify rotation angle in degerees around Y axis: "))
      
 (while (setq en (ssname ss 0))
   (setq obj (vlax-ename->vla-object en))
   (setq alg (vla-get-alignment obj))
   (setq tp (vla-get-textalignmentpoint obj))
   (setq ipt (vla-get-insertionpoint obj)
	 sp (cdr (assoc 10 (entget en))))

   (setq xp (list (+ (car sp) 1000)(cadr sp)(caddr sp))
	 vpt (vlax-3d-point xp))
   
   (vla-rotate3d obj ipt vpt (dtr q) )
   (vla-update obj)
   (setq xp (list (car sp)(+ (cadr sp) 1000) (caddr sp))
	 vpt (vlax-3d-point xp))
   (vla-rotate3d obj ipt vpt (dtr p))
   (if (/= alg 0)
   (vla-put-textalignmentpoint obj ipt)
     (vla-put-insertionpoint obj ipt)
     )
   (vla-update obj)
   (ssdel en ss)
)
      )
    )
      (princ)
      )
~'J'~
Олег (jr.) вне форума  
 
Непрочитано 20.08.2010, 18:36
#10
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Цитата:
Сообщение от kp+ Посмотреть сообщение
Если у тебя BricsCad или ZwCAD - работать не будет
В bricscad работать будет!
Цитата:
Сообщение от Дима_ Посмотреть сообщение
(mapcar '(lambda (ent) (entmod (subst (cons 210 ...) (assoc 210...) ...))) (ss->list(ssget ...)))
Дима_, Озвучьте функцию ss->list и кода станет вдвое больше
katm___, ты просил повернуть, вот все и поворачивают
gomer вне форума  
 
Непрочитано 20.08.2010, 21:24
#11
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Цитата:
Сообщение от gomer Посмотреть сообщение
Дима_, Озвучьте функцию ss->list и кода станет вдвое больше
они обычно в "арсенале" готовые есть:
Код:
[Выделить все]
(defun sstolist (ss / i lst); конвертирует набор в список
(setq i 0)
(if ss
(repeat (sslength ss)
(setq lst (append lst (list (ssname ss i))) i (1+ i))
));end of repeat & if
lst);end of sstolist
Код:
[Выделить все]
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 21.08.2010, 00:45
#12
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от Дима_ Посмотреть сообщение
Для писавших код - даю информацию к размышлению
(mapcar '(lambda (ent) (entmod (subst (cons 210 ...) (assoc 210...) ...))) (ss->list(ssget ...))).
Так я думаю будет практичней.
И текст улетает в соседнюю галактику

~'J'~
Олег (jr.) вне форума  
 
Непрочитано 21.08.2010, 00:49
#13
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Цитата:
Сообщение от Олег (jr.) Посмотреть сообщение
И текст улетает в соседнюю галактику
Это если с 210 работать не умеешь...
p.s. (trans...)
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 21.08.2010, 01:27
#14
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от Дима_ Посмотреть сообщение
Это если с 210 работать не умеешь...
p.s. (trans...)
Ну и чего ж пример не показать раз шибко умеешь
Олег (jr.) вне форума  
 
Непрочитано 21.08.2010, 01:36
#15
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


Капризный я что-то стал формат заявки мне не понравился:
Код:
[Выделить все]
(mapcar '(lambda (lst)
(entmod (subst (list 210 0 -1 0) (assoc 210 lst) lst)))
(mapcar 'entget (sstolist (ssget (list (cons 0 "*text"))))))
__________________
Когда в руках молоток все вокруг кажется гвоздями.
Дима_ вне форума  
 
Непрочитано 21.08.2010, 11:33
#16
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от Дима_ Посмотреть сообщение
Капризный я что-то стал формат заявки мне не понравился:
Код:
[Выделить все]
(mapcar '(lambda (lst)
(entmod (subst (list 210 0 -1 0) (assoc 210 lst) lst)))
(mapcar 'entget (sstolist (ssget (list (cons 0 "*text"))))))
Я даже не стану проверять - улетит как миленький
Читай теорию
Олег (jr.) вне форума  
 
Непрочитано 21.08.2010, 11:40
#17
Дима_

Продуман
 
Регистрация: 22.02.2007
Питер
Сообщений: 2,840


А я вот проверял...
Может и Вы попробуете?
Миниатюры
Нажмите на изображение для увеличения
Название: пример.jpg
Просмотров: 166
Размер:	11.9 Кб
ID:	44055  
__________________
Когда в руках молоток все вокруг кажется гвоздями.

Последний раз редактировалось Дима_, 21.08.2010 в 11:48.
Дима_ вне форума  
 
Непрочитано 21.08.2010, 12:03
#18
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от Дима_ Посмотреть сообщение
А я вот проверял...
Может и Вы попробуете?
Проверил на чертеже автора топика
Улетает
Олег (jr.) вне форума  
 
Непрочитано 21.08.2010, 14:15
#19
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Цитата:
Сообщение от Дима_ Посмотреть сообщение
Может и Вы попробуете?
Код:
[Выделить все]
(defun c:test (/ ss osm ocmd adoc i en)
  (vl-load-com)
  (if (setq ss (ssget "_a" (list '(0 . "TEXT"))))
    (progn
      (setq osm	 (getvar 'osmode)
	    ocmd (setvar 'cmdecho 0)
	    adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	    i 0
      )
      (mapcar 'setvar (list 'osmode 'cmdecho) (list 0 0))
      (vla-StartUndoMark adoc)
      (repeat (sslength ss)
	(vla-Rotate3D 
		 (vlax-ename->vla-object(setq en (ssname ss i)))
		 (vlax-3d-point (setq pt10 (cdr (assoc 10 (entget en)))))
		 (vlax-3d-point (polar pt10 (+ 0 ;|(* 0.5 pi)|; (cdr (assoc 50 (entget en)))) 1.0))
		 (* 0.5 pi)
	)
	(setq i (1+ i))
      )
      (mapcar 'setvar (list 'osmode 'cmdecho) (list osm ocmd))
      (vla-EndUndoMark adoc)
    )
  )
  (princ)
)
Попробуйте
gomer вне форума  
 
Непрочитано 21.08.2010, 14:44
#20
Олег (jr.)

специалист по околачиванию грушевых деревьев
 
Регистрация: 14.09.2004
Pietari, Venäjä
Сообщений: 813


Цитата:
Сообщение от gomer Посмотреть сообщение
Код:
[Выделить все]
(defun c:test (/ ss osm ocmd adoc i en)
  (vl-load-com)
  (if (setq ss (ssget "_a" (list '(0 . "TEXT"))))
    (progn
      (setq osm	 (getvar 'osmode)
	    ocmd (setvar 'cmdecho 0)
	    adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	    i 0
      )
      (mapcar 'setvar (list 'osmode 'cmdecho) (list 0 0))
      (vla-StartUndoMark adoc)
      (repeat (sslength ss)
	(vla-Rotate3D 
		 (vlax-ename->vla-object(setq en (ssname ss i)))
		 (vlax-3d-point (setq pt10 (cdr (assoc 10 (entget en)))))
		 (vlax-3d-point (polar pt10 (+ 0 ;|(* 0.5 pi)|; (cdr (assoc 50 (entget en)))) 1.0))
		 (* 0.5 pi)
	)
	(setq i (1+ i))
      )
      (mapcar 'setvar (list 'osmode 'cmdecho) (list osm ocmd))
      (vla-EndUndoMark adoc)
    )
  )
  (princ)
)
Попробуйте
Я врубился вы оба не понимаете что хочет автор вопроса:
Цитата:
Координаты текста не меняются. Причем должна быть возможность поворота текста не только вокруг оси Х но и вокруг оси Y, ось Z - вертикальная.
~'J'~
Олег (jr.) вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Поворот текста в пространстве

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 272 06.06.2021 23:12
LISP. Выравнивание текста по двум точкам. Krieger Готовые программы 10 24.12.2011 16:02
Поворот текста klinker AutoCAD 9 20.10.2010 09:52
Научите правильно чертить Dr_Zlo AutoCAD 112 03.03.2009 08:31
Поворот текста в таблице Мишаня AutoCAD 2 24.04.2007 12:10