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

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

Поворот на 90 градусов.

Ответ
Перейти к новому Перейти к новому  
Поиск в этой теме
Непрочитано 27.07.2005, 10:15 #1
Поворот на 90 градусов.
Pave1
 
электроснабжение и автоматика
 
г. Пермь
Регистрация: 21.06.2005
Сообщений: 329
Уважаемые знатоки. Не сочтите за труд - напишите лисп, облегчите жизнь проектировщика, плз.
Хочется получить лисп, который будет поворачивать выделенный объект на 90 градусов без указания точки вокруг которой необходимо вращать объект. Пусть он вращается вокруг своего центра.
Заранее благодарен. Павел.
__________________
хочу все знать
Просмотров: 11056
 
Непрочитано 27.07.2005, 10:34
#2
Павлов Андрей

Инженер-строитель
 
Регистрация: 27.05.2004
Республика Беларусь
Сообщений: 67

Мне кажется , что в этом бы Вам помог Toolpac . Там есть поворот вокруг геометрического центра примитива . Если нужно повернуть набор из нескольких примитивов , то можно последние сгруппировать .
__________________
Andrey
Павлов Андрей вне форума  
 
Автор темы   Непрочитано 27.07.2005, 10:48
#3
Pave1

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329

Цитата:
Сообщение от Павлов Андрей
Мне кажется , что в этом бы Вам помог Toolpac .
Да, наверно помог бы. Если бы я знал:
- что это такое?
- где его взять?
- как им пользоваться?
. . . и еще целая куча вопросов.
Может быть просто кто-нибудь напишет лиспик.
__________________
хочу все знать
Pave1 вне форума  
 
Непрочитано 27.07.2005, 11:09
#4
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099

Код:
[Выделить все] 
(defun c:mrot(/ CUROBJ MAXPT MINPT MIPT MNPT MXPT OLDANG VLAOBJ)
  (vl-load-com)
  (if(not blrot:ang)(setq blrot:ang 1.5708))
  (setq oldAng blrot:ang
	blrot:ang(getangle
		   (strcat"\nSpecify rotation angle <"(angtos blrot:ang)">: "))
	curObj(entlast)
	); end setq
  (if(null blrot:ang)(setq blrot:ang oldAng))
  (while curObj
    (setq curObj(car(entsel "\nSelect object to Rotate ")))
    (if curObj
      (progn
    (setq vlaObj(vlax-ename->vla-object curObj))
    (vla-GetBoundingBox vlaObj 'MinPt 'MaxPt)
    (setq mnPt(vlax-safearray->list MinPt)
	  mxPt(vlax-safearray->list MaxPt)
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list
	  ); end setq
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list vlaObj(vlax-3D-Point miPt)blrot:ang)))
      (princ "\nObject on locked layer!")
      ); end if
    ); end progn
      ); end if
    ); end while
  (princ)
  ); end of c:mrot
За угол вращения принимается центр ограничевающего объект прямоугольника. Угол запрашивается, но по умолчаию он равен 90 градусов и можно просто нажать пробел.
{Smirnoff} вне форума  
 
Непрочитано 27.07.2005, 11:28
#5
che

Прораб
 
Регистрация: 16.05.2005
Osh
Сообщений: 52

Прога, что надо, только я бы порекомендовал Pave1 строки

Код:
[Выделить все] 
blrot:ang(getangle
(strcat"\nSpecify rotation angle <"(angtos blrot:ang)">: "))
закоментриовать, дабы лишний раз пробел не жать.
che вне форума  
 
Автор темы   Непрочитано 27.07.2005, 11:30
#6
Pave1

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329

Fantomas
хотелось бы чтобы прога про угол вообще не спрашивала и еще поварачивала ранее выделенные объекты
__________________
хочу все знать
Pave1 вне форума  
 
Непрочитано 27.07.2005, 11:43
#7
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099

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

Устанавливаем масшаб единый для вставки всех блоков:
Код:
[Выделить все] 
;;;******************************************************************
;;;*************** УСТАНОВКА МАСШТАБА ВСТАВКИ БЛОКОВ ****************
;;;******************************************************************

