• На форуме с 10 июля 2004г.
  • Сообщений: 8,349
  • Спасибо: 4

Тема: LISP. Выравнивание отрезков по осям X и Y

Программу разработал Александр Ривилис по запросу участника форума под ником Forma.
Код можно сохранить в файле с именем l_align_xy.lsp

;;----------------------------------------------------
;;  Программа для выравнивания отрезков по осям X и Y
;;  Если отрезки не будут лежать в плоскости МСК
;;  результат работы не определен.
;;  Автор Александр Ривилис.
;;----------------------------------------------------
(defun C:L_ALIGN_XY ( / ss en e p1 p2 i n dir d dr x y l dl)
    (setvar "CMDECHO" 0)
    (if (null L_ALIGN_XY_delta_ang) (progn
       (setq L_ALIGN_XY_delta_ang 1.0)
    )) ;; (if (progn
    (setq d (getreal
      (strcat "\nМаксимальный угол отклонения от оси в градусах <"
              (rtos L_ALIGN_XY_delta_ang 2 3) ">: ")))
    (if d (setq L_ALIGN_XY_delta_ang (abs d)))
    (setq d (* PI (/ L_ALIGN_XY_delta_ang 180.0)))
    (princ "\nВыберите отрезки для выравнивания: ")
    (cond
      ((setq ss (ssget '((0 . "LINE"))))
        (setq i 0 n (sslength ss))
        (while (< i n)
          (setq e (entget (ssname ss i)))
          (setq p1 (cdr (assoc 10 e)) p2 (cdr (assoc 11 e)))
          (setq l (distance p1 p2)) ;; Длина отрезка
          (setq dir (angle p1 p2)) ;; Находим угол с осью X
          ;; Приводим угол в диапазон 0...2*PI
          (if (< dir 0.0) (setq dir (+ (* 2.0 PI) dir)))
          (cond
            ;; Отрезок условно параллелен оси X
            ((or (equal dir 0.0 d) (equal dir PI d) (equal dir (* 2.0 PI) d))
              (setq y (* 0.5 (+ (cadr p1) (cadr p2))))
              (setq p1 (list (car p1) y (caddr p1)))
              (setq p2 (list (car p2) y (caddr p2)))
              (setq dl (* 0.5 (- l (distance p1 p2))))
              ;; Восстанавливаем длину отрезка
              (setq p1 (polar p1 (angle p2 p1) dl))
              (setq p2 (polar p2 (angle p1 p2) dl))
              (setq e (subst (cons 10 p1) (assoc 10 e) e))
              (setq e (subst (cons 11 p2) (assoc 11 e) e))
              (entmod e)
            )
            ;; Отрезок условно параллелен оси Y
            ((or (equal dir (* PI 0.5) d) (equal dir (* PI 1.5) d))
              (setq x (* 0.5 (+ (car p1) (car p2))))
              (setq p1 (list x (cadr p1) (caddr p1)))
              (setq p2 (list x (cadr p2) (caddr p2)))
              (setq dl (* 0.5 (- l (distance p1 p2))))
              ;; Восстанавливаем длину отрезка
              (setq p1 (polar p1 (angle p2 p1) dl))
              (setq p2 (polar p2 (angle p1 p2) dl))
              (setq e (subst (cons 10 p1) (assoc 10 e) e))
              (setq e (subst (cons 11 p2) (assoc 11 e) e))
              (entmod e)
            )
          ) ;; (cond
          (setq i (1+ i))
        ) ;; endof (while
      )
      (T
       (princ "\nНичего не выбрано, или выбрано что-то не то!")
      )
    ) ;; (cond
    (princ)
)

Возможный макрос для кнопки или пункта меню:

^C^C^P(if (not C:L_ALIGN_XY) (load "l_align_xy")) L_ALIGN_XY

  • marta
  • Восстановленный участник
  • На форуме с 20 января 2006г.
  • Сообщений: 1
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Спасибо, приятная и нужная программка, а то надоело чистить за "студентами"...

  • Саша
  • Восстановленный участник
  • На форуме с 30 апреля 2006г.
  • Сообщений: 1
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Подскажите как и где создаются кнопки для запуска программы

  • WA
  • Восстановленный участник
  • На форуме с 30 апреля 2007г.
  • Сообщений: 19
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Огромное спасибо от пользователей!!!
WA/2007

  • На форуме с 23 апреля 2003г.
  • Сообщений: 795
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Практически аналогично работает стандартная команда автокада change  с включенным режимом ortho.

  • Rust
  • Восстановленный участник
  • На форуме с 16 октября 2003г.
  • Сообщений: 270
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Эдуард Смолянка пишет:

Практически аналогично работает стандартная команда автокада change с включенным режимом ortho.

Это не совсем так. Изначально предлагаемая программа создавалась для выравнивания отвекторизированных отрезков. Поэтому , в первых, в программе имеется некий "фильтр" линий расположенных под углом. И ,в вторых, имеется специфичный порядок работы- отличный от работы с командой change, что весьма существенно при обработке сотен и тысяч линий.

  • tulips
  • Восстановленный участник
  • На форуме с 26 марта 2008г.
  • Сообщений: 1
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Вроде все было сделано по правилам, но прога пчему-то не работает?? подскажите, пожалуйста, в чем могут быть причины (ну кроме природной тупизны, кншн) :))

  • Yuriy
  • Восстановленный участник
  • На форуме с 28 февраля 2008г.
  • Сообщений: 116
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Нужная программа.
Прочитал и тяжко вздохнул.
А ведь кроме отрезков есть
aec_wall
curtainwall
railing
(AA-ADT)
Ох и обделенные же ADTэшники (
В двух фирмах уже спросили а нельзя ли стеночки?

  • На форуме с 4 марта 2006г.
  • Сообщений: 2
  • Спасибо: 0

Re: LISP. Выравнивание отрезков по осям X и Y

Спасибо, хорошая штучка, особенно после обводки
разных "кривых" растров.