[AlexZh]

Здравствуйте!

Скажите, как выполнить команду "ПОВЕРНУТЬ"?

Код:

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

 (defun c:rot_bl	(/ old_orthmode obj p1 p2 p3 p4)
  (setq old_orthmode (getvar "ORTHOMODE"))
  (setvar "ORTHOMODE" 0)
  (setq obj (car (entsel "\nВыберите объект:")))
  (setq p1 (getpoint "\nВыберите базу:"))
  (setq p2 (getpoint p1 "\nВыберите опорный отрезок:"))
  (setq p3 (getpoint "\nНачало отрезка выравнивания:"))
  (setq p4 (getpoint p3 "\nКонец отрезка выравнивания:"))
  (command "_.ROTATE" _p p1 "Опорный угол" p1 p2 "Точки" p3 p4)
  (setvar "ORTHOMODE" 0)
))

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

В каком месте проблема?
http://forum.dwg.ru/showpost.php?p=271151&postcount=167
http://autolisp.ru/2010/03/04/localization/

[Krieger]

Код:

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

(defun c:rot_bl	(/ old_orthmode obj p1 p2 p3 p4)
  (setq old_orthmode (getvar "ORTHOMODE"))
  (setvar "ORTHOMODE" 0)
  (setq obj (car (entsel "\nВыберите объект:")))
  (setq p1 (getpoint "\nВыберите базу:"))
  (setq p2 (getpoint p1 "\nВыберите опорный отрезок:"))
  (setq p3 (getpoint "\nНачало отрезка выравнивания:"))
  (setq p4 (getpoint p3 "\nКонец отрезка выравнивания:"))
  (command "_.ROTATE" obj "" p1 "_r" p1 p2 "_p" p3 p4)
  (setvar "ORTHOMODE" old_orthmode)
)

[AlexZh]

Спасибо! Заработало!

[trushev]

Сообщение от AlexZh Заработало!

Учтите предупреждениеКулик Алексей aka kpblc, по объектной привязке.

[Profan]

Не мешало бы здесь уточнить запросы программы. И нужные привязки временно включить.
Примерно так:

Код:

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

(defun c:rot_bl	(/ osm old_orthmode obj p1 p2 p3 p4)
  (setq osm (getvar "OSMODE"))
  (setvar "OSMODE" 33)
  (setq old_orthmode (getvar "ORTHOMODE"))
  (setvar "ORTHOMODE" 0)
  (setq obj (car (entsel "\nВыберите поворачиваемый объект:")))
  (setq p1 (getpoint "\nУкажите базовую точку поворота:"))
  (setq p2 (getpoint p1 "\nУкажите вторую точку поворачиваемого объекта:"))
  (setq p3 (getpoint "\nНачало отрезка выравнивания:"))
  (setq p4 (getpoint p3 "\nКонец отрезка выравнивания:"))
  (command "_.ROTATE" obj "" p1 "_r" p1 p2 "_p" p3 p4)
  (setvar "OSMODE" osm)
  (setvar "ORTHOMODE" old_orthmode)
(princ)
)

[Nike]

Вот такой лиспик есть, для выравнивания (поворота) блоков по линии, может пригодится..

Код:

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

 (defun c:align_blocks_line (/ ang ang1 ang0 ss ss2 en el p1 p2 u v ang tmp i n ul vl)
  (princ "\nВыберите отрезок, по которому будет выполняться выравнивание: ")
  (if (setq ss (ssget "_:S:E" '((0 . "LINE"))))
    (progn
      (setq el (entget (ssname ss 0)))
      (setq p1 (cdr (assoc 10 el))
            p2 (cdr (assoc 11 el))
      ) ;_ end of setq
      (if (> (car p1) (car p2))
        (progn
          (setq tmp (list p1 p2)
                p1  (last tmp)
                p2  (car tmp)
          ) ;_ end of setq
        ) ;_ end of progn
      ) ;_ end of if
      ;; (if (progn
      (setq ang (angle p1 p2))
      (princ "\nВыберите блоки для выравнивания: ")
      (if (setq ss2 (ssget '((0 . "Insert"))))
        (progn
          (setq n (sslength ss2)
                i 0
          ) ;_ end of setq
          (while (< i n)
            (setq block_name  (ssname ss2 i)
                  block_koord (list (car (cdr (assoc 10 (entget block_name)))) (caddr (assoc 10 (entget block_name))))
            ) ;_ end of setq
            (setq ang0 (* (cdr (assoc 50 (entget block_name))) (/ -180.0 pi)))
            (setq ang1 (* ang (/ 180.0 pi)))
            (command "_.rotate" block_name "" block_koord ang0)
            (command "_.rotate"
                     block_name
                     ""
                     (list (car (cdr (assoc 10 (entget block_name)))) (caddr (assoc 10 (entget block_name))))
                     ang1
            ) ;_ end of command
            (setq i (1+ i))
          ) ;_ end of while
        ) ;_ end of progn
      ) ;_ end of if
      ;; (if (progn
    ) ;_ end of progn
  ) ;_ end of if
  ;; (if (progn
  (princ)

[Profan]

Сообщение от Nike Вот такой лиспик есть, для выравнивания (поворота) блоков по линии, может пригодится..

Программа не доделана.

[arminos]

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

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

А не проще будет посмотреть в опции команды _.rotate ?

[arminos]

Этот метод хорош только для штучных объектов. А у меня их 19000 блоков. Пока, как говорится, каждого оближешь-хотелось бы по шустрее работать. Делал динамический блок, да удобно, но после каждого поворота (19000) блока, образуется 19000ушек (*U-блоков).

[name02]

Сообщение от arminos Здравствуйте, можно написать лисп

Попробуй такой лисп:

Код:

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

 (defun c:AAA (/ a ss ent i ang0)
  ;;Поворот выбранных блоков (выбирать можно до или после вызова программы)
  ;;относительно точки их вставки на угол, задаваемый направлением 

  (setq a (cadr (ssgetfirst)))

  (if a
    (progn
      (setq ss (ssadd))
      (repeat (setq i (sslength a))
        (setq ent (ssname a (setq i (1- i))))
        (if (= (cdr (assoc 0 (entget ent))) "INSERT")
          (ssadd ent ss)
          ) ;_ end if
        ) ;_ end repeat
      ) ;_ end progn
    (setq ss (ssget '((0 . "INSERT"))))
    ) ;_ end if

  (if (and
        ss
        (setq ang0 (getorient "\nУкажите направление выравнивания:"))
        ) ;_ end and
    (repeat (setq i (sslength ss))

      (vla-put-rotation
        (vlax-ename->vla-object (ssname ss (setq i (1- i))))
        ang0
        ) ;_ end vla-put-rotation

      ) ;_ end repeat
    ) ;_ end if

  (princ)

  ) ;_ end defun

[arminos]

name02, то что доктор прописал! Человеческое вам спасибо!