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

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

Lisp для подсчета суммы округленных длин сегментов полилинии

Ответ
Поиск в этой теме
Непрочитано 09.09.2017, 22:00 #1
Lisp для подсчета суммы округленных длин сегментов полилинии
Alex_Shaton
 
Гомель
Регистрация: 09.09.2017
Сообщений: 19

Уважаемые форумчане!
Доброго времени суток!
На форуме неоднократно рассматривался вопрос подсчета сумм длин полилиний. Я просмотрел все темы по данному вопросу, в т.ч. и закрепленные.
В представленных решениях производится подсчет общей длины полилинии, затем по необходимости округление ее значения. На практике округленная длина полилинии и сумма округленных длин сегментов могут значительно отличатся друг от друга. Пытался подредактировать Lispы уважаемых VVA, КОС и других форумчан, но решить проблемму так и не смог.
Суть вопроса:
Имеется полилиния с множеством сегментов, в т.ч. и дуговых.
Как программно получить сумму округленных до одного знака после запятой значений длин всех сегментов полилинии, как линейных, так и дуговых?
Алгоритм примерно такой:
1.Указываем полилинию.
2.Производится подсчет и округление до одного знака после запятой длин каждого сегмента полилинии, затем суммирование полученных значений.
3.Вставка полученной суммы в виде текста(мтекста) в чертеж в место, указанное мышью.
Может у кого-то есть решение данной проблемы?
Думаю, что меня хорошо поймут все, кто работает с учетом инженерных сетей. Образмерить сегменты полилинии с учетом округления несложно, а считать полученные значения на калькуляторе муторно.
Просмотров: 3881
 
Непрочитано 10.09.2017, 07:49
#2
trir


 
Регистрация: 18.12.2010
Сообщений: 5,047


для этого есть ГИС - задачу можно решить в один SQL-запрос
trir вне форума  
 
Автор темы   Непрочитано 10.09.2017, 20:45
#3
Alex_Shaton


 
Регистрация: 09.09.2017
Гомель
Сообщений: 19


То, что это удобней выполнить в ГИС(даже в ArcView3) - понятно, но нужно именно в AutoCAD. Дамы у меня на работе с трудом осваивают AutoCAD 2007, а ГИСы для них - непреодолимое препятствие.
Alex_Shaton вне форума  
 
Непрочитано 20.09.2017, 14:30
| 1 #4
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Сообщений: 5,091


Цитата:
Сообщение от Alex_Shaton Посмотреть сообщение
Имеется полилиния с множеством сегментов, в т.ч. и дуговых.
Как программно получить сумму округленных до одного знака после запятой значений длин всех сегментов полилинии, как линейных, так и дуговых?
Так понимаю, вопрос в том, что длина полилинии, которую можно взять из свойств объекта, вычисленная с высокой точностью, "не бьется" с суммой округленных длин участков?

Цитата:
Сообщение от Alex_Shaton Посмотреть сообщение
Алгоритм примерно такой:
1.Указываем полилинию.
2.Производится подсчет и округление до одного знака после запятой длин каждого сегмента полилинии, затем суммирование полученных значений.
3.Вставка полученной суммы в виде текста(мтекста) в чертеж в место, указанное мышью.
С этим, без шуток и преувеличения, техническим заданием, прямая дорога в раздел "Поиск исполнителей"

Последний раз редактировалось kp+, 20.09.2017 в 14:37.
kp+ вне форума  
 
Непрочитано 26.09.2017, 14:55
#5
koMon


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


Цитата:
Сообщение от Alex_Shaton Посмотреть сообщение
1.Указываем полилинию.
2.Производится подсчет и округление до одного знака после запятой длин каждого сегмента полилинии, затем суммирование полученных значений.
3.Вставка полученной суммы в виде текста(мтекста) в чертеж в место, указанное мышью.
Может у кого-то есть решение данной проблемы?
Alex_Shaton,
Для решения специфической задачи мне пришлось обратится к Автолиспу через много лет, освежая так сказать память, я набрёл на этот форум и эту тему. Поскольку написание этого лиспа для меня являетя достаточно тривиальной задачей и как-то перекликнулось с моей. я решил вам помочь раз и навсегда)
По сути:
1. Задаётся точность округления, 1 или 2, по пробелу, вводу 1.
2. Создаётся текстовый стиль Arial_Regular, при этом считается что файл шрифта Arial.ttf лежит в папке c:\Windows\Fonts
3. Создаётся слой "Polyline Length Text", для которого задаётся только цвет RGB 255 0 0, красный
4. Выбирается только полилиния
5. Создаётся текст в созданном слое и созданном стиле высотой 5. Текст перемещается в нужное место.
Команда зацикленна, то есть прервать её можно по Esc. Название стиля, слоя. высоты текста и др. в соответствующих переменных.
Удачи!
Вложения
Тип файла: lsp Get_PLine_Length.lsp (5.0 Кб, 130 просмотров)
koMon вне форума  
 
