[Mozgunov]

Как при помощи автолиспа получить массив точек пересечения двух полилиний? Собственно заголовок и являяется вопросом. Подскажите хотя бы напрвление в котором нужно искать. Спасибо!

[Дима_]

Держи:

Код:

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

(defun intersect (obj1 obj2 / tmp x y)
(setq tmp 
(vlax-variant-value (apply 'vla-intersectwith
(reverse (cons acExtendNone (mapcar 'vlax-ename->vla-object (list obj1 obj2)))))))
(if (> (vlax-safearray-get-u-bound tmp 1) 0)
(vl-remove nil (mapcar '(lambda (z / ret) 
(if y (setq ret (list x y z) x nil y nil) (if x (setq y z) (setq x z))) ret) 
(vlax-safearray->list tmp)))
);end of if
);end of intersect

пример: (intersect (entlast) (entnext))

[Юта]

А как получить точки пересечения одной полилинии, указанной юзером (находящейся неважно в каком слое) и других линий (полилиний), находящихся в слое "triangulate"?

[Кулик Алексей aka kpblc]

Код:

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

(defun get-intersections (/                              _kpblc-list-dublicates-remove  _kpblc-conv-selset-to-ename
                          _kpblc-conv-list-to-3dpoints   _kpblc-conv-ent-to-ename       _kpblc-conv-ent-to-vla
                          _kpblc-conv-vla-to-list        selset1                        selset2
                          )

  (defun _kpblc-list-dublicates-remove (lst / result)
                                       ;|
*    Функция исключения дубликатов элементов списка 
*    Параметры вызова:
*	lst	обрабатываемый список
*    Возвращаемое значение: список без дубликатов соседних элементов
*    Примеры вызова:
(_kpblc-list-dublicates-remove '((0.0 0.0 0.0) (10.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0)) nil)
((0.0 0.0 0.0) (10.0 0.0 0.0) (0.0 0.0 0.0))
|;
    (foreach x lst
      (if (not (member x result))
        (setq result (cons x result))
        ) ;_ end of if
      ) ;_ end of foreach
    (reverse result)
    ) ;_ end of defun

  (defun _kpblc-conv-selset-to-ename (selset / tab item)
                                     ;|
*    Преобразование набора, полученного через ssget, в список ename-представлени
* примитивов.
*    Параметры вызова:
	selset	набор примитивов
*    Примеры вызова:
(_kpblc-conv-selset-to-ename (ssget))
|;
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((= (type selset) 'vla-object)
       (_kpblc-conv-vla-to-list selset)
       )
      ((listp selset) selset)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
                                      ;|
*    Функция конвертации списка чисел в список 3-мерных точек.
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             (if (caddr lst)
                               (caddr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-3dpoints (cdddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-ename (ent_value /)
                                  ;|
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в примитив. Может
*			быть именем примитива, vla-указателем или просто
*			списком.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-ename (entlast))
(_kpblc-conv-ent-to-ename (vlax-ename->vla-object (entlast)))
|;
    (cond
      ((= (type ent_value) 'vla-object)
       (vlax-vla-object->ename ent_value)
       )
      ((= (type ent_value) 'ename) ent_value)
      ((= (type ent_value) 'str) (handent ent_value))
      ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-vla (ent_value / res)
                                ;|
*    Функция преобразования полученного значения в vla-указатель.
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в указатель. Может
*			быть именем примитива, vla-указателем или просто
*			списком.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-vla (entlast))
(_kpblc-conv-ent-to-vla (vlax-ename->vla-object (entlast)))
|;
    (cond
      ((= (type ent_value) 'vla-object) ent_value)
      ((= (type ent_value) 'ename) (vlax-ename->vla-object ent_value))
      ((setq res (_kpblc-conv-ent-to-ename ent_value))
       (vlax-ename->vla-object res)
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((listp value)
       (mapcar '_kpblc-conv-vla-to-list value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (member (type value) (list 'ename 'str 'vla-object))
            (setq value (_kpblc-conv-ent-to-vla value))
            (and (= (type value) 'vla-object)
                 (vlax-property-available-p value 'count)
                 ) ;_ end of and
            ) ;_ end of and
       (vlax-for sub (_kpblc-conv-ent-to-vla value)
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (if (and (= (type (setq selset1 (vl-catch-all-apply
                                    (function
                                      (lambda ()
                                        (ssget)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           (= (type (setq selset2 (vl-catch-all-apply
                                    (function
                                      (lambda ()
                                        (ssget)
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           ) ;_ end of and
    (progn
      (foreach item (mapcar (function vlax-ename->vla-object) (_kpblc-conv-selset-to-ename selset1))
        (foreach sub (mapcar (function vlax-ename->vla-object) (_kpblc-conv-selset-to-ename selset2))
          (setq res (append res
                            (_kpblc-conv-list-to-3dpoints
                              (_kpblc-conv-vla-to-list
                                (vla-intersectwith item sub acextendnone)
                                ) ;_ end of _kpblc-conv-vla-to-list
                              ) ;_ end of _kpblc-conv-list-to-3dpoints
                            ) ;_ end of append
                ) ;_ end of setq
          ) ;_ end of foreach
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (_kpblc-list-dublicates-remove res)
  ) ;_ end of defun

[Юта]

Спасибо! Буду пробовать.
Поражаюсь быстроте написания кода!!!
___
Проверила. Не работает
после указания полилинии программа выдает "nil"

[Victor]

У неё же там не полилинии а фэйсы какие-то.
А потом она скажет точки надо бы по высоте проинтерполировать.
А потом скажет а нехило бы их подписать текстами.

[Кулик Алексей aka kpblc]

Юта, я проверял на полилиниях, гарантированно пересекающихся. Работало. Короче, образец в студию.
Victor, а такие "хотелки" уже, как говорится, "за отдельную плату"

[Юта]

В файле по точкам, имеющим разную высоту (имитирующим съемку рельефа) построены типа триангуляционные линии (желтым цветом).
Надо проставить точки на пересечениях этих линий и одной из линий белого цвета, по моему выбору. Причем эти точки должны иметь координату Z такую же, как на линиях "triangulate" в местах пересечения.

Victor, у блондинок не фейсы, а формы. Это раз.
Во-вторых, интерполировать не надо, уже есть программка, спасибо гуру от автокада.
И в-третьих, а что, "жаба давит" поделиться кодом, если просят?
(прошу принять эти претензии с улыбкой. Типа я совсем не обиделась).

[Кулик Алексей aka kpblc]

Код проверяет истинное, а не "кажущееся" пересечение. У тебя в файле полилинии лежат на разных уровнях - вот и все. При таких условиях надо предварительно "плющить" чертеж (кстати, для какой системы координат?), вычислять точки пересечений, потом вычислять ближайшую проекцию этой точки на нужную (кстати, как ее определить?) полилинию/кривую и добавлять в результат. Долго, муторно, и без гарантий корректности работы. Подобное я как-то делал на cadtutor.net, но искать и модифицировать сейчас нет возможности.

[Юта]

Но вручную-то точки ставятся без проблем. И на нужную высоту.

[Кулик Алексей aka kpblc]

Прааально. В режиме "кажущегося пересечения".

[Victor]

Э-ээ. Я как бы не о ваших формах а о вашем файле "Котлован". Там не полилинии а 3D face.

[Дима_]

То Юта, что-бы сделать то что Вы хотите, надо - написать процедуру нахождения кажущегося пересечения двух линий (аналог inters), но с учетом вектора просмотра, ну или хотя-бы по вектору '(0 0 1) - то есть ограничиться просмотром сверху в мировой системе координат - что вобщем не сложно. После нахождения этой точки ее еще надо спроецировать на линию, пот тем-же вектором просмотра - что тоже в общем не сложно в случае с просмотром сверху '(0 0 1) и плоским рассположением координат линии (z pt1 = z pt2), но с произвольным углом как просмотра, так и линии в пространстве "процедурка" в принципе не очень большая - но на все проверки день убить надо, а так как еще ясно, что после этого еще что-то понадобиться - возиться с этим просто лень. Хотели-же в паралельном посте изучать лисп - вот отличный пример, заодно и пространственное мышление оживите, ну а если, что конкретное не получаеться, либо не понятно как делать - то сюда - подскажем.

[Юта]

Victor, да поняла я всё. Просто скаламбурила.
Дима_, Кулик Алексей, спасибо за разъяснение. Видимо придется потренироваться в создании 3D модели. Такие коды пока мне не под силу.

[Дима_]

Вам понадобяться (как минимум) разобраться с dxf кодами полилиний и 3d face и понять принцип работы (inters...) и (trans...), да и вобще что такое единичный вектор направления.

[Mozgunov]

Алексей, Дмитрий Спасибо за коды. Дмитрий не получилось воспользоваться кодом. Что я неправильно делаю?

Код:

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

(defun intersect (obj1 obj2 / tmp x y)
(setq tmp 
(vlax-variant-value (apply 'vla-intersectwith
(reverse (cons acExtendNone (mapcar 'vlax-ename->vla-object (list obj1 obj2)))))))
(if (> (vlax-safearray-get-u-bound tmp 1) 0)
(vl-remove nil (mapcar '(lambda (z / ret) 
(if y (setq ret (list x y z) x nil y nil) (if x (setq y z) (setq x z))) ret) 
(vlax-safearray->list tmp)))
);end of if
);end of intersect

(setq obj1 (entsel "Укажите объект") )
(setq obj2 (entsel "Укажите объект") )

(intersect (obj1) (obj2))

скобочки убрал всё равно не помогает ( (obj1) (obj2)

[VVA]

Mozgunov,

Код:

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

(setq obj1 (car(entsel "Укажите объект")))
(setq obj2 (car(entsel "Укажите объект")))
(intersect obj1 obj2)

*Добавлено*
Здесь найдешь очень много полезных функций.
В том числе и

VxGetInters - Returns all intersection points between two objects VxGetBlockInters-Returns all intersection points between a block and an object

[Mozgunov]

VVA, попробовал сделать так как вы говорите, всё равно не работает:no function definition: nil

[Дима_]

попробуй вести перед запуском (vl-load-com)
p.s. Да и вообще отучайтесь в лиспе от лишних переменных

Код:

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

(intersect (car (entsel)) (car (entsel)))

[Mozgunov]

Код:

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

(vl-load-com)
(defun intersect (obj1 obj2 / tmp x y)
(setq tmp 
(vlax-variant-value (apply 'vla-intersectwith
(reverse (cons acExtendNone (mapcar 'vlax-ename->vla-object (list obj1 obj2)))))))
(if (> (vlax-safearray-get-u-bound tmp 1) 0)
(vl-remove nil (mapcar '(lambda (z / ret) 
(if y (setq ret (list x y z) x nil y nil) (if x (setq y z) (setq x z))) ret) 
(vlax-safearray->list tmp)))
);end of if
);end of intersect

(setq obj1 (car(entsel "Укажите объект")))
(setq obj2 (car(entsel "Укажите объект")))
(intersect obj1 obj2)

Всё равно не получается.