Поворот блоков в 3D (multirotate)

Поворот блоков в 3D (multirotate) · 04.07.2007, 15:11

как повернуть несколько блоков в 3D на определенный угол, вокруг определенной оси, относительно базовой точки каждого блока?
для 2D пользуюсь этим кодом

Код:

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

(defun c:REB ( / i op op1 blks n-blks inc operador p1-min p1 ent-vl-max minimo maximo VT L-obj-modelo inc 

blk-act L-blks)	
  (command "_undo" "_begin")
  (grtext -3 "")
  (setq	blks(ssget (list (cons -4 "<OR")(CONS 0 "INSERT")(CONS 0 "TEXT")(CONS 0 "MTEXT")(cons -4 "OR>")))I 0 

L-blks nil)
  ;(sssetfirst nil blks)
  (while (< i(sslength blks))(setq L-blks(cons (ssname blks i)L-blks))(setq i(1+ i)))
  (setq op1(dos_msgboxex "Select mode:" "Rotate Texts and/or Blocks"  (list "Cancel" "COPY >>" "ANGLE >>" 

"DYNAMIC>>")))
  (cond
   ((= op1 0)(alert "COMANDO CANCELADO")(sssetfirst)(EXIT))
   ((= op1 1)(setq ang-a-rotar(cdr(assoc 50(entget(car(entsel "\nSelect object to copy an angle")))))))
   ((= op1 2)(setq ang-a-rotar(getangle"\nPRINT AN ANGLE: ")i 0))
   ((= op1 3)(setq ang-a-rotar 0.05 COLOR-ADD 1))
  )
  (SETQ BAND T)
  (if(= op1 3)
   ; ROTAR OBJETO "A OJO"
  (while (/= 13 operador)
   (IF BAND (PROGN(princ"\nSCALE [+ / - / enter / 8(+++) / 2(---)]:")(SETQ BAND NIL)))
   (grtext -1 (strcat ".  INCREMENT: " (angtos ang-a-rotar 1 2)"      .")) 
   (setq operador(cadr(grread nil 2)));4 pasa a 1 como argumento, este apaga el cursor
   (cond
    ((= operador 43)
   ;  (if(> (+ COLOR-ADD 1)255)(setq COLOR-ADD 10)(setq COLOR-ADD (+ COLOR-ADD 1)))
     (foreach blk-act L-blks
      (setq L-entidad(entget blk-act) ang-orig (cdr (assoc 50 L-entidad))) 
      (entmod(subst(cons 50(+ ang-orig ang-a-rotar)) (assoc 50 L-entidad)L-entidad))
    ;  (entmod(subst(cons 62 COLOR-ADD) (assoc 62 (entget blk-act))(entget blk-act)))
     )
    )
    ((= operador 45)
     ;(if(< (- COLOR-ADD 1)1)(setq COLOR-ADD 255)(setq COLOR-ADD (- COLOR-ADD 1))) 
     (foreach blk-act L-blks
      (setq L-entidad(entget blk-act) ang-orig (cdr (assoc 50 L-entidad)))
      (entmod(subst(cons 50(- ang-orig ang-a-rotar)) (assoc 50 L-entidad)L-entidad))
      ;(entmod(subst(cons 62 COLOR-ADD) (assoc 62 (entget blk-act))(entget blk-act)))
     )
    )
    ((= operador 50)(setq ang-a-rotar(- ang-a-rotar 0.015)))
    ((= operador 56)(setq ang-a-rotar(+ ang-a-rotar 0.015)))
   ) 
  )  
  ; ROTAR OBJETO INGRESANDO O COPIANDO UN ANGULO
  (progn
    (setq op(dos_msgboxex "Select mode to change an angle :" "Rotate Texts and/or Blocks"  (list "Cancelar" 

"SUBTRACT >>" "SUM >>" "ABSOLUTE >>")))
    (setq i 0 listo nil)
    (foreach blk-act L-blks
      (SETQ L-entidad(entget blk-act)ang-orig (cdr(assoc 50 L-entidad)))
      (cond
       ((= op 0)(alert "COMANDO CANCELADO")(sssetfirst)(exit))
       ((= op 1)(entmod(subst(cons 50 (- ang-orig ang-a-rotar)) (assoc 50 L-entidad)L-entidad)))
       ((= op 2)(entmod(subst(cons 50 (+ ang-orig ang-a-rotar)) (assoc 50 L-entidad)L-entidad)))
       ((= op 3)(entmod(subst(cons 50 ang-a-rotar) (assoc 50 L-entidad)L-entidad)))     
      )
    )
   ) 
  )
  (sssetfirst)
  (grtext -3 "")(command "_undo" "_end")
  (princ)
)

Zouss · 04.07.2007, 17:53