Непрочитано 26.09.2017, 15:37
#6
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Цитата:
Сообщение от koMon Посмотреть сообщение
я решил вам помочь раз и навсегда
Не говори "Гоп"...
Profan вне форума  
 
Автор темы   Непрочитано 26.09.2017, 19:36
#7
Alex_Shaton


 
Регистрация: 09.09.2017
Гомель
Сообщений: 19


Уважаемый koMon! Огромное спасибо! То, что нужно, на AutoCAD 2015 работает без проблем.
Alex_Shaton вне форума  
 
Непрочитано 27.09.2017, 08:50
#8
koMon


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


Цитата:
Сообщение от Profan Посмотреть сообщение
Не говори "Гоп"...
А быть может это был смешливый автовозврат?!...

----- добавлено через -----
Цитата:
Сообщение от Alex_Shaton Посмотреть сообщение
Уважаемый koMon! Огромное спасибо! То, что нужно, на AutoCAD 2015 работает без проблем.
Рад был помочь)
koMon вне форума  
 
Непрочитано 27.09.2017, 12:22
1 | #9
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Слегка модернизированный вариант программы koMon.
Запросы на русском, высота текста = 300, прерывать цикл по Esc теперь не надо, достаточно щелкнуть мышкой в пустом месте или нажать правую кнопку мыши (или Enter).
Код:
[Выделить все]
;******************************************************************************************************************************
;
;                                       Written by koMon 09/26/2017
;                            Редактировал Владимир Громов aka Profan 27.09.2017
;******************************************************************************************************************************

