[viequt]

Добрый день.

Подскажите как получить имя примитива указанием точки внутри контура замкнутой непересекающейся плоской полилинии с прямолинейными сегментами (для выпуклых и невыпуклых многоугольников).

Пока решение вижу преобразовать все необходимые многоугольники в области и в визуальном стиле отличном от 2D или каркас, выделить ssget`ом после getpoint`а.

Может есть способ "попрямее"?

[VVA]

Смотри команды _BOUNDARY и _BPOLY (для лиспа есть функция bpoly)

Код:

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

(defun C:bp ( / gp e )
(setq gp (getpoint "\nSelect point within boundary: "))
(if (setq e (bpoly gp))
  (alert "Countour created")
  (alert "Countour NOT created")
  )
  (princ)
)

Использование BOUNDARY можно глянуть здесь
LISP. Отрисовка внешнего контура выбранных объектов
to find each closed boundary of selected object
Outline Objects

[viequt]

Сообщение от VVA Смотри команды _BOUNDARY и _BPOLY (для лиспа есть функция bpoly)

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

Имеется массив примыкающих друг к другу сторонами многоугольников(пусть квадраты). Задача такая: кликом в центре многоугольника (полилинии) извлекать его имя, в месте клика добавить текст, затем следует проход по всем сторонам многоугольника, если у стороны нет расширенных данных (РД), тогда если к стороне ничего не примыкает записать 0 в РД, если к стороне примыкает сторона другого многоугольника записать 1 по текущей стороне в РД первой поли и 2 в РД по смежной стороне во второй поли.
Программа проходит по всем сторонам с этим условием. После цикла прописываем в РД флаг редактирования + имя (ранее вставленный текст).
Далее кликаем следующий многоугольник (не обязательно смежный) проверяем флаг редактирования, если ранее редактированное алерт, если нет вставляем текст с префиксом указанным в начале программы и с прогрессией и проходим по сторонам...
Завершение программы при запросе n-ой точки.

Так вот как найти имя многоугольника внутри которого жмакнули.

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

[skkkk]

В свое время передо мной встала аналогичная задача. Первая мысль была именно такая:

Сообщение от viequt нужно найти первое пересечение от точки в любую сторону

и из тех же соображений

Сообщение от viequt но это же пересечение возьмёт в набор и смежный многоугольник

отмелась. Лениво мне как-то стало такие обработки производить, и нашел я, кажется, тут на форуме функцию, не помню, к моему сожалению, кто автор, и при беглом поиске найти повторно ее не смог, т.к. похоже я ее переименовал в понятное мне имя и, возможно слегка переделал под свои нужды. Нет! Таки нашел!! Автор, как я и думал, разумеется VVA, и лежит она тут. (Заколебался я ее переделывать - добавил два аргумента и две точки с запятой ) Вот эта функция (вместе с вспомогательными):

Код:

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

 ;;; Функция проверяет, лежит ли точка внутри контура. 