(defun c:bsca (/ oldSymsca)
  (if(not as:symsca)(setq as:symsca 1.0))
  (setq oldSymsca as:symsca
	as:symsca(getreal(strcat "\nSpecify symbols scale <" (rtos as:symsca) "> : "))
	); end setq
  (if(null as:symsca)(setq as:symsca oldSymsca))
  (princ(strcat "\nCurrent symbols scale 1:" (rtos as:symsca)))
  (princ)
  ); end of c:bsca
Пишем программу вставки блоков с вращением:
Код:
[Выделить все] 
;;;******************************************************************
;;;***************  ВСТАВКА БЛОКА С ВРАЩЕНИЕМ  **********************
;;;******************************************************************

(defun asmi_SymInsert (blName / oldEcho insSca blPath *error*)

  (defun *error* (msg)
    (setvar "cmdecho" oldEcho)
    ); end of *error*

  (setq oldEcho(getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (if(not as:symsca)(setq as:symsca 1.0))
  (setq insSca as:symsca)
  (if
    (not(tblsearch "block" blName))
    (progn
      (if
       (setq blPath(findfile(strcat blName ".dwg")))
	 (command "-insert" blPath "_s" insSca pause pause)
         (princ(strcat "\n*** File " (strcat blName ".dwg") " not found! *** "))
       ); end if
      ); end progn
    (command "-insert" blName "_s" insSca pause pause)
    ); end if
  (setvar "cmdecho" oldEcho)
  (entlast)
    ); end of asmi_SymInsert
До кучи пишем программу создания и активации новых слоёв:
Код:
[Выделить все] 
;;;***************************************************************
;;;************* СОЗДАНИЕ ИЛИ АКТИВАЦИЯ НОВОГО СЛОЯ **************
;;;***************************************************************

(defun asmi_Layer_Activate (
			    Name	; - Имя нового слоя
			    aFlag	; - Если Т - сделать активным
			    /
			    actDoc	; - Метка активного документа
			    layCol	; - Коллекция слоев
			    nLayer	; - Метка нового слоя
			    )
  (setq actDoc(vla-get-ActiveDocument
		(vlax-get-acad-object))
	layCol(vla-get-Layers actDoc)
	); end setq
  (if(not(tblsearch "LAYER" Name))
    (setq nLayer(vla-Add layCol Name))
    (setq nLayer(vla-item layCol Name))
    ); end if
  (if aFlag
        (vla-put-ActiveLayer actDoc nLayer)
    ); end if
nLayer
  ); end of asmi_Layer_Activate



;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;;;                  СОЗДАНИЕ СЛОЯ "GLM Fire Alarm"                  
;;;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun lay_GLM_Fire_Alarm (/ newLayer)
  (setq newLayer(asmi_Layer_Activate "GLM Fire Alarm" T))
  (vla-put-Color newLayer 20)
  (vla-put-LineType newLayer "Continuous")
  (vla-put-LineWeight newLayer acLnWt020)
  (princ)
  ); end of lay_GLM_Fire_Alarm
Теперь пишем кучу маленьких прогамок вставки отдельных блоков в нужный слой сразу с вращением:
Код:
[Выделить все] 
(defun c:fds()
  (lay_GLM_Fire_Alarm)
  (asmi_SymInsert "AsmiCAD_F_Smoke_Detector")
  (princ)
  )
Вызываем их из командной строки или делаем панельки типа такой (см. картинку).
[ATTACH]1122450237.JPG[/ATTACH]
{Smirnoff} вне форума  
 
Непрочитано 27.07.2005, 11:56
#8
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367

Как вариант

Лучше иметь рутину для произвольных углов, IMHO...

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

;Начало кода

(defun dtr (a)
  (* pi (/ a 180.0))
)

;								;

(defun  rotang (ang / acsp adoc ar_obj base i obj reg_ar reg_obj ss)
  
  (setq  adoc (vla-get-activedocument
         (vlax-get-acad-object)
       )
  acsp (vla-get-block
         (vla-get-activelayout adoc)
       )
  )
  (vla-startundomark adoc)
  (vl-cmdf "_.ucs" "_W")
  (setq ss (ssget)  i -1)
  (repeat (sslength ss)
  (setq i (1+ i)
      obj (vlax-ename->vla-object (ssname ss i)))
    (if (and (wcmatch (vla-get-objectname obj) "~Polyline")
	     (eq (vla-get-closed obj) :vlax-true))
(progn	
(setq ar_obj (vlax-make-safearray vlax-vbobject '(0 . 0))
      ar_obj (vlax-safearray-fill ar_obj (list obj)))
(vl-catch-all-apply
  (function (lambda ()
  (setq reg_ar (vlax-invoke-method
		 acsp
		 'Addregion
		 ar_obj
	       )))))
(setq reg_obj (vlax-safearray-get-element (vlax-variant-value reg_ar) 0)
	base (trans (vlax-get reg_obj "Centroid") 0 1))
(vla-rotate obj
	    (vlax-3d-point base)
	    (dtr ang)
  )
(vlax-release-object obj)
	     (vla-delete reg_obj)
	     (vlax-release-object reg_obj)
           )
)
    )
  (vla-endundomark adoc)
  (princ)
)

;									;
(prompt "Ввести в командной строке: #ROTATE - для выполнения программы")
;									;
 (defun C:#rotate (/ ang)
   (vl-load-com)
   (initget 3)
   (setq ang (getreal "\nЗадайте угол поворота\n"))
   (if ang (rotang ang))
   (princ)
)
(C:#rotate)
(princ)
;Окончание кода
fixo вне форума  
 
Непрочитано 27.07.2005, 12:01
#9
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099

Объекты из заранее созданного набора на 90 градусов, без лишнего базара. Если набор отсутствует то предлагается объекты выбрать.
Код:
[Выделить все] 
(defun c:r90 (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT OBJSET VLAOBJ)
 (vl-load-com)
  (setq errCount 0)
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (if objSet
    (progn
      (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(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list
	  ); end setq
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)1.5708)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
      (princ)
      ); end of c:drot
Единственное чего я не понял. Весь набор надо вращать относительно его центра или отдельные объекты?
{Smirnoff} вне форума  
 
Автор темы   Непрочитано 27.07.2005, 13:01
#10
Pave1

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329

Цитата:
Сообщение от Fantomas
Единственное чего я не понял. Весь набор надо вращать относительно его центра или отдельные объекты?
вращать надо весь набор относительно центра всего набора.
__________________
хочу все знать
Pave1 вне форума  
 
Автор темы   Непрочитано 27.07.2005, 13:12
#11
Pave1

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329

Fantomas
А так-то последний твой вариант как раз то что надо. Вот еще бы он вращал бы все объекты вокруг одного общего центра, а ни каждый вокруг своего, было бы вообще замечательно.
__________________
хочу все знать
Pave1 вне форума  
 
Непрочитано 27.07.2005, 13:18
#12
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367

Fantomas
Проверь почту please
fixo вне форума  
 
Непрочитано 27.07.2005, 14:18
#13
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099

>Fatty

Проверил, ответил.

>Pave1

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

Код:
[Выделить все] 
(defun c:r90a (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
	       OBJSET VLAOBJ PTLST XLST YLST)
 (vl-load-com)
  (if(not r90a:ang)(setq r90a:ang 1.5708))
;;;    (setq oldAng r90a:ang
;;;	r90a:ang(getangle
;;;		   (strcat"\nSpecify rotation angle <"(angtos r90a:ang)">: "))
;;;	); end setq
;;;  (if(null r90a:ang)(setq r90a:ang oldAng))
  (setq errCount 0
	ptLst '()
	); en setq
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (if objSet
    (progn
      (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)
	  ptLst(append ptLst(list mnPt))
	  ptLst(append ptLst(list mxPt))
	  xLst(vl-sort ptLst (function(lambda(e1 e2)(<(car e1)(car e2)))))
          yLst(vl-sort ptLst (function(lambda(e1 e2)(<(cadr e1)(cadr e2)))))
	  mxPt(list(caar(reverse xLst))(cadar yLst))
	  mnPt(list(caar xLst)(cadar(reverse yLst)))
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list	  
	  ); end setq
	); end foreach
   (foreach obj objSet
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)r90a:ang)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
      (princ)
      ); end of c:r90a
{Smirnoff} вне форума  
 
Автор темы   Непрочитано 27.07.2005, 14:39
#14
Pave1

электроснабжение и автоматика
 
Регистрация: 21.06.2005
г. Пермь
Сообщений: 329

Fantomas
СПАСИБО.
__________________
хочу все знать
Pave1 вне форума  
 
Непрочитано 27.07.2005, 16:00
#15
che

Прораб
 
Регистрация: 16.05.2005
Osh
Сообщений: 52

>Fantomas

Все же вместо:

Код:
[Выделить все] 
(setq r90a:ang 1.5708)
применил бы:

Код:
[Выделить все] 
(setq r90a:ang (/ pi 2))
Так как pi в лиспе содержит, насколько я знаю, до 14 или 15 цифр после запятой. Иначе после многократного применения поворота прямые линии становятся немного косыми.
che вне форума  
 
Непрочитано 27.07.2005, 16:14
#16
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367

Тоже вариант однако
Код:
[Выделить все] 
  (defun rota (ang	/	 acsp	  adoc	   ax_ss    com_center
	       cpt	ctr_list div_list maxpt	   minpt    ss
	      )
    (defun dtr (a)
      (* pi (/ a 180.0))
    )
    (vl-load-com)
    (setq adoc (vla-get-activedocument
		 (vlax-get-acad-object)
	       )
	  acsp (vla-get-block
		 (vla-get-activelayout adoc)
	       )
    )
    (vla-startundomark adoc)
    (vl-cmdf "_.ucs" "_W")
    (if	(not ang)
      (setq ang 90.)
    )
    (vla-clear (vla-get-activeselectionset adoc))
    (setq ss	(ssget)
	  ax_ss	(vla-get-activeselectionset adoc)
    )
    (setq ctr_list nil)

    (vlax-for a	ax_ss
      (vla-getboundingbox a 'minpt 'maxpt)
      (setq cpt	(mapcar	'*
			(mapcar	'+
				(vlax-safearray->list maxpt)
				(vlax-safearray->list minpt)
			)
			'(0.5 0.5 0.5)
		)

      )
      (setq ctr_list (cons cpt ctr_list))
    )
    (setq com_center
	   (list
	     (/	(apply '+ (mapcar 'car ctr_list))
		(length ctr_list)
	     )
	     (/	(apply '+ (mapcar 'cadr ctr_list))
		(length ctr_list)
	     )
	     (/	(apply '+ (mapcar 'caddr ctr_list))
		(length ctr_list)
	     )
	   )
    )
    (vlax-for a	ax_ss
      (vla-rotate
	a
	(vlax-3d-point com_center)
	(dtr ang)
      )
    )
    (vla-clear ax_ss)
    (vlax-release-object ax_ss)
    (vla-regen adoc acactiveviewport)
    (vla-endundomark adoc)
    (princ)
  )