210 группу модифицировать, только получить из заданных пользователем угла пиворота и оси координаты конца этого вектора я не в состоянии сейчас
еще можно попробовать использовать команду _rotate3d примерно так:

Код:

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

(defun c:Multiblockrotate3D (/ pt1 pt2 ang dx dy dz ss sscur ed en n i)
  (command "_.UNDO" "_BE")
  (setq	ss  (ssget '((0 . "Insert")))
	pt1 (getpoint "\nSpecify first point on axis: ")
	pt2 (getpoint "\nSpecify second point on axis: ")
	ang (getreal "\nSpecify rotation angle: ")
	dx  (- (car pt2) (car pt1))
	dy  (- (cadr pt2) (cadr pt1))
	dz  (- (caddr pt2) (caddr pt1))
	n   (sslength ss)
  ) ;_  setq
  (repeat n
    (setq ed	(entget (setq en (ssname ss 0)))
	  sscur	(ssadd en)
	  pt1	(cdr (assoc 10 ed))
	  pt2	(list (+ (car pt1) dx) (+ (cadr pt1) dy) (+ (caddr pt1) dz))
    ) ;_  setq
    (command "_rotate3d" sscur "" pt1 pt2 ang)
    (ssdel en sscur)
    (ssdel en ss)
  ) ;_  repeat
  (command "_.UNDO" "_E")
) ;_  defun

угол поворота - число с клавиатуры, возможна ситуация, когда придется перед запуском программы отключать привязки

ASLYS · 05.07.2007, 12:17

не работает (крутит куда попало, в разные стороны)
лучше наверно, не через команду, а разобраться с 210 группой
возник такой вопрос,

Код:

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

(vla-get-centroid(VLAX-ENAME->VLA-OBJECT(CAR(ENTSEL "\nSelect object: "))))

выдает variant
как этот variant преобразовать в список типа (1.23 45.6 0.0)?

Zouss · 05.07.2007, 14:45

поправил пост - теперь работает. ашипка глупейшая была: вместо (setq pt2 (list (+ (car pt1) dx) (+ (cadr pt1) dy) (+ (caddr pt1) dz))) было (setq pt2 (list (+ (car pt1) dx) (+ (cadr pt1) dy) (+ (cadr pt1) dz))), так что теперь все завертелось

а по последнему вашему вопросу ничем помочь не могу - vlisp пока не знаю

ASLYS · 05.07.2007, 16:01

теперь работает, но не совсем как хотелось бы
попробуйте загрузить мой код, и выбрать опцию DYNAMIC, с 3D блоками, нажимая "+" или "-" они будут вращаться каждый вокруг своей базовой точки, но в одной плоскости.
Я хочу добавить возможность выбора плоскости

AY · 05.07.2007, 16:20

Код:

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

(vlax-safearray->list
  (vlax-variant-value
    (vla-get-centroid
      (VLAX-ENAME->VLA-OBJECT (CAR (ENTSEL "\nSelect object: ")))
    )
  )
)

Zouss · 05.07.2007, 17:14

мне кажется, что вы все таки хотите добавить возможность выбора оси

если не получится через (entmode, попозже я попробую вклеить свой поворот в вашу программу - сейчас со временем не очень просто

fixo · 05.07.2007, 17:19

Цитата:

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

не работает (крутит куда попало, в разные стороны)
лучше наверно, не через команду, а разобраться с 210 группой
возник такой вопрос,

Код:

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

(vla-get-centroid(VLAX-ENAME->VLA-OBJECT(CAR(ENTSEL "\nSelect object: "))))

выдает variant
как этот variant преобразовать в список типа (1.23 45.6 0.0)?

Усточиво пока работает и следующее выражение:

Код:

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

(vlax-get (VLAX-ENAME->VLA-OBJECT(CAR(ENTSEL "\nSelect object: "))) 'Centroid)

~'J'~

ASLYS · 05.07.2007, 18:11

AY

Цитата:

Код:
(vlax-safearray->list
(vlax-variant-value
(vla-get-centroid
(VLAX-ENAME->VLA-OBJECT (CAR (ENTSEL "\nSelect object: ")))
)
)
)

то, что надо

Alaspher · 05.07.2007, 18:32

Может так сойдёт?

Код:

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

(vl-load-com)
(defun c:reb3 () (pl:bl3drot))
(defun pl:bl3drot
       (/ adoc ang asel axi insp lays locs ssel ssnm pl:obj-filter-select-manual pointtr)
  (defun pointtr (point axi)
    (cond ((= axi "X") (list (1+ (car point)) (cadr point) (caddr point)))
          ((= axi "Y") (list (car point) (1+ (cadr point)) (caddr point)))
          ((= axi "Z") (list (car point) (cadr point) (1+ (caddr point))))
          (t point)
    )
  )
  (defun pl:obj-filter-select-manual (sel filter)
    (vla-selectonscreen
      sel
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbinteger (cons 0 (1- (length filter))))
        (mapcar (function car) filter)
      )
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbvariant (cons 0 (1- (length filter))))
        (mapcar (function cdr) filter)
      )
    )
  )
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        lays (vla-get-layers adoc)
        ssel (vla-get-selectionsets adoc)
        ssnm "pl:blrot-sel"
  )
  (if (vl-catch-all-error-p
        (setq asel (vl-catch-all-apply (function vla-item) (list ssel ssnm)))
      )
    (setq asel (vla-add (vla-get-selectionsets adoc) ssnm))
  )
  (vla-clear asel)
  (pl:obj-filter-select-manual asel '((0 . "INSERT")))
  (vlax-for i asel
    (if (= :vlax-true (vla-get-lock (vla-item lays (vla-get-layer i))))
      (setq locs (cons i locs))
    )
  )
  (if locs
    (vla-removeitems
      asel
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbobject (cons 0 (1- (length locs))))
        locs
      )
    )
  )
  (if (zerop (vla-get-count asel))
    (princ "\nНе выбрано блоков на незаблокированных слоях.")
    (progn
      (initget "X Y Z")
      (if (not (setq axi (getkword "\nВыбери ось вращения [X/Y/Z] <Z>: ")))
        (setq axi "Z")
      )
      (initget 2)
      (if (setq ang (getangle "\nУкажи угол поворота <Exit>: "))
        (progn (vla-startundomark adoc)
               (vlax-for i asel
                 (vla-rotate3d
                   i
                   (setq insp (vla-get-insertionpoint i))
                   (vlax-3d-point
                     (pointtr (vlax-safearray->list (vlax-variant-value insp)) (strcase axi))
                   )
                   ang
                 )
                 (vla-endundomark adoc)
               )
        )
      )
    )
  )
  (princ)
)
(progn (princ "\nType 'reb3' for start.") (princ))

