| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Выравнивание полилинии в одну линию.

Выравнивание полилинии в одну линию.

Ответ
Поиск в этой теме
Непрочитано 25.03.2008, 14:55
Выравнивание полилинии в одну линию.
f0lk
 
Регистрация: 16.10.2007
Сообщений: 7

Здравствуйте.
Есть полилиния - нужна программа которая выравнивает точки полилинии по одной прямой, со сохранением длин между вершинами полилинии.
С лиспом практически незнаком, а стандартными средствами такое сделать не получается.
Просмотров: 30919
 
Непрочитано 24.03.2021, 04:22
#41
gette


 
Регистрация: 24.03.2021
Сообщений: 1


Цитата:
Сообщение от VVA Посмотреть сообщение
Ну вот по быстрому что-то сфарганил. По идее должна разворачивать все пересекающие полилинию объекты. Особо не теститровал. Поэтому лучше пока сразу выставить МСК
Спасибо. Отлично работает, за исключением одного но - если исходная полилиния пересекает объект дважды/трижды/множество раз другой объект, то на результирующей отображается только один раз этот объект, а не в каждой точке пересечения.
Если бы еще иметь возможность захватывать близлежащие объекты (в указанном диапазоне/коридоре) и корректно наносить их на развертку, цены бы этому коду не было.
gette вне форума  
 
Непрочитано 06.07.2023, 13:14
#42
natural_gl


 
Регистрация: 13.05.2022
Сообщений: 33


Цитата:
Сообщение от Дима_ Посмотреть сообщение
Копирует так-же круги и любые блоки, НО чтоб центр (или точка вставки для блока) лежали строго на вершине полилинии.
Код:
[Выделить все]
(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
Вложения
Тип файла: dwg
DWG 2013
Развертка.dwg (115.9 Кб, 7 просмотров)
natural_gl вне форума  
 
Непрочитано 06.07.2023, 16:03
#43
AlexCondor

инженер
 
Регистрация: 03.08.2007
Сообщений: 1,326


natural_gl, Ну не дружит эта програмулина с дугами.
AlexCondor вне форума  
 
Непрочитано 07.07.2023, 13:17
#44
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от 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)
)
__________________
K Lisp
koMon вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Выравнивание полилинии в одну линию.

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
lisp: Длина по полилинии до точки vosh LISP 19 15.07.2013 15:10
Как получить контур полилинии с различной шириной Marina AutoCAD 5 26.12.2008 09:16
Странное выравнивание в таблице Bull AutoCAD 8 12.03.2008 12:01
Как рисуя одну полилинию получить сразу 4? Димас AutoCAD 33 22.07.2006 01:17
некорректно определяется площадь замкнутой полилинии elena_din AutoCAD 16 23.09.2005 17:37