;Call:
(rota nil);=>поворот на 90
fixo вне форума  
 
Непрочитано 27.07.2005, 16:18
#17
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099

>che

Цитата:
Все же вместо:

Код:
(setq r90a:ang 1.5708)


применил бы:

Код:
(setq r90a:ang (/ pi 2))
Согласен, так действительно корректнее. Учту на будующее
{Smirnoff} вне форума  
 
Непрочитано 29.04.2010, 09:49
#18
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 106

А есть еще лиспы для поворота на 90 градусов по осям y и z?

UPD

поворот на 90 градусов по оси x:
Код:
[Выделить все] 
(defun c:90x (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
	       OBJSET VLAOBJ PTLST XLST YLST)
 (vl-load-com)
  (if(not 90x:ang)(setq 90x:ang (/ pi 2)))
  (vl-cmdf "_.ucs" "_W")
  (vl-cmdf "_.ucs" "_y" "90")
;;;    (setq oldAng 90x:ang
;;;	90x:ang(getangle
;;;		   (strcat"\nSpecify rotation angle <"(angtos 90x:ang)">: "))
;;;	); end setq
;;;  (if(null 90x:ang)(setq 90x:ang oldAng))
  (setq errCount 0
	ptLst '()
	); en setq
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (if objSet
    (progn
      (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)
	  ptLst(append ptLst(list mnPt))
	  ptLst(append ptLst(list mxPt))
	  xLst(vl-sort ptLst (function(lambda(e1 e2)(<(car e1)(car e2)))))
          yLst(vl-sort ptLst (function(lambda(e1 e2)(<(cadr e1)(cadr e2)))))
	  mxPt(list(caar(reverse xLst))(cadar yLst))
	  mnPt(list(caar xLst)(cadar(reverse yLst)))
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list	  
	  ); end setq
	); end foreach
   (foreach obj objSet
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)90x:ang)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
      (princ)
      ); end of c:90x
поворот на 90 градусов по оси y:
Код:
[Выделить все] 
(defun c:90y (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
	       OBJSET VLAOBJ PTLST XLST YLST)
 (vl-load-com)
  (if(not 90y:ang)(setq 90y:ang (/ pi 2)))
  (vl-cmdf "_.ucs" "_W")
  (vl-cmdf "_.ucs" "_x" "90")

;;;    (setq oldAng 90y:ang
;;;	90y:ang(getangle
;;;		   (strcat"\nSpecify rotation angle <"(angtos 90y:ang)">: "))
;;;	); end setq
;;;  (if(null 90y:ang)(setq 90y:ang oldAng))
  (setq errCount 0
	ptLst '()
	); en setq
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (if objSet
    (progn
      (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)
	  ptLst(append ptLst(list mnPt))
	  ptLst(append ptLst(list mxPt))
	  xLst(vl-sort ptLst (function(lambda(e1 e2)(<(car e1)(car e2)))))
          yLst(vl-sort ptLst (function(lambda(e1 e2)(<(cadr e1)(cadr e2)))))
	  mxPt(list(caar(reverse xLst))(cadar yLst))
	  mnPt(list(caar xLst)(cadar(reverse yLst)))
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list	  
	  ); end setq
	); end foreach
   (foreach obj objSet
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)90y:ang)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
      (princ)
      ); end of c:90y
