[Apelsinov]

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

то есть собсно меня интересует один момент - как имея два vla-объекта линий, определить лежат они на одной прямой или нет?

[asys]

Насчет объединения нескольких линий в 2006 версии появилась интересная команда - JOIN

[Lenich]

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

[Apelsinov]

Lenich
Гениально!
как минимум для плоскости. И почему только дальние (кстати это еще поди определи) - любые. Угол отн. оси Х линии проведенной между любыми двумя точками двух линий должен быть равен углу наклона отн оси X обеих этих линий - если эти линии лежат на одной прямой.

Круто!

Lenich - СПАСИБО!

[Lenich]

Apelsinov,

прям теорема какая-то

"дальние" - это я так, погорячился. Конечно можно и любые, главное чтоб не одну и ту же.

[Pilot]

Но если две "соосные" линии проводились навстречу друг другу (или наоборот, в разные стороны) - то их углы будут отличаться на 180 градусов. Так что еще дополнительная проверка нужна.

[Лентяй]

Pilot: Но если две "соосные" линии проводились навстречу друг другу (или наоборот, в разные стороны) - то их углы будут отличаться на 180 градусов. Так что еще дополнительная проверка нужна.

Так же с учетом "теткинского" (он же - китайский) стиля черчения я бы световал проверку на fuzz, типа, как это делается для объединения полилиний. Кстати, вот вам и описание макроса
1. Объединть все отрезки в полилинию.
2. Спрямить (Straight) по начальной/конечной точкам.
3. Взорвать на хрен.

[Apelsinov]

Код:

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

;;;проверка на принадлежность одной прямой для двух линий
;;;аргументы
;;;LINE1 -первая линия
;;;LINE2 - вторая линия
;;;fuzz - точность
;;;Apelsinov
;;;30.09.05
(defun APEL-LINE-2LINE_IN_LINE (LINE1 LINE2 fuzz / list_points ugol_0)
  (setq	list_points
	 (APEL-FUNCTION-ELEM_MATRIX
	   'APEL-POINT-VARIANT_TO_LIST
	   (list (mapcar 'vla-get-startpoint (list line1 line2))
		 (mapcar 'vla-get-Endpoint (list line1 line2))
	   )
	 )
  )
  (setq ugol_0 (apply 'ANGLE (mapcar 'cadr list_points)))
  (null
    (vl-some
      'null
      (mapcar '(lambda (i)
		 (or (equal ugol_0 i fuzz) (equal ugol_0 (+ i pi) fuzz) (equal ugol_0 (- i pi) fuzz))
	       )
	      (APEL-FUNCTION-ELEM_MATRIX_2 'ANGLE list_points)
      )
    )
  )
)
;;;(APEL-LINE-2LINE_IN_LINE (APEL-ENTSEL"") (APEL-ENTSEL"") 0.001)


;;;Применение некоей c одним аргументом функции к каждому элементу матрицы
;;;аргументы:
;;;func - применяемая функция
;;;lst - матрица
(defun APEL-FUNCTION-ELEM_MATRIX (func lst /)
  (mapcar (function (lambda (i) (mapcar func i))) lst)
)
;;;(APEL-FUNCTION-ELEM_MATRIX '1+ '((1 2) (3 4)))
;;;--> ((2 3) (4 5))

;;;Преобразование точки заданной вариантом в список координат
;;;аргумент - вариант
;;;apelsinov
;;;29.09.05
(defun APEL-POINT-VARIANT_TO_LIST (var /)
  (vlax-safearray->list (vlax-variant-value var))
)
;;;(APEL-POINT-VARIANT_TO_LIST (vla-get-StartPoint (APEL-ENTSEL "")))
;;;--> (60143.7 25552.1 0.0)

;;;Применение некоей функции c несколькими аргументами функции к каждой строке матрицы
;;;аргументы:
;;;func - применяемая функция
;;;lst - матрица
(defun APEL-FUNCTION-ELEM_MATRIX_2 (func lst /)
  (mapcar '(lambda (i) (apply func i)) lst)
)
;;;(APEL-FUNCTION-ELEM_MATRIX_2 '+ '((1 2)(3 4)))
;;;->(3 7)

[vk]

Может посмотреть в сторону overkill? Может его как то удасться приладить к этой задаче...