[f0lk]

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

[gette]

Сообщение от VVA Ну вот по быстрому что-то сфарганил. По идее должна разворачивать все пересекающие полилинию объекты. Особо не теститровал. Поэтому лучше пока сразу выставить МСК

Спасибо. Отлично работает, за исключением одного но - если исходная полилиния пересекает объект дважды/трижды/множество раз другой объект, то на результирующей отображается только один раз этот объект, а не в каждой точке пересечения.
Если бы еще иметь возможность захватывать близлежащие объекты (в указанном диапазоне/коридоре) и корректно наносить их на развертку, цены бы этому коду не было.

[natural_gl]

Сообщение от Дима_ Копирует так-же круги и любые блоки, НО чтоб центр (или точка вставки для блока) лежали строго на вершине полилинии. Код: [Выделить все] (defun c:razv2 ( / P lst lst2 lst3 n obj krd) (setq krd 0 n 0 obj (entget (car (entsel "Выберите полилинию ")))) (if (/= (cdr (assoc 0 obj)) "LWPOLYLINE") (progn (alert "Это не LW полилиния") (exit))) (setq p (trans (getpoint "Куда вставлять развертку ") 1 0)) ;записывает координаты вершин (while (/= krd nil) (setq krd (nth n obj)) (if (= (car krd) 10) (setq lst (append lst (list (list (cadr krd) (caddr krd))))) );end of if (setq n (1+ n)) );end of while ;записывает расстояния (setq n 0) (while (/= (nth (1+ n) lst) nil) (setq lst2 (append lst2 (list (distance (nth n lst) (nth (1+ n) lst)))) n (1+ n) );end of setq );end of while ;записывает координаты новых вершин (setq n 0 krd p lst3 (list krd)) (repeat (length lst2) (setq krd (list (+ (car krd) (nth n lst2)) (cadr krd)) lst3 (append lst3 (list krd)) n (1+ n) );end of setq );end of repeat ;строит полилинию (pl lst3) ;переносит объекты (setq obj (entnext)) (while (/= obj nil) (if (or (= (cdr (assoc 0 (entget obj))) "CIRCLE") (= (cdr (assoc 0 (entget obj))) "INSERT") ) (progn (setq n 0) (repeat (length lst3) (if (equal (cdr (assoc 10 (entget obj))) (append (nth n lst) (list 0.0)) 1e-6) (entmakex (cdr (subst (append (list 10) (nth n lst3)) (assoc 10 (entget obj)) (entget obj)))) );end of if (setq n (1+ n)) );end of repeat );end of progn );end of if (setq obj (entnext obj)) );end of while );end defun (defun pl (obj / ed n tmp); создает полилинию по списку вершин obj. (setq ed (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length obj)));end of list n 0 tmp (nth n obj) );end of setq (while (/= tmp nil) (setq ed (append ed (list (append (list 10) (nth n obj)))) n (1+ n) tmp (nth n obj) );end setq );end of while (entmakex ed) );end of defun P.S. Запускать "RAZV2".

Не подскажите в чем проблема? пытаюсь развернуть полилинию но смотрю длина развернутой линии отилчается от исходной. прикрепляю файл dwg

[AlexCondor]

natural_gl, Ну не дружит эта програмулина с дугами.

[koMon]

Сообщение от natural_gl развернуть полилинию

без всяко-разных блоков, просто распрямление полилинии.