поворот на 90 градусов по оси z:
Код:
[Выделить все] 
(defun c:90z (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
	       OBJSET VLAOBJ PTLST XLST YLST)
 (vl-load-com)
  (if(not 90z:ang)(setq 90z:ang (/ pi 2)))
  (vl-cmdf "_.ucs" "_W")
;;;    (setq oldAng 90z:ang
;;;	90z:ang(getangle
;;;		   (strcat"\nSpecify rotation angle <"(angtos 90z:ang)">: "))
;;;	); end setq
;;;  (if(null 90z:ang)(setq 90z:ang oldAng))
  (setq errCount 0
	ptLst '()
	); en setq
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (if objSet
    (progn
      (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)
	  ptLst(append ptLst(list mnPt))
	  ptLst(append ptLst(list mxPt))
	  xLst(vl-sort ptLst (function(lambda(e1 e2)(<(car e1)(car e2)))))
          yLst(vl-sort ptLst (function(lambda(e1 e2)(<(cadr e1)(cadr e2)))))
	  mxPt(list(caar(reverse xLst))(cadar yLst))
	  mnPt(list(caar xLst)(cadar(reverse yLst)))
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list	  
	  ); end setq
	); end foreach
   (foreach obj objSet
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)90z:ang)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
      (princ)
      ); end of c:90z
Последний раз редактировалось DonJad, 29.04.2010 в 10:47.
DonJad вне форума  
 
Непрочитано 30.04.2010, 13:07
#19
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,996

Похожая тема. Там есть еще парочка команд. Rotate нескольких объектов вокруг своей оси
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 06.05.2010, 13:14
#20
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 106

Немного поменял скрипты, теперь ПСК, возвращается в мировую, и выделение не сбрасывается после выполнения команды, точнее набор заново выбирается.

Еще одну ошипку не могу забороть, для выбора центра вращения в скрипте находятся только две координаты - X,Y, а Z - выставляется в ноль, а надо бы чтобы z - тоже находилась и корректно обрабатывалась.


