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

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

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

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

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

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

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

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

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

Заранее большое спасибо!
Просмотров: 6328
 
Непрочитано 23.03.2019, 21:01
#2
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


наверно, это развитие подобной темы - получить набор полилиний определенного цвета (и слоя, наверно, тоже) и дальше смотрите пост #23 от VVA в указанной ранее теме.
Сергей812 вне форума  
 
Автор темы   Непрочитано 24.03.2019, 08:48
#3
aafeoktistov


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
наверно, это развитие подобной темы - получить набор полилиний определенного цвета (и слоя, наверно, тоже) и дальше смотрите пост #23 от VVA в указанной ранее теме.
Я видел эту тему, но не совсем понимаю как это применить к обычным LINE, а главное как привязать все это именно к их ЦВЕТУ...
aafeoktistov вне форума  
 
Непрочитано 24.03.2019, 12:37
#4
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
как это применить к обычным LINE, а главное как привязать все это именно к их ЦВЕТУ...
разделяете на две подзадачи: получить набор красных отрезков:
Код:
[Выделить все]
 (ssget "_X" '((-4 .  "<AND") (62 . %Номер цвета%) (0 . "LINE") (-4."AND>"))) 
а потом для каждого элемента полученного набора ищите блоки, которые на нем лежат. Как переделать на LINE - лучше в той ветке спросить совета у VVA, имхо.. Я на .Net пишу, поэтому с ходу не могу сказать - что там надо подправить в лисп-коде 23 поста)
Сергей812 вне форума  
 
Автор темы   Непрочитано 25.03.2019, 15:58
#5
aafeoktistov


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
разделяете на две подзадачи: получить набор красных отрезков:
Код:
[Выделить все]
 (ssget "_X" '((-4 .  "<AND") (62 . %Номер цвета%) (0 . "LINE") (-4."AND>"))) 
а потом для каждого элемента полученного набора ищите блоки, которые на нем лежат. Как переделать на LINE - лучше в той ветке спросить совета у VVA, имхо.. Я на .Net пишу, поэтому с ходу не могу сказать - что там надо подправить в лисп-коде 23 поста)
Мне просто кажется что моя задача проще, чем описанная в той теме... И главная проблема что я не знаю как связать это все в лисп.

т.е логика такая:

1). Выбрать все линии определенного цвета
2). Найти все блоки с ИЗВЕСТНЫМ ЗАРАНЕЕ названием, которые пересекают линии этого цвета.

Вот и всё... И если кто то мог бы соединить это в LISP было бы оч круто
aafeoktistov вне форума  
 
Непрочитано 26.03.2019, 10:23
#6
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
1). Выбрать все линии определенного цвета
2). Найти все блоки с ИЗВЕСТНЫМ ЗАРАНЕЕ названием, которые пересекают линии этого цвета.
Вот и всё...
от того, что переписали 4 пост своими словами - лисп не появиться) Если не хотите разбираться в программировании ради разовой задачи - есть раздел исполнителей.
Сергей812 вне форума  
 
Автор темы   Непрочитано 26.03.2019, 10:52
#7
aafeoktistov


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


Цитата:
Сообщение от Сергей812 Посмотреть сообщение
от того, что переписали 4 пост своими словами - лисп не появиться) Если не хотите разбираться в программировании ради разовой задачи - есть раздел исполнителей.
Впринципе это тоже вариант. Просто я думал что знающему человеку это дело пары минут, а еще что возможно это кому то тоже понадобится для использования. В любом случае всем спасибо!
aafeoktistov вне форума  
 
Непрочитано 26.03.2019, 12:08
#8
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,004


В посте №4 привел код для получения всех отрезков заданного цвета, во посте №2 - ссылку на код от VVA, получающий вставки блоков на полилинии. И посоветовал обратиться в ту же ветку с вопросом - как изменить этот код под отрезок. Дальше только писать за ТС весь код...
Сергей812 вне форума  
 
Автор темы   Непрочитано 26.03.2019, 14:24
#9
aafeoktistov


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


В посте №4 привел код для получения всех отрезков заданного цвета, во посте №2 - ссылку на код от VVA, получающий вставки блоков на полилинии. И посоветовал обратиться в ту же ветку с вопросом - как изменить этот код под отрезок. Дальше только писать за ТС весь код...[/quote]

Я прочитал ту ветку, там задача сильно отличается от моей хотя и похожа, но попробую спросить там.
aafeoktistov вне форума  
 
Непрочитано 26.03.2019, 15:44
1 | #10
koMon


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Подскажите как запилить LISP
например так:
Код:
[Выделить все]
 
