[Mazai]

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

Код:

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

;| Подпрограммка показывает, какие объекты смежны с указываемым
|;
(defun c:ssget_F (/ El Ent lstPt_Koord Nabor)
  (if (setq El (car (entsel "\nВыберите линию: ")))
    (progn
      (setq Ent		(entget El)
	    lstPt_Koord	(lib:pline-get-verts El)
	    Nabor	(ssget "_F" lstPt_Koord (list (assoc 8 Ent)))
      )
      (sssetfirst nil Nabor)
      (princ
	(strcat "\nВыбрано " (itoa (sslength Nabor)) " объектов!")
      )
    ) ;_ end progn
  ) ;_ end if
  (princ)
) ;_ end defun

Извените, вот библиотечные функции, которые я нашёл на форуме, и использую в своей программке

Код:

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

;| ============ Библиотечные ф-ции =============================
*	Ф-ция lib:pline-get-verts
*	Возвращает координаты вершин полилинии
*	Взята или на autocad.ru или на dwg.ru 
*	Вызов [Type]:
		pline_obj = Object [Vla-Object]
*	Возвращает [Type]:
		список координат вида ((90.987 183.524) (93.2774 206.991) ...)
=================================================================|;
(defun lib:pline-get-verts (pline_obj)
  (if pline_obj
    (progn
      (if (= (type pline_obj) 'Ename)
	(setq pline_obj (vlax-ename->vla-object pline_obj))
      ) ;_ end of if
      (cond
	((wcmatch (vlax-get pline_obj 'Objectname)
		  "AcDb2dPolyline,AcDb3dPolyline"
	 )
	 (pl:group-by-num (vlax-get pline_obj 'Coordinates) 3)
	)
	((eq (vlax-get pline_obj 'Objectname)
	     "AcDbPolyline"
	 )
	 (pl:group-by-num (vlax-get pline_obj 'Coordinates) 2)
	)
	((eq (vlax-get pline_obj 'Objectname)
	     "AcDbLine"
	 )
	 (list (vlax-curve-getstartpoint pline_obj)
	       (vlax-curve-getendpoint pline_obj)
	 )
	)
	(T nil)
      )
    ) ;_ end progn
  ) ;_ end if pline_obj
)

;|======================================================;;
*	written by Fatty The Old Horse 10/13/05    ;;
*	
*	группировка списка по номеру
======================================================|;
(defun pl:group-by-num (lst num / ls ret)
  (if (= (rem (length lst) num) 0)
    (progn (setq ls nil)
	   (repeat (/ (length lst) num)
	     (repeat num
	       (setq ls	 (cons (car lst) ls)
		     lst (cdr lst)
	       )
	     )
	     (setq ret (append ret (list (reverse ls)))
		   ls  nil
	     )
	   )
    )
  )
  ret
)

[Дима_]

А что мешает выбирать не по этой прямой, а по паралельной на 0.0001 "выше"
P.S. да и на четреже не прямая у тебя ни разу.

[Mazai]

Проблема в том, что я это всё делаю программно. И понять как ориентированы эти перпендикуляры - сложно. Или я ошибаюсь?

[Дима_]

Кажеться сейчас понял в чем задача, (слово прямая меня смутила - она полилинией оказалась), не знаю есть ли у ssget точность задания (насколько я понимаю нет), посему два варианта - либо выбирать многоугольником вокруг полилинии, но тут отдельную процедуру придется писать которая его координаты рассчитывает - геморно, но можно, либо полилинию в 4 стороны подвигать на значение допуска и получившиеся твоей программой наборы сложить - не та точность, но быстрее.

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

Попробуй так:

Код:

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

(defun test (prec / adoc selset ent _dwgru-conv-pickset-to-list selset_res pt)
            ;|
	prec	точность обработки "схождения" вершин
|;


;;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2007  DWGru Programmers Group
;;; *
;;; * _dwgru-conv-pickset-to-list
;;; *
;;; * 03/12/2007 Версия 0001. 
;;; ************************************************************************

  (defun _dwgru-conv-pickset-to-list (value / lst item)
;;; Назначение:
;;; Преобразовывает набор (pickset) в обычный список имен примитивов (ename)
;;; Низкоуровневая функция. Контроль соответствия типов не производится

;;; Параметры: 
;;; value - набор (pickset) или nil если пустой набор
;;; Возврат:
;;;   - список примитивов (Ename)
;;;; Пример
    ;|
(setq point (vla-addpoint (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point '(0 0 0))))
(_dwgru-conv-pickset-to-list (ssget "_L")) ;_(<Имя объекта: 7ef85e00>)
(_dwgru-conv-pickset-to-list (ssadd)) ;_nil
  |;
    (repeat (setq item (sslength value)) ;_ end setq
      (setq lst (cons (ssname value (setq item (1- item))) lst))
      ) ;_ end repeat
    lst
    ) ;_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (if
    (and
      (= (type (setq ent (vl-catch-all-apply
                           '(lambda ()
                              (prompt "\nУкажи основной кусок <Отмена> : ")
                              (ssget "_:E:S" '((0 . "*LINE")))
                              ) ;_ end of lambda
                           ) ;_ end of vl-catch-all-apply
                     ) ;_ end of setq
               ) ;_ end of type
         'pickset
         ) ;_ end of =
      ent
      (setq ent (vlax-ename->vla-object (ssname ent 0)))
      (= (type (setq
                 selset (vl-catch-all-apply
                          '(lambda ()
                             (prompt "\nУкажи объекты для обработки <Отмена> : ")
                             (ssget '((0 . "*LINE")))
                             ) ;_ end of lambda
                          ) ;_ end of vl-catch-all-apply
                 ) ;_ end of setq
               ) ;_ end of type
         ) ;_ end of =
      ) ;_ end of and
     (progn
       (setq selset_res (ssadd))
       (foreach item (mapcar 'vlax-ename->vla-object
                             (_dwgru-conv-pickset-to-list selset)
                             ) ;_ end of mapcar
         (if (or (equal (distance (setq pt (vlax-curve-getstartpoint item))
                                  (vlax-curve-getclosestpointto ent pt)
                                  ) ;_ end of DISTANCE
                        0
                        prec
                        ) ;_ end of equal
                 (equal (distance (setq pt (vlax-curve-getendpoint item))
                                  (vlax-curve-getclosestpointto ent pt)
                                  ) ;_ end of DISTANCE
                        0
                        prec
                        ) ;_ end of equal
                 ) ;_ end of or
           (setq selset_res (ssadd (vlax-vla-object->ename item) selset_res))
           ) ;_ end of if
         ) ;_ end of foreach
       (sssetfirst selset_res selset_res)
       ) ;_ end of progn
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

особо не гонял.

[Mazai]

Кулик Алексей aka kpblc, немного не понял что должен делать твой код.
Хотел бы уточнить, что я сижу на цивиле. так вот в нём есть специальная утилита для обработки карт (меню КАРТА \ Сервсис \ Очистка чертежа) Эта утилита позволяет исправить в чертеже (в карте) многие неточности, которые возникают при перекодировании из других программ, в программу автокада. В частности там есть операция "продолжать недоводы". Недоводы действительно пролдлеваются, но почему-то у некоторых отрезков так и не появляется общих точек. Их всё так же невозможно добавить в набор. По всей видимости недоводы остаются, но уже настолько мизерные, что их незаметно даже при максимальном приближении. По всей видимости Автокад через-чур точно отслеживает кооординаты. Замечено, что если попытаться скопировать полученный результат в новый чертёж, то некоторые недоводы всё-таки прилипают к линии, но почему-то не все и не всегда. Есть ли возможность в Автокаде ввести какую-то несущественную погрешность, которая бы игнорировала скажем недовод в 0.0000000001 ???

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

А Elevation, например, у этих отрезков; и полилиния, до которой надо продлевать - это одинаково? А точка на продолжении отрезка точно лежит на ограничивающей?
Мой код просто выделяет те объекты, которые надо доводить. Сделать вариант "довести до полилинии" в общем-то не сильно проблема. Проблема в другом - только вечером смогу сесть

[Mazai]

Кулик Алексей aka kpblc, твой код пока не работает... попробую его поковырять...

По правде сказать, это не обязательно может быть и полилиния. В чертеже это просто длинная граница к которой опущены перпендикуляры. В совокупности это обозначение откоса. И вот при переводе в автокад эта граница местами распознаётся как прямой отрезок, а местами - как полилиния. Я просто выложил кусок для примера. Но так как чертёж создавался не в автокаде и потом в него переводился - там закрались такие ошибки, как недоводы, не все отрезки доходят до ограничивающей линии. В свойствах этих всех примитивов пишется что они все находятся на нулевой высоте и имеют нулевые координаты по оси Z. Мне принципиально необходимо, что бы они имели общие точки, что бы я выбрав границу, мог увидеть перпендикуляры к выбранному участку.
Передомной поставлена задача превратить эту границу (откос) в обычную полилинию. А для этого мне нужно удалить все эти перпендикуляры путём их выбора. И всё это выполнить нужно программно. Так как объёмы чертежа большие и он такой не один. Вот я и пытаюсь привести чертёж в нормальный вид, что бы нормально можно было с ним работать. А для этого я пытаюсь решить проблему с недоводами. Или же я хочу узнать - можно ли как-то принебрегнуть высокой точностью автокада...

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

Может, я чего не понимаю... Эта граница (откос) - у нее все вершины гарантированно лежат в одной плоскости, а эти "недоводы", как я понимаю - имеют разную отметку Z для разных концов отрезка, так?
Просто есть идея втупую использовать _.pedit (либо программно, либо руками - методология формирования набора немного отличаться просто будет).

[Mazai]

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

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

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

[Дима_]

Накалякал свой вариант, дотягивает все отрезки "LINE" до полининий "lwpolyline" - с указанным допуском; с сопряжениями не дружит, сильно не гонял.

Код:

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

;дотягивает отрезки до поллилиний в пределах допуска
;пример запуска (dovodka 0.1) - дотянуть все отрезки до полилиний, недостающих 0,1.
(defun dovodka (dopusk / pln1 pln2 obj pt1 pt2 pt3 pt4)
(setq obj (entnext))
(while obj
(if (= (cdr (assoc 0 (entget obj))) "LINE")
(progn
(setq 	pt1 (cdr (assoc 10 (entget obj))); начало отрезка
	pt2 (cdr (assoc 11 (entget obj))); конец 
	pt3 (polar pt1 (angle pt2 pt1) dopusk); начало + допуск
	pt4 (polar pt2 (angle pt1 pt2) dopusk); конец + допуск
	pln1 (ssget "_f" (list pt1 pt3) (list (cons 0 "lwpolyline")))
	pln2 (ssget "_f" (list pt2 pt4) (list (cons 0 "lwpolyline")))
);end of setq
(if pln1
(long obj (ssname pln1 0) 10 pt3)
);end of if 
(if pln2
(long obj (ssname pln2 0) 11 pt4)
);end of if
));end of progn & if obj = line
(setq obj (entnext obj))
);end of while
);end of dovodka

(defun long (obj pln cod pt / tmppt lst tmp i); удлиняет отрезок obj до pln
(setq i 0 lst (pltolist pln) tmppt (cdr (assoc cod (entget obj))))
(repeat (1- (length lst))
(setq tmp (inters (nth i lst) (nth (1+ i) lst) tmppt pt))
(if (and tmp (not (equal tmp tmppt))) 
(entmod (subst (cons cod tmp) (cons cod tmppt) (entget obj)))
);end of if
(setq i (1+ i))
);end of repeat
(if (= 1 (cdr (assoc 70 (entget pln)))); проверка последнего сегмента
(progn
(setq tmp (inters (nth i lst) (car lst) tmppt pt))
(if (and tmp (not (equal tmp tmppt))) 
(entmod (subst (cons cod tmp) (cons cod tmppt) (entget obj)))
);end of if
));end of progn & if
);end of long

(defun pltolist (obj / lst); возращает список вершин полилинии
(foreach tmp (entget obj)
(if (= (car tmp) 10) (setq lst (append lst (list(cdr tmp)))))
);end of foreach
lst
);end of pltolist

[Mazai]

Дима_, глянул твой код. Оригинально придумано... Сейчас адаптирую под свои задачи.
Спасибо!

[Дима_]

Удачи