X
Код:
[Выделить все] 
(defun c:90x (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
	       OBJSET VLAOBJ PTLST XLST YLST)
 (vl-load-com)
  (if(not 90x:ang)(setq 90x:ang (/ pi 2)))
;;;    (setq oldAng 90x:ang
;;;	90x:ang(getangle
;;;		   (strcat"\nSpecify rotation angle <"(angtos 90x:ang)">: "))
;;;	); end setq
;;;  (if(null 90x:ang)(setq 90x:ang oldAng))
  (setq errCount 0
	ptLst '()
	); en setq
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (vl-cmdf "_.ucs" "_W")
  (vl-cmdf "_.ucs" "_y" "90")

  (if objSet
    (progn
      (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)
	  ptLst(append ptLst(list mnPt))
	  ptLst(append ptLst(list mxPt))
	  xLst(vl-sort ptLst (function(lambda(e1 e2)(<(car e1)(car e2)))))
          yLst(vl-sort ptLst (function(lambda(e1 e2)(<(cadr e1)(cadr e2)))))
	  mxPt(list(caar(reverse xLst))(cadar yLst))
	  mnPt(list(caar xLst)(cadar(reverse yLst)))
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list	  
	  ); end setq
	); end foreach
   (foreach obj objSet
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)90x:ang)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
   (vl-cmdf "_.ucs" "_W")

   (vl-cmdf "_.pselect" "_P" "")

   ; (sssetfirst nil objSet); выделение первоначального набора? удалить эту строку если не работает
      (princ)
      ); end of c:90x
Y
Код:
[Выделить все] 
(defun c:90y (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
	       OBJSET VLAOBJ PTLST XLST YLST)
 (vl-load-com)
  (if(not 90y:ang)(setq 90y:ang (/ pi 2)))
;;;    (setq oldAng 90y:ang
;;;	90y:ang(getangle
;;;		   (strcat"\nSpecify rotation angle <"(angtos 90y:ang)">: "))
;;;	); end setq
;;;  (if(null 90y:ang)(setq 90y:ang oldAng))
  (setq errCount 0
	ptLst '()
	); en setq
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (vl-cmdf "_.ucs" "_W")
  (vl-cmdf "_.ucs" "_x" "90")

  (if objSet
    (progn
      (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)
	  ptLst(append ptLst(list mnPt))
	  ptLst(append ptLst(list mxPt))
	  xLst(vl-sort ptLst (function(lambda(e1 e2)(<(car e1)(car e2)))))
          yLst(vl-sort ptLst (function(lambda(e1 e2)(<(cadr e1)(cadr e2)))))
	  mxPt(list(caar(reverse xLst))(cadar yLst))
	  mnPt(list(caar xLst)(cadar(reverse yLst)))
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list	  
	  ); end setq
	); end foreach
   (foreach obj objSet
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)90y:ang)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
   (vl-cmdf "_.ucs" "_W")
   (vl-cmdf "_.pselect" "_P" "")
      (princ)
      ); end of c:90y
Z
Код:
[Выделить все] 
(defun c:90z (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
	       OBJSET VLAOBJ PTLST XLST YLST)
 (vl-load-com)
  (if(not 90z:ang)(setq 90z:ang (/ pi 2)))
;;;    (setq oldAng 90z:ang
;;;	90z:ang(getangle
;;;		   (strcat"\nSpecify rotation angle <"(angtos 90z:ang)">: "))
;;;	); end setq
;;;  (if(null 90z:ang)(setq 90z:ang oldAng))
  (setq errCount 0
	ptLst '()
	); en setq
 (if
   (not(setq objSet(ssget "_I")))
   (setq objSet(ssget))
   ); end if
  (vl-cmdf "_.ucs" "_W")

  (if objSet
    (progn
      (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)
	  ptLst(append ptLst(list mnPt))
	  ptLst(append ptLst(list mxPt))
	  xLst(vl-sort ptLst (function(lambda(e1 e2)(<(car e1)(car e2)))))
          yLst(vl-sort ptLst (function(lambda(e1 e2)(<(cadr e1)(cadr e2)))))
	  mxPt(list(caar(reverse xLst))(cadar yLst))
	  mnPt(list(caar xLst)(cadar(reverse yLst)))
	  miPt(list(+(car mnPt)(/(-(car mxPt)(car mnPt))2))
		   (+(cadr mnPt)(/(-(cadr mxPt)(cadr mnPt))2))
		   0.0); end list	  
	  ); end setq
	); end foreach
   (foreach obj objSet
    (if
      (vl-catch-all-error-p
	(vl-catch-all-apply 'vla-rotate
	  (list obj(vlax-3D-Point miPt)90z:ang)))
      (setq errCount(1+ errCount))
      ); end if
	); end foreach
      (if(/= 0 errCount)
	(princ(strcat "\n" (itoa errCount) " objects were on locked layer! "))
	); end if
      ); end progn
    ); end if
   (vl-cmdf "_.pselect" "_P" "")
      (princ)
      ); end of c:90z
DonJad вне форума  
 
Непрочитано 06.05.2010, 13:40
#21
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 40,450

А если по аналогии с таким?
Код:
[Выделить все] 
(vl-load-com)

(defun c:rotate-90x (/ adoc selset res midp minp maxp )

  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if (setq res (setq selset (ssget "_:L")))
    (foreach obj (mapcar
                   (function vlax-ename->vla-object)
                   ((lambda (/ tab item)
                      (repeat (setq tab  nil
                                    item (sslength selset)
                                    ) ;_ end setq
                        (setq tab
                               (cons (ssname selset (setq item (1- item))) tab)
                              ) ;_ end of setq
                        ) ;_ end of repeat
                      ) ;_ end of lambda
                    )
                   ) ;_ end of mapcar
      (vla-getboundingbox obj 'minp 'maxp)
      (setq midp (mapcar (function (lambda (a b) (* (+ a b) 0.5)))
                         (vlax-safearray->list minp)
                         (vlax-safearray->list maxp)
                         ) ;_ end of mapcar
            ) ;_ end of setq
      (vla-rotate3d
        obj
        (vlax-3d-point midp)
        (vlax-3d-point
          (list (+ (car midp) 1.)
                (cadr midp)
                (caddr midp)
                ) ;_ end of list
          ) ;_ end of vlax-3d-point
        (/ pi 2.)
        ) ;_ end of vla-Rotate3D
      ) ;_ end of foreach
    ) ;_ end of if
  (sssetfirst res res)
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
P.S. Полностью код не гонял. По идее поворот осуществляется вокруг мировой оси Ох.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.05.2010, 08:51
#22
Евгений А.

Армспорт
 
Регистрация: 18.07.2006
Ейск
Сообщений: 355

DonJad, если устроит готовое решение, то у меня в программе Help-Paper есть недокументированная функция ad-rot, она вертит все выбранные объекты вокруг общего геометрического центра или каждое отдельно вокруг своего центра, управляется цифровыми клавишами клавиатуры:
1, 3 (7, 9) - вокруг оси Z (соответственно в одну или другую сторону),
2, 8 - вокруг оси X,
4, 6 - вокруг оси Y,
5 - окно настройки. угол поворота за один раз (по умолчанию 45 градусов),
esc - выход.
Оси берёт из текущей системы координат.
Последний раз редактировалось Евгений А., 07.06.2010 в 08:52.
Евгений А. вне форума  
 
Непрочитано 14.05.2010, 11:40
#23
DonJad


 
Регистрация: 20.12.2005
Murmansk
Сообщений: 106

Спасибо всем!!!

Попробую на днях разобраться в примере который опубликовал уважаемый Крыс. Надо тренироваться в лиспе ))
DonJad вне форума  
 
Непрочитано 06.06.2010, 01:00
#24
Нефтепроводчик


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

Спасибо, прикольный лисп! Не помешало бы, что бы после первого поворота придлагалось повторить команду.
Можно ли сделать, если выбран в качестве объекта блок, чтобы вращение происходило вокруг базовой точки этого блока?
Последний раз редактировалось Нефтепроводчик, 06.06.2010 в 01:23.
Нефтепроводчик вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Поворот на 90 градусов.

Опции темы Поиск в этой теме
Поиск в этой теме:

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


Обратная связь - Вверх