Команда inters или подобная

Команда inters или подобная · 09.09.2010, 15:31

Есть такая штука, как inters, находит точку пересечения двух линий, НО у этих двух линий нужно знать точки начала и конца, а как найти точку пересечения, если я пущу линию из точки и буду знать точки начала и конца только одного отрезка...а какой она пересечет второй понятия не имею, но хочу узнать. Как быть? Помогите!

Ну хоть скажите можно так сделать или нет?

CB · 10.09.2010, 13:30

Только для линий...

Код:

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

(defun test (/ pt10 ang pt11 sset int_out)
  (if (and
        (setq pt10 (getpoint "\nBase point : "))
        (setq ang (getangle pt10 "\nAngle : "))
        (setq pt11 (polar pt10 ang 10.))
        (setq sset (ssget "_X" '((0 . "LINE"))))
      ) ;_ end of and
    (foreach x
               (vl-remove-if
                 'listp
                 (mapcar (function cadr)
                         (ssnamex sset)
                 ) ;_ end of mapcar
               ) ;_ end of vl-remove-if
      ((lambda (pt / p1 p2 int)
         (setq p1  (cdr (assoc '10 pt))
               p2  (cdr (assoc '11 pt))
               int (inters pt10 pt11 p1 p2 nil)
         ) ;_ end of setq
         (if
           (equal (+ (distance int p1) (distance int p2))
                  (distance p1 p2)
                  1e-6
           ) ;_ end of equal
            (if int_out
              (if
                (< (distance pt10 int)
                   (distance pt10 int_out)
                ) ;_ end of <
                 (setq int_out int)
              ) ;_ end of if
              (setq int_out int)
            ) ;_ end of if
         ) ;_ end of if
       ) ;_ end of lambda
        (entget x)
      )
    ) ;_ end of foreach
  ) ;_ end of if
      int_out
) ;_ end of defun
;;;вызов -> (test)

Zaghim · 10.09.2010, 13:34

Почему-то не работает все равно с экстендом((( рисует линию, все выбирает, а потом все стирается и ничего не происходит)

CB, круто - работает!!! А с полилинией никак?

Do$ · 10.09.2010, 15:01

А с полилинией надо через vla- и vlax-

Zaghim · 10.09.2010, 15:23

А можно пример? Влисп вообще не бум-бум)

Do$ · 10.09.2010, 17:09

Набросал на скорую руку, так что за корректную работу во всех случаях не ручаюсь.

Код:

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

;;http://elpanov.com/
(defun rec_lst_3d (lst)
  (if lst
    (cons
      (list
    (car lst)
    (cadr lst)
    (caddr lst)
      ) ;_  list
      (rec_lst_3d (cdddr lst))
    ) ;_  cons
  ) ;_  if
) ;_  defun
 
 
(defun get-nearest-pline-for-direction (base_point
                    direct_point
                    /
                    ang
                    obj
                    sset
                    pt_out
                    int
                    bnd
                    pt_lst
                    pt_tmp
                       )
  (vl-load-com)
  (if (and
    (setq ang (angle base_point direct_point))
    (setq obj (vlax-ename->vla-object
            (entmakex
              (list '(0 . "LINE")
                (cons 10 base_point)
                (cons 11 direct_point)
              ) ;_ end of list
            ) ;_ end of entmakex
          ) ;_ end of vlax-ename->vla-object
    ) ;_ end of setq
    (setq sset (ssget "_X" '((0 . "*POLYLINE"))))
      ) ;_ end of and
    (foreach x
           (mapcar 'vlax-ename->vla-object
               (vl-remove-if
             'listp
             (mapcar (function cadr)
                 (ssnamex sset)
             ) ;_ end of mapcar
               ) ;_ end of vl-remove-if
           ) ;_ end of mapcar
      (setq int (vla-IntersectWith obj x acExtendThisEntity))
      (setq
    bnd (vlax-safearray-get-u-bound (vlax-variant-value int) 1)
      ) ;_ end of setq
      (if (/= bnd -1)
    (if
      (setq    pt_lst
         (vl-remove-if-not
           '(lambda (pt) (equal (angle base_point pt) ang 1.0e-008))
           (rec_lst_3d
             (vlax-safearray->list (vlax-variant-value int))
           ) ;_ end of rec_lst_3d
         ) ;_ end of vl-remove-if-not
      ) ;_ end of setq
       (progn
         (setq pt_tmp
            (car (vl-sort
               pt_lst
               '(lambda (pt1 pt2)
                  (< (distance pt1 base_point)
                 (distance pt2 base_point)
                  ) ;_ end of <
                ) ;_ end of lambda
             ) ;_ end of vl-sort
            ) ;_ end of car
         ) ;_ end of setq
         (if (or (not pt_out)
             (>    (distance base_point pt_out)
            (distance base_point pt_tmp)
             ) ;_ end of >
         ) ;_ end of or
           (setq pt_out (vl-symbol-value 'pt_tmp))
         ) ;_ end of if
       ) ;_ end of progn
    ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of foreach
  ) ;_ end of if
  (vla-delete obj)
  pt_out
) ;_ end of defun
 
(defun c:test (/ pt)
 
  (setq pt (trans (getpoint "\nBase point : ") 1 0))
  (if
    (setq pt1 (get-nearest-pline-for-direction
        pt
        (trans (getpoint pt "\nDirection point:") 1 0)
          ) ;_ end of get-nearest-pline-for-direction
    ) ;_ end of setq
     (entmakex
       (list '(0 . "LINE")
         (cons 10 pt)
         (cons 11 pt1)
       ) ;_ end of list
     ) ;_ end of entmakex
     (alert "Не пересекает полилинию!")
  ) ;_ end of if
) ;_ end of defun

Zaghim · 10.09.2010, 17:20

Я так понял она по завершении дает не координату а сразу имя примитива с которым пересеклась?

Почему-то она игнорирует такую линию (см. приложение).

Понял почему так. У нее задан параметр Elevation, если его выставить в 0, то пересекает. Блин такой гимор, потому что этот Elevation не будет нулевым. А еще есть 3дполилинии у них тоже координата Z присутствует

TararykovDG · 10.09.2010, 21:44

Zaghim, на Вашем же примере 1.dwg конструкция с extendом отработала нормально, и не нужно думать про Elevation и 3dполилинии. Попробуйте не всю конструкцию сразу, а поочередно ввести в ком. строке
все команды и скажите когда именно происходит ошибка? Лично у меня все работает

Disney · 11.09.2010, 12:10

По-моему, всё гораздо проще

Код:

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

(defun inter (t1 ang dist / ss)
  (If (setq
	ss (ssget "_F" (list t1 (polar t1 ang dist)))
      )
    (cadr (cadddr (car (ssnamex ss))))
  )
)

Код:

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

(defun c:test (/ t1 t2)
  (entmakex (list (cons 0 "POINT")
		  (cons	10
			(inter (setq
				 t1 (getpoint)
			       )
			       (angle t1 (setq t2 (getpoint t1)))
			       (distance t1 t2)
			)
		  )
	    )
  )
)

[IMG]http://s003.***********/i202/1009/0d/9e854494c630.gif[/IMG]

CB · 14.09.2010, 13:49

Цитата:

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

А с полилинией никак?

Теперь и для полилиний...
В выходном списке - имя пересекаемого объекта + точка пересечения:

Код:

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

(defun test (/ pt10 ang pt11 sset int_out base_line)
  (if (and
        (setq pt10 (getpoint "\nBase point : "))
        (setq ang (getangle pt10 "\nAngle : "))
        (setq pt11 (polar pt10 ang 10.))
        (setq sset (ssget "_X" '((0 . "*LINE"))))
      ) ;_ end of and
    (progn
      (vla-put-visible
        (setq base_line (vlax-ename->vla-object
                          (entmakex
                            (list '(0 . "LINE")
                                  (cons 10 pt10)
                                  (cons 11 pt11)
                            ) ;_ end of list
                          ) ;_ end of entmakex
                        ) ;_ end of vlax-ename->vla-object
        ) ;_ end of setq
        :vlax-false
      ) ;_ end of vla-put-visible
      (foreach item
                    (vl-remove-if
                      'listp
                      (mapcar (function cadr)
                              (ssnamex sset)
                      ) ;_ end of mapcar
                    ) ;_ end of vl-remove-if
        ((lambda (vla-name / int)
           (setq int_in
                  (vl-catch-all-apply
                    (function
                      (lambda ()
                        (vlax-safearray->list
                          (vlax-variant-value
                            (vla-IntersectWith
                              base_line
                              vla-name
                              acExtendBoth
                            ) ;_ end of vla-IntersectWith
                          ) ;_ end of vlax-variant-value
                        ) ;_ end of vlax-safearray->list
                      ) ;_ end of lambda
                    ) ;_ end of function
                  ) ;_ end of vl-catch-all-apply
           ) ;_ end of setq
           (if (not (vl-catch-all-error-p int_in))
             (while int_in
               (setq int    (list (car int_in)
                                  (cadr int_in)
                                  (caddr int_in)
                            ) ;_ end of list
                     int_in (cdddr int_in)
               ) ;_ end of setq
               (if
                 (vlax-curve-getParamAtPoint vla-name int)
                  (if (or (not int_out)
                          (< (distance pt10 int)
                             (distance pt10 (cadr int_out))
                          ) ;_ end of <
                      ) ;_ end of or
                    (setq int_out (list item int))
                  ) ;_ end of if
               ) ;_ end of if
             ) ;_ end of while
           ) ;_ end of if
         ) ;_ end of lambda
          (vlax-ename->vla-object item)
        )
      ) ;_ end of foreach
    ) ;_ end of progn
  ) ;_ end of if
  (vla-delete base_line)
  int_out
) ;_ end of defun

Zaghim · 14.09.2010, 15:59

А то, что выше, вам не нравится?
Т.е. этот код дает пересечение ТОЛЬКО с плинией? Если на его пути попадется обычная линия или текст - он с ней пересечется?

CB · 14.09.2010, 16:48

А что, сложно проверить? Я же написал

Цитата:

Теперь и для полилиний...

т.е для LINE, POLYLINE и SPLINE.

Disney · 15.09.2010, 09:02

Цитата:

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

Если на его пути попадется обычная текст - он с ней пересечется?

[IMG]http://s002.***********/i200/1009/35/7d6c71593604.gif[/IMG]

CB · 15.09.2010, 10:27

Цитата:

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

[IMG]http://s002.***********/i200/1009/35/7d6c71593604.gif[/IMG]

Да ничего прикольного нет - пересечение существует, правда не чисто с текстом, а с его boundingbox'ом, т.е. обрамляющей текст рамкой...

Do$ · 15.09.2010, 10:57

Цитата:

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

[IMG]http://s002.***********/i200/1009/35/7d6c71593604.gif[/IMG]

Disney

Один минус - ищется именно реальное пересечение, в отличие от остальных представленных в теме кодов.

Цитата:

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

Да ничего прикольного нет - пересечение существует, правда не чисто с текстом, а с его boundingbox'ом, т.е. обрамляющей текст рамкой...

А вложенный ролик посмотреть?

Disney · 15.09.2010, 11:14

Цитата:

Сообщение от Do$

Один минус - ищется именно реальное пересечение, в отличие от остальных представленных в теме кодов.

С текстом - да, минус (но может кому-нибудь когда-нибудь и такое пересечение пригодиться), а вот с остальными примитивами вроде нормальные пересечения.

Do$ · 15.09.2010, 12:16

Не, ты не понял... Указываем 2 точки: начальную и конечную. Твой код ищет пересечение этого отрезка с примитивом между начальной и конечной точкой. А СВ и я искали точку пересечения на продолжении этого отрезка, то есть пересечение луча с примитивом чертежа.
А чего хотел Zaghim - одному ему известно

CB · 15.09.2010, 15:50

Цитата:

Сообщение от Do$

А вложенный ролик посмотреть?

Действительно прикольно, не досмотрел ролик...

gomer · 15.09.2010, 19:42

хи-хи, пересечение "е" в одном месте... Должно быть как минимум 3

Zaghim · 16.09.2010, 09:23

Do$: Зажим хотел то, что сделал Disney... конечно, в идеале, было бы круто, если бы по такой же схеме, но выбирались только п-линия и 3д-п-линия. А так пришлось просто заморозить quickselect'ом все лишнее, но это не заняло много времени...

Do$ · 16.09.2010, 09:57

Нужны только полилинии - добавь фильтр в ssget в функции inter из поста #28.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива	Profan	Готовые программы	272	06.06.2021 23:12
Печать из модели по выбору объекта	zenon	Программирование	192	04.05.2017 09:41
Преобразование полей в текст	YuraVel	AutoCAD	17	14.04.2015 14:30
ACAD-2002. Глюк начальной загрузки ЛИСП?	===AAA===	LISP	27	31.08.2005 07:58

09.09.2010, 15:31
Команда inters или подобная Zaghim Регистрация: 01.07.2010 Сообщений: 521 Есть такая штука, как inters, находит точку пересечения двух линий, НО у этих двух линий нужно знать точки начала и конца, а как найти точку пересечения, если я пущу линию из точки и буду знать точки начала и конца только одного отрезка...а какой она пересечет второй понятия не имею, но хочу узнать. Как быть? Помогите! Ну хоть скажите можно так сделать или нет? Последний раз редактировалось Zaghim, 09.09.2010 в 16:14.
Просмотров: 8060