(setq blocks_sset (ssadd)
	  line_color 7 ;white
	  block_name "ИМЯ_БЛОКА"
	  certain_lines_ss (ssget "_x" (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))
)
(if certain_lines_ss
	(progn
		(setq certain_lines_list (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)
koMon вне форума  
 
Непрочитано 26.03.2019, 16:21
#11
Семёныч


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
1). Выбрать все линии определенного цвета
2). Найти все блоки с ИЗВЕСТНЫМ ЗАРАНЕЕ названием, которые пересекают линии этого цвета.
Простая программа:
Код:
[Выделить все]
(defun C:SBL ( / echo osm nc nb ssl lssl n spb ssn pt1 pt2 spo lspo k ssb spb)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq osm (getvar "OSMODE"))
(setvar "OSMODE" 0)
(initget 7)
(setq nc (getint "\nВведите номер цвета: "))
(setq nb (getstring T "\nВведите имя блока: "))
(setq ssl (ssget "_X" (list (cons 0 "LINE") (cons 62 nc))))
(if ssl
    (progn
    (setq lssl (sslength ssl) n 0 spb nil spb (ssadd))
    (repeat lssl
            (setq ssn (ssname ssl n))
            (setq pt1 (cdr (assoc 10 (entget ssn))))
            (setq pt2 (cdr (assoc 11 (entget ssn))))
            (vl-cmdf "_SELECT" "_f" pt1 pt2 "" "")
            (setq spo (ssget "_p"))
            (setq lspo (sslength spo) k 0)
            (repeat lspo
                    (setq ssb (ssname spo k))
                    (if (and (= (cdr (assoc 0 (entget ssb))) "INSERT")
                             (= (cdr (assoc 2 (entget ssb))) nb)
                        )
                        (setq spb (ssadd ssb spb))
                    )
                    (setq k (+ k 1))
            )
            (setq n (+ 1 n))
    )
    (if spb (sssetfirst spb spb))
    )
)
(setvar "CMDECHO" echo)
(setvar "OSMODE" osm)
(princ)
)
Семёныч вне форума  
 
Автор темы   Непрочитано 26.03.2019, 16:43
#12
aafeoktistov


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


koMon и Cемёныч большое Вам спасибо! Мне подходит больше вариант от koMon, но обе версии обязательно кому нибудь пригодятся.

Проверил все работает отлично! ЕЩЕ раз большое спасибо!
aafeoktistov вне форума  
 
Автор темы   Непрочитано 26.03.2019, 18:23
#13
aafeoktistov


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


Цитата:
Сообщение от koMon Посмотреть сообщение
например так:
Код:
01
(setq blocks_sset (ssadd)
02
******line_color 7 ;white
03
******block_name "ИМЯ_БЛОКА"
04
******certain_lines_ss (ssget "_x" (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))
05
)
06
(if certain_lines_ss
07
****(progn
08
********(setq certain_lines_list (mapcar 'cadr (ssnamex certain_lines_ss)))
09
********(foreach line_entity certain_lines_list
10
************(setq blocks_found_ss (ssget "_f" (list
11
****************************************************(list
12
**********************************************************(car (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
13
**********************************************************(cadr (vlax-get (vlax-ename->vla-object line_entity) 'startpoint))
14
****************************************************)
15
****************************************************(list
16
**********************************************************(car (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
17
**********************************************************(cadr (vlax-get (vlax-ename->vla-object line_entity) 'endpoint))
18
****************************************************)
19
**********************************************)
20
**********************************************(list (cons 0 "INSERT"))
21
**********************************)
22
************)
23
************(if blocks_found_ss
24
****************(progn
25
********************(setq blocks_found_list (mapcar 'cadr (ssnamex blocks_found_ss)))
26
********************(if blocks_found_list
27
************************(foreach block_entity blocks_found_list
28
****************************(if (= block_name (vla-get-effectivename (vlax-ename->vla-object block_entity)))
29
********************************(setq blocks_sset (ssadd block_entity blocks_sset))
30
****************************)
31
************************)
32
********************)
33
****************)
34
************)
35
********)
36
****)
37
)
38
(sssetfirst nil blocks_sset)
39
(princ)
Извиняюсь за наглость, но не подскажите как изменить лисп так чтобы поиск шел не по всем объектам а только по выделенным заранее? Заранее спасибо!

----- добавлено через ~1 мин. -----
Огромное спасибо koMon и Семёныч!!!!

----- добавлено через ~32 мин. -----
Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Извиняюсь за наглость, но не подскажите как изменить лисп так чтобы поиск шел не по всем объектам а только по выделенным заранее? Заранее спасибо!

----- добавлено через ~1 мин. -----
Огромное спасибо koMon и Семёныч!!!!
Имею ввиду что сначала выделяю рамкой нужный чертеж, а потом к нему применяется лисп а не ко всем объектам на листе.
aafeoktistov вне форума  
 
Непрочитано 26.03.2019, 19:14
#14
Семёныч


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Имею ввиду что сначала выделяю рамкой нужный чертеж, а потом к нему применяется лисп а не ко всем объектам на листе.
Код:
[Выделить все]
(defun C:SBL ( / echo osm nc nb ssl lssl n spb ssn pt1 pt2 spo lspo k ssb spb)
(setq echo (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq osm (getvar "OSMODE"))
(setvar "OSMODE" 0)
(initget 7)
(setq nc (getint "\nВведите номер цвета: "))
(setq nb (getstring T "\nВведите имя блока: "))
;;;(setq ssl (ssget "_X" (list (cons 0 "LINE") (cons 62 nc)))) ;;; Выбор всех отрезков
(setq ssl (ssget (list (cons 0 "LINE") (cons 62 nc)))) ;;; Выбор объектов (отрезков) рамкой, секрамкой и т.д
(if ssl
    (progn
    (setq lssl (sslength ssl) n 0 spb nil spb (ssadd))
    (repeat lssl
            (setq ssn (ssname ssl n))
            (setq pt1 (cdr (assoc 10 (entget ssn))))
            (setq pt2 (cdr (assoc 11 (entget ssn))))
            (vl-cmdf "_SELECT" "_f" pt1 pt2 "" "")
            (setq spo (ssget "_p"))
            (setq lspo (sslength spo) k 0)
            (repeat lspo
                    (setq ssb (ssname spo k))
                    (if (and (= (cdr (assoc 0 (entget ssb))) "INSERT")
                             (= (cdr (assoc 2 (entget ssb))) nb)
                        )
                        (setq spb (ssadd ssb spb))
                    )
                    (setq k (+ k 1))
            )
            (setq n (+ 1 n))
    )
    (if spb (sssetfirst spb spb))
    )
)
(setvar "CMDECHO" echo)
(setvar "OSMODE" osm)
(princ)
)
Семёныч вне форума  
 
Автор темы   Непрочитано 27.03.2019, 08:12
#15
aafeoktistov


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


Уважаемый! А не подскажите как переписать ваш лисп так чтобы в нем изначально был записан нужный цвет и название блока без возможности выбора?

----- добавлено через ~10 мин. -----
П.С. И что то когда я убираю из ssget _x вообще ничего не происходит, хотя я выбираю нужный чертеж заранее
aafeoktistov вне форума  
 
Непрочитано 27.03.2019, 08:41
1 | #16
koMon


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Извиняюсь за наглость, но не подскажите как изменить лисп так чтобы поиск шел не по всем объектам а только по выделенным заранее
просто заменить
Код:
[Выделить все]
 (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>")))
----- добавлено через ~3 мин. -----
Цитата:
Сообщение от Семёныч Посмотреть сообщение
Простая программа:
не будут обрабатываться дин. блоки
koMon вне форума  
 
Непрочитано 27.03.2019, 08:57
#17
Семёныч


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


Для koMon
Про динамические блоки автор темы ничего не писал. А программа моя названа простой, потому что она и есть ПРОСТАЯ.
Для aafeoktistov
Не надо выбирать объекты до начала работы программы.
Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Уважаемый!
В данном случае обращение "Уважаемый" звучит как "Эй, половой", поэтому я откланиваюсь.
Семёныч вне форума  
 
Автор темы   Непрочитано 27.03.2019, 09:14
#18
aafeoktistov


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


Цитата:
Сообщение от 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>")))
----- добавлено через ~3 мин. -----

не будут обрабатываться дин. блоки
Большое спасибо! Но почему то выдает ошибку

; ошибка: неверный тип аргумента: lentityp (0 (12181.5 17123.0 0.0))

с _x все работает нормально, но все таки хочется разобраться с выделением руками ((
aafeoktistov вне форума  
 
Непрочитано 27.03.2019, 09:28
#19
koMon


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


Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
; ошибка: неверный тип аргумента: lentityp (0 (12181.5 17123.0 0.0))
Код:
[Выделить все]
 (setq blocks_sset (ssadd)
	  line_color 5 ;white
	  block_name "ИМЯ_БЛОКА"
	  certain_lines_ss (ssget (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))
;	  certain_lines_ss (ssget "_x" (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))

)
(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)

Последний раз редактировалось koMon, 27.03.2019 в 09:38.
koMon вне форума  
 
Автор темы   Непрочитано 27.03.2019, 10:47
#20
aafeoktistov


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


Цитата:
Сообщение от koMon Посмотреть сообщение
Код:
[Выделить все]
 (setq blocks_sset (ssadd)
	  line_color 5 ;white
	  block_name "ИМЯ_БЛОКА"
	  certain_lines_ss (ssget (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))
;	  certain_lines_ss (ssget "_x" (list (cons -4 "<and") (cons 0 "LINE") (cons 62 line_color) (cons -4 "and>")))

)
(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 мин. -----
Цитата:
Сообщение от aafeoktistov Посмотреть сообщение
Я может что то не так запускаю но он теперь просто считает выделенные линии
а точнее считает линии, которые пересекают блок...

т.е с _x все работает четко, но вот с выбором руками пока не выходит...

Извините что достаю, просто очень хочется разобраться, потому как реализация выглядит оч грамотной!
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