(defun C:Get_PLine_Length ( / echo *error* acadObj doc modelSpace dwg_textStyles_set textStyles_Set_List dwg_Layers_Set Layers_Set_List precision
                              text_Height Pline_Length_layer Pline_Length_Text_Style txtStyleObj layerObj layerObj_color
                              setting_precision Flag is_Polyline nentsel_data selected_object_vl selected_object_name 
                              vertices_List pline_is_Closed vertices_number vertices_index bulge_index bulge_points_list
                              bulge_points_list_index segment_length pline_length one_forth_of_included_Angle chord 
                              arc_radius arc_length text_insert_Point textObj)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
;; Обработчик ошибок
(defun *error* (msg)(princ msg)
(setvar "CMDECHO" echo)
(princ)
) ; *error*
;******************************************************************************************************************************

(defun Make_List_from_Set (set_Object / )
	(setq Set_Items_number (vlax-get set_Object 'Count)
		  Set_index 0
		  Set_List '()
	)
	(repeat Set_Items_number
		(setq Set_List (cons (cons (vlax-get (vla-Item set_Object Set_index) 'Name) (vla-Item set_Object Set_index)) Set_List)
			  Set_index (1+ Set_index)
		)
	)
	Set_List
)

;******************************************************************************************************************************

	(setq acadObj (vlax-get-acad-object)
    	  doc (vla-get-ActiveDocument acadObj)
		  modelSpace (vla-get-ModelSpace doc)
		  dwg_textStyles_set (vla-get-TextStyles doc)
		  textStyles_Set_List (Make_List_from_Set dwg_textStyles_set)
		  dwg_Layers_Set (vla-get-Layers doc)
		  Layers_Set_List (Make_List_from_Set dwg_Layers_Set)
		  precision 1
;;		  text_Height 5.0
		  text_Height 300.0
		  Pline_Length_layer "Polyline Length Text"
		  Pline_Length_Text_Style "Arial_Regular"
	)

	;(print textStyles_List)
	;(print Layers_Set_List)

	(if (not (assoc Pline_Length_Text_Style textStyles_Set_List))
		(progn
			(setq txtStyleObj (vla-Add dwg_textStyles_set Pline_Length_Text_Style))
			(vla-put-fontFile txtStyleObj "C:\\Windows\\Fonts\\Arial.ttf")
		)
	)

	(if (not (assoc Pline_layer Layers_Set_List))
		(progn
			(setq layerObj (vla-Add dwg_Layers_Set Pline_Length_layer))
			(setq layerObj_color (vlax-create-object (strcat "AutoCAD.AcCmColor." (substr (getvar "ACADVER") 1 2))))
    		(vla-SetRGB layerObj_color 255 0 0)
			(vla-put-TrueColor layerObj layerObj_color)

		)
	)

	(initget 6)
	(setq setting_precision t)
	(while setting_precision
;;		(setq precision (getint (strcat "\nУкажите точность <1-2>: ")))
		(setq precision (getint "\nУкажите точность <1-2>: "))
		(cond
			(
				(null precision)
					(setq precision 1 setting_precision nil)
			)
			(
				(> precision 2)
					nil
			)
			(
				t
					(setq setting_precision nil)
			)
		)
	)
(setq Flag T)
	(while Flag
		(setq is_Polyline nil)
		(while (not is_Polyline)
			(setq nentsel_data (nentsel "\nВыберите полилинию: "))
			(cond
			((not nentsel_data) (princ "\nНичего не выбрано. ") (setq is_Polyline T Flag nil))
			(t (setq selected_object_vl (vlax-ename->vla-object (car nentsel_data))  
                                 selected_object_name (vla-get-ObjectName selected_object_vl))
 	                   (if (= selected_object_name "AcDbPolyline")
				(setq is_Polyline t Flag T)
				(princ "\nНеверный выбор. ")
			    ) ; if
			)
			) ; cond
		) ; wile 
            (if Flag
                (progn
		(setq vertices_List (vlax-get selected_object_vl 'Coordinates)
			  pline_is_Closed (vla-get-closed selected_object_vl)
			  vertices_number (length vertices_List)
			  vertices_index 0
			  bulge_index 0
			  bulge_points_list '()
		)

		(repeat (/ vertices_number 2)
			(setq bulge_points_list (cons (list (vla-GetBulge selected_object_vl bulge_index) (list (nth vertices_index vertices_List) (nth (1+ vertices_index) vertices_List))) bulge_points_list)
				  vertices_index (+ 2 vertices_index)
				  bulge_index (1+ bulge_index)
			)
		)
		(if (= pline_is_Closed ':vlax-true)
			(setq bulge_points_list (reverse (cons (last bulge_points_list) bulge_points_list)))
			(setq bulge_points_list (reverse bulge_points_list))
		)
		(setq bulge_points_list_index  0
			  pline_length 0
		)
		(repeat (1- (length bulge_points_list))
			(cond
				(
					(= (car (nth bulge_points_list_index bulge_points_list)) 0)
						(setq segment_length (distance (cadr (nth bulge_points_list_index bulge_points_list)) (cadr (nth (1+ bulge_points_list_index) bulge_points_list)))
							  segment_length (atof (rtos segment_length 2 precision))
							  pline_length (+ pline_length segment_length)
						)
						;(print segment_length)
				)
				(
					t
						(setq one_forth_of_included_Angle (atan (abs (car (nth bulge_points_list_index bulge_points_list))))
							  chord (distance (cadr (nth bulge_points_list_index bulge_points_list)) (cadr (nth (1+ bulge_points_list_index) bulge_points_list)))
							  arc_radius (/ (/ chord 2.0) (sin (* 2.0 one_forth_of_included_Angle)))
						      arc_length (atof (rtos (* 4.0 arc_radius one_forth_of_included_Angle) 2 precision))
							  pline_length (+ pline_length arc_length)
						)
						;(print arc_length)
				)
			)
			(setq bulge_points_list_index (1+ bulge_points_list_index))
		)
		(setq text_insert_Point (vlax-3d-point (cadr nentsel_data))
			  textObj (vla-AddText modelSpace (vl-string-subst "," "." (rtos pline_length 2 precision)) text_insert_Point text_Height)
		)
		(vla-put-Layer textObj Pline_Length_layer)
		(vla-put-StyleName textObj Pline_Length_Text_Style)
                (princ "\nРасположите текст.")
                (command "_copybase" "_none" (cadr nentsel_data) (entlast) "" "_erase" (entlast) "" "_pasteclip" pause)
;;		(command-s "_move" (vlax-vla-object->ename textObj) "" (cadr nentsel_data))
                ) ; progn
            ) ; if
	) ; While
(setvar "CMDECHO" echo)
(princ)
)
Profan вне форума  
 
Непрочитано 27.09.2017, 14:47
1 | #10
koMon


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


Profan,

Цитата:
Сообщение от Profan Посмотреть сообщение
Слегка модернизированный вариант программы koMon.
Profan,

Ну не знаю...

Лично мне идея с копипастом не нравится) И останов по пустому выбору если честно тоже.

Хотел было функцию укоротить, но теперь уж ни к чему наверное)

(defun Make_List_from_Set (set_Object / Set_Item Set_List)
(setq Set_List '())
(vlax-for set_Item set_Object
(setq Set_List (cons (cons (vlax-get set_Item 'Name) set_Item) Set_List))
)
Set_List
)
koMon вне форума  
 
Непрочитано 27.09.2017, 16:09
1 | #11
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Остонов по Enter - стандартный останов. Если он еще срабатывает и по пустому указанию объекта - тем лучше. А выход из программы (цикла) по Esc вообще-то запускает обработчик ошибок. Это в текущей программе практически нет критических изменяемых системных переменных, но полно программ, в которых этих переменных много и их необходимо возвращать в исходные значения при аварийном выходе из программы (а таким выходом сплошь и рядом как раз является выход по Esc).
Использование буфера обмена для вставки текста в нужное место - не самый лучший вариант, особенно при удаленной работе с чертежами через Интернет. Зато текст "висит" на курсоре без отображения исходного текста и вставка его в чертеж аналогична вставке блока. Возможна другая процедура вставки текста (фрагмент кода в конце):
Код:
[Выделить все]
		(setq text_insert_Point (vlax-3d-point (getpoint "\nУкажите точку вставки текста: "))
			  textObj (vla-AddText modelSpace (vl-string-subst "," "." (rtos pline_length 2 precision)) text_insert_Point text_Height)
		)
		(vla-put-Layer textObj Pline_Length_layer)
		(vla-put-StyleName textObj Pline_Length_Text_Style)
                ) ; progn
            ) ; if
	) ; While
(setvar "CMDECHO" echo)
(princ)
)
К сожалению, в этом случае самого текста до указания точки не видно.
Тот же фрагмент с использованием блока:
Код:
[Выделить все]
		(setq text_insert_Point (vlax-3d-point (cadr nentsel_data))
			  textObj (vla-AddText modelSpace (vl-string-subst "," "." (rtos pline_length 2 precision)) text_insert_Point text_Height)
		)
		(vla-put-Layer textObj Pline_Length_layer)
		(vla-put-StyleName textObj Pline_Length_Text_Style)
                (vl-cmdf "_-BLOCK" "instext" (cadr nentsel_data) (entlast) "")
                (princ "\nРасположите текст.")
                (vl-cmdf "_-INSERT" "instext" pause "1" "1" "0")
                (vl-cmdf "_EXPLODE" (entlast))
                (vl-cmdf "_PURGE" "_B" "*" "_N")
                ) ; progn
            ) ; if
	) ; While
(setvar "CMDECHO" echo)
(princ)
)
Код получился несколько длиннее, да ведь это ерунда.
Допускаю, что в целом код не оптимален, но если тебя, например, устраивает именно твой вариант, то меня как раз устраивает любой из моих вариантов. Если ты, конечно, не будешь категорически против.
Profan вне форума  
 
Непрочитано 27.09.2017, 17:19
#12
koMon


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


Цитата:
Сообщение от Profan Посмотреть сообщение
А выход из программы (цикла) по Esc вообще-то запускает обработчик ошибок.
В этом конкретном случае я не писал обработчик ошибок именно по простоте лиспа в части взаимодействия со средой автокада. Хотелось сделать быстрый и красивый лисп.

Цитата:
Сообщение от Profan Посмотреть сообщение
Если ты, конечно, не будешь категорически против.
Категорически возражать я, конечно же не буду)
koMon вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Lisp для подсчета суммы округленных длин сегментов полилинии

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужен LISP для суммы длин отрезков линни ilka_t LISP 219 10.09.2019 10:22
LISP. Как в ActiveX выдернуть координаты полилинии? Как задавать атребуты блока через LISP? wpww LISP 31 16.08.2016 14:17
lisp: Длина по полилинии до точки vosh LISP 19 15.07.2013 15:10
LISP для подсчета суммы длин линий Kostinok LISP 18 26.04.2013 14:56
LISP. Как найти точку пересечения полилинии и сплайна или другой полилинии? LastGraff LISP 11 09.09.2011 13:23