[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 Вот такой лиспик есть, для выравнивания (поворота) блоков по линии, может пригодится..

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