[Sege]

Коллеги!

Возможно, уже есть готовая лиспина.

Задача такая. Есть полилиния, которая имеет определенной кол-во вершин. Требуется создать неполной "дубликат" указанной полилинии по 2-м опорным вершинам в существующей полилинии. Т.е. указываем стартовую вершину (она не обязательно может быть 1-й), указываем конечную вершину (аналогично не обязательно последней) в существующей полилинии -> создается дубликат указанной части полилинии, ограниченной указанными вершинами.

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

А штатные средства "не катят"? Скопировать полилинию, потом _.break (дважды). Ну или _trim

[Sege]

Сообщение от Кулик Алексей aka kpblc А штатные средства "не катят"? Скопировать полилинию, потом _.break (дважды). Ну или _trim

Фишка break - это то что он после разрыва оставляет разорванную линию (т.е. в итоге на чертеже получается 3 полилинии)

Примерно понимаю как реализовать:
- получаем от пользователя координаты 2-х точек на вершине полилинии-донора
- формируем список из координат всех вершин полилинии-донора
- находим в этом списке первую ранее указанную точку
- находим в этом списке вторую ранее указанную точку
- удаляем из списка все что левее и правее этих точек
- строим полилинию с модифицированным списком

----- добавлено через ~10 мин. -----
Алексей, я смотрел в твоей PLTOOLS функцию PL-CLONE, однако она требует последовательного указания всех сегментов ) Практически то что нужно, однако хочется за 2 шага для пользователя это сделать )

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

PLTOOLS - Не моя разработка.

[koMon]

в модели, LWPL

Код:

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

 (defun c:partial_clone_pline (/ pline_object clone_start_point clone_end_point clone_start_parameter clone_end_parameter
							 	clone_parameter_list clone_vertices_raw_list clone_bulge_list pline_clone_object vertex_index
							 )
	(setq pline_object (vlax-ename->vla-object (car (entsel "\nВыберите полилинию: ")))
		  clone_start_point (trans (osnap (getpoint "\nТочка начала клонируемой полилинии: ") "_endp") 1 0)
		  clone_end_point (trans (osnap (getpoint "\nТочка конца клонируемой полилинии: ")  "_endp") 1 0)
		  clone_start_parameter (fix (vlax-curve-getparamatpoint pline_object clone_start_point))
		  clone_end_parameter (fix (vlax-curve-getparamatpoint pline_object clone_end_point))
		  clone_parameter_list (vl-sort (list clone_start_parameter clone_end_parameter) '<)
		  clone_start_parameter (1- (car clone_parameter_list))
		  clone_end_parameter (cadr clone_parameter_list)
		  clone_parameter_list nil
	)
	(repeat (abs (- clone_end_parameter clone_start_parameter))
		(setq clone_parameter_list (append clone_parameter_list (list (setq clone_start_parameter (1+ clone_start_parameter)))))
	)
	(foreach parameter clone_parameter_list
		(setq clone_vertices_raw_list (append clone_vertices_raw_list (reverse (cdr (reverse (vlax-curve-getpointatparam pline_object parameter))))))
		(setq clone_bulge_list (append clone_bulge_list (list (vla-getbulge pline_object parameter))))
	)
	(vlax-safearray-fill (setq pline_vertices_array (vlax-make-safearray vlax-vbdouble (cons 1 (length clone_vertices_raw_list))))
												    clone_vertices_raw_list
	)
	(setq pline_clone_object (vla-addlightweightpolyline (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) pline_vertices_array))
	(vla-put-color pline_clone_object 1)
	(setq vertex_index -1)
	(foreach bulge clone_bulge_list
		(vla-setbulge pline_clone_object (setq vertex_index (1+ vertex_index)) bulge)
	)
)

[Sege]

У меня примерно так получилось:

Код:

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

 

(defun delete_end(list)                      
  (cond ((null (cdr list)) 
     nil)                        
    (t 
     (cons (car list) 
           (delete_end (cdr list)))))
		   )

(defun add (thing lst) (append lst (list thing)))

(defun C:npline()
(setq new_lst nil)
(setq ent (car (entsel "\nSelect polyline: ")))
(setq pt_lst (mapcar 'cdr (vl-remove-if-not '(lambda (a) (= (car a) 10)) (entget ent))))
(setq startPt (delete_end (getpoint "Pick the start point")))
(setq endPt (delete_end (getpoint "Pick the end point")))
(setq startPos (vl-position startPt pt_lst) 
	  endPos (vl-position endPt pt_lst) 
)
(setq new_lst (list (nth startPos pt_lst)))
(setq k (+ 1 startPos))
(while (< k (+ 1 endPos))
(setq new_lst (add (nth k pt_lst) new_lst))  
(setq k (+ 1 k))
)
(command "_.pline")
(mapcar 'command new_lst)
(command "")
)

[koMon]

без функции delete_end не заведётся

[SetQ]

Вариант с помощью команды BREAK:

Код:

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

 ;;; Partial copy of the polyline
(defun C:pcpline (/ ent obj pt1 pt2 pt0 ptN par1 par2 par0 parN tmp)
  (setq
    ent	 (car (entsel "\nSelect polyline: "))
    pt1	 (getpoint "\nPick the 1 point")
    pt2	 (getpoint "\nPick the 2 point")
    obj	 (vlax-ename->vla-object ent)
    pt0	 (vlax-curve-getStartPoint obj)
    ptN	 (vlax-curve-getEndPoint obj)
    par0 (vlax-curve-getStartParam obj)
    par1 (vlax-curve-getParamAtPoint obj (trans pt1 1 0))
    par2 (vlax-curve-getParamAtPoint obj (trans pt2 1 0))
    parN (vlax-curve-getEndParam obj)
  )
  (if (> par1 par2)
    (setq tmp pt1
	  pt1 pt2
	  pt2 tmp
	  tmp nil
    )
  )
  (vla-copy obj)
  (command "_draworder" ent "" "_a" (entlast) "")
  (command "_break" ent pt1 (trans pt0 0 1))
  (command "_break" ent pt2 (trans ptN 0 1))
  (vla-put-color obj 1)
  (prin1)
)

----- добавлено через ~3 ч. -----

Сообщение от Sege Фишка break - это то что он после разрыва оставляет разорванную линию (т.е. в итоге на чертеже получается 3 полилинии)

Если одна из точек разрыва - первая или последняя точка полилинии, то сносит участок начисто, без остатка.

[Sege]

Сообщение от koMon без функции delete_end не заведётся

Добавил. Хотя можно и без нее: это координата Z просто удаляется )

[koMon]

Сообщение от Sege Добавил.

ну это... ботанический огород... (reverse (cdr (reverse

Сообщение от Sege Хотя можно и без нее

можно ... искать в списке... и не найти)
там кстати ещё defun не замыкается, и дуговые сегменты побоку...

[Sege]

Сообщение от koMon ну это... ботанический огород... (reverse (cdr (reverse можно ... искать в списке... и не найти)

Ну тогда можно вообще проще: (list (nth 0 startPt) (nth 1 startPt))