Удаление объектов находящихся за заданным контуром

VladERR · 21.01.2009, 15:14

исходные:
AutoCAD Civil 3D 2009 - Русский как AutoCAD,
большое количество 3D точек (есть координата z),
замкнутая полилиния (на плоскости).

требуется:
удалить все точки находящиеся за пределами полилинии (вне ее контура).

ЗЫ. для "ручной" чистки - объем очень большой, а времени мало. Гуру, помогите пожалуйста!

VVA · 21.01.2009, 15:25

Подборка
1. Выделение снаружи _pline
2. LISP.Выделение объектов в области контура

Хмурый · 21.01.2009, 15:30

[удалено]
я здесь про многоугольную рамку выбора писал WPolygon
потом удалил сообщение, т. к. VVA привел программы.

VladERR · 21.01.2009, 15:34

Хмурый , не пойдет. полилиния имеет кривы, переходные кривые. обводить точно - очень долго.

VVA, Выделение снаружи _pline, почитал, но ничего не понял. решение не найдено?

зы. Спасибо что отозвались!!!

VladERR · 21.01.2009, 15:53

по совету VVA "1. Выделение снаружи _pline" сделал лисп-файл, обозвал "KONTUR", подгрузил его в автокад. при вызове команды пишет "Неизвестная команда "KONTUR". Для вызова справки нажмите F1."

что не так сделал?

Хмурый · 21.01.2009, 16:11

надо вызывать, то, что написано в строке программы defun

OCS

VladERR · 21.01.2009, 16:22

Хмурый , не получается. всеравно "Неизвестная команда "

VVA? по совету "2. LISP.Выделение объектов в области контура" при вводе команды SCWP - просит выбрать полилинию - указываю. зумом показывает весь лист и все.

Хмурый · 21.01.2009, 16:27

VladERR, из какого сообщения взял код из #2 или #3?

запуск кода из 2-го сообщения ocs
запуск кода из 3-го сообщения ocd

ещё написано в #2 - "необходимо наличие Express tools"

VVA · 21.01.2009, 16:31

>VladERR , Команда OCS при выборе криволинейных контуров не всегда работала (при апроксимации получались дублирующиеся точки, что для ssget не приемлимо.
Исправил посты #2 и #3. Скачай заново
Как правильно делать см. ссылку в моей подписи

VladERR · 21.01.2009, 16:45

экспрес тулса в 2009 цивиле небыло, прикрутил от 2008 - работает.
Хмурый, лисп брал из топика #7, вызвался по out (спасибо что подсказал, никогда бы не додумался), и выдал "неверный тип аргумента: lselsetp nil".

VVA · 21.01.2009, 17:02

VladERR, На будущее. Всегда читай коментарии.

Цитата:

(defun C:OCS ( / en ss lst ssall bbox tmp head)
;Выделение снаружи полилинии
;_ http://forum.dwg.ru/showthread.php?t=12899
;Required Express tools
;OutSide Contour Select

Успехов в борьбе с точками

VladERR · 21.01.2009, 17:22

VVA, Хмурый, спасибо что откликнулись и помогли! сейчас сделал лисп OCD, отредактированный VVA, пока ошибок не выдает, обрабатывает. позже отпишусь о результатах.

VladERR · 22.01.2009, 09:42

лисп OCD работает, но ОЧЕНЬ медленно....

VVA · 22.01.2009, 10:36

VladERR, В OCD используется extrim из Express'а. Тебе он не нужен.
Попробуй OCD1 из #17

VladERR · 22.01.2009, 11:30

то же не справляется. VVA, а можно написать лисп для выделения объектов внутри замкнутого контура, то же без подрезки, но с переносом их в заданный слой. желательно что бы имя слоя спрашивалось после выбора контура. Возможно такая операция сможет ускорить процесс.

зы. есть полоса съемки шириной порядка 1км длиной порядка 30км, провести триангуляцию такого объема - не представляется возможным. решено вырезать коридор шириной 200м и триангулировать его... буду благодарен за продуктивные идеи!

VVA · 22.01.2009, 15:16

Пробуй
ICS - подсвечивает объекты внутри контура. При большом количестве может занимать много времени
ICSL - переносит на выбранный слой без всяких иллюминаций

Код:

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

(defun C:ICS (/ en ss lst ssall tmp head)
  ;;Выделение внутри контура
  ;;http://forum.dwg.ru/showthread.php?t=12899
  ;; Нужно наличие Express Tools
  ;;Required Express tools
  ;;OutSide Contour Select
  ;;Required Express tools 
  ;;OutSide Contour Select 
  (vl-load-com)
  (if (and (setq en (car (entsel "\nSelect contour: ")))
           (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE")
      ) ;_ end of and
    (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)
                   ) ;_ end of vl-remove-if
        ) ;_ end of setq
      ) ;_ end of while
      (setq lst (reverse tmp)) ;_ end of setq
      (if (setq ss (ssget "_CP" lst))
        (sssetfirst ss ss)
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
(defun C:ICSL (/ en ss lst i tmp head lay)
  ;;Выделение внутри контура с перебросом примитивов на указанный слой
  ;;http://forum.dwg.ru/showthread.php?t=12899
  ;; Нужно наличие Express Tools
  ;;Required Express tools
  ;;OutSide Contour Select
  ;;Required Express tools 
  ;;OutSide Contour Select 
  (vl-load-com)
  (if (and (setq en (car (entsel "\nSelect contour: ")))
           (wcmatch (cdr (assoc 0 (entget en))) "*POLYLINE")
           (setq lay   (mydcl "Select Layer" (ACAD_STRLSORT(tablelist "LAYER"))))
      ) ;_ end of and
    (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)
                   ) ;_ end of vl-remove-if
        ) ;_ end of setq
      ) ;_ end of while
      (setq lst (reverse tmp)) ;_ end of setq
      (ACET-SS-ZOOM-EXTENTS (ACET-LIST-TO-SS (list en)))
      (command "_.Zoom" "0.95x")      
      (if (setq ss (ssget "_CP" lst))
        (progn
           (setq i 0.0)
           (repeat (setq head (sslength ss)) ;_ end setq
             (grtext -1 (strcat "Working " (rtos (setq i (1+ i)) 2 0)))
             (vl-catch-all-apply '(lambda()
                 (vla-put-Layer (vlax-ename->vla-object (ssname ss (setq head (1- head)))) lay)                  
                                    )
               )
         );_ end repeat
          (alert (strcat (rtos i 2 0)" object tranfering to layer\n" lay))
         )
      ) ;_ end of if
    ) ;_ end of progn
  ) ;_ end of if
)
(defun mydcl (zagl info-list / fl ret dcl_id)
    (vl-load-com)
    (if (null zagl)
        (setq zagl "Выбор")
    ) ;_ end of 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 ;"
                  "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 (and (not(minusp(setq dcl_id (load_dialog fl))))
      (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
    (unload_dialog dcl_id)
    (vl-file-delete fl)
    ret
) ;_ end of defun
;;;================================================================================
;;;Written By Michael Puckett. 
;;;Список элементов символьных таблиц АвтоКАДа 
;;; - s- имя таблицы
;;;Пример - список всех слоев - (setq all_layers (tablelist "LAYER"))
;;;(setq all_layers (tablelist "LAYER"))
;;;
;;;AutoLisp should return something like this :
;;;Start Coding Here 
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))
  )     ;while
)     ;defun
  
(princ "\nType ICS or ICSL")

*** Добавлено
Диалоговое окно, Zoom выбранного контура на экран

VladERR · 22.01.2009, 16:24

после ввода ICSL - выбрал контур - в появившемся окошке указал слой в который хотел бы перенести точки находящиеся внутри контура и.... после 9-ти минутного ожидания - ничего..........

их текстового окна автокада:
Команда:

Select contour: nil

Команда:

Уменьшил размер контура выбора и сработало!!! только не ясно, зачем лисп и контур перенес в слой указанный для точек...

ЗЫ. VVA, на данный момент ICSL - самое быстрое решение.

VVA · 22.01.2009, 17:26

Для корректного выбора контур должен быть целиком на экране.
Обновил лисп в #16.
Добавил:
1. Зуммирование контура на экран (выделил красным)
2. Окно итога работы (правда количество - это количество выбранных объектов)

Цитата:

зачем лисп и контур перенес в слой указанный для точек

Потому что ты так сказал.
Создай для контура отдельный слой и заблокируй его

VladERR · 26.01.2009, 10:38

VVA, исправленный лисп в #16. работает лучше, проблем с выбором контура - никаких. Премного благодарен!!!!

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
FILTER / фильтр	BM60	Справочник команд	0	08.07.2008 15:35
Удаление объектов из пространства листа	paradoxvaha	Программирование	9	24.08.2007 14:25
Удаление объектов, сделанных недоступным ObjectARX-прил.	жертва нашизма	AutoCAD	11	25.07.2006 09:37
Удаление дублируюшихся объектов	Арлинг	AutoCAD	2	25.04.2004 13:56

21.01.2009, 15:14		#1
Удаление объектов находящихся за заданным контуром VladERR Регистрация: 21.01.2009 Сообщений: 21 исходные: AutoCAD Civil 3D 2009 - Русский как AutoCAD, большое количество 3D точек (есть координата z), замкнутая полилиния (на плоскости). требуется: удалить все точки находящиеся за пределами полилинии (вне ее контура). ЗЫ. для "ручной" чистки - объем очень большой, а времени мало. Гуру, помогите пожалуйста!
Просмотров: 18610