Программа+макрос на кнопку "Ориентирование обьектов в AutoCAD по контрольной линии" (Страница 2 из 3)

;;--------------------------------------------------
;; Функция для выравнивания растра по отрезку.
;; По всем вопросам использования к Forma
;;--------------------------------------------------
(defun C:ALIGN_IMAGE ( / ss en el p1 p2 u v ang ang_u ul vl _ce)
  ;; Функция вычисляет длину вектора
  ;; Усовершенствование: Евгений Елпанов
  (defun vector_len (v)
    (sqrt (apply (function +) (mapcar (function (lambda (x)(* x x))) v)))
  )
  ;;
  (setq _ce (getvar "cmdecho")) (setvar "cmdecho" 0)
  (command "_.Undo" "_Group")
  (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)))
    ;; Упорядочим отрезок по оси X
    (if (> (car p1) (car p2)) (progn
      (setq p1 (list p1 p2) p2 (car p1) p1 (last p1))
    )) ;; (if (progn
    ;; Разберемся с углом:
    (setq ang (angle p1 p2))
    (cond
     ((and (> ang (* PI 0.25)) (< ang (* PI 0.75)))
      ;; Угол с вертикалью
      (setq ang (angle (list (car p1) (cadr p2)) (list (car p2) (cadr p1))))
      (setq ang (+ ang (* PI 0.5)))
     )
     ((and (> ang (* PI 1.25)) (< ang (* PI 1.75)))
      ;; Угол с вертикалью
      (setq ang (angle (list (car p1) (cadr p2)) (list (car p2) (cadr p1))))
      (setq ang (- ang (* PI 0.5)))
     )
     (t
      ;; Угол с горизонталью
      (setq ang (angle (list (car p1) (cadr p2)) (list (car p2) (cadr p1))))
     )
    ) ;; (cond
    (princ "\nВыберите растр для выравнивания: ")
    (if (setq ss (ssget "_:S:E" '((0 . "IMAGE")))) (progn
      (setq el (entget (ssname ss 0)))
      (setq u (cdr (assoc 11 el)) v (cdr (assoc 12 el)))
      (setq ang_u (angle '(0.0 0.0 0.0) u))
      (setq el (subst (cons 11 (polar '(0.0 0.0 0.0)
               (+ ang ang_u) (vector_len u))) (assoc 11 el) el))
      (setq el (subst (cons 12 (polar '(0.0 0.0 0.0)
               (+ ang (* PI 0.5) ang_u) (vector_len v))) (assoc 12 el) el))
      (entmod el)
    )) ;; (if (progn
  )) ;; (if (progn
  (command "_.Undo" "_end")
  (setvar "cmdecho" _ce)
  (princ)
)