Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Чтобы отправить ответ, вы должны войти или зарегистрироваться
мне нужно удалить все линии на слое. А в чем ошибка не пойму. Подскажите!!!!!
(defun udal( / )
(setq layer (assoc 8 (entget (car (entsel "\nSelect layer object:")))))
(foreach en (ssnamex (ssget "_X" '(0 . "LINE") layer))))
(entdel en)
) ;_endof foreach
) ;_endof defun
...
(foreach en (ssnamex (ssget "_X" '(0 . "LINE") layer))))...
ssnamex ?
Исправил ваши ошибки
(defun udal (/)
(setq layer (assoc 8 (entget (car (entsel "\nSelect layer object:")))))
(foreach en (ssnamex (ssget "_X" (list '(0 . "LINE")
layer)))
(entdel (cadr en))
) ;_ end foreach
) ;_ end defunХотя я бы такое написал так:
(defun udal (/)
(and (setq msg (entsel "\nSelect layer object:"))
(setq msg (assoc 8 (entget (car msg))))
(setq msg (ssget "_X" (list '(0 . "LINE") msg))) ;_ end setq
(foreach str (ssnamex msg) (entdel (cadr str)))
) ;_ end and
) ;_ end defun
Как вариант:
(if (ssget "_X" (list '(0 . "LINE")(assoc 8 (entget (car (entsel "\nSelect layer object:"))))))(command "_.erase" "_p" ""))
Спасибо, все работает!!!Хотел попробовать сложный фильтр, но он почему то не “фильтрует”. И подскажите пожалуйста как сделать выбор по цвету с запросом, выбирая примитив мышью.(указывая тем самым цвет)
(defun c:udal7 (/)
(and (setq msg (entsel "\nSelect layer object:"))
(setq msg (assoc 8 (entget (car msg))))
(setq msg
(ssget "_X"((-4."<AND") (0 . "LINE") (-4."AND>") (0 . "circle") msg))) ;
(foreach str (ssnamex msg) (entdel (cadr str)))
) ;_ end and
) ;_ end defun
> Виктор Бабченко
(defun c:erase_7 (/ selset count selset_len)
(setq count 0)
(if (setq selset (ssget "_X" '((0 . "LINE,ARC"))))
(progn
(setq selset_len (sslength selset))
(foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
(if
(not
(vl-catch-all-error-p
(vl-catch-all-apply '(lambda () (entdel item)))
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(setq count (1+ count))
) ;_ end of if
) ;_ end of foreach
) ;_ end of progn
) ;_ end of if
(princ (strcat "\n"
(rtos count 2 0)
" примитивов успешно удалено из "
(rtos selset_len 2 0)
) ;_ end of strcat
) ;_ end of princ
) ;_ end of defunНасчет "сделать выбор по цвету с запросом, выбирая примитив мышью.(указывая тем самым цвет)" - а что делать, если цвет "ПоСлою"? Выбирать примитивы с цветом "ПоСлою"? Или что-то иное?
Не совсем понял вопрос.
Вот недавно написал функцию (ещё сырая): Указываешь на приметив мышой - вылезает список с его свойствами (лучше вкл. динам. ввод) выбираем нужное свойство и в модели выбираются и выделяются все примитивы с таким свойством, дальше можно продолжать или выход по ESC и делаешь с выделенными примитивами чего хочешь стандартными командами Када.
;(c:ad-select)
(defun c:ad-select (/ old_ss all)
(setq old_ss (cadr (SSGETFIRST))
all '((0 "Type")
(2 "Name")
(62 "Color")
(8 "Layer")
(6 "LineType")
(48 "LineType Scale")
(7 "TextStyle")
)
all (reverse all)
) ;_ end setq
(while
(null
(VL-CATCH-ALL-ERROR-P
(VL-CATCH-ALL-APPLY
(FUNCTION
(LAMBDA (/ sel dxf ss msg ind n message)
(setq message "Ничего не выбрано\n")
(if (and (setq sel (entsel))
(setq dxf (entget (car sel)))
(progn (setq all_sel '()
template '()
all_initget "Отмена"
all_spisok "Отмена"
) ;_ end setq
(FOREACH str all
(if (setq msg (assoc (car str) dxf))
(setq all_sel (cons msg all_sel)
all_initget (strcat (itoa (car str)) " " all_initget)
all_spisok (strcat (itoa (car str))
" "
(cadr str)
" = "
(VL-PRINC-TO-STRING (cdr msg))
"/"
all_spisok
) ;_ end strcat
) ;_ end setq
) ;_ end if
) ;_ end FOREACH
all_sel
) ;_ end progn
) ;_ конец and
(progn
(INITGET all_initget)
(if (VL-CATCH-ALL-ERROR-P
(setq
msg (VL-CATCH-ALL-APPLY
'GETKWORD
(list (strcat "Выберите фильтр <Отмена> [" all_spisok "]"))
) ;_ end VL-CATCH-ALL-APPLY
) ;_ end setq
) ;_ end VL-CATCH-ALL-ERROR-P
(progn (princ "error\n"))
(if (/= msg "Отмена")
(progn (setq ss (ssget "_X" (list (assoc (atoi msg) all_sel)))
n (sslength ss)
ind n
) ;_ конец setq
(if old_ss
(repeat n (SSADD (ssname ss (setq ind (1- ind))) old_ss)) ;_ конец repeat
(setq old_ss ss)
) ;_ конец if
(SSSETFIRST old_ss old_ss) ;_ конец SSSETFIRST
(setq message (strcat "\" найдено "
(itoa n)
" шт. всего "
(itoa (sslength old_ss))
" шт.\n"
) ;_ конец strcat
) ;_ end setq
) ;_ end progn
) ;_ end if
) ;_ end if
) ;_ end progn
) ;_ end if
(princ message)
) ;_ end LAMBDA
) ;_ end FUNCTION
'()
) ;_ end VL-CATCH-ALL-APPLY
) ;_ end VL-CATCH-ALL-ERROR-P
) ;_ end null
) ;_ end while
(princ " Сброс\n")
(princ)
) ;_ конец defunПопробуйте - может и вам пойдёт
Небольшое пожелание:
- вместо (ssget "_X"(list (assoc (atoi msg) all_sel))) все же использовать (ssget "_X" (append (list (assoc (atoi msg) all_sel)) (list (cons 410 (getvar "ctab")))) - для фильтрации по текущему пространству. На самом деле (getvar "ctab") не всегда возвращает то, что нужно, но на данный момент ИМХО это не важно.
И вот еще. Если надо выбрать примитивы с таким же цветом, как выбранный примитив, а у того 62-я группа nil, то выбрать не удастся вообще ничего.
P.S. Мне вот все же интересно, зачем писать аналог _qselect?
P.S. Мне вот все же интересно, зачем писать аналог _qselect?
- да потому что qselect - мягко говоря очень неудобный (моё личное мнение). Будет время и настроение - напишу что-нибудь путное на его замену. А группу 410 пихать не вижу смасла, ssget всё равно работает только в активном пространстве. Если над чем и колдовать, то лучше сделать диалог со списком и возможность выбора нескольких фильтров, а то с динамическим выбором очень ненадёжно
ssget всё равно работает только в активном пространстве
это не так
> Евгений А.
(ssget "_X" ...) работает со всем чертежом. Остальные варианты только с активным пространством.
> Евгений А.
ИМХО можно сделать так: в чистом файле в листе создать отрезок, удалив все остальное (второй и дальше листы снести). Перейти в модель. Выполнить:
(defun try (/ selset)
(if (and (setq selset (ssget "_X"))
(> (sslength selset) 0)
) ;_ end of and
(progn
(sssetfirst selset selset)
) ;_ end of progn
) ;_ end of if
) ;_ end of defunИ посмотреть в панель свойств. Там показывается, что выделено 2(!) объекта (проверял на ADT 2006Rus + SP1). Находясь в модели!. Переходим в лист - естественно, что выделение снимается. Возврат обратно в модель. Ctrl + A - опять показывает, что выбрано 2 объекта (видовой экран и отрезок). Нет, я примерно предполагаю, откуда тут уши растут, но рагребать эти тонкости лично у меня никакого желания нет :( Проще поставить выбор по текущему пространству и не мучиться. И не отвечать на возмущенные вопросы типа "Я воспользовался кнопкой твоей, а у меня в листе все размеры пропали! 3 часа работы!" ну и тому подобное :)
Спасибо, господа, просветили! Буду знать! Это стандартные команды автокада работают только в активном пространстве, поэтому такое "Я воспользовался кнопкой твоей, а у меня в листе все размеры пропали! 3 часа работы!" не происходило.
Сделал так
(ssget "_X" (list (assoc 410 dxf) (assoc (atoi msg) all_sel)))
Ну редко я пользуюсь ssget, предпочитаю vlax-for ...
Кстати предупреждаю GETKWORD в таком коде частенько возвращает nil или даже ошибку, я же предупреждал, что код сырой и надо всётаки делать диалог...
> Евгений А.
тебе код моей функции получения "чего бы то ни было" нужон? Если да, напиши в мыло - соберу и вышлю.
Господа, а чем вам старый добрый "SSX" не угодил? Вводишь его в интерактивном режиме, выбираешь параметры фильтрования, и стирай чо хошь...
> Евгений А.
Я для запроса у пользователей вариантов через диалоговое окно написал небольшую ф-цию. Предлагаю тебе заменить сложнай запрос с отловом ошибок через getkword на нее.
;_ *********** MYDCL **************************************************************
;_ * Запрос варианта выбора через диалоговое окно *
;_ * Диалоговое окно (dcl) формируется программно *
;_ * Программно же и удаляется *
;_ * zagl - заголовок окна *
;_ * info-list - список строковых значение *
;_ * Возвращает выбранную строку или nil, если нажата клавиша отмена *
;_ * Пример *
;_ * (mydcl "Пример использования" '("Вариант1" "Вариант2" "Вариант3" "Вариант4"))*
;_ ********************************************************************************
(defun mydcl (zagl info-list / fl ret dcl_id)
(vl-load-com)
(if (null zagl)(setq zagl "Выбор"))
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar '(lambda (x) (write-line x ret))
(list "mip_msg : dialog { "
(strcat "label=\"" zagl "\";")
" :list_box {"
"alignment=top ;"
"width=51 ;"
(if (> (length info-list) 26)
"height= 26 ;"
(strcat "height= " (itoa (+ 3 (length info-list))) ";")
) ;_ end of if
"is_tab_stop = false ;"
"key = \"info\";}"
"ok_cancel;}"
) ;_ end of list
) ;_ end of mapcar
(setq ret (close ret))
(if (setq dcl_id (load_dialog fl))
(if (new_dialog "mip_msg" dcl_id)
(progn
(start_list "info")
(mapcar 'add_list info-list)
(end_list)
(set_tile "info" "0")
(setq ret (car info-list))
(action_tile "info" "(setq ret (nth (atoi $value) info-list))")
(action_tile "cancel" "(progn(setq ret nil)(done_dialog 0))")
(action_tile "accept" "(done_dialog 1)")
(start_dialog)
) ;_ end of progn
) ;_ end of if
) ;_ end of if
(unload_dialog dcl_id)
(vl-file-delete fl)
ret
) ;_ end of defunИспользование
(setq all_spisok '("Фильтр2" "Фильтр1" "Фильтр3" "Фильтр5" "Фильтр4")) ;_Список строковых значений
(mydcl
"Пример использования" ;_Заголовок окна
(acad_strlsort all_spisok) ;_Сортированный спиcок
)> VVA
Да так гораздо лучше!
Немного изменил ваш вариант и добавил множественный выбор. Кстати, некорректна строка
(if (setq dcl_id (load_dialog fl))
Вот что получилось:
;(c:ad-select)
(defun c:ad-select (/ old_ss all)
(setq old_ss (cadr (SSGETFIRST))
all '((0 "Type")
(2 "Name")
(62 "Color")
(8 "Layer")
(6 "LineType")
(48 "LineType Scale")
(7 "TextStyle")
)
all (reverse all)
) ;_ end setq
(while
(null
(VL-CATCH-ALL-ERROR-P
(VL-CATCH-ALL-APPLY
(FUNCTION
(LAMBDA (/ sel dxf ss msg ind n message all_sel template)
(setq message "Ничего не выбрано\n")
(if (and (setq sel (entsel))
(setq dxf (entget (car sel)))
(progn (setq all_sel '()
template '()
) ;_ end setq
(FOREACH str all
(if (setq msg (assoc (car str) dxf))
(setq all_sel (cons (strcat (itoa (car msg))
" "
(cadr str)
" "
(VL-PRIN1-TO-STRING (cdr msg))
) ;_ end strcat
all_sel
) ;_ end cons
) ;_ end setq
) ;_ end if
) ;_ end FOREACH
(setq msg (mydcl "Выбор фильтров" all_sel)) ;_ end setq
) ;_ end progn
) ;_ end and
(progn (setq template (mapcar
(FUNCTION
(LAMBDA (str / spis)
(cons (car (setq spis (read (strcat "(" str ")"))))
(caddr spis)
) ;_ end list
) ;_ end LAMBDA
) ;_ end FUNCTION
msg
) ;_ end mapcar
ss (ssget "_X" (cons (assoc 410 dxf) template)) ;_ end ssget
n (sslength ss)
ind n
) ;_ конец setq
(if old_ss
(repeat n (SSADD (ssname ss (setq ind (1- ind))) old_ss)) ;_ конец repeat
(setq old_ss ss)
) ;_ конец if
(SSSETFIRST old_ss old_ss) ;_ конец SSSETFIRST
(setq message (strcat "\" найдено "
(itoa n)
" шт. всего "
(itoa (sslength old_ss))
" шт.\n"
) ;_ конец strcat
) ;_ end setq
) ;_ end progn
) ;_ end if
) ;_ end LAMBDA
) ;_ end FUNCTION
'()
) ;_ end VL-CATCH-ALL-APPLY
) ;_ end VL-CATCH-ALL-ERROR-P
) ;_ end null
) ;_ end while
(princ " Сброс\n")
(princ)
) ;_ конец defun
(defun mydcl (zagl info-list / fl ret dcl_id msg)
;от VVA (https://www.caduser.ru/forum/topic36450.html)
;изменена немного
(vl-load-com)
(if (null zagl)
(setq zagl "Выбор")
) ;_ end if
(setq fl (vl-filename-mktemp "mip" nil ".dcl"))
(setq ret (open fl "w"))
(mapcar '(lambda (x) (write-line x ret))
(list "mip_msg : dialog { "
(strcat "label=\"" zagl "\";")
" :list_box {"
"alignment=top ;"
"multiple_select = true ;"
"width=31 ;"
(if (> (length info-list) 26)
"height= 26 ;"
(strcat "height= " (itoa (+ 3 (length info-list))) ";")
) ;_ end of if
"is_tab_stop = false ;"
"key = \"info\";}"
"ok_cancel;}"
) ;_ end of list
) ;_ end of mapcar
(setq ret (close ret))
(if (and (null (minusp (setq dcl_id (load_dialog fl))))
(new_dialog "mip_msg" dcl_id)
) ;_ end and
(progn (start_list "info")
(mapcar 'add_list info-list)
(end_list)
(set_tile "info" "0")
(setq ret (car info-list))
(action_tile "info" "(setq ret $value)")
(action_tile "cancel" "(done_dialog 0)")
(action_tile "accept" " (done_dialog 1)")
(if (zerop (start_dialog))
(setq ret nil)
(setq ret (mapcar (FUNCTION (lambda (num) (nth num info-list)))
(read (strcat "(" ret ")"))
) ;_ end mapcar
) ;_ end setq
) ;_ end if
(unload_dialog dcl_id)
) ;_ end of progn
) ;_ end of if
(vl-file-delete fl)
ret
) ;_ end of defunПодрихтовал код проги, выкладывать здесь её не буду, а то не совсем в тему, да и Виктор Бабченко молчит.
Всунул эту команду в Help-Paper.vlx на http://ad-cad.narod.ru , там и буду исправлять и обновлять.
->VVA отдельное спасибо за участие!
Кстати, некорректна строка
(if (setq dcl_id (load_dialog fl))
Спасибо, исправил
Просто автокада нет поблизости. Спасибо за варианты решений задачи.Обязательно все попробую!
> Виктор Бабченко
Кстати, про сложный выбор.
Ваша строка
(ssget "_X"((-4."<AND") (0 . "LINE") (-4."AND>") (0 . "circle") msg))
должна выглядеть так:
(ssget "_X" (list '(-4 . "<OR") '(0 . "LINE") '(0 . "CIRCLE") '(-4 . "OR>") msg))
А может так:
(ssget "_X" '((0 . "LINE,CIRCLE")))
> Кулик Алексей aka kpblc
Для текстовых значений конечно можно и так
> Евгений А.
:?: Не очень догнал, что имеется в виду
В смысле значение DXF группы с TYPE = String. Вот, к примеру, надо выделить объекты с фильтром по двум цветам например (62 . 2) и (62 . 3) (т.е. тип Integer), то тут с запятой делать нечего... или нет???
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форум работает на PunBB, при поддержке Informer Technologies, Inc