;;; аргументы:
;;; 	e1 - контур - замкнутая полилиния (ENAME)
;;; 	pt1 - проверяемая на принадлежность контуру точка (LIST of REAL)
(defun IsPtInContour (e1 pt1 / pt2 pt3 ang)
  (vl-load-com)
  (and
    ; (setq e1 (car(entsel "\nВыбери полилинию-контур: "))) 
    ; (setq pt1 (getpoint "\nУкажи точку (не на контуре): "))
    (setq pt2 (vlax-curve-getclosestpointto e1 pt1)) ;_ см п.2 пост #20
    (setq pt3 (vlax-curve-getFirstDeriv e1 (vlax-curve-getParamAtPoint e1 pt2)));_ см п.3 пост #20
    (setq pt1 (mapcar '- pt1 pt2))
    (setq ang (3d_Wnorm pt1 pt3)) ;_ см п.4 пост #20
    (if (lib:pline_clockwise e1) ;;; если контур по часовой стрелке
      (progn
        ;;;Если бы точка была снаружи, то угол был бы отрицательным
        (if (minusp (last ang))
          nil
          T
        )
      )
      (progn  ;;; если контур против часовой стрелки
        (if (minusp (last ang))
          T
          nil
          )
        )
      )
    )
  )

;********************************
; Векторное произведение векторов
;********************************
; W1, W2 - вектора
; Возвращает: вектор нормали к плоскости заданной векторами  в правой системе координат.
;W1 и W2 не должны лежать на одной прямой).
(defun 3d_Wnorm (W1 W2)
  (if (< (length W1) 3)(setq W1 (list (car W1)(cadr W1) 0)))
  (if (< (length W2) 3)(setq W2 (list (car W2)(cadr W2) 0)))
  (list (- (* (cadr W1)(caddr W2))(* (caddr W1)(cadr W2)))
        (- (* (caddr W1)(car W2)) (* (car W1)(caddr W2)))(- (* (car W1)(cadr W2)) (* (cadr W1)(car W2)))))


(defun lib:pline_clockwise ( lw  / LST MAXP MINP)
;;;Eugeni Elpanov
;;; Arguments
;;;         lw - ename or vla object of polyline
;;; Return
;;;     t - clockwise
;;;    nil - counter-clockwise
  
(if (= (type lw) 'ENAME)
    (setq lw (vlax-ename->vla-object lw)))  
(vla-GetBoundingBox lw 'MinP 'MaxP)
(setq
minp(vlax-safearray->list minp)
MaxP(vlax-safearray->list MaxP)
lst(mapcar(function(lambda(x)
(vlax-curve-getParamAtPoint lw
(vlax-curve-getClosestPointTo lw x))))
(list minp(list(car minp)(cadr MaxP))
MaxP(list(car MaxP)(cadr minp)))))
(if(or
(<=(car lst)(cadr lst)(caddr lst)(cadddr lst))
(<=(cadr lst)(caddr lst)(cadddr lst)(car lst))
(<=(caddr lst)(cadddr lst)(car lst)(cadr lst))
(<=(cadddr lst)(car lst)(cadr lst)(caddr lst))) t nil))

Далее я осуществлял запрос точки и в цикле подставлял ее в эту функцию, перебирая все замкнутые полилинии нужного слоя. Примерно так (без обертки в defun и различных проверок и обработок ошибок):

Код:

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

 (setq pt (getpoint)
	  ss (ssget "_X" '((0 . "LWPOLYLINE")(8 . "Имя_слоя"))) ; тут можно добавить и другие условия, например замкнутость полилинии
	  i 0 ; счетчик примитивов в наборе
)
(while (and (setq en (ssname ss i))(null (IsPtInContour en pt))) ; пока есть примитивы в наборе, и точка не лежит внутри какого-то из них
	(setq i (1+ i)) ; продолжаем цикл, подставляя примитив в функцию 
)
(if (and en (IsPtInContour en pt)) ; если по завершении цикла у нас есть примитив и точка лежит внутри него,
	; (тут задаем программе нужную последовательность действий, например, создаем текст в указанной точке pt...) 
	(princ "\nТочка не лежит внутри ни одного из выбранных контуров"))
)

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

[nolte]

Я пользуюсь следующим способом:
Кликаю внутри полигона, замкнутой полилинии, затем из точки клика вычерчиваю луч или если мах размер известен, то отрезок.
Для всех искомых полигонов, полигоны на соответствующих слоях или еще какой нибудь признак, нахожу точки пересечения.
Тот полигон у которого нечетное количество точек пересечения есть полигон внутри которого я кликнул.
Удаляю примитив луч.

[viequt]

Сообщение от nolte Я пользуюсь следующим способом: Тот полигон у которого нечетное количество точек пересечения есть полигон внутри которого я кликнул.

А не будет ошибочного срабатывания если луч пересечёт вершину другого многоугольника?

Сообщение от skkkk Далее я осуществлял запрос точки и в цикле подставлял ее в эту функцию

Что-то у меня некорректно определяется полилиния - при клике внутри одного контура (треугольник) возращает разные имена. Отдельно проверил функцию определения направления обхода, не всегда возвращает корректное направление.


Вот что у меня получилось с пересечением лучом (сразу извиняюсь за паршивый штиль, танцую как могу):

Код:

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

 
(defun c:markas (/ lin ssfas pt i en)
  (vl-load-com)
  (setq pt (getpoint "Укажите точку: "))
  (setq ssfas (ssget "_F" (list pt (mapcar '+ pt '(0 10000 0)))))
  (command "_line" pt (mapcar '+ pt '(0 10000 0)) "")
  (setq lin (vlax-ename->vla-object (entlast)))
  (setq i 0)
  (while (and (setq en (vlax-ename->vla-object (ssname ssfas i))) (> (length (MeGetInters en lin 0)) 1))
      (setq i (1+ i))
    )
  (vla-delete lin)
  (princ en) ;для проверки
  (princ)
  )


; -- Function MeGetInters
; Returns all intersection points between two objects.
; Copyright:
;   ©2000 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
;   Fst = First object [VLA-OBJECT]
;   Nxt = Second object [VLA-OBJECT]
;   Mde = Intersection mode [INT]
;         Constants:
;         - acExtendNone           Does not extend either object.
;         - acExtendThisEntity     Extends the Fst object.
;         - acExtendOtherEntity    Extends the Nxt object.
;         - acExtendBoth           Extends both objects.
; Return [Type]:
;   > List of points '((1.0 1.0 0.0)...[list]
;   > Nil if no intersection found
; Notes:
;   - None
; 
(defun MeGetInters (Fst Nxt Mde / IntLst PntLst)
 (setq IntLst (vlax-invoke Fst 'IntersectWith Nxt Mde))
 (cond
  (IntLst
   (repeat (/ (length IntLst) 3)
    (setq PntLst (cons
                  (list
                   (car IntLst)
                   (cadr IntLst)
                   (caddr IntLst)
                  )
                  PntLst
                 )
          IntLst (cdddr IntLst)
    )
   )
   (reverse PntLst)
  )
  (T nil)
 )
)

[nolte]

Сообщение от viequt сразу извиняюсь за паршивый штиль, танцую как могу

я тоже не профессор сори

Код:

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

 
(defun pol (p / tmp_obj lst mm)
(setq lst(list 100000000))
(setq tmp_obj
	(vla-addray (vla-get-modelspace (vla-get-activedocument(vlax-get-acad-object)))
		(vlax-3d-point p)
		(vlax-3d-point(subst (1+ (cadr p))(cadr p) p))
	)
)
(mapcar '(lambda(a / mm)
					(if(eq(vla-get-closed a) :vlax-true)
						(if
							(not
								(eq
									(vlax-safearray-get-u-bound
										(setq mm(vlax-variant-value (vla-intersectwith tmp_obj a acExtendNone)))
										1
									)
									'-1
								)
							)
							(if(not(zerop(rem(length(setq mm(l-lst-to-lst-3-coor(vlax-safearray->list mm)))) 2)))
								(if lst
									(if(>(car lst)(distance p (car mm)))
										(setq lst(list (distance p (car mm)) a))
									)
								)
							)
						)
					)
				)
	(mapcar 'vlax-ename->vla-object(l-conv-set-to-lst(ssget "_X" (list(cons 0 "*POLYLINE")))))
)
(vla-delete tmp_obj)
(cadr lst)
)

(defun L-conv-set-to-lst (n / i lst)
(if n
	(repeat (setq i (sslength n))
		(setq lst (cons (ssname n (setq i (1- i))) lst))
	)
	nil
)
)

(defun l-lst-to-lst-3-coor (lst / l2)
(while lst
	(setq l2 (cons (list(car lst)(cadr lst)(caddr lst)) l2))
	(setq lst(cdddr lst))
)
(reverse l2)
)

пробуй

[VVA]

Сообщение от viequt Вот что у меня получилось с пересечением лучом

Еще один вариант алгоритма по ссыле skkkk

[skkkk]

Сообщение от viequt Что-то у меня некорректно определяется полилиния - при клике внутри одного контура (треугольник) возращает разные имена. Отдельно проверил функцию определения направления обхода, не всегда возвращает корректное направление.

Я не вникал в суть работы кода, но точно помню, что у меня работало безотказно. Однако у меня искомые контуры не имели общих точек. Хотя смутно могу представить себе, чем могут помешать общие точки, т.к. контуры обрабатываются по очереди независимо друг от друга.

----- добавлено через ~57 мин. -----

Сообщение от VVA Еще один вариант алгоритма по ссыле skkkk

Думается мне, что это чуть ли не самый надежный способ, но имеет несколько нюансов. Лиспер упоминал о двух из них в теме по этой ссылке чуть ниже указанного VVA поста:
1. Полилиния не должна иметь самопересечений. Насколько я понял, это исключено по условию задачи.
2. Она не должна иметь дуговых сегментов. Если они есть - нужно аппроксимировать полилинию прямыми сегментами с нужной точностью. Для этого есть команда в комплекте Pl-tools.
3. При выборе ssget с опцией _CP все точки контура должны быть в видимой части экрана. Иначе - ошибка будет. Можно перед выполнением зумировать по объекту, а затем вернуть вид обратно.