Набросок - не тестировал.

ASLYS · 05.07.2007, 19:08

(defun c:reb3() (pl:bl3drot) )
буду пробовать

Alaspher · 05.07.2007, 22:44

Цитата:

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

(defun c:reb3() (pl:bl3drot) )
буду пробовать

Исправил, спасибо за замечание!

ASLYS · 06.07.2007, 16:44

вроде что-то получилось... может есть какие замечания?

Код:

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

(DEFUN C:R33( / I op Obj-vla-ename Obj-ename onjs P-ins minimo maximo p1-min p1-max tipo-obj INDX 
        ang-ini ANG-X ANG-Y ANG-Z P-rot-X-1 P-rot-X-2 P-rot-Y-1 P-rot-Y-2  P-rot-Z-1 P-rot-Z-2) 
 (vl-load-com)
 (setq ang-ini 0.0174532889) 
 (setq *ACTIVE-DOCUMENT* (vla-get-ActiveDocument (VLAX-GET-ACAD-OBJECT))) 
 (vla-startundomark *active-document*) 
 (princ "\n Выбирете объекты:") 
 (setq objs(ssget)) 

 (setq i(dos_proplist "Поворот 3D" "Выбирете угол для каждой оси" 
     (list (cons "Ось X: " (angtos ang-ini 1 4))(cons "Ось Y: " (angtos ang-ini 1 4))(cons "Ось Z: " (angtos ang-ini 1 4)) ))) 
  
 (if i(setq i(mapcar'(lambda(x)(angtof(cdr x)) )i) ANG-X(nth 0 i)ANG-Y(nth 1 i)ANG-Z(nth 2 i))(PROGN(ALERT "** COMANDO CANCELADO **")(exit))) 
  
 (command "_redraw") 
 (princ "\nНажмите: [1 или 4 -> ось X] [2 или 5 -> ось Y] [3 или 6 -> ось Z][S -> Смена углов]") 
 (setq op nil) 
 (while (/= op 13) 
  (setq op(cadr(grread nil 4 1))) 
    
  (setq indx 0) 
  (while(< indx (sslength objs)) 
   (setq Obj-ename (ssname objs indx)Obj-vla-ename(VLAX-ENAME->VLA-OBJECT Obj-ename) tipo-obj(cdr(assoc 0(entget Obj-ename)))) 
   (cond 
    ((= tipo-obj "3DSOLID") (setq P-ins(vlax-safearray->list(vlax-variant-value(vla-get-centroid Obj-vla-ename))))) 
    ((= tipo-obj "INSERT")  (setq P-ins(vlax-safearray->list(vlax-variant-value(vla-get-insertionpoint Obj-vla-ename))))) 
    ((or(= tipo-obj "CIRCLE")(= tipo-obj "ELLIPSE")) (setq P-ins(vlax-safearray->list(vlax-variant-value(vla-get-center Obj-vla-ename))))) 
    (t(setq P-ins(list 0 0 0))) 
   ) 
  
   (setq P-rot-X-1 (list(-(nth 0 P-ins) 100000)(nth 1 P-ins)(nth 2 P-ins)) P-rot-X-2 (list(+(nth 0 P-ins) 100000)(nth 1 P-ins)(nth 2 P-ins))) 
   (setq P-rot-Y-1 (list(nth 0 P-ins)(-(nth 1 P-ins) 100000)(nth 2 P-ins)) P-rot-Y-2 (list(nth 0 P-ins)(+(nth 1 P-ins) 100000)(nth 2 P-ins))) 
   (setq P-rot-Z-1 (list(nth 0 P-ins)(nth 1 P-ins)(-(nth 2 P-ins) 100000)) P-rot-Z-2 (list(nth 0 P-ins)(nth 1 P-ins)(+(nth 2 P-ins) 100000))) 
   (if (= 1(sslength objs)) (progn (GRVECS(LIST 12 P-rot-X-1 P-rot-X-2)) (GRVECS(LIST 106 P-rot-Y-1 P-rot-Y-2)) (GRVECS(LIST 164 P-rot-Z-1 P-rot-Z-2)))) 
   (cond 
    ((= op 52);Aumenta angulo en Eje X    
     (IF(MINUSP ANG-X)(SETQ ANG-X(- ANG-X))) 
     (VLA-Rotate3D (VLAX-ENAME->VLA-OBJECT Obj-ename)  (VLAX-3D-POINT P-rot-X-1) (VLAX-3D-POINT P-rot-X-2) ANG-X) 
    ) 
    ((= op 49);Disminuye angulo en Eje X 
     (IF(NOT(MINUSP ANG-X))(SETQ ANG-X(- ANG-X))) 
     (VLA-Rotate3D (VLAX-ENAME->VLA-OBJECT Obj-ename)  (VLAX-3D-POINT P-rot-X-1) (VLAX-3D-POINT P-rot-X-2) ANG-X) 
    ) 
    ((= op 53);Aumenta angulo en Eje Y    
     (IF(MINUSP ANG-Y)(SETQ ANG-Y(- ANG-Y))) 
     (VLA-Rotate3D (VLAX-ENAME->VLA-OBJECT Obj-ename)  (VLAX-3D-POINT P-rot-Y-1) (VLAX-3D-POINT P-rot-Y-2) ANG-Y) 
    ) 
    ((= op 50);Disminuye angulo en Eje Y 
     (IF(NOT(MINUSP ANG-Y))(SETQ ANG-Y(- ANG-Y))) 
     (VLA-Rotate3D (VLAX-ENAME->VLA-OBJECT Obj-ename)  (VLAX-3D-POINT P-rot-Y-1) (VLAX-3D-POINT P-rot-Y-2) ANG-Y) 
    ) 
    ((or(= op 45)(= op 54));Aumenta angulo en Eje Z    
     (IF(MINUSP ANG-Z)(SETQ ANG-Z(- ANG-Z))) 
     (VLA-Rotate3D (VLAX-ENAME->VLA-OBJECT Obj-ename)  (VLAX-3D-POINT P-rot-Z-1) (VLAX-3D-POINT P-rot-Z-2) ANG-Z) 
    ) 
    ((or(= op 43)(= op 51));Disminuye angulo en Eje Z 
     (IF(NOT(MINUSP ANG-Z))(SETQ ANG-Z(- ANG-Z))) 
     (VLA-Rotate3D (VLAX-ENAME->VLA-OBJECT Obj-ename)  (VLAX-3D-POINT P-rot-Z-1) (VLAX-3D-POINT P-rot-Z-2) ANG-Z) 
    ) 

    ((= op 115);Configura los ángulos      
     (setq i(dos_proplist "Поворот 3D" "Выбирете угол для каждой оси" 
     (list (cons "Ось X: " (angtos ANG-X 1 4))(cons "Ось Y: " (angtos ANG-Y 1 4))(cons "Ось Z: " (angtos ANG-Z 1 4)) ))) 
     (if i 
      (setq i(mapcar'(lambda(x)(angtof(cdr x)) )i) ANG-X(nth 0 i)ANG-Y(nth 1 i)ANG-Z(nth 2 i)) 
      (PROGN(ALERT "** Los angulos no se modificaron **")) 
     ) 
     (setq op nil) 
    ) 
   ) 
   (setq indx(+ 1 indx)) 
  ) 
 ) 

 (COMMAND "_redraw")  
 (redraw Obj-ename 4) 
 (vla-endundomark *ACTIVE-DOCUMENT*) 
)

(setq op(cadr(grread nil 4 1))) эта штука у меня "блокирует" клик на мышке, можно как-то от этого избавиться?