[Apelsinov]

Задача такая:
Есть две полилинии (3dpoly) с одной общей крайней вершиной, вершины полилиний лежат в разных плоскостях, как можно програмно (или средствами самого акада) обьединить их в одну полилинию, по аналогии с pedit -> join (pljoin из express) для обычной полилинии.

Была пожожая тема. Может читали?
http://dwg.ru/forum/viewtopic.php?p=12433#12433

[Torino]

На сайте www.black-cad.de была нужная программка.
Сейчас сайт не отвечает. Поэтому >>Apelsinov см. мыло.

[Apelsinov]

>AY, Да читал я эту тему, но голова совсем дырявая, забыл
> Torino, спасибо большое, прога работает. Но она просто поверх полилиний рисует еще одну по их вершинам, при этом даже не копируя свойства обьединяемого примитива, напрямую командой 3dpoly, не обрабатывает esc, и не удаляя исходные.
И еще дурацкое окно выдает DEMO-VERSION.
Демонстрация явно не удалась.

[Torino]

Да сыровата программа.
Но идея замечательно простая: не надо ничего объединять, просто рисуем новую общую полилинию поверх.
Чисто прорабская идея

[Apelsinov]

Написал свою, обьединяет две 3dpolyline:
(Исправил 26.11.04)

Код:

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

(defun c:3dpoly_join (/ pline1 pline2 list-vp)
  (if (and (setq pline1 (entsel))
	   (setq pline2 (entsel))
      )
    (progn
      (setq list-vp (mapcar '(lambda (i)
			       (vlax-ename->vla-object (car i))
			     )
			    (list pline1 pline2)
		    )
      )
      (if (vl-member-if-not
	    '(lambda (i) (eq i "AcDb3dPolyline"))
	    (mapcar 'vla-get-objectname list-vp)
	  )
	(princ "Error: This is not polyline")
	(if (not (APEL-StEn-POINTS (car list-vp) (cadr list-vp) 0.001))
	  (progn
	    (mapcar '(lambda (i)
		       (vla-AppendVertex (car list-vp) (vlax-3d-point i))
		     )
		    (APEL_RAZB_PO3_SPIS
		      (vlax-safearray->list
			(vlax-variant-value (vla-get-coordinates (cadr list-vp)))
		      )
		    )
	    )
	    (vla-delete (cadr list-vp))
	  )
	)
      )
    )
  )
  (princ)
)
;;;Обработка списка. Превращает список типа '(n1 n2 n3 ... ni) в список '((n1 n2 n3)(n4 n5 n6)...(ni-2 ni-1 ni))
;;;аргумент : список
;;;Возвращает список
(defun APEL_RAZB_PO3_SPIS (spis / pspis aspis)
  (foreach i spis
    (if	(eq (length (setq pspis (cons i pspis))) 3)
      (setq aspis (cons (reverse pspis) aspis)
	    pspis nil
      )
    )
  )
  (reverse aspis)
)

;;;Аргументы: pline1 - полининия
;;;Возвращает: nil
(defun APEL-REVERSE-PLINE (pline / safearray-list)
  (vla-put-coordinates
    pline
    (vlax-safearray-fill
      (setq safearray-list (vlax-variant-value (vla-get-coordinates pline)))
      (apply 'append
	     (reverse
	       (APEL_RAZB_PO3_SPIS
		 (vlax-safearray->list safearray-list)
	       )
	     )
      )
    )
  )
)

;;;Аргументы: pline1 pline2 - полилинии
;;;           dop - допуск
;;;Возвращает: nil - если точки найдены
;;;Строку - если нет
(defun APEL-StEn-POINTS	(pline1 pline2 dop / 1p1 1p2 2p1 2p2 list-StEn-points)
  (setq	list-StEn-points
	 (list
	   (list (vlax-curve-getstartpoint pline1)
		 (vlax-curve-getendpoint pline1)
	   )
	   (list (vlax-curve-getstartpoint pline2)
		 (vlax-curve-getendpoint pline2)
	   )
	 )
  )
;;;;;(mapcar '(lambda (i) (member i (cadr list-StEn-points))) (car list-StEn-points))
  (setq	1p1 (car (car list-StEn-points))
	2p1 (cadr (car list-StEn-points))
	1p2 (car (cadr list-StEn-points))
	2p2 (cadr (cadr list-StEn-points))
  )
  (cond
    ((equal 1p1 2p2 dop)
     (progn (APEL-REVERSE-PLINE pline1)
	    (APEL-REVERSE-PLINE pline2)
     )
    )
    ((equal 1p1 1p2 dop) (APEL-REVERSE-PLINE pline1))
    ((equal 2p1 1p2 dop) ())
    ((equal 2p1 2p2 dop) (APEL-REVERSE-PLINE pline2))
    ((princ "Error: plines is have not equal start/end points"))
  )
)