Код:

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

 
(defun c:straighten_pline (/ pline_ename vertex_index vertex_length_list straightened_pline_starting_point
							 straightened_pline_vertex_list
						  )
	(while (and
				(setq pline_ename (car (entsel "\nВыберите полилинию для распрямления: ")))
				(null (= "LWPOLYLINE" (cdr (assoc 0 (entget pline_ename)))))
		   )
	)
	(if pline_ename
		(progn
			(setq vertex_index -1)
			(repeat (1+ (fix (vlax-curve-getendparam pline_ename)))
				(setq vertex_length_list (append vertex_length_list 
												(list (vlax-curve-getdistatparam pline_ename 
																				(setq vertex_index (1+ vertex_index))
													  )
												)
										 )
				)
			)
			(setq straightened_pline_starting_point (trans (getpoint "\nУкажите начальную точку для распрямлённой полилинии: ") 1 0)
				  straightened_pline_vertex_list (mapcar '(lambda (_length) (list (+ _length (car straightened_pline_starting_point)) 
				  																  (cadr straightened_pline_starting_point)
																			)
														  )
														  vertex_length_list
												 )
			)
			(vla-addlightweightpolyline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) 
										(vlax-safearray-fill 
											(vlax-make-safearray 
												vlax-vbdouble 
												(cons 1 (length (apply 'append straightened_pline_vertex_list)))
											)
											(apply 'append straightened_pline_vertex_list)
										)
			)
		)
	)
	(princ)
)

[mvartem]

Привет! А если полилиния 3Д? Её можно развернуть с сохранением Z координаты в вершинах? 3Д полилиния безо всяких дуг. Очень пригодилось бы для построения профилей

[koMon]

Сообщение от mvartem 3Д полилиния безо всяких дуг.

3d полилиния в автокаде не может иметь дуговых сегментов.

[mvartem]

Сообщение от koMon 3d полилиния в автокаде не может иметь дуговых сегментов.

Хорошо, пусть так. Но возможен ли вариант разворачивания 3Д полилинии с сохранением Z координаты в вершинах?

[name02]

Сообщение от mvartem разворачивания 3Д полилинии с сохранением Z координаты в вершинах?

После разворачивания 3Д полилинии будут только две коородинаты - одна координата будет идти вдоль "профиля", а вторая будет соответствовать высотной отметке вершин 3Д полилинии

Вот программа, которая разворачивает 3Д полилинию в 2Д полилинию в плоскости XY (координат Z становится координатой Y):
PL2Profile.lsp

Код:

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

 (vl-load-com)

(defun C:PL2Profile (/ pt3d->2d ss en pt1 pt2 dpts)

  (defun pt3d->2d (pt / ) (reverse (cons 0. (cdr (reverse pt)))))
  
  (prompt "\nRequired a SINGLE 3D Polyline,")
  (if (and (setq ss (ssget "_+.:E:S" '((0 . "POLYLINE"))))
	   (= 1 (sslength ss))
	   (setq en (ssname ss 0)))
    (progn
      (repeat (setq par (fix (vlax-curve-getEndParam en)))
	(setq pt1 (vlax-curve-getPointAtParam en par)
	      pt2 (vlax-curve-getPointAtPAram en (setq par (1- par)))
	      dpts (cons (list (distance (pt3d->2d pt1)
					 (pt3d->2d pt2))
			       (- (last pt2)
				  (last pt1)))
			 dpts)))
      (command "_.pline") (princ " ...for the profile: ") (command PAUSE)
      (repeat (length dpts)
	(command "_none" (polar (polar (getvar 'LASTPOINT)
				       0
				       (caar dpts))
				(* 0.5 pi)
				(* (cadar dpts) 1))) ; Evelation scale (profile's y)
	(setq dpts (cdr dpts)))
      (command "")))
)

Взято отсюда https://forums.autodesk.com/t5/visua...e/td-p/5825544

[koMon]

Сообщение от mvartem вариант разворачивания 3Д полилинии с сохранением Z координаты в вершинах

распрямляется в 3d полилинию вдоль оси X в плоскости x0z.

Код:

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

 
(defun c:straighten_3d_pline (/ 3d_pline straightened_3d_pline_starting_point 3d_pline_vertices_raw_list 3d_pline_vertices_list
			        3d_pline_segment_list straightened_3d_pline_point_list next_x 3d_pline_z_list
			     )
  (setq 3d_pline (vlax-ename->vla-object (car (entsel "\nВыберите 3d полилинию: ")))
	straightened_3d_pline_starting_point (getpoint "\nУкажите начальную точку для распрямлённой 3d полилинии: ")
	3d_pline_vertices_raw_list (vlax-get 3d_pline 'coordinates)
  )
  (while 3d_pline_vertices_raw_list
	(setq 3d_pline_vertices_list (append 3d_pline_vertices_list (list (list (car 3d_pline_vertices_raw_list)
									    	(cadr 3d_pline_vertices_raw_list)
									        (caddr 3d_pline_vertices_raw_list)
								          )
								    )
				    )
	      3d_pline_vertices_raw_list (cdddr 3d_pline_vertices_raw_list)
	)  
  )
  (setq 3d_pline_z_list (mapcar 'caddr 3d_pline_vertices_list) 
  	3d_pline_segment_list (mapcar '(lambda (start end) (list start end)) 3d_pline_vertices_list (cdr 3d_pline_vertices_list))
  	straightened_3d_pline_point_list (mapcar '(lambda (deltas) (list (sqrt (apply '+ (mapcar '* deltas deltas '(1.0 1.0))))
									 (cadr straightened_3d_pline_starting_point)
									 (caddr deltas)
								   )
						  )
				    	          (mapcar '(lambda (segment) (mapcar '- (cadr segment) (car segment))) 3d_pline_segment_list)
			 	         )
  	next_x (car straightened_3d_pline_starting_point) 
  	straightened_3d_pline_point_list (mapcar '(lambda (point) (list (setq next_x (+ next_x (car point)))
									(cadr point)
									(caddr point)
								  )
						  )
						  straightened_3d_pline_point_list
				   	 )
  	straightened_3d_pline_point_list (append (list straightened_3d_pline_starting_point) straightened_3d_pline_point_list)
	straightened_3d_pline_point_list (mapcar '(lambda (point z) (list (car point) (cadr point) z)) straightened_3d_pline_point_list 3d_pline_z_list)
  )
  (vla-add3dpoly (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) 
		 (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble 
					     		  (cons 1 (length (apply 'append straightened_3d_pline_point_list)))
				      )
				      (apply 'append straightened_3d_pline_point_list)
		 )
  )
  (princ)
)

[1958]

Подыму тему.

Сообщение от VVA вот по быстрому что-то сфарганил

Класс!

Сообщение от gette Если бы еще иметь возможность захватывать близлежащие объекты (в указанном диапазоне/коридоре) и корректно наносить их на развертку, цены бы этому коду не было.

Присоединяюсь.

Ещё одно поже6лание - возможность выбора начальной и конечной точек на исходной полилинии. Чтобы развертка рисовалась не для всей линии, а в заданном диапазоне.

[1958]

Сообщение от 1958 Ещё одно поже6лание - возможность выбора начальной и конечной точек на исходной полилинии. Чтобы развертка рисовалась не для всей линии, а в заданном диапазоне.

Строго не судите, но что-то у меня получилось.
Правда выбираются только пересекаемые объекты.