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

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

Выбор определенного блока, при пересечении с линией нужного цвета

Ответ
Поиск в этой теме
Непрочитано 23.03.2019, 16:06
Выбор определенного блока, при пересечении с линией нужного цвета
aafeoktistov
 
Регистрация: 26.02.2019
Сообщений: 49

Здравствуйте!

Суть проблемы следующая, сейчас использую вот такой макрос

(sssetfirst nil (ssget "_i" '((0 . "INSERT")(2 . "Название_блока"))))

Как видно, в набор добавляются все блоки с определенным названием.

Подскажите как запилить LISP или подправить макрос, чтобы выделялись только те блоки, которые находятся на пересечении с линиями определенного цвета (допустим №7 (по нумерации автокада))

Заранее большое спасибо!
Просмотров: 6325
 
Непрочитано 27.03.2019, 11:35
#21
frostmourn


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


Цитата:
Сообщение от koMon Посмотреть сообщение
просто заменить

Код:
[Выделить все]
 (ssget "_x" (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))
на

Код:
[Выделить все]
 (ssget (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))
"and" не нужен здесь.
frostmourn вне форума  
 
Автор темы   Непрочитано 27.03.2019, 11:41
#22
aafeoktistov


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


Цитата:
Сообщение от frostmourn Посмотреть сообщение
"and" не нужен здесь.
Вообще нигде не нужен?

----- добавлено через ~2 мин. -----
Теперь пишет "слишком мало аргументов"
aafeoktistov вне форума  
 
Непрочитано 27.03.2019, 11:55
#23
koMon


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Я может что то не так запускаю но он теперь просто считает выделенные линии
однако
Код:
[Выделить все]
 (setq blocks_sset (ssadd)
	  line_color 5 ;white
	  block_name "ИМЯ_БЛОКА"
)

(cond
	(
		(null (cadr (ssgetfirst)))
	  		(setq certain_lines_ss (ssget (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>"))))
;		  	(setq certain_lines_ss (ssget "_x" (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>"))))
			(setq certain_lines_list (vl-remove-if '(lambda (list_member) (/= 'ename (type list_member))) (mapcar 'cadr (ssnamex certain_lines_ss))))
	)
	(
		t
			(setq certain_lines_ss (cadr (ssgetfirst))
				  certain_lines_list (vl-remove-if '(lambda (list_member)
																	(or
																		(/= 'ename (type list_member))
																		(not
																			(and
																				(= "LINE" (cdr (assoc 0 (entget list_member))))
																				(= line_color (cdr (assoc 62 (entget list_member))))
																			)
																		)
																	)
													)
													(mapcar 'cadr (ssnamex certain_lines_ss))
									 )
			)
	)
)

(if certain_lines_ss
	(progn
;		(setq certain_lines_list (vl-remove-if '(lambda (list_member) (/= 'ename (type list_member))) (mapcar 'cadr (ssnamex certain_lines_ss))))
		(foreach line_entity certain_lines_list
			(setq blocks_found_ss (ssget "_f" (list
													(list
														  (car (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
														  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
													)
													(list
														  (car (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
														  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
													)
											  )
											  (list (cons 0 "INSERT"))
							   	  )
			)
			(if blocks_found_ss
				(progn
					(setq blocks_found_list (mapcar 'cadr (ssnamex blocks_found_ss)))
					(if blocks_found_list
						(foreach block_entity blocks_found_list
							(if (= block_name (vla-get-effectivename (vlax-ename->vla-object block_entity)))
								(setq blocks_sset (ssadd block_entity blocks_sset))
							)
						)
					)
				)
			)
		)
	)
)
(sssetfirst nil blocks_sset)
(princ)
----- добавлено через ~10 мин. -----
Цитата:
Сообщение от frostmourn Посмотреть сообщение
"and" не нужен здесь.
aafeoktistov, frostmourn говорит, что нуно так
(setq certain_lines_ss (ssget (list (cons 0 "LINE") (cons 62 line_color))))
koMon вне форума  
 
Автор темы   Непрочитано 27.03.2019, 13:02
#24
aafeoktistov


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


Код:
[Выделить все]
 (defun C:CHCL ( / ssl lssl n sl cl)
(setq blocks_sset (ssadd)
	  line_color 7 ;white
	  block_name "Опора УБ"
)

(cond
	(
		(null (cadr (ssgetfirst)))
	  		(setq certain_lines_ss (ssget (list (cons 0 "LINE") (cons 62 line_color))))
;		  	(setq certain_lines_ss (ssget "_x" (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>"))))
			(setq certain_lines_list (vl-remove-if '(lambda (list_member) (/= 'ename (type list_member))) (mapcar 'cadr (ssnamex certain_lines_ss))))
	)
	(
		t
			(setq certain_lines_ss (cadr (ssgetfirst))
				  certain_lines_list (vl-remove-if '(lambda (list_member)
																	(or
																		(/= 'ename (type list_member))
																		(not
																			(and
																				(= "LINE" (cdr (assoc 0 (entget list_member))))
																				(= line_color (cdr (assoc 62 (entget list_member))))
																			)
																		)
																	)
													)
													(mapcar 'cadr (ssnamex certain_lines_ss))
									 )
			)
	)
)

(if certain_lines_ss
	(progn
;		(setq certain_lines_list (vl-remove-if '(lambda (list_member) (/= 'ename (type list_member))) (mapcar 'cadr (ssnamex certain_lines_ss))))
		(foreach line_entity certain_lines_list
			(setq blocks_found_ss (ssget "_f" (list
													(list
														  (car (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
														  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
													)
													(list
														  (car (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
														  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
													)
											  )
											  (list (cons 0 "INSERT"))
							   	  )
			)
			(if blocks_found_ss
				(progn
					(setq blocks_found_list (mapcar 'cadr (ssnamex blocks_found_ss)))
					(if blocks_found_list
						(foreach block_entity blocks_found_list
							(if (= block_name (vla-get-effectivename (vlax-ename->vla-object block_entity)))
								(setq blocks_sset (ssadd block_entity blocks_sset))
							)
						)
					)
				)
			)
		)
	)
)
(sssetfirst nil blocks_sset)
(princ)
)
в итоге получилось так? Пытаюсь запустить макросом ^C^C^P(if (not C:CHCL) (load "chcl")) CHCL

теперь вообще не запускается, что посоветуете?

----- добавлено через ~14 мин. -----
Покопался видимо какой то глюк!!! С последней версией все работает так как нужно!!! Огромнейшее спасибо Семёныч и koMon!!! и всем кто поучаствовал!
aafeoktistov вне форума  
 
Непрочитано 27.03.2019, 15:04
#25
koMon


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
(defun C:CHCL ( / ssl lssl n sl cl)
в команде нет этих локальных переменных, но есть кучка других, так что правильнее было бы перечислить последние
koMon вне форума  
 
Автор темы   Непрочитано 27.03.2019, 16:35
#26
aafeoktistov


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


Цитата:
Сообщение от koMon Посмотреть сообщение
в команде нет этих локальных переменных, но есть кучка других, так что правильнее было бы перечислить последние
Это я взял из другого лиспа, но вроде все работает... а чего не хватает?
aafeoktistov вне форума  
 
Непрочитано 28.03.2019, 09:23
#27
koMon


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
а чего не хватает?
после слеша нужно перечислить локальные переменные, используемые в определяемой команде
Код:
[Выделить все]
 (defun c:CHCL ( / block_sset line_color block_name certain_lines_ss certain_lines_list block_found_ss blocks_found_list )
koMon вне форума  
 
Непрочитано 28.03.2019, 10:14
#28
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от koMon Посмотреть сообщение
после слеша нужно перечислить локальные переменные, используемые в определяемой команде
Код:
[Выделить все]
 (defun c:CHCL ( / block_sset line_color block_name certain_lines_ss certain_lines_list block_found_ss blocks_found_list )
blocks_sset тоже локальная переменная? Вроде же это глобальный набор в чертеже? Или я ошибаюсь?
tsetse вне форума  
 
Непрочитано 28.03.2019, 11:34
#29
koMon


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


Цитата:
Сообщение от tsetse Посмотреть сообщение
blocks_sset тоже локальная переменная? Вроде же это глобальный набор в чертеже? Или я ошибаюсь?
зависит от кон. цели. если набор нужен в переменной, то его нужно делать глобальным, а так: команду выполнили, получили набор - делаем с ним что-то
koMon вне форума  
 
Непрочитано 28.03.2019, 12:46
#30
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от koMon Посмотреть сообщение
зависит от кон. цели. если набор нужен в переменной, то его нужно делать глобальным, а так: команду выполнили, получили набор - делаем с ним что-то
Я имею ввиду, если его сделать локальной переменной, после (sssetfirst nil blocks_sset) и завершения работы программы, выбранные объекты автоматически перейдут в новый набор, имя которого сгенерирует автокад?
tsetse вне форума  
 
Непрочитано 28.03.2019, 13:46
#31
koMon


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


чисто теоретически да, практически нет. переменная с набором глобализируется.
koMon вне форума  
 
Автор темы   Непрочитано 28.03.2019, 17:48
#32
aafeoktistov


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


Цитата:
Сообщение от koMon Посмотреть сообщение
чисто теоретически да, практически нет. переменная с набором глобализируется.
А не подскажите как добавить код, чтобы НЕ выбирались блоки, которые пересекают ДВЕ линии белая (7) и допустим оранжевая (30). Заранее спасибо!
aafeoktistov вне форума  
 
Непрочитано 28.03.2019, 19:59
#33
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
А не подскажите как добавить код, чтобы НЕ выбирались блоки, которые пересекают ДВЕ линии белая (7) и допустим оранжевая (30). Заранее спасибо!
Просто повторяете операцию дважды. Сначала делаете набор с пересечением белыми линиями. Потом набор с пересечением оранжевыми. Затем вычитаете из первого второе. Посмотрите справку по ssdel.
tsetse вне форума  
 
Автор темы   Непрочитано 28.03.2019, 20:36
#34
aafeoktistov


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


Цитата:
Сообщение от tsetse Посмотреть сообщение
Просто повторяете операцию дважды. Сначала делаете набор с пересечением белыми линиями. Потом набор с пересечением оранжевыми. Затем вычитаете из первого второе. Посмотрите справку по ssdel.
Ну тут проблема в том что у меня есть те же самые блоки пересекающиеся с просто оранжевыми линиями и их выделять как раз ненужно, интересует невыделение именно "пограничного" варианта.

Просто мне кажется или есть более изящное решение или ssdel единственный вариант?
aafeoktistov вне форума  
 
Непрочитано 01.04.2019, 15:24
#35
koMon


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
А не подскажите как добавить код, чтобы НЕ выбирались блоки, которые пересекают ДВЕ линии белая (7) и допустим оранжевая (30). Заранее спасибо!
Offtop: L'appétit vient en mangeant.)
за изящность не скажу, но с добавкой будет так
Код:
[Выделить все]
 
(defun c:CHCL ( / block_sset in_blocks_found_list ex_blocks_found_list
				  include_line_color exclude_line_color block_name
				  in_ex_lines_ss in_ex_lines_list
				  in_blocks_found_ss in_blocks_list
			  )
	(setq blocks_sset (ssadd)
		  in_ex_lines_list '()
		  in_blocks_found_list '()
		  ex_blocks_found_list '()
		  include_line_color 7  ;white
		  exclude_line_color 30 ;orange
		  block_name "Опора УБ"
	)
	(cond
		(
			(null (cadr (ssgetfirst)))
		  		(setq in_ex_lines_ss (ssget (list (cons 0 "LINE") (cons -4 "<or") (cons 62 include_line_color) (cons 62 exclude_line_color) (cons -4 "or>"))))
				(if in_ex_lines_ss (setq in_ex_lines_list (vl-remove-if '(lambda (list_member) (/= 'ename (type list_member))) (mapcar 'cadr (ssnamex in_ex_lines_ss)))))
		)
		(
			t
				(setq in_ex_lines_ss (cadr (ssgetfirst))
					  in_ex_lines_list (vl-remove-if '(lambda (list_member)
																		(or
																			(/= 'ename (type list_member))
																			(not
																				(and
																					(= "LINE" (cdr (assoc 0 (entget list_member))))
																					(or
																						(= include_line_color (cdr (assoc 62 (entget list_member))))
																						(= exclude_line_color (cdr (assoc 62 (entget list_member))))
																					)
																				)
																			)
																		)
														)
														(mapcar 'cadr (ssnamex in_ex_lines_ss))
										 )
				)
		)
	)
	(if in_ex_lines_list
		(progn
			(foreach line_entity in_ex_lines_list
				(setq in_blocks_found_ss (ssget "_f" (list
														(list
															  (car (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
															  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
														)
														(list
															  (car (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
															  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
														)
												  )
												  (list (cons 0 "INSERT"))
									  )
				)
				(if in_blocks_found_ss
					(progn
						(setq in_blocks_list (mapcar 'cadr (ssnamex in_blocks_found_ss)))
						(foreach block_entity in_blocks_list
							(if (= block_name (vla-get-effectivename (vlax-ename->vla-object block_entity)))
								(if (= include_line_color (cdr (assoc 62 (entget line_entity))))
									(setq in_blocks_found_list (cons block_entity in_blocks_found_list))
									(setq ex_blocks_found_list (cons block_entity ex_blocks_found_list))
								)
							)
						)
					)
				)
			)
			(foreach exclude_member ex_blocks_found_list 
				(setq in_blocks_found_list 
					(vl-remove-if '(lambda (in_blocks_found_list_member) 
										(equal exclude_member in_blocks_found_list_member)
								   ) 
								   in_blocks_found_list
					)
				)
			)
			(foreach block_entity in_blocks_found_list (setq blocks_sset (ssadd block_entity blocks_sset)))
			(princ (strcat "\nВыбрано блоков \"" block_name "\": " (itoa (sslength blocks_sset))))
			(sssetfirst nil blocks_sset)
			(setq blocks_sset nil)
		)
		(princ (strcat "\nвыбрано блоков \"" block_name "\": 0"))
	)
	(princ)
)
koMon вне форума  
 
Автор темы   Непрочитано 01.04.2019, 17:53
#36
aafeoktistov


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Offtop: L'appétit vient en mangeant.)
за изящность не скажу, но с добавкой будет так
Код:
[Выделить все]
 
(defun c:CHCL ( / block_sset in_blocks_found_list ex_blocks_found_list
				  include_line_color exclude_line_color block_name
				  in_ex_lines_ss in_ex_lines_list
				  in_blocks_found_ss in_blocks_list
			  )
	(setq blocks_sset (ssadd)
		  in_ex_lines_list '()
		  in_blocks_found_list '()
		  ex_blocks_found_list '()
		  include_line_color 7  ;white
		  exclude_line_color 30 ;orange
		  block_name "Опора УБ"
	)
	(cond
		(
			(null (cadr (ssgetfirst)))
		  		(setq in_ex_lines_ss (ssget (list (cons 0 "LINE") (cons -4 "<or") (cons 62 include_line_color) (cons 62 exclude_line_color) (cons -4 "or>"))))
				(if in_ex_lines_ss (setq in_ex_lines_list (vl-remove-if '(lambda (list_member) (/= 'ename (type list_member))) (mapcar 'cadr (ssnamex in_ex_lines_ss)))))
		)
		(
			t
				(setq in_ex_lines_ss (cadr (ssgetfirst))
					  in_ex_lines_list (vl-remove-if '(lambda (list_member)
																		(or
																			(/= 'ename (type list_member))
																			(not
																				(and
																					(= "LINE" (cdr (assoc 0 (entget list_member))))
																					(or
																						(= include_line_color (cdr (assoc 62 (entget list_member))))
																						(= exclude_line_color (cdr (assoc 62 (entget list_member))))
																					)
																				)
																			)
																		)
														)
														(mapcar 'cadr (ssnamex in_ex_lines_ss))
										 )
				)
		)
	)
	(if in_ex_lines_list
		(progn
			(foreach line_entity in_ex_lines_list
				(setq in_blocks_found_ss (ssget "_f" (list
														(list
															  (car (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
															  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
														)
														(list
															  (car (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
															  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
														)
												  )
												  (list (cons 0 "INSERT"))
									  )
				)
				(if in_blocks_found_ss
					(progn
						(setq in_blocks_list (mapcar 'cadr (ssnamex in_blocks_found_ss)))
						(foreach block_entity in_blocks_list
							(if (= block_name (vla-get-effectivename (vlax-ename->vla-object block_entity)))
								(if (= include_line_color (cdr (assoc 62 (entget line_entity))))
									(setq in_blocks_found_list (cons block_entity in_blocks_found_list))
									(setq ex_blocks_found_list (cons block_entity ex_blocks_found_list))
								)
							)
						)
					)
				)
			)
			(foreach exclude_member ex_blocks_found_list 
				(setq in_blocks_found_list 
					(vl-remove-if '(lambda (in_blocks_found_list_member) 
										(equal exclude_member in_blocks_found_list_member)
								   ) 
								   in_blocks_found_list
					)
				)
			)
			(foreach block_entity in_blocks_found_list (setq blocks_sset (ssadd block_entity blocks_sset)))
			(princ (strcat "\nВыбрано блоков \"" block_name "\": " (itoa (sslength blocks_sset))))
			(sssetfirst nil blocks_sset)
			(setq blocks_sset nil)
		)
		(princ (strcat "\nвыбрано блоков \"" block_name "\": 0"))
	)
	(princ)
)
Большое спасибо!
aafeoktistov вне форума  
 
Автор темы   Непрочитано 03.04.2019, 18:00
#37
aafeoktistov


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


Господа! Возникла новая проблема, помогите плз.

Как добавить в этот лисп чтобы блоки выделялись только при пересечении линии (line) черного цвета (7) (любой длины) и линии (line) черного цвета, но с длиной 3.3. Никак не могу найти чтобы можно было использовать 2 свойства...

Заранее спасибо!

Пока lisp выглядит так

Код:
[Выделить все]
 (defun c:CHCL10 ( / block_sset in_blocks_found_list ex_blocks_found_list
				  include_line_color exclude_line_color block_name
				  in_ex_lines_ss in_ex_lines_list
				  in_blocks_found_ss in_blocks_list
			  )
	(setq blocks_sset (ssadd)
		  in_ex_lines_list '()
		  in_blocks_found_list '()
		  ex_blocks_found_list '()
		  include_line_color 7  ;white
		  exclude_line_color 30 ;orange
		  block_name "Имя блока"
	)
	(cond
		(
			(null (cadr (ssgetfirst)))
		  		(setq in_ex_lines_ss (ssget (list (cons 0 "LINE") (cons -4 "<or") (cons 62 include_line_color) (cons 62 exclude_line_color) (cons -4 "or>"))))
				(if in_ex_lines_ss (setq in_ex_lines_list (vl-remove-if '(lambda (list_member) (/= 'ename (type list_member))) (mapcar 'cadr (ssnamex in_ex_lines_ss)))))
		)
		(
			t
				(setq in_ex_lines_ss (cadr (ssgetfirst))
					  in_ex_lines_list (vl-remove-if '(lambda (list_member)
																		(or
																			(/= 'ename (type list_member))
																			(not
																				(and
																					(= "LINE" (cdr (assoc 0 (entget list_member))))
																					(or
																						(= include_line_color (cdr (assoc 62 (entget list_member))))
																						(= exclude_line_color (cdr (assoc 62 (entget list_member))))
																					)
																				)
																			)
																		)
														)
														(mapcar 'cadr (ssnamex in_ex_lines_ss))
										 )
				)
		)
	)
	(if in_ex_lines_list
		(progn
			(foreach line_entity in_ex_lines_list
				(setq in_blocks_found_ss (ssget "_f" (list
														(list
															  (car (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
															  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
														)
														(list
															  (car (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
															  (cadr (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
														)
												  )
												  (list (cons 0 "INSERT"))
									  )
				)
				(if in_blocks_found_ss
					(progn
						(setq in_blocks_list (mapcar 'cadr (ssnamex in_blocks_found_ss)))
						(foreach block_entity in_blocks_list
							(if (= block_name (vla-get-effectivename (vlax-ename->vla-object block_entity)))
								(if (= include_line_color (cdr (assoc 62 (entget line_entity))))
									(setq in_blocks_found_list (cons block_entity in_blocks_found_list))
									(setq ex_blocks_found_list (cons block_entity ex_blocks_found_list))
								)
							)
						)
					)
				)
			)
			(foreach exclude_member ex_blocks_found_list 
				(setq in_blocks_found_list 
					(vl-remove-if '(lambda (in_blocks_found_list_member) 
										(equal exclude_member in_blocks_found_list_member)
								   ) 
								   in_blocks_found_list
					)
				)
			)
			(foreach block_entity in_blocks_found_list (setq blocks_sset (ssadd block_entity blocks_sset)))
			(princ (strcat "\nВыбрано блоков \"" block_name "\": " (itoa (sslength blocks_sset))))
			(sssetfirst nil blocks_sset)
			(setq blocks_sset nil)
		)
		(princ (strcat "\nвыбрано блоков \"" block_name "\": 0"))
	)
	(princ)
)
----- добавлено через ~3 мин. -----
Подумал вот, достаточно будет если будет выделяться блок при пересечении с линией (line) определенного цвет (7) и длины (3.3). Т.е получается в каком то роде это упрощение предыдущего лиспа, но я никак не могу понять как объединить 2 свойства одной линии (цвет и длину).

Последний раз редактировалось aafeoktistov, 03.04.2019 в 18:26. Причина: неправильный лисп
aafeoktistov вне форума  
 
Непрочитано 05.04.2019, 14:20
#38
tsetse

Инженер-конструктор
 
Регистрация: 25.12.2015
Москва
Сообщений: 77


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Господа! Возникла новая проблема, помогите плз.

Как добавить в этот лисп чтобы блоки выделялись только при пересечении линии (line) черного цвета (7) (любой длины) и линии (line) черного цвета, но с длиной 3.3. Никак не могу найти чтобы можно было использовать 2 свойства...
Подумал вот, достаточно будет если будет выделяться блок при пересечении с линией (line) определенного цвет (7) и длины (3.3). Т.е получается в каком то роде это упрощение предыдущего лиспа, но я никак не могу понять как объединить 2 свойства одной линии (цвет и длину).
Выложи dwg, на котором тестировать можно
tsetse вне форума  
 
Автор темы   Непрочитано 05.04.2019, 15:49
#39
aafeoktistov


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


Цитата:
Сообщение от tsetse Посмотреть сообщение
Выложи dwg, на котором тестировать можно
Прикрепил

Нужно добиться того, чтобы блоки выделялись только при пересечении с линиями цвета 7 и длиной 3.3

в другой моей теме был предложен такой вариант, но он почему то не работает, выделяются вообще ВСЕ блоки...

Код:
[Выделить все]
  (defun c:chcl ()
	(setq blocks_sset (ssadd)
	      seek_block_line_color 7 ;white
		  seek_block_line_length 3.3
	      seek_block_name "Имя блока"
	)
	(cond
	    (
	        (null (cadr (ssgetfirst)))
	            (setq seek_lines_ss (ssget (list (cons 0 "LINE") (cons 62 seek_block_line_color))))
	    )
	    (
	        t
	            (setq seek_lines_ss (cadr (ssgetfirst)))
	    )
	)
	(if seek_lines_ss
		(progn
			(while (not (zerop (sslength seek_lines_ss)))
				(if (= "LINE" (cdr (assoc 0 (entget (ssname seek_lines_ss 0)))))
	    	    	(if (setq blocks_found_ss (ssget "_f" (list
	    	    	                                      	(vlax-get (vlax-ename->vla-object (ssname seek_lines_ss 0)) 'startpoint)
	    	    	                                        (vlax-get (vlax-ename->vla-object (ssname seek_lines_ss 0)) 'endpoint)
	    	    	                                  	  )
	    	    	                                  	  (list (cons 0 "INSERT"))
	    	    	    				  	  )
						)
	    	    	    (progn
	    	    	        (setq blocks_found_list (mapcar 'cadr (ssnamex blocks_found_ss)))
	    	    	        (if blocks_found_list
	    	    	            (foreach block_entity blocks_found_list
	    	    	                (if (and
											(= seek_block_name (vla-get-effectivename (vlax-ename->vla-object block_entity)))
											(equal seek_block_line_length (vla-get-length (vlax-ename->vla-object (ssname seek_lines_ss 0))) 1e-4)
										)
	    	    	                    (setq blocks_sset (ssadd block_entity blocks_sset))
	    	    	                )
	    	    	            )
	    	    	        )
	    	    	    )
					)
				)
				(setq seek_lines_ss (ssdel (ssname seek_lines_ss 0) seek_lines_ss))
			)
			(sssetfirst nil blocks_sset)
		)
	)
	(princ)
)
Вложения
Тип файла: dwg
DWG 2013
Для_теста.dwg (385.9 Кб, 2 просмотров)
aafeoktistov вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Выбор определенного блока, при пересечении с линией нужного цвета

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Быстрый выбор нужного слоя dim5678 AutoCAD 23 29.02.2024 23:03
Выбор атрибута (площади) по возрастанию и затем нумерация блока koskos LISP 2 02.10.2016 21:24
Как при пересечении двух линий сделать установку нужного блока в месте пересечения 128500 Программирование 34 07.10.2014 11:06
Копирование нужного атрибута блока в другой блок. Alexeipost Программирование 4 25.05.2011 09:33
Привязка только к объектам определенного цвета Torino AutoCAD 30 29.03.2004 15:56