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

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

Ищу программу для расстановки в автокаде блоков вдоль полилинии

Ответ
Поиск в этой теме
Непрочитано 07.02.2018, 15:37 #1
Ищу программу для расстановки в автокаде блоков вдоль полилинии
MSWAN
 
Регистрация: 07.02.2018
Сообщений: 6

Добрый день!
Задача такая - нужно расставить в атокаде блоки вдоль полилинии, расстояния между блоками различные и импортируются из таблицы excel. В жизни это выглядит так: у меня есть журнал расстановки опор, т.е. список пролетов между опорами, и есть трасса, полилиния в автокаде. Хочу автоматизировать процесс переноса опор с профиля на план. Через поиск решение своей задачи не нашел. Буду признателен за помощь!
Просмотров: 11087
 
Непрочитано 07.02.2018, 15:47
#2
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Язык понятно Lisp.. и в чем сложность? Какие то свои попытки/наработки есть? покажите публике? В каком месте и что не понятно?
Boxa вне форума  
 
Непрочитано 07.02.2018, 15:56
#3
trir


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


формулой в Excel'е:
(command "_insert" ...)
trir вне форума  
 
Непрочитано 07.02.2018, 15:58
#4
Enik

ГИП
 
Регистрация: 07.06.2015
Сообщений: 1,254


Ну так, в экселе рассчитать координаты вершин, через cadtools отрисовать по ним полилинию, лиспом blocktopline вставить в вершины блоки.
Enik вне форума  
 
Непрочитано 07.02.2018, 16:02
#5
trir


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


http://www.cadtutor.net/forum/archiv.../t-95548.html?
trir вне форума  
 
Автор темы   Непрочитано 07.02.2018, 16:08
#6
MSWAN


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


С программированием не дружу.. Для расстановки пикетов по трассе пользуюсь лиспом "piket" к сожалению на автора сослаться не могу, т.к. не помню. Возможно ли добавить в код запрос данных из excel вместо запроса дистанции?

Код:
[Выделить все]
 (vl-load-com) 
(defun c:piket ( / name_of_bl dis pln dis_pl dis_run i krd prm_pnt
proiz ugol_pl ugol_pl_gr my_blok my_att spis_att
att_old att_new spis_att strt stp)
(setq snp (getvar "Osmode"))
(setvar "Osmode" 0) 
(setq name_of_bl (getstring "Name of blok? "))
(setq dis (getreal "Distance? "))
(setq strt (getint "\nStart number? "))
(setq stp (getint "\nStep? ")) 
(setq pref (getstring "\nPrefiks? "))
(setq suff (getstring "\nSuffiks? "))
(setq pln (car (entsel)))
(setq dis_pl (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln)))
(setq dis_run (- 0.0 dis) i (- strt stp))
(while(< (+ dis_run dis) dis_pl)
(progn
(setq i (+ i stp))
(setq dis_run (+ dis_run dis))
(setq krd (vlax-curve-getPointAtDist pln dis_run))
(setq prm_pnt (vlax-curve-getParamAtPoint pln krd))
(setq proiz (vlax-curve-getFirstDeriv pln prm_pnt))
(setq ugol_pl (angle '(0 0 0) proiz))
(setq ugol_pl_gr (* ugol_pl 57.29747))
(setvar "attreq" 0)
(command "_.insert" name_of_bl krd 1.0 1.0 ugol_pl_gr)
(setq my_blok (entlast))
(setq my_att (entnext my_blok))
(setq spis_att (entget my_att)) ;spisok 
(setq att_old (assoc 1 spis_att)) ;name
(setq num_new (itoa i))
(setq num_new (strcat pref num_new suff))) 
(setq att_new (cons 1 num_new)) ;
(setq spis_att (subst att_new att_old spis_att)); zamena
(entmod spis_att)
(entupd (cdr (assoc -1 spis_att)))
) ;progn
)
(setvar "Osmode" snp)
)
----- добавлено через ~7 мин. -----
Цитата:
Сообщение от Enik Посмотреть сообщение
Ну так, в экселе рассчитать координаты вершин, через cadtools отрисовать по ним полилинию, лиспом blocktopline вставить в вершины блоки.
появится определенная погрешность, т.к. надо учитывать углы
MSWAN вне форума  
 
Непрочитано 07.02.2018, 16:15
#7
trir


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


возможно, я с этого начял изучение lisp'а...
trir вне форума  
 
Непрочитано 08.02.2018, 08:58
#8
koMon


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


Цитата:
Сообщение от MSWAN Посмотреть сообщение
… таблицы excel. … полилиния в автокаде.
А можно их посмотреть?
koMon вне форума  
 
Автор темы   Непрочитано 08.02.2018, 09:32
#9
MSWAN


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


Вот - список пролетов в excel и автокад с полилинией, создан блок с атрибутом - "опора", который нужно копировать.
Вложения
Тип файла: xlsx 1.xlsx (8.7 Кб, 122 просмотров)
Тип файла: dwg
DWG 2000
расстановка вдоль линии.dwg (137.6 Кб, 157 просмотров)
MSWAN вне форума  
 
Непрочитано 08.02.2018, 09:54
#10
Boxa

КЖ; C#
 
Регистрация: 03.11.2005
Санкт-Петербург
Сообщений: 2,588


Цитата:
Сообщение от MSWAN Посмотреть сообщение
Для расстановки пикетов по трассе пользуюсь лиспом "piket" к сожалению на автора сослаться не могу, т.к. не помню.
Позвольте я за Вас поищу в интернете и напомню Вам автора: http://forum.dwg.ru/showpost.php?p=415536&postcount=20

В указанной теме много кода, возможно что то Вам подойдет.
Boxa вне форума  
 
Непрочитано 08.02.2018, 11:45
#11
koMon


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


Offtop: Это уже интрига))) Говорил же Профан, не говори гоп…
koMon вне форума  
 
Непрочитано 08.02.2018, 13:31
2 | #12
koMon


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


Цитата:
Сообщение от MSWAN Посмотреть сообщение
Вот - список пролетов в excel и автокад с полилинией, создан блок с атрибутом - "опора", который нужно копировать.
Oops, I did it again)))

Ну если использовать созданную обстановку: dwg с полилинией, блок "Опора" с атрибутом "НОМЕР_ОПОРЫ" , сохранённый в этом dwg, файл с дистанцияями в формате, например *.txt с числами в один столбец (поскольку excel содержит всего лишь один столбец с числами), то лисп может выглядет как-то так.

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

Код:
[Выделить все]
 (defun get_listed_objects ( get_prompt objects_list / entity_seleсted vla_object )
	(while
  		(or (not (setq entity_seleсted (vl-catch-all-apply 'entsel (list get_prompt))))
			(= 'VL-CATCH-ALL-APPLY-ERROR (type entity_seleсted))
  			(not
  				(member (vla-get-objectname (setq vla_object (vlax-ename->vla-object (car entity_seleсted))))
  						objects_list
  				)
  			)
  		)
	)
	vla_object
)

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

(defun c:Block_Along_PLine ( /
								Acad_Object All_Attributes_List Aux_Get_Angle_Point Current_Distance Current_Footing_Block Current_Footing_Block_Angle
								Current_String Distance_From_Beginning Document_Layers_Collection Document_Object Drawing_Path File_To_Open Footings_File
								Footings_Processed Footing_Block_Name Insertion_Point Modelspace_Object Target_Polyline
							)

	(setq acad_Object (vlax-get-acad-object)
		  document_object (vla-get-ActiveDocument acad_Object)
		  document_layers_collection (vla-get-Layers document_object)
		  modelSpace_object (vla-get-ModelSpace document_Object)
		  drawing_path (strcat (vlax-get document_object 'Path) "\\")
		  footing_block_name "Опора"
		  distance_from_beginning 0.0
		  target_polyline (get_listed_objects "\nSelect Target PolyLine to Arrange Footings: " (list "AcDbPolyline"))
	)
	(if (= (getvar "USERS1") "")
		(setvar "USERS1" drawing_path)
		(if (not (vl-file-directory-p (getvar "USERS1"))) (setvar "USERS1" drawing_path) (setq drawing_path (getvar "USERS1")))
	)
	(if (setq file_to_open (getfiled "Select Footing Data File to Read from" drawing_path "txt" 16))
		(progn
			(setq footings_file (open file_to_open "r")
				  footings_processed 1
			)
			(setvar "USERS1" (vl-filename-directory file_to_open))

			(while (setq current_string (read-line footings_file))
				(setq current_distance (atof current_string)
					  distance_from_beginning (+ distance_from_beginning current_distance)
					  insertion_point (vlax-3d-point (vlax-curve-getPointAtDist target_polyline distance_from_beginning))
					  aux_get_angle_point (vlax-3d-point (vlax-curve-getPointAtDist target_polyline (+ 0.1 distance_from_beginning)))
					  current_footing_block_angle (vla-AngleFromXAxis (vla-get-Utility document_object) insertion_point aux_get_angle_point)
				      current_footing_block (vla-InsertBlock modelSpace_object insertion_point footing_block_name 1 1 1 current_footing_block_angle)
					  all_attributes_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_footing_block)))
				)
				(foreach attribute_item all_attributes_list
					(if (= "НОМЕР_ОПОРЫ" (vla-get-TagString attribute_item))
						(vla-put-TextString attribute_item (strcat "№" (itoa footings_processed)))
					)
				)
				(setq footings_processed (1+ footings_processed))
  			)
  			(close footings_file)
			(princ (strcat "\nTotal of " (itoa footings_processed) " Footings Were Processed"))
		)
		(princ "\nYou've Just Cancelled the Command!")
	)
	(princ)
)
Вложения
Тип файла: lsp Block_Along_PLine.lsp (3.2 Кб, 151 просмотров)
koMon вне форума  
 
Непрочитано 08.02.2018, 13:42
#13
jackUAROBEY

Проектировщик ВК
 
Регистрация: 18.09.2014
Анапа
Сообщений: 55


Удалено
jackUAROBEY вне форума  
 
Автор темы   Непрочитано 08.02.2018, 14:48
#14
MSWAN


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Oops, I did it again)))

