Рисую линию

Рисую линию · 15.04.2008, 16:39

Здравствуйте.
Помогите разобраться в некоторой ситуации.
Задача: Есть два отрезка на плоскости. Отрезки расположены на прямых, у которых есть точка пересечения. Сами отрезки общих точек не имеют.
Нужно соединить отрезки линией, проходящей через точку пересечения отрезков.

Для этого мною был написан небольшой код, в котором указывались два отрезка и рисовалась линия, проходящая через точку пересечение отрезков. НО всё бы было хорошо, если бы не возникал следующий "баг". Когда я пытаюсь соеденить прямые с точкой пересечения, лежащей на одной из отрезков - линия рисуется не так как я её запрограммировал.

Из-за чего возникает эта ошибка? Или это наблюдаеться только у меня на компе? (у меня Автокад 2008 русский)
Для наглядности прикрепляю ещё два рисунка с результатами работы программы.

Для анализа привожу свой код.

Код:

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

;|=========================================================
*    Вступительная часть - ввод данных.
*	Вводим два отрезка (точка пересечения пусть лежит на одном из отрезков)
*    
|;
(vl-load-com)
(defun c:Go (/)
  (if (setq Target1 (entsel "\n***Выберите 1-ый отрезок: ")
	    Target2 (entsel "\n***Выберите 2-ой отрезок: ")
      )
    (setq Metka1 (cdr (assoc 5 (entget (car Target1))))
	  Metka2 (cdr (assoc 5 (entget (car Target2))))
    )
    (princ "\n Не выбраны отрезки")
  ) ;_ end if
  (Peresek Metka1 Metka2)
  (princ)
) ;_ end defun

;|=========================================================
*    Соединение отрезков прямыми,
*    проходящими через точку пересечения отрезков
*    Параметры вызова:
	Line1		метка линии 1 на чертеже
	Line2		метка линии 2 на чертеже
|;
(defun Peresek ( Line1 Line2 / obj_Line1 obj_Line2 ptStart1 ptEnd1 ptStart2 ptEnd2 )
  (setq	obj_Line1 (vlax-ename->vla-object (handent Line1))
	obj_Line2 (vlax-ename->vla-object (handent Line2))
  ) ;_end setq
  (setq	ptStart1 (vlax-safearray->list
		   (vlax-variant-value
		     (vla-get-StartPoint obj_Line1)))
	ptEnd1	 (vlax-safearray->list
		   (vlax-variant-value
		     (vla-get-EndPoint obj_Line1)))
	ptStart2 (vlax-safearray->list
		   (vlax-variant-value
		     (vla-get-StartPoint obj_Line2)))
	ptEnd2	 (vlax-safearray->list
		   (vlax-variant-value
		     (vla-get-EndPoint obj_Line2)))
  ) ;_ end setq
  (if
    (setq PtInters (inters PtStart1 PtEnd1 ptStart2 PtEnd2 nil))
     (progn
       (setvar "cecolor" "5")
       (command "_Line" PtStart1 PtInters ptStart2 "")
       (setvar "cecolor" "0")
     ) ;_ end progn
     (princ "\n***Пересечения нет!")
  ) ;_ end if
) ;_ end defun

Zouss · 15.04.2008, 16:53

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

Кулик Алексей aka kpblc · 15.04.2008, 16:57

Ну навскидку примерно так (без анализа попадания точки пересечения на один из отрезков):

Код:

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

(defun test (/ ent1 ent2 pt_int pt_lst adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if
    (and
      (=
        (type (setq
                ent1 (vl-catch-all-apply
                       '(lambda () (car (entsel "\nПервый отрезок <Отмена> : ")))
                       ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
        'ename
        ) ;_ end of =
      (= (cdr (assoc 0 (entget ent1))) "LINE")
      (=
        (type (setq
                ent2 (vl-catch-all-apply
                       '(lambda () (car (entsel "\nВторой отрезок <Отмена> : ")))
                       ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
        'ename
        ) ;_ end of =
      (= (cdr (assoc 0 (entget ent2))) "LINE")
      (not (equal ent1 ent2))
      (> (vlax-safearray-get-u-bound
           (vlax-variant-value
             (setq pt_int (vla-intersectwith
                            (setq ent1 (vlax-ename->vla-object ent1))
                            (setq ent2 (vlax-ename->vla-object ent2))
                            acextendboth
                            ) ;_ end of vla-intersectwith
                   ) ;_ end of setq
             ) ;_ end of vlax-variant-value
           1
           ) ;_ end of vlax-safearray-get-u-bound
         0
         ) ;_ end of >
      (setq pt_int (vlax-safearray->list (vlax-variant-value pt_int)))
      ) ;_ end of and
       (foreach pt
                (mapcar
                  '(lambda (x)
                     (vlax-safearray->list
                       (vlax-variant-value
                         (car
                           (vl-sort
                             (list (vla-get-startpoint x)
                                   (vla-get-endpoint x)
                                   ) ;_ end of list
                             '(lambda (a b)
                                (< (distance
                                     (vlax-safearray->list (vlax-variant-value a))
                                     pt_int
                                     ) ;_ end of distance
                                   (distance
                                     (vlax-safearray->list (vlax-variant-value b))
                                     pt_int
                                     ) ;_ end of distance
                                   ) ;_ end of <
                                ) ;_ end of lambda
                             ) ;_ end of vl-sort
                           ) ;_ end of car
                         ) ;_ end of vlax-variant-value
                       ) ;_ end of vlax-safearray->list
                     ) ;_ end of lambda
                  (list ent1 ent2)
                  ) ;_ end of mapcar
         (entmakex
           (list (cons 0 "LINE") (cons 10 pt) (cons 11 pt_int) (cons 62 5))
           ) ;_ end of entmakex
         ) ;_ end of foreach
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

P.S. Можно попробовать почти без vla- обойтись, но мне уже просто некогда переделывать код на нормальный вариант

---
Добавлено:
Во, второй вриант:

Код:

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

(defun test2 (/ ent1 ent2 pt_int pt_lst adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if
    (and
      (=
        (type (setq
                ent1 (vl-catch-all-apply
                       '(lambda () (car (entsel "\nПервый отрезок <Отмена> : ")))
                       ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
        'ename
        ) ;_ end of =
      (= (cdr (assoc 0 (entget ent1))) "LINE")
      (=
        (type (setq
                ent2 (vl-catch-all-apply
                       '(lambda () (car (entsel "\nВторой отрезок <Отмена> : ")))
                       ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
        'ename
        ) ;_ end of =
      (= (cdr (assoc 0 (entget ent2))) "LINE")
      (not (equal ent1 ent2))
      (> (vlax-safearray-get-u-bound
           (vlax-variant-value
             (setq pt_int (vla-intersectwith
                            (vlax-ename->vla-object ent1)
                            (vlax-ename->vla-object ent2)
                            acextendboth
                            ) ;_ end of vla-intersectwith
                   ) ;_ end of setq
             ) ;_ end of vlax-variant-value
           1
           ) ;_ end of vlax-safearray-get-u-bound
         0
         ) ;_ end of >
      (setq pt_int (vlax-safearray->list (vlax-variant-value pt_int)))
      ) ;_ end of and
     (progn
       (foreach pt
                   (mapcar
                     '(lambda (x)
                        (setq x (entget x))
                        (car
                          (vl-sort
                            (list (cdr (assoc 10 x))
                                  (cdr (assoc 11 x))
                                  ) ;_ end of list
                            '(lambda (a b)
                               (< (distance a pt_int)
                                  (distance b pt_int)
                                  ) ;_ end of <
                               ) ;_ end of lambda
                            ) ;_ end of vl-sort
                          ) ;_ end of car
                        ) ;_ end of lambda
                     (list ent1 ent2)
                     ) ;_ end of mapcar
         (entmakex
           (list (cons 0 "LINE") (cons 10 pt) (cons 11 pt_int) (cons 62 5))
           ) ;_ end of entmakex
         ) ;_ end of foreach
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Pastor · 15.04.2008, 17:06

Цитата:

Сами отрезки общих точек не имеют.
Нужно соединить отрезки линией, проходящей через точку пересечения отрезков.

Меня подобные несоответствия в текстах вопросов мгновенно вводят в ступор.
Господа! Как Вам удается улавливать суть вопроса и давать вразумительные ответы?

Mazai · 15.04.2008, 17:06

Во блин! Была привязка - она всё портила.
Как только её отключил - всё заработало так как и ожидалось.
подскажите пожалуйста в какой переменной записываеться значение привязки, что бы программно это отслеживать?

Mazai · 15.04.2008, 17:11

Цитата:

Сообщение от Pastor

Господа! Как Вам удается улавливать суть вопроса и давать вразумительные ответы?

Цитата:

Сообщение от Mazai

Отрезки расположены на прямых, у которых есть точка пересечения.

Я пытался всё написать более менее доходчиво.

Zouss · 15.04.2008, 17:12

OSMODE
Pastor, в какой-то книжке apparent intersection был переведен как "кажущееся пересечение", тоже повод усомниться в собственной адекватности

Елпанов Евгений · 15.04.2008, 17:42

без проверок типов...

Код:

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

(defun c:test (e1 e2 / i)
 ;;(c:test (car (entsel "\n первая линия"))(car (entsel "\n вторая линия")))
 (if (setq i (inters (vlax-curve-getStartPoint e1)
                     (vlax-curve-getEndPoint e1)
                     (vlax-curve-getStartPoint e2)
                     (vlax-curve-getEndPoint e2)
                     nil
             ) ;_  inters
     ) ;_  setq
  (progn (if (> (distance i (vlax-curve-getClosestPointTo e1 i)) 1e-8)
          (entmakex (list '(0 . "line")
                         '(62 . 1)
                         (cons 10 i)
                         (cons 11 (vlax-curve-getClosestPointTo e1 i))
                   ) ;_  list
          ) ;_  entmake
         ) ;_  if
         (if (> (distance i (vlax-curve-getClosestPointTo e2 i)) 1e-8)
          (entmakex (list '(0 . "line")
                         '(62 . 1)
                         (cons 10 i)
                         (cons 11 (vlax-curve-getClosestPointTo e2 i))
                   ) ;_  list
          ) ;_  entmake
         ) ;_  if
  ) ;_  progn
  (alert "Линии не имеют пересечений  :(  ")
 ) ;_  if
 (princ)
)

Александр Ривилис · 15.04.2008, 18:55

Цитата:

Сообщение от Mazai

Во блин! Была привязка - она всё портила.
Как только её отключил - всё заработало так как и ожидалось.
подскажите пожалуйста в какой переменной записываеться значение привязки, что бы программно это отслеживать?

Не вдаваясь в стиль программирования. Замени (command "_Line" PtStart1 PtInters ptStart2 "") на (command "_Line" "_none" PtStart1 "_none" PtInters "_none" ptStart2 "")

VVA · 15.04.2008, 18:56

Чтобы не зависеть от OSMODE и не накликать гнев пользователей ее обнулением, можно обойтись так

Код:

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

 
(command "_Line" "_non" PtStart1 "_non" PtInters "_non" ptStart2 "")

Елпанов Евгений · 15.04.2008, 19:03

Александр Ривилис, VVA, Вы сговорились, одновременно ответить?

Mazai · 16.04.2008, 08:22

Всем спасибо! Разобрался!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Помогите создать линию в автокаде.	tuguz	AutoCAD	4	14.12.2007 03:27
Нужен лисп, рисующий линию заданной длины	ВоваН	LISP	3	19.06.2006 21:43
как создать винтовую линию в ProEngineer	Yujin	Прочее. Программное обеспечение	2	07.04.2006 03:02
При рендере объекта дуга превращается в ломаную линию	!!!DEN!!!	AutoCAD	4	28.03.2006 12:03
Как на LISPе автоматически выбрать линию и точку?	Mikhail	LISP	4	28.10.2003 10:33

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск