Выделение снаружи _pline

Выделение снаружи _pline · 31.07.2007, 17:40

С помощью ssget можно получить набор примитивов внутри выпуклой полилинии. А как получить набор примитивов находящихся снаружи полилинии, или хотя бы прямоугольника?

VVA · 31.07.2007, 18:03

Например так

Код:

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

(defun C:OCS (  / en ss lst ssall bbox tmp head)
;Выделение снаружи полилинии
;_ http://forum.dwg.ru/showthread.php?t=12899
;Required Express tools
;OutSide Contour Select
(vl-load-com) 
(if (null ACET-GEOM-OBJECT-POINT-LIST)
    (progn
      (alert "Required Express tools!!!")
      (exit)
      )
    )
  (if (and (setq en (car(entsel "\nSelect contour: "))) 
           (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE")) 
    (progn 
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-3)) 
      (setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst))
      (while lst
        (setq head (car lst)
          tmp (cons head tmp)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
          )
        )
  (setq lst (reverse tmp))
      (if (and 
            (setq ss (ssget "_CP" lst)) 
            (setq ssall (ssget "_X" (list (assoc 410 (entget en))))) 
            (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssall)))) 
            (setq lst (vl-remove-if '(lambda(x)(minusp 
            (cdr(assoc 62 (tblsearch "layer" 
            (cdr(assoc 8 (entget x)))))))) lst)) 
            (setq ssall nil ssall (ACET-LIST-TO-SS lst)) 
           ) 
        (progn 
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) 
          (foreach e1 lst (ssdel e1 ssall)) 
          (SSSETFIRST ssall ssall) 
          ) 
        ) 
      ) 
    ) 
  ) 
(princ "\nType OCS")

но полилиния не должна иметь самопересечений, и необходимо
наличие Express tools

** Исправлено: Выключенные слои
21.01.2009 Обработка криволинейных контуров (удаление дублирующихся точек)

VVA · 31.07.2007, 18:11

Выше быстро переделанный код удаления снаружи полилинии с обрезкой.

Код:

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

(defun C:OCD (  / en ss lst ssall bbox tmp head)
;Удаление снаружи полилинии
;Опубликовано http://forum.dwg.ru/showthread.php?t=12899
;http://forums.augi.com/showthread.php?t=65088&page=3
;Required Express tools
;OutSide Contour Delete
(vl-load-com)
(if (null ACET-GEOM-OBJECT-POINT-LIST)
    (progn
      (alert "Required Express tools!!!")
      (exit)
      )
    )
  (if (and (setq en (car(entsel "\nSelect contour: ")))
           (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
    (progn
      (setq bbox (ACET-ENT-GEOMEXTENTS en))
      (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-6))
      (while lst
        (setq head (car lst)
          tmp (cons head tmp)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-3))(cdr lst))
          )
        )
      (setq lst (reverse tmp))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
      (command "_.Zoom" "0.95x")
      (if (null etrim)(load "extrim.lsp"))
      (etrim en (polar
                  (car bbox)
                  (angle (car bbox)(cadr bbox))
                  (* (distance (car bbox)(cadr bbox)) 1.1)))
      (if (and
            (setq ss (ssget "_CP" lst))
            (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
           )
        (progn
          (setq lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
          (foreach e1 lst (ssdel e1 ssall))
          (ACET-SS-ENTDEL ssall)
          )
        )
      )
    )
  )
(princ "\nType OCD")

plugin · 31.07.2007, 18:56

Спасибо. Но, к сожалению OCS выделяет все примитивы внутри контура на выключенных слоях.

VVA · 31.07.2007, 19:13

Исправил. См. пост №3

plugin · 31.07.2007, 19:29

Программа OCD из поста 3 данной темы поступает еще более жестоко, она удаляет абсолютно все на выключенных слоях внутри прямоугольника.

Кулик Алексей aka kpblc · 31.07.2007, 22:01

Еще один вариант, достаточно кривой кстати:

Код:

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

(defun c:out (/ ent selset_all selset_in selset_out)
  (vl-load-com)
  (if (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    '(lambda ()
                       (setq ent (car (entsel "\nУкажите контур <Отмена> : ")))
                       ) ;_ end of lambda
                    ) ;_ end of vl-catch-all-apply
                  ) ;_ end of vl-catch-all-error-p
                ) ;_ end of not
           ent
           (= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
           (= (logand (cdr (assoc 70 (entget ent))) 129) 1)
           ) ;_ end of and
    (progn
      (setq selset_all (ssget "_X")
            selset_in  (ssget "_WP"
                              (mapcar '(lambda (a) (list (car a) (cadr a) 0.))
                                      (mapcar 'cdr
                                              (vl-remove-if-not
                                                '(lambda (x) (= (car x) 10))
                                                (entget ent)
                                                ) ;_ end of vl-remove-if-not
                                              ) ;_ end of mapcar
                                      ) ;_ end of mapcar
                              ) ;_ end of ssget
            selset_in  (ssadd ent selset_in)
            selset_out (ssadd)
            ) ;_ end of setq
      (foreach item (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset_all)))
        (if (not (ssmemb item selset_in))
          (setq selset_out (ssadd item selset_out))
          ) ;_ end of if
        ) ;_ end of foreach
      ) ;_ end of progn
    ) ;_ end of if
  (sssetfirst selset_out selset_out)
  ) ;_ end of defun

P.S. тестировалось только в мировой системе координат.

plugin · 31.07.2007, 22:16

Уважаемый Владимир! Большое спасибо. После исправлений программа стала работать намного лучше. Но на некоторых файлах все равно выделяются объекты внутри контура.
На прилагаемом чертеже внутри прямоугольника блок на выключенном слое. Подправленная программа OCS к сожалению его выделяет.
[ATTACH]1185905713.dwg[/ATTACH]

Аshаs-ка · 31.07.2007, 22:48

К слову. В китайском-раскитайском ZW-CADе есть опция "выделить все вне рамки"... www.zw-cad.ru

Клякса · 15.08.2007, 23:53

Сорри за вопрос, а можно поподробнее рассказать про функцию ssget? Или ссылку на соответствующий ресурс кинуть.
Заранее благодарен...

Кулик Алексей aka kpblc · 16.08.2007, 00:29

Справку цитировать как-то не гуд... vlide -> F1, а также любая книга Н.Н.Полещука, посвященная AutoLISP и (или) VisualLISP.

Клякса · 16.08.2007, 20:20

Осознал. Большое спасибо. :0)

VVA · 22.08.2007, 15:53

>plugin Команда работает правильно. Блок у тебя неправильный

Сам блок вставлен на включенный слой 0, а внутри него объекты отрисованы на слое 2. Слой 2 выключен, поэтому блока не видно.

Клякса · 22.08.2007, 22:02

А в VB что-нибудь похожее на ssget есть, или самому надо процедурку писать?

Кулик Алексей aka kpblc · 22.08.2007, 23:40

В VBA точно есть. А для VB надо библиотеки подключать либо использовать позднее связывание со всеми вытекающими.

Клякса · 23.08.2007, 21:22

Ок. Будем искать. А акадовские библиотеки по-любому подключать приходится.

VVA · 22.01.2009, 10:34

Вариант кода из #3 без Express'овского extrim'а. Просто удаляет объекы за пределами контура

Код:

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

(defun C:OCD1 (  / en ss lst ssall bbox tmp head)
;Удаление снаружи полилинии
; Необходимо наличие Express tools  
;Опубликовано http://forum.dwg.ru/showthread.php?t=12899
;http://forums.augi.com/showthread.php?t=65088&page=3
;Required Express tools
;OutSide Contour Delete
(vl-load-com)
  (if (null ACET-GEOM-OBJECT-POINT-LIST)
    (progn
      (alert "Необходимо наличие Express Tools!!!")
      (exit)
      )
    )
  (if (and (setq en (car(entsel "\nSelect contour: ")))
           (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
    (progn
      (setq bbox (ACET-ENT-GEOMEXTENTS en))
      (setq bbox (mapcar '(lambda(x)(trans x 0 1)) bbox))
      (setq lst (ACET-GEOM-OBJECT-POINT-LIST en 1e-6))
      (while lst
        (setq head (car lst)
          tmp (cons head tmp)
          lst (vl-remove-if '(lambda(pt)(equal pt head 1e-3))(cdr lst))
          )
        )
      (setq lst (reverse tmp))
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
      (command "_.Zoom" "0.95x")
      (if (and
            (setq ss (ssget "_CP" lst))
            (setq ssall (ssget "_X" (list (assoc 410 (entget en)))))
           )
        (progn
          (setq tmp '-1)
          (repeat (sslength ss)
            (ssdel (ssname ss (setq tmp (1+ tmp))) ssall)
            )
          (ACET-SS-ENTDEL ssall)
          )
        )
      )
    )
)
(princ "\nType OCD1")

Nike · 09.04.2013, 12:14

Цитата:

Сообщение от VVA

удаляет объекы за пределами контура

Если внутри контура есть видовые экраны, то они удаляются вместе с объектами за пределами.
Можно ли подправить?

VVA · 10.04.2013, 18:25

Nike, Приложи образец. Постараюсь помочь.

sime · 20.05.2013, 18:26

А можно сделать так что бы выбрать несколько контуров и удалить все что снаружи?

31.07.2007, 17:40		#1
Выделение снаружи _pline plugin Москва Регистрация: 09.07.2007 Сообщений: 10 С помощью ssget можно получить набор примитивов внутри выпуклой полилинии. А как получить набор примитивов находящихся снаружи полилинии, или хотя бы прямоугольника?
Просмотров: 16263