Ну если использовать созданную обстановку: dwg с полилинией, блок "Опора" с атрибутом "НОМЕР_ОПОРЫ" , сохранённый в этом dwg, файл с дистанцияями в формате, например *.txt с числами в один столбец (поскольку excel содержит всего лишь один столбец с числами), то лисп может выглядет как-то так.
Гениально! работает!)) спасибо огромное!

Цитата:
Сообщение от koMon Посмотреть сообщение
Oops, I did it again)))

Ну если использовать созданную обстановку: dwg с полилинией, блок "Опора" с атрибутом "НОМЕР_ОПОРЫ" , сохранённый в этом dwg, файл с дистанцияями в формате, например *.txt с числами в один столбец (поскольку excel содержит всего лишь один столбец с числами), то лисп может выглядет как-то так.
Спасибо огромное!! Настоящий человечище! Прога просто гениальна!!

Последний раз редактировалось Кулик Алексей aka kpblc, 08.02.2018 в 16:45.
MSWAN вне форума  
 
Непрочитано 08.02.2018, 16:44
#15
koMon


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


Пожалуйста) Offtop: Но утврждения 2, 3 всё-таки как-то гиперболизированы)
koMon вне форума  
 
Непрочитано 21.02.2018, 15:43
#16
Scared


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Ну если использовать созданную обстановку: dwg с полилинией, блок "Опора" с атрибутом "НОМЕР_ОПОРЫ" , сохранённый в этом dwg, файл с дистанцияями в формате, например *.txt с числами в один столбец (поскольку excel содержит всего лишь один столбец с числами), то лисп может выглядет как-то так.
Спасибо, полезная функция!
А нельзя сюда добавить также и обратное действие?
В качестве исходных данных - полилиния и блоки, содержащие атрибут "название", которые вдоль неё натыканы.
На выходе - экселевская табличка, в которой содержится столбец названий и столбец расстояний
Расстояния должны измеряться, понятно, вдоль полилинии. Если базовая точка блока не совпадает с полилинией - брать ближайшую к базе блока точку полилинии.
Вложения
Тип файла: dwg
DWG 2010
Ось дороги.dwg (63.8 Кб, 101 просмотров)
Scared вне форума  
 
Непрочитано 21.02.2018, 16:18
#17
koMon


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


Цитата:
Сообщение от Scared Посмотреть сообщение
А нельзя сюда добавить также и обратное действие?
Можно конечно, я и сам об этом подумывал, да и поворт блока как-то коряво на выходе получается...
koMon вне форума  
 
Непрочитано 21.02.2018, 17:15
#18
Scared


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Можно конечно, я и сам об этом подумывал
Было б круто )
Scared вне форума  
 
Непрочитано 21.02.2018, 22:12
#19
Tyhig

Оснащение проходки горных выработок, ПОС, нормоконтроль, КР, АР
 
Блог
 
Регистрация: 30.01.2008
Ленинград
Сообщений: 18,620


Если ко мне когда-нибудь придёт проект этих опор сделанный в этих ваших макросах, я автора по айпи вычислю !
Ну что за глупости ? Опоры надо на плане расставлять !
__________________
"Безвыходных ситуаций не бывает" барон Мюнхаузен
Tyhig вне форума  
 
Непрочитано 28.02.2018, 17:51
#20
koMon


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


Пока товарищ нормоконтролёр находится в состоянии ожидания перспективного приходящего проекта, а его со-товарищ барон Мюнхаузен мечется по микрокосму всемирной паутины в поисках требуемого IP-адреса, восседая на электроне, я произвёл корректировку макроса, который теперь сможет экспортировать дистанции точек вставки блоков, находящихся на полилинии.

Цитата:
Сообщение от Scared Посмотреть сообщение
А нельзя сюда добавить также и обратное действие?
Методология следующая:
1. Выбирается полилиния и анализируются объекты, пересекаемые ею.
1-1. Если среди объектов находятся блоки, то предлагается ввести имя файла *.csv (разделитель "точка с запятой") для экспорта дистанций этих блоков от начала полилинии, которое помечается флажком. Если точка вставки блока не лежит на полилинии экспортируется дистанция до ближайшей к ней точки полилинии, в которую корректируется точка встаки блока. Дистанции и др. инормация экпортируются в следующем формате: "П/н блока;Атрибут-Номер_опоры;Атрибут-Название;Отн. дистаниция;Абс. дистанция". Если в блоке есть атрибуты, указанные выше, то и их значения, экспортируются в соответстующую колонку, в противном случае "Nonе".
1-2. Если среди объектов нет блоков, то предлагаеися ввести имя файла с дистанциями для расстановки блоков по ним. Файл может быть или *.txt, в котором относительные дистанции находятся в одном столбце или *.csv, подобный созданному в п.1-1, из которого также берутся относительные листанции. Если в dwg нет блока "Опора", то он создаётся таким, каким он был у MSWAN, только атрибут расположен горизонтально и выравнивание текста у него "по центру". Размещение атрибутов я изменил в сравнении с предыдущим лиспом на итолько горизонтальное. Оно конечно не идеальное, но пока заниматься улучшением не хочется. Дистанции экспортируются в восходящем порядке.
2. Проверки на правильность импортируемых данных отсутствуют.
Ну вот, как-то так)))

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

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

;											        koMon 28.02.2018

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

													 (vl-load-com)

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

(defun get_corrected_angle (input_angle / output_angle)
  	(cond
  	  		(
  			 	(and
  				  (or (> input_angle 0.0) (equal input_angle 0.0 1e-10))
  				  (or (< input_angle (/ pi 2)) (< (- input_angle (/ pi 2)) 1e-10))
  			  	)
  			 		(setq output_angle (+ input_angle (/ pi 2)))
  			)
  			(
  				(and
  				  (or (> input_angle pi) (< (- input_angle pi) 1e-10))
  				  (or (< input_angle (+ pi (/ pi 2))) (< (- input_angle (+ pi (/ pi 2))) 1e-10))
  			  	)
  				  	(setq output_angle (- input_angle (/ pi 2)))
  			)
  			(
  				(and
  				  (> input_angle (/ pi 2))
  				  (< input_angle pi)
  			  	)
  				  	(setq output_angle (- input_angle (/ pi 2)))
  			)
  				(
  				(and
  				  (> input_angle (+ pi (/ pi 2)))
  				  (< input_angle (* pi 2))
  			  	)
  				  	(setq output_angle (+ input_angle (/ pi 2)))
  			)
	)
)

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

(defun get_pline ( / is_selecting_polyline entsel_return entsel_data polyline_object)
	(setq is_selecting_polyline t)
	(while is_selecting_polyline
		(setq entsel_return (type (setq entsel_data (vl-catch-all-apply 'EntSel (list "\nSelect Polyline or Press ESC to Cancel ")))))
		(cond
			(
				(= entsel_return 'LIST)
					(cond
						(
						 	(member (vla-get-objectname (setq polyline_object (vlax-ename->vla-object (car entsel_data)))) (list "AcDbPolyline" "AcDb2dPolyline"))
						 		(setq is_selecting_polyline nil)
						)
							(
								t
									(princ "\nWrong Selection! ")

							)
					)
			)
			(
				(= entsel_return 'VL-CATCH-ALL-APPLY-ERROR)
					(setq is_selecting_polyline nil)
			)
			(
				t
					(princ "\nNothing is Selected! ")

			)
		)
	)
	polyline_object
)

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

(defun c:Block_Along_PLine ()

	(setq block_ALong_Pline_Vars '(
									Acad_Object All_Attributes_List Aux_Get_Angle_Point Aux_Start_Angle_Point Blocks_List Block_Name Block_Number
		  							Block_Point blocks_processed Block_Uniscale Crossing_Window_Sset_Object Current_Distance Current_Footing_Block Current_Footing_Block_Angle
		  							Current_Line Current_Relative_Distance Current_String Distances_File Distance_File_Path Distance_From_Beginning Document_Object
		  							Document_Selection_Sets Dwg_Blocks_Collection Error_Occured File_To_Open Footings_Processed Footing_Block_Added Footing_Block_Attribute_Object
		  							Footing_Block_Circle_Object Footing_Block_Is_Defined Footing_Block_Name Has_Name Has_Number Insertion_Point Intersections_Number
		  							Intersection_Points_Array Is_Zoomed_Out Is_Zoommed_Out Left_Lower_Corner Modelspace_Object Objects_To_Remove Objects_To_Remove_List
		  							Polyline_Start_Flag_Array Polyline_Start_Flag_Object Previous_Relative_Distance Right_Upper_Corner Segment_0_End_Width Screen_Center_Units
									Screen_Height_Units Screen_Llc Screen_Ruc Screen_Size_Pixels Screen_Width_Units Segment_0_Start_Width Selected_Index Start_Flag_Angle
									Target_Polyline	Target_Polyline_Start_Point There_Is_Crossing_Window_Sset Vla_Method_Executed Width_Multiplier Current_Line_Char_List
									Current_String_Char_List Read_Data_List File_To_Open_Is_Txt selecting_export_file
								   )
		  target_polyline (get_pline)
	)
	(and target_polyline
		(progn
			(setq acad_Object (vlax-get-acad-object)
				  document_object (vla-get-ActiveDocument acad_Object)
				  modelSpace_object (vla-get-ModelSpace document_Object)
				  Distance_File_Path (strcat (vlax-get document_object 'Path) "\\")
				  document_Selection_sets (vla-get-SelectionSets document_object)
				  there_is_Crossing_Window_Sset nil
				  polyline_start_flag_array (vlax-make-safearray vlax-vbDouble '(0 . 11))
				  vla_method_executed (vlax-safearray-fill polyline_start_flag_array '(0 0 0 10 8 10 5 7.5 8 5 0 5))
				  polyline_start_flag_object (vla-AddLightWeightPolyline modelSpace_object polyline_start_flag_array)
				  target_polyline_start_point (list (car (vlax-get target_polyline 'Coordinates)) (cadr (vlax-get target_polyline 'Coordinates)))
				  aux_start_angle_point (vlax-3d-point (vlax-curve-getPointAtDist target_polyline 0.1))
				  start_flag_angle (vla-AngleFromXAxis (vla-get-Utility document_object) (vlax-3d-point target_polyline_start_point) aux_start_angle_point)
				  vla_method_executed (vla-Move polyline_start_flag_object (vlax-3d-point 0 0 0) (vlax-3d-point target_polyline_start_point))
				  vla_method_executed (vla-Rotate polyline_start_flag_object (vlax-3d-point target_polyline_start_point) start_flag_angle)
				  vla_method_executed (vla-GetWidth target_polyline 0 'Segment_0_Start_Width 'Segment_0_End_Width)
				  block_uniscale (if (and (not (zerop Segment_0_Start_Width)) (> Segment_0_Start_Width 10)) (/ Segment_0_Start_Width 5) 1)
				  vla_method_executed (vla-ScaleEntity polyline_start_flag_object (vlax-3d-point target_polyline_start_point) block_uniscale)
				  vla_method_executed (vla-GetBoundingBox target_polyline 'left_lower_corner 'right_upper_corner)
				  screen_center_units (getvar "VIEWCTR")
				  screen_height_units (getvar "VIEWSIZE")
				  screen_size_pixels (getvar "SCREENSIZE")
				  width_multiplier (/ (car screen_size_pixels)  (cadr screen_size_pixels))
				  screen_width_units (* screen_height_units width_multiplier)
				  screen_llc (list (- (car screen_center_units) (/ screen_width_units 2.0)) (- (cadr screen_center_units) (/ screen_height_units 2.0)))
				  screen_ruc (list (+ (car screen_center_units) (/ screen_width_units 2.0)) (+ (cadr screen_center_units) (/ screen_height_units 2.0)))
			)
			(if (or
					(< (car (vlax-safearray->list left_lower_corner)) (car screen_llc))
					(< (cadr (vlax-safearray->list left_lower_corner)) (cadr screen_llc))
					(> (car (vlax-safearray->list left_lower_corner)) (car screen_llc))
					(> (cadr (vlax-safearray->list left_lower_corner)) (cadr screen_llc))
				)
					(progn
						(vla-ZoomWindow acad_Object left_lower_corner right_upper_corner)
						(setq is_zoommed_out t)
					)
			)
			(vlax-for selection_set document_Selection_sets
				(if (= "Crossing_Window_Sset" (vla-get-name selection_set))
					(setq there_is_Crossing_Window_Sset t
						  Crossing_Window_sset_Object selection_set
					)
				)
			)
			(if there_is_Crossing_Window_Sset
				(progn
					(vla-delete Crossing_Window_sset_Object)
					(vlax-release-object Crossing_Window_sset_Object)
					(setq Crossing_Window_sset_Object (vla-Add document_Selection_sets "Crossing_Window_Sset"))
				)
				(setq Crossing_Window_sset_Object (vla-Add document_Selection_sets "Crossing_Window_Sset"))
			)
			(vla-Select Crossing_Window_sset_Object acSelectionSetCrossing left_lower_corner right_upper_corner)
			(if is_zoommed_out (setq vla_method_executed (vla-ZoomPrevious acad_Object) is_zoomed_out nil))
			(setq objects_to_remove_list '()
				  selected_index 0
			)
			(repeat (vla-get-count Crossing_Window_sset_Object)
				(if (/= "AcDbBlockReference" (vla-get-objectname (vla-item Crossing_Window_sset_Object selected_index)))
					(setq objects_to_remove_list (cons (vla-item Crossing_Window_sset_Object selected_index) objects_to_remove_list))
					(progn (setq intersection_Points_array (vl-catch-all-apply 'vla-IntersectWith (list target_polyline (vla-item Crossing_Window_sset_Object selected_index) acExtendNone)))
						(if (or
								(= (type intersection_Points_array) 'VL-CATCH-ALL-APPLY-ERROR)
								(< (setq intersections_number (vlax-safearray-get-u-bound (vlax-variant-value intersection_Points_array) 1)) 0)
							)
								(setq objects_to_remove_list (cons (vla-item Crossing_Window_sset_Object selected_index) objects_to_remove_list))
						)
					)
				)
				(setq selected_index (1+ selected_index))
			)
			(setq objects_to_remove (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objects_to_remove_list))))
				  selected_index 0
			)
			(repeat (length objects_to_remove_list)
				(vlax-safearray-put-element objects_to_remove selected_index (nth selected_index objects_to_remove_list))
				(setq selected_index (1+ selected_index))
			)
			(vla-RemoveItems Crossing_Window_sset_Object objects_to_remove)
			(if (not (zerop (vla-get-count Crossing_Window_sset_Object)))

				(progn		;<+++++++++++++++++++++export code +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
					(setq blocks_list '())
					(vlax-for block_item Crossing_Window_sset_Object
						(setq block_point (vlax-curve-getClosestPointTo target_polyline (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint block_item))))
							  vla_method_executed (vla-put-insertionpoint block_item (vlax-3d-point block_point))
							  blocks_list (cons (list (vlax-curve-getdistatpoint target_polyline block_point) block_item) blocks_list)
						)
					)
					(setq blocks_list (vl-sort blocks_list
									  		(function (lambda (element_1 element_2)
															(< (car element_1) (car element_2))
													  )
											)
									  )
					)
					(if (null (vlax-ldata-list modelSpace_object))
						(vlax-ldata-put modelSpace_object "Distance_File_Path" Distance_File_Path)
						(if (not (vl-file-directory-p (cdr (assoc "Distance_File_Path" (vlax-ldata-list modelSpace_object)))))
							(vlax-ldata-put document_object "Distance_File_Path" Distance_File_Path)
							(setq Distance_File_Path (cdr (assoc "Distance_File_Path" (vlax-ldata-list modelSpace_object))))
						)
					)
					(setq selecting_export_file nil)
					(while (not selecting_export_file)
						(setq file_to_open (getfiled "Enter Distances Data File Name to Write to" Distance_File_Path "csv" 3))
						(if file_to_open (if (null (setq distances_file (open file_to_open "w"))) (alert "Selected file is Locked! \nEnter Another Name.") (setq selecting_export_file t)) (setq selecting_export_file t))
					)
					(if file_to_open
						(progn
							(setq previous_relative_distance 0.0
								  blocks_processed 1
								  vla_method_executed (vlax-ldata-put modelSpace_object "Distance_File_Path" (strcat (vl-filename-directory file_to_open) "\\"))
							)
							(write-line "П/н блока;Атрибут-Номер_опоры;Атрибут-Название;Отн. дистаниция;Абс. дистанция" distances_file)
							(foreach block_item blocks_list
								(setq current_relative_distance (- (car block_item) previous_relative_distance)
									  previous_relative_distance (car block_item)
									  all_attributes_list '()
									  all_attributes_list (if (= :vlax-true (vla-get-hasattributes (cadr block_item))) (vlax-safearray->list (vlax-variant-value (vla-getattributes (cadr block_item)))))
									  has_number nil
									  has_name nil
									  all_attributes_list (if all_attributes_list (vl-remove-if-not
																						(function
																							(lambda (attribute_item)
																								(or
																									(and (= "НОМЕР_ОПОРЫ" (vla-get-TagString attribute_item)) (setq has_number t) (setq block_number (vla-get-TextString attribute_item)))
																									(and (= "НАЗВАНИЕ" (vla-get-TagString attribute_item)) (setq has_name t) (setq block_name (vla-get-TextString attribute_item)))
																								)
																							)
																						)
																						all_attributes_list
																				  )
														   )
								)
								(setq current_line (strcat (itoa blocks_processed) ";" (if has_number block_number "None") ";" (if has_name block_name "None") ";" (rtos current_relative_distance) ";" (rtos (car block_item))))
								(write-line current_line distances_file)
								(setq blocks_processed (1+ blocks_processed))
							)
							(princ (strcat "\nTotal of " (itoa (1- blocks_processed)) " Blocks Were Processed"))
							(close distances_file)
						)
						(setq vla_method_executed (vla-erase polyline_start_flag_object)
							  error_occured	(princ "\nYou've Just Cancelled the Command!")
						)
					)
				)			;<+++++++++++++++++++++export code +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

				(progn 		;<+++++++++++++++++++++import code +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
					(setq dwg_blocks_collection (vla-get-Blocks document_Object)
						  Distance_File_Path (strcat (vlax-get document_object 'Path) "\\")
						  distance_from_beginning 0.0
						  footing_block_name "Опора"
						  footing_block_is_defined nil
					)
					(vlax-for collection_block dwg_blocks_collection
						(if (= (vla-get-name collection_block) footing_block_name)
							(setq footing_block_is_defined t)
						)
					)
																			;	attribute height 2.5
																			;	attribute mode acAttributeModeVerify
																			;	attribute prompt "Номер опоры"
																			;	attribute insertion point -4.0 5.5 0.0
																			;	attribute tag "НОМЕР_ОПОРЫ"
																			;	atribute value "&"
					(if (not footing_block_is_defined)
						 (setq footing_block_added (vla-Add dwg_blocks_collection (vlax-3d-point 0 0 0) "Опора")
							   footing_block_circle_object (vla-AddCircle footing_block_added (vlax-3d-point 0 0 0) 5.0)
							   footing_block_attribute_object (vla-AddAttribute footing_block_added 2.5 acAttributeModeVerify "Номер опоры" (vlax-3d-point 0.0 0.0 0.0) "НОМЕР_ОПОРЫ" "&")
							   vla_method_executed (vla-put-alignment footing_block_attribute_object 1)
							   vla_method_executed (vla-put-TextAlignmentPoint footing_block_attribute_object (vlax-3d-point 0.0 10.0 0.0))
						 )
					)

					(if (null (vlax-ldata-list modelSpace_object))
						(vlax-ldata-put modelSpace_object "Distance_File_Path" Distance_File_Path)
						(if (not (vl-file-directory-p (cdr (assoc "Distance_File_Path" (vlax-ldata-list modelSpace_object)))))
							(vlax-ldata-put document_object "Distance_File_Path" Distance_File_Path)
							(setq Distance_File_Path (cdr (assoc "Distance_File_Path" (vlax-ldata-list modelSpace_object))))
						)
					)
					(if (setq file_to_open (getfiled "Select Footing Data File to Read from" Distance_File_Path "txt;csv" 16))
						(progn
							(setq distances_file (open file_to_open "r")
								  vla_method_executed (vlax-ldata-put modelSpace_object "Distance_File_Path" (strcat (vl-filename-directory file_to_open) "\\"))
								  file_to_open_is_txt (if (= (strcase (vl-filename-extension file_to_open) t) ".txt") t nil)
							)
							(setq current_string (read-line distances_file)
								  footings_processed 1
							)
							(while current_string
								(setq current_distance (if file_to_open_is_txt
															(atof current_string)
															(progn
																(setq current_string_char_list (vl-string->list current_string)
      																  read_data_list '()
																)
																(while (setq delimiter_position (vl-position 59 current_string_char_list))
  																	(setq read_data_list (cons (substr current_string 1 delimiter_position) read_data_list)
																		  current_string_char_list (cdr (member 59 current_string_char_list))
																		  current_string (vl-list->string current_string_char_list)
  																	)
																)
																(setq read_data_list (reverse (cons current_string read_data_list)))
																(atof (cadddr read_data_list))
															)
													   )
									  distance_from_beginning (+ distance_from_beginning current_distance)
									  insertion_point (vlax-curve-getPointAtDist target_polyline distance_from_beginning)
								)
								(if insertion_point
									(if (not (zerop current_distance))
										(progn
											(setq aux_get_angle_point (vlax-3d-point (vlax-curve-getPointAtDist target_polyline (- distance_from_beginning 0.1)))
												  current_footing_block_angle (vla-AngleFromXAxis (vla-get-Utility document_object) aux_get_angle_point (vlax-3d-point insertion_point))
												  current_footing_block (vla-InsertBlock modelSpace_object (vlax-3d-point insertion_point) footing_block_name block_uniscale block_uniscale 1 current_footing_block_angle)
												  all_attributes_list (vlax-safearray->list (vlax-variant-value (vla-getattributes current_footing_block)))
												  current_string (read-line distances_file)
											)
											(foreach attribute_item all_attributes_list
												(if (= "НОМЕР_ОПОРЫ" (vla-get-TagString attribute_item))
													(setq vla_method_executed (vla-put-TextString attribute_item (strcat "№" (itoa footings_processed)))
														  vla_method_executed (vla-put-Rotation attribute_item 0.0)
														  vla_method_executed (if (= 1 (vla-get-Alignment attribute_item))
																	  				(vla-put-TextAlignmentPoint attribute_item (vlax-3d-point (polar insertion_point (get_corrected_angle current_footing_block_angle) (* block_uniscale 10.0))))
																					(setq vla_method_executed (vla-put-Alignment attribute_item 1)
																						  vla_method_executed (vla-put-TextAlignmentPoint attribute_item (vlax-3d-point (polar insertion_point (get_corrected_angle current_footing_block_angle) (* block_uniscale 10.0))))
																					)
																			  )

													)
												)
											)
											(setq footings_processed (1+ footings_processed))
										)
										(setq current_string (read-line distances_file))
									)
									(setq current_string nil
										  error_occured (princ "\nNot Enough Length of Polyline to Place all Footings!")
									)
								)
  							)
  							(close distances_file)
							(princ (strcat "\nTotal of " (itoa (1- footings_processed)) " Footings Were Processed"))
						)
						(setq vla_method_executed (vla-erase polyline_start_flag_object)
							  error_occured	(princ "\nYou've Just Cancelled the Command!")
						)
					)
				)		;<+++++++++++++++++++++import code +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
			)
		)
	)
	(if (null target_polyline) (princ "\nYou've Just Cancelled the Command!"))
	(foreach nth_var block_ALong_Pline_Vars (set nth_var nil))
	(setq block_ALong_Pline_Vars nil)
	(princ)
)

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



Последний раз редактировалось koMon, 02.03.2018 в 21:05. Причина: Выявил косяки
koMon вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Ищу программу для расстановки в автокаде блоков вдоль полилинии

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Возможно ли в Автокаде 2014 в свойствах полилинии сделать площадь в квадратных метрах? erikbond AutoCAD 13 13.04.2016 19:07
Как преобразовать модель автомобиля, из блоков, линий, 3d линий, полилиний... Legion AutoCAD 11 29.08.2015 13:33
в автокаде редактор блоков не закрывается, но выдает себя за основной файл SitchAzamat AutoCAD 3 18.09.2012 16:49
Поворот блоков вдоль полилинии, сплайна Victor Готовые программы 3 19.02.2012 22:12
ищу функцию построения 3d полилинии mankurt Программирование 8 07.02.2012 12:43