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

Re: Макрос на кнопку "Равноудаленная линия"

Подумал еще. Полусумму длин для первого способа нельзя задавать, обрезать круг не получится. Да тут еще есть и третий случай - отрезки продолжаются за точку пересечения, пока оставлю на потом.
Вот программа для простейшего случая:

;*************** b_line.lsp Построение биссектрисы угла ********
;      Ограничение: отрезки должны пересекаться,
;                   но не должны продолжаться за точку пересечения.
;
(defun C:B_LINE ( / ob1 ob2 ob3 ob4 0b5 line1 line2 p11 p12 p21 p22
                    dist1 dist2 dist3 p3)
    (setvar "CMDECHO" 0)
        (setq ob1 (entsel "\n Выберите первый отрезок: "))
        (redraw (car ob1) 3)
        (setq ob2 (entsel "\n Выберите второй отрезок: "))
        (redraw (car ob2) 3)
        (setq line1 (entget (car ob1)))
        (setq line2 (entget (car ob2)))
        (setq p11 (cdr (assoc 10 line1)))
        (setq p12 (cdr (assoc 11 line1)))
        (setq p21 (cdr (assoc 10 line2)))
        (setq p22 (cdr (assoc 11 line2)))
        (setq center (inters p11 p12 p21 p22))
        (setq dist1 (distance p11 p12))
        (setq dist2 (distance p21 p22))
        (setq dist3 (min dist1 dist2))
        (command "_CIRCLE" center dist3)
        (setq ob3 (entlast))
        (command "_TRIM" ob1 ob2 "" ob3 "")
        (setq ob4 (entlast))
        (command "_DIVIDE" ob4 2)
        (setq ob5 (entlast))
        (setq p3 (cdr (assoc 10 (entget ob5))))
        (command "_LINE" "_none" center "_none" p3 "")
        (command "_ERASE" ob4 ob5 "")
        (redraw (car ob1) 4)
        (redraw (car ob2) 4)
(princ)
)

Вроде намудрил, но работает.

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

Re: Макрос на кнопку "Равноудаленная линия"

Вот программа для случая, когда отрезки могут не иметь общей точки, а могут и иметь:

;*************** b_line.lsp Построение биссектрисы угла ********
;      Ограничение: Отрезки не должны быть параллельны,
;                   могут пересекаться, но не должны продолжаться
;                   за точку пересечения, иначе результат непредсказуем.
;
(defun C:B_LINE ( / ob1 ob2 ob3 ob4 0b5 line1 line2 p11 p12 p21 p22
                    dist1 dist2 dist3 p3)
    (setvar "CMDECHO" 0)
        (setq ob1 (entsel "\n Выберите первый отрезок: "))
        (redraw (car ob1) 3)
        (setq ob2 (entsel "\n Выберите второй отрезок: "))
        (redraw (car ob2) 3)
        (setq line1 (entget (car ob1)))
        (setq line2 (entget (car ob2)))
        (setq p11 (cdr (assoc 10 line1)))
        (setq p12 (cdr (assoc 11 line1)))
        (setq p21 (cdr (assoc 10 line2)))
        (setq p22 (cdr (assoc 11 line2)))
        (setq center (inters p11 p12 p21 p22 nil))
        (setq dist1 (distance p11 p12))
        (setq dist2 (distance p21 p22))
        (setq dist3 (min dist1 dist2))
        (command "_CIRCLE" center dist3)
        (setq ob3 (entlast))
        (command "_TRIM" ob1 ob2 "" ob3 "")
        (setq ob4 (entlast))
        (command "_DIVIDE" ob4 2)
        (setq ob5 (entlast))
        (setq p3 (cdr (assoc 10 (entget ob5))))
        (command "_LINE" "_none" center "_none" p3 "")
        (command "_ERASE" ob4 ob5 "")
        (redraw (car ob1) 4)
        (redraw (car ob2) 4)
(princ)
)

В этом коде добавлен признак nil в функцию inters.
Основной недостаток - неудачное положение биссектрисы при малом угле между исходными отрезками, если они не имеют общей точки.

  • Откуда: Украина / Киев
  • На форуме с 15 апреля 2005г.
  • Сообщений: 8,666
  • Спасибо: 158

Re: Макрос на кнопку "Равноудаленная линия"

Доброе утро. А вот мой вариант:

;;----------------------------------------------------
;;  Функция для построения биссектрисы двух отрезков
;;  Отрезки могут быть параллельны, пересекаться или
;;  пересекаться их продолжение.
;;  Если отрезки не будут лежать в одной плоскости -
;;  результат работы не определен.
;;----------------------------------------------------
(defun C:BI_LINE ( / en1 en2 e1 e2 p1 p2 p11 p12 p21 p22 tmp d1 d2 _bm)
    (setvar "CMDECHO" 0)
    (setq en1 (car (entsel "\nВыберите первый отрезок: ")))
    (if en1 (redraw en1 3))
    (setq en2 (car (entsel "\nВыберите второй отрезок: ")))
    (if en2 (redraw en2 3))
    (setq _bm (getvar "BLIPMODE")) (setvar "BLIPMODE" 0)
    (if (and en1 en2 (setq e1 (entget en1)) (setq e2 (entget en2))
             (= "LINE" (cdr (assoc 0 e1))) (= "LINE" (cdr (assoc 0 e2))))
     (progn
      (setq p11 (cdr (assoc 10 e1)) p12 (cdr (assoc 11 e1))
            p21 (cdr (assoc 10 e2)) p22 (cdr (assoc 11 e2)))
      (if (> (+ (distance p11 p21) (distance p12 p22))
             (+ (distance p11 p22) (distance p12 p21))) (progn
          ; Меняем местами начало и конец второго отрезка
          (setq tmp (list p21 p22) p21 (cadr tmp) p22 (car tmp))
      ))
      (cond
        ;; Отрезки сами пересекаются
        ((setq p1 (inters p11 p12 p21 p22 T))
          (setq d1 (max (distance p1 p11) (distance p1 p21)))
          (setq d2 (max (distance p1 p12) (distance p1 p22)))
          (setq p11 (polar p1 (angle p1 p11) d1))
          (setq p12 (polar p1 (angle p1 p12) d2))
          (setq p21 (polar p1 (angle p1 p21) d1))
          (setq p22 (polar p1 (angle p1 p22) d2))
        )
        ;; Пересекаются прямые, на которых лежат отрезки
        ((setq p1 (inters p11 p12 p21 p22 nil))
          (if (> (distance p1 p11) (distance p1 p12)) (progn
             (setq tmp (list p11 p12) p11 (cadr tmp) p12 (car tmp))
             (setq tmp (list p21 p22) p21 (cadr tmp) p22 (car tmp))
          )) ;; (if (progn
          (setq d1 (min (distance p1 p11) (distance p1 p21)))
          (setq d2 (max (distance p1 p12) (distance p1 p22)))
          (setq p11 (polar p1 (angle p1 p11) d1))
          (setq p12 (polar p1 (angle p1 p12) d2))
          (setq p21 (polar p1 (angle p1 p21) d1))
          (setq p22 (polar p1 (angle p1 p22) d2))
        )
      ) ;; (cond
      (setq p1 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p11 p21)))
      (setq p2 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p12 p22)))
      (command "_.LINE" "_none" (trans p1 0 1)
                        "_none" (trans p2 0 1) "")
     )
     (progn
       (princ "\nЧто-то не выбрано, или выбрано что-то не то!")
     )
    )
    (setvar "BLIPMODE" _bm)
    (if en1 (redraw en1 4))
    (if en2 (redraw en2 4))
    (princ)
)

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

Re: Макрос на кнопку "Равноудаленная линия"

> Александр Ривилис
Доброе утро!
Попробовал вашу программу. Хорошо. Хорошо, что учтен случай параллельных отрезков. Но вот задача, она и меня затормозила. В случае, когда отрезки продолжаются за точку пересечения - куда нарисуется биссектриса - можно предсказать?
У меня четыре возможных варианта, у вас, похоже, два, т.к. биссектриса отрисовывается в обе стороны от точки пересечения. Подумаете?

  • Forma
  • Восстановленный участник
  • На форуме с 9 июня 2005г.
  • Сообщений: 382
  • Спасибо: 0

Re: Макрос на кнопку "Равноудаленная линия"

Добрый день! Прошу прощения. Я навскидку взял один вариант.
Последний. Все отлично работает. Углы равны. Большое спасибо.
Эту программу смело можно поместить в "копилку". Кстати, как насчет дайджеста? Эта идея не такая плохая. Раз в неделю. Раз в месяц. Или по мере накопления.

  • Откуда: Украина / Киев
  • На форуме с 15 апреля 2005г.
  • Сообщений: 8,666
  • Спасибо: 158

Re: Макрос на кнопку "Равноудаленная линия"

> Владимир Громов
У меня действительно если отрезки пересекаются, то биссектриса рисуется в обе строны от точки пересечения. И биссектриса строится для меньшего из внутренних углов, хотя это не 100%.

  • Forma
  • Восстановленный участник
  • На форуме с 9 июня 2005г.
  • Сообщений: 382
  • Спасибо: 0

Re: Макрос на кнопку "Равноудаленная линия"

> Александр Ривилис
Это нормально. Я проверял. Главное, что бы линия была корректна. С ней все равно дальше работать.