[Pain]

Народ мне нужна очень "ерьезная вещ"в автокаде))),а именно.....С помощью замкнутой полилинии я должен обвести облясть с энным каличеством ибьектов и при выделении этой полилинии должны выдилится все обьекты попавшие в контуры полилинии.Заранее говорю блок з0десь неподойдет потомучто эта полилиния должна легко изменять свою форму и соответственнол изменяется количество попавших обьектов в нуть этой самой линии и распределение обьектов по слоям тоже неподходит ибо это небыстрее чем расчет вручную :cry: .Может быть необходимо написать специалный скрипт для решения этой задачи.....может кто подскажет ...или это проще зделать в какой либо другой программе.Да и чтобы избавить вас от лышних вопросов сразу говорю все это нужно в области Градостроительства для быстрого подщета планогаммы расселения городов

[Dym]

tak na eto estj specialjno obuchennij vibor po konturu

[Кулик Алексей aka kpblc]

А если попробовать группы?

[VVA]

>PAIN Пробуй

Код:

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

;| ! *******************************************************************
;; !                  lib:IsPtInView
;; ! *******************************************************************
;; ! Проверяет находится ли точка в видовом экране
;; ! Auguments: 'pt'  - Точка для анализа в МСК!!!
;; ! Return   : T или nil если 'pt' в видовом экране или нет
;; ! *******************************************************************|;
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc)
(setq pt (trans pt 0 1))  
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
   SSZ (getvar "SCREENSIZE")
   X_Pix (car SSZ) Y_Pix (cadr SSZ)
   X_Len (* (/ X_Pix Y_Pix) Y_Len)
   Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len))
   Uc (polar Lc 0.0 X_Len)
   Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len))
   Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len)))
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
	 (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc)))
	T nil))
(defun DTR (a)(* pi (/ a 180.0)))
;| ! ***************************************************************************
;; !           lib:pt_extents
;; ! ***************************************************************************
;; ! Function : Возвращает границы MIN, MAX X,Y,Z списка точек
;; ! Argument : 'vlist' - Список точек
;; ! Returns  : Список точек (ЛевНижн ПравВерхн)
;; ! ***************************************************************************|;
(defun  lib:pt_extents (vlist / tmp)
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x))
 (mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist))
 '(0 1 2))));_setq
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun

; ! ***********************************************************
;; !                             lib:Zoom2Lst
;; ! **********************************************************
;; ! Function : Zoom границ списка точек
;; ! Arguments: 'vlist' - Список точек в МСК!!!!
;; ! Зуммирует экран, чтобы все точки были видны
;; ! Returns  : t - было зуммирование nil - нет
;; ! **********************************************************
(defun lib:Zoom2Lst( vlist / bl tr Lst OS)
(setq	Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst))
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr)))
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0)
(command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1)
	"_.Zoom" "0.95x")
(setvar "OSMODE" OS) T) NIL))

;****** Команда *******

(defun C:SPL ( / en pl n ss lst)
  (setq en (car(entsel "\nУкажите полилинию: ")))
  (if (and en (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE"))
    (progn (setq pl (vlax-ename->vla-object en) n 0)
      (while (<= n (vlax-curve-getEndParam pl))
	(setq lst (append lst (list (vlax-curve-getPointAtParam pl n)))
	      n   (1+ n)))
      (lib:Zoom2Lst lst);_Гарантированно полилиния на экране
      (setq lst (mapcar '(lambda(x)(trans x 0 1)) lst))
      (if (setq ss (ssget "_WP" lst))(SSSETFIRST ss ss))
      (setq ss nil)))(princ))
(princ "\nНаберите в командной строке SPL")

1. Выбор производится Рамкой многоугольника (_WP). Т.е. попадают объекты, которые полностью лежат внутри многоугольной области. Если нужно секущим многоугольником, замени текст

Код:

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

(ssget "_WP" lst)

на

Код:

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

(ssget "_CP" lst)

2. Полилиния контура должна быть выпуклой

***Добавлено*** 2011-03-14
Фрагмент чертежа по прямоугольной, круглой или ломаной границе
Команды: SCWP; SCCP
Выделение объектов путем указания существующего контура.
В качестве контура могут выступать сплайны, полилинии, дуги, круги, элипсы.
Контур должен быть выпуклым.

Код:

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

;;;Команды: SCWP; SCCP
;;;Выделение объектов путем указания существующего контура.
;;;В качестве контура могут выступать сплайны, полилинии, дуги, круги, элипсы.
;;;Контур должен быть выпуклым.
(defun SelectContour ( opt / en ss lst) 
(defun DTR (a)(* pi (/ a 180.0))) 
(defun  lib:pt_extents (vlist / tmp) 
(setq tmp (mapcar '(lambda (x) (vl-remove-if 'null x)) 
(mapcar '(lambda (what) (mapcar '(lambda (x) (nth what x)) vlist)) 
'(0 1 2))));_setq 
  (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp))) 
(defun lib:IsPtInView (pt / VCTR Y_Len SSZ X_Pix Y_Pix X_Len Lc Uc) 
(setq pt (trans pt 0 1)) 
(setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE") 
   SSZ (getvar "SCREENSIZE") 
   X_Pix (car SSZ) Y_Pix (cadr SSZ) 
   X_Len (* (/ X_Pix Y_Pix) Y_Len) 
   Lc (polar VCTR (dtr 180.0) (* 0.5 X_Len)) 
   Uc (polar Lc 0.0 X_Len) 
   Lc (polar Lc (dtr 270.0) (* 0.5 Y_Len)) 
   Uc (polar Uc (dtr 90.0) (* 0.5 Y_Len))) 
(if (and (> (car pt) (car Lc))(< (car pt) (car Uc)) 
    (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc))) 
   T nil)) 
(defun lib:Zoom2Lst( vlist / bl tr Lst OS) 
(setq   Lst (lib:pt_extents vlist) bl (car Lst) tr (cadr Lst)) 
(if (not (and (lib:IsPtInView bl) (lib:IsPtInView tr))) 
(progn  (setq OS (getvar "OSMODE"))(setvar "OSMODE" 0) 
(command "_.Zoom" "_Window" (trans bl 0 1)(trans tr 0 1) 
   "_.Zoom" "0.95x") 
(setvar "OSMODE" OS) T) NIL)) 
(defun TraceObject (obj / typlst typ TracePline TraceACE TraceLine 
                         TraceSpline TraceType1Pline 
                          TraceType23Pline) 
    (defun ZClosed (lst) 
    (if (and (vlax-curve-isClosed obj) 
       (not(equal (car lst)(last lst) 1e-6))) 
      (append lst (list (car lst))) 
      lst)) 
  (defun TracePline (obj / param endparam anginc tparam pt blg 
                           ptlst delta inc arcparam flag) 
    (setq param (vlax-curve-getStartParam obj) 
          endparam (vlax-curve-getEndParam obj) 
          anginc (* pi (/ 7.5 180.0))) 
    (setq tparam param) 
      (while (<= param endparam) 
        (setq pt (vlax-curve-getPointAtParam obj param)) 
        (if (not (equal pt (car ptlst) 1e-12)) 
          (setq ptlst (cons pt ptlst))) 
        (if  (and (/= param endparam) 
            (setq blg (abs (vlax-invoke obj 'GetBulge param))) 
            (/= 0 blg)) 
          (progn 
            (setq delta (* 4 (atan blg)) ;included angle 
                  inc (/ 1.0 (1+ (fix (/ delta anginc)))) 
                  arcparam (+ param inc)) 
            (while (< arcparam (1+ param)) 
              (setq pt (vlax-curve-getPointAtParam obj arcparam) 
                    ptlst (cons pt ptlst) 
                    arcparam (+ inc arcparam)))) 
        ) 
        (setq param (1+ param))) 
    (if (and (apply 'and ptlst) 
        (> (length ptlst) 1)) 
     (ZClosed (reverse ptlst)))) ;end 
  (defun TraceACE (obj / startparam endparam anginc 
                         delta div inc pt ptlst) 
    (setq startparam (vlax-curve-getStartParam obj) 
          endparam (vlax-curve-getEndParam obj) 
          anginc (* pi (/ 5.0 180.0))) 
    (if (equal endparam (* pi 2) 1e-12) 
      (setq delta endparam) 
      (setq delta (NormalAngle (- endparam startparam)))) 
    (setq div (1+ (fix (/ delta anginc))) 
          inc (/ delta div)) 
    (while (or 
        (< startparam endparam) 
        (equal startparam endparam 1e-12)) 
      (setq pt (vlax-curve-getPointAtParam obj startparam) 
            ptlst (cons pt ptlst) 
            startparam (+ inc startparam))) 
    (reverse ptlst)) ;end 
  (defun TraceLine (obj)(list (vlax-get obj 'StartPoint) 
        (vlax-get obj 'EndPoint))) 
  (defun TraceSpline (obj / startparam endparam ncpts inc param 
                            fd ptlst pt1 pt2 ang1 ang2 a) 
    (setq startparam (vlax-curve-getStartParam obj) 
          endparam (vlax-curve-getEndParam obj) 
          ncpts (vlax-get obj 'NumberOfControlPoints) 
          inc (/ (- endparam startparam) (* ncpts 7)) 
          param (+ inc startparam) 
          fd (vlax-curve-getfirstderiv obj param) 
          ptlst (cons (vlax-curve-getStartPoint obj) ptlst)) 
    (while (< param endparam) 
      (setq pt1 (vlax-curve-getPointAtParam obj param) 
            ang1 fd 
            param (+ param inc) 
            pt2 (vlax-curve-getPointAtParam obj param) 
            fd (vlax-curve-getfirstderiv obj param) 
            ang2 fd 
            a (abs (3d_angw1w2 ang1 ang2))) 
      (if (> a 0.00218166)(setq ptlst (cons pt1 ptlst)))) 
    (if (not (equal 
          (setq pt1 (vlax-curve-getEndPoint obj)) (car ptlst) 1e-8)) 
      (setq ptlst (cons pt1 ptlst))) 
    (reverse ptlst)) ;end 
  (defun TraceType1Pline (obj / ptlst objlst lst) 
    (setq ptlst (list (vlax-curve-getStartPoint obj)) 
          objlst (vlax-invoke obj 'Explode)) 
    (foreach x objlst 
      (setq lst (TraceACE x)) 
      (if (not (equal (car lst) (last ptlst) 1e-8)) 
        (setq lst (reverse lst))) 
      (setq ptlst (append ptlst (cdr lst))) 
      (vla-delete x))(ZClosed  ptlst)) ;end 
  (defun TraceType23Pline (obj / objlst ptlst lastpt) 
    (setq objlst (vlax-invoke obj 'Explode) 
          lastpt (vlax-get (last objlst) 'EndPoint)) 
    (foreach x objlst 
      (setq ptlst (cons (vlax-get x 'StartPoint) ptlst)) 
      (vla-delete x))(ZClosed (reverse (cons lastpt ptlst)))) ;end 
  (defun Trace3DPline (obj / coord ptlst) 
    (setq coord (vlax-get obj 'Coordinates)) 
    (repeat (/ (length coord) 3) 
      (setq ptlst (cons (list (car coord) (cadr coord)(caddr coord)) ptlst)) 
      (setq coord (cdddr coord)))(ZClosed (reverse ptlst))) ;end 
(defun NormalAngle (a)(if (numberp a)(angtof (angtos a 0 14) 0))) 
(defun 3d_angw1w2 (Wekt1 Wekt2 / CosA) 
(if (equal (setq CosA (/ (apply '+ (mapcar '* Wekt1 Wekt2)) 
        (distance '(0 0 0) Wekt1) (distance '(0 0 0) Wekt2))) -1.0 1e-6) 
  Pi 
  (if (equal CosA 0.0 1e-6) (* 0.5 PI)(atan (sqrt (- 1 (* CosA CosA))) CosA)))) 
  (setq typlst '("AcDb2dPolyline" "AcDbPolyline" "AcDb3dPolyline" "AcDbCircle" 
     "AcDbArc" "AcDbEllipse" "AcDbSpline" "AcDbLine")) 
  (or (eq (type obj) 'VLA-OBJECT) 
    (setq obj (vlax-ename->vla-object obj))) 
  (setq typ (vlax-get obj 'ObjectName)) 
  (if (vl-position typ typlst) 
    (cond ((or (eq typ "AcDb2dPolyline") (eq typ "AcDbPolyline")) 
      (cond ((or 
               (not (vlax-property-available-p obj 'Type)) 
               (= 0 (vlax-get obj 'Type))) 
              (TracePline obj)) 
            ((or (= 3 (vlax-get obj 'Type)) (= 2 (vlax-get obj 'Type))) 
              (TraceType23Pline obj)) 
            ((= 1 (vlax-get obj 'Type)) 
              (TraceType1Pline obj)))) 
       ((eq typ "AcDbLine")(TraceLine obj)) 
       ((or (eq typ "AcDbCircle") (eq typ "AcDbArc") (eq typ "AcDbEllipse")) 
         (TraceACE obj)) 
       ((eq typ "AcDbSpline")(TraceSpline obj)) 
       ((eq typ "AcDb3dPolyline")(Trace3DPline obj)) 
    ))) 
(vl-load-com) 
  (setq en (car(entsel "\nУкажите контур: "))) 
  (if (and en (wcmatch (cdr(assoc 0 (entget en))) "*POLYLINE,SPLINE,CIRCLE,ARC,ELLIPSE")) 
    (progn 
      (setq lst (TraceObject (vlax-ename->vla-object en))) 
      (lib:Zoom2Lst lst);_Гарантированно полилиния на экране 
      (setq lst (mapcar '(lambda(x)(trans x 0 1)) lst)) 
      (setq lst (mapcar '(lambda(x)(list (car x)(cadr x))) lst)) 
(if (setq ss (ssget opt lst))(SSSETFIRST ss ss)) 
(setq ss nil)))(princ)) 
;_Select Contour Window Polygon 
(defun C:SCWP ()(SelectContour "_WP")) 
;_Select Contour Crossing Polygon 
(defun C:SCCP ()(SelectContour "_CP")) 
(princ "\nНаберите в командной строке SCWP или SCCP")

[Pain]

Большое спасибо что откликнулись))!!
Группы здесь скорее всего не подойдут потому-то они постоянно могут изменятся. В качестве примера вылежал фрагмент расселения, на карте 2 зоны пересекающие друг друга…..и мне нужна такая вещ…При выделении синей или зеленой полилинии должны выделятся ТОЛЬКО все красные точки попавшие в ее контуры. про wpolygon я знаю это немного другое мне нужна именно линия отображающаяся на чертеже а не многоугольный курсор, причем я должен при желании изменить форму или переместить эту линию и соответственно точки попавшие в контур станут другие. Незнаю на сколько всё это решаемо, жду ваших комментариев. Заранее спасибо)
[ATTACH]1161695004.jpg[/ATTACH]

[{Smirnoff}]

Судя по картинке это не точки а блоки. Попробуйте этот лиспик. Сначала указываете граничную полилинию, потом образцовый блок. Если надо действительно точки то переделать несложно.

Код:

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

(defun c:pbsel(/ polyBound vlaPoly utilObj ordLst
         Index curOrd stopFlag blSet curVar
	 filLst)

  (vl-load-com)
  (if
    (not
      (and
	(setq polyBound
         (entsel "\nSelect boundary polyline > "))
     (= "AcDbPolyline"
      (vla-get-Objectname
       (setq vlaPoly
        (vlax-ename->vla-object (car polyBound)))))
	); end not
      ); end and
    (progn
      (princ "\n+++ It's not LWPolyline +++ ")
      (setq vlaPoly nil)
      ); end progn
    ); end if
  (if vlaPoly(vla-Highlight vlaPoly :vlax-true))
    (if
    (not
      (and vlaPoly
	   (setq samBl
	    (entsel "\nSelect Block Reference >"))
     (= "INSERT"
	(cdr(assoc 0(setq dxfLst(entget(car samBl))))))
       ); end and
      ); end not
    (progn
      (princ "\n+++ It's not Block Reference +++ ")
      (setq samBl nil)
      ); end progn
    ); end if
  (if vlaPoly(vla-Highlight vlaPoly :vlax-false))
  (if(and vlaPoly samBl)
    (progn
    (setq utilObj(vla-get-Utility
       (vla-get-ActiveDocument
         (vlax-get-acad-object)))
    ordLst '()
    Index 0
    filLst(vl-remove-if
	    '(lambda(x)(not(member(car x) '(0 2))))dxfLst)
    ); end setq
    (while(not stopFlag)
 (if
  (not
    (vl-catch-all-error-p
      (setq curOrd (vl-catch-all-apply
        'vla-get-Coordinate(list vlaPoly Index)))))
  (progn
    (setq curOrd
	   (append
	     (vlax-safearray->list
	       (vlax-variant-value curOrd))
	        (list(vla-Get-Elevation vlaPoly))))
    (setq curVar(vlax-make-safearray 5 '(0 . 2)))
    (vlax-safearray-fill curVar curOrd)
    (setq curOrd(vlax-make-variant curVar))
    (setq ordLst
     (append ordLst
       (list
       (vlax-safearray->list
         (vlax-variant-value
           (vla-TranslateCoordinates utilObj
              curOrd acOCS acUCS :vlax-false
	       (vla-get-Normal vlaPoly))))
       ); end list
       ); end append
    ); end setq
    ); end progn
  (setq stopFlag T)
  ); end if
      (setq Index(1+ Index))
      ); end while
    (if
      (setq blSet
       (ssget "_CP" ordLst filLst))
      (progn
	(sssetfirst nil blSet)
	(princ
	  (strcat "\n$$$ "
		  (itoa(sslength blSet))
		  " Block References were selected $$$ "))
	); end progn
      (princ "\n+++ No Block References found inside boundary. +++")
      ); end if
  ); end progn
      ); end if
  (princ)
); end of c:pbsel

Если нужно выбирать также пересекаемые блоки см. постинг VVA.

[skkkk]

VVA, #4:
Диалог текстового окна

Код:

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

Команда: SPL

Укажите полилинию: ; ошибка: no function definition: DTR

[skkkk]

Тут есть рабочий лисп на эту тему от VVA (корректно второе издание, переработанное и дополненное).
Мне, например, надо выделять объекты в области контура (замкнутого, разумеется) точь-в-точь, т.е., именно то, что находится внутри контура, ни больше ни меньше... Лисп же с этой ссылки делает чуть не так. Команда SCWP выделяет только объекты, целиком попавшие в контур, при этом игнорируются те, что находятся по обе стороны контура. А команда SCCP выделяет все те, хотя бы часть которых попала в контур. Лиспом, точнее командой BreakTouching отсюда я разрываю все граничащие с контуром линии. Потом делаю Offset (Подобие) секущего контура внутрь на 0,1мм с удалением исходного секущего контура, и выделяю то, что внутри контура командой SCCP, либо наоборот, Offset наружу и командой SCWP. Подобие нужно потому, как я понял, что наш секущий контур после разрыва всех линий касается этих линий как внутри, так и снаружи себя, что нежелательно в моем случае при использовании ни SCCP, ни SCWP. В принципе, это выход, но очень много манипуляций. Может, можно как-то выбирать объекты внутри контура с их разрывом одной командой?

P.S. Изначально хотел, просто донести информацию до кого-то, кому это может пригодиться, но если кто подскажет, как упростить процесс, буду благодарен, хотя и так труда особого не составляет. Вчера коллегу удивил, вырезав из большой карты круглый фрагмент за пятнадцать секунд..... Она break'ом все линии рвала, потом выделяла по одной

[VVA]

skkkk, Добавил в #4 dtr (так, для порядку). SCWP и SCCP лучше (обрабатывают дуговые сегменты). Ты все правильно понял и правильно делаешь. В BreakTouching, по-моему, можно вызвать разрыв функцией, но это нужно смотреть.

[skkkk]

Может, и здесь этот лиспик разместить, раз он лучше?

[skkkk]

Вот еще идея возникла написать макрос на кнопку. С BreakTouching и SCWP все понятно, но как с Offset'ом быть? Как объяснить машине программно, что мне надо сделать Offset внутрь, например, на 0,1?

[VVA]

Это самое сложное, проще наверное попросить пользователя "ткнуть" мышкой. Как вариант - преобразовать в регион и взять центр тяжести.

[skkkk]

VVA,

...преобразовать в регион и взять центр тяжести.

Для меня это звучит подобно следующему:

Индексация финансовых сигригенций зависит от латентоадекватных мажеритарных абструкций.(с)М. Задорнов

[VVA]

Кое-то про склеивание BreakTouching + SCСP + Offset
здесь

[skkkk]

Фрагмент чертежа по прямоуг. или кругл. границе
Хотя, пожалуй лучше опубликую тут - ссылки иногда теряются:

Код:

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

;|==================================================== 
Фрагмент чертежа по прямоуг. или кругл. границе 
(программа тестировалась на AutoCAD 2006, 2008) 

Программа Дениса Флюстикова "Fragm_Den" от 16.12.08 
Новое: 
- работа с таблицами 

Макрос для кнопки: 
^C^C^P(load "Fragm_Den");Fragm_Den 

Замечания и предложения по адресу fd-@mail.ru 

====================================================|; 

(defun c:Fragm_Den (/ *error* aa1 aa2 aa3 aa4 aa5 aa6 aa7 aa8 aa9 aa10) 

(if (>= (atof (getvar "ACADVER")) 16.2)(progn 

(setq aa8 "Размер" ;Слой построения контура 
      aa1 (getpoint "\nПервая точка прямоугольной области или <Круглая>:") 
      aa2 nil 
      aa6 nil) 

(vl-load-com) 
(if aa1 
(if (setq aa2 (getcorner aa1 "\nВторая точка области:"))(progn 
(setq aa1 (trans aa1 1 0) 
      aa2 (trans aa2 1 0) 
      aa7 (list (cons 10 aa1) 
      (cons 10 (list (car aa1)(cadr aa2))) 
      (cons 10 aa2) 
      (cons 10 (list (car aa2)(cadr aa1)))) 
) 
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) 
(setvar "CMDECHO" 0) 
(command "_.undo" "_m") 
(if aa8 (if (tblsearch "Layer" aa8)(setvar "CLAYER" aa8))) 
) 
)(progn 

(setq aa1 (getpoint "\nЦентр круглой области:")) 

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) 
(setvar "CMDECHO" 0) 
(command "_.undo" "_m") 
(if aa8 (if (tblsearch "Layer" aa8)(setvar "CLAYER" aa8))) 

(princ "\nРадиус области:") 

(vl-cmdf "_.circle" aa1) 
(while (= (getvar 'cmdactive) 1) 
(setq aa2 (vl-cmdf pause))) 

(if aa2 (progn 
(setq aa2 (cadr (grread 1 1)) 
      aa2 (trans aa2 1 0) 
      aa4 (entlast) 
      aa3 (vlax-ename->vla-object aa4) 
      aa5 (vlax-curve-getEndParam aa3) 
      aa5 (vlax-curve-getDistAtParam aa3 aa5) 
      aa5 (/ aa5 256.0) 
      aa1 0 
      aa7 '()) 

(repeat 256 
(setq aa7 (append aa7 (list (cons 10 (vlax-curve-getpointatdist aa3 aa1))))) 
(setq aa1 (+ aa1 aa5))) 

)))) 

(if aa2 (progn 

(defun *error* (msg) 
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) 
(if (< (atof (getvar "ACADVER")) 17.1) 
(vla-sendcommand (vla-get-activedocument 
(vlax-get-acad-object)) "_.undo 1 ") 
(command nil nil nil nil "_.undo" 1)) 
(princ "\nВыход во время обработки данных\n") 
)     

(setq aa3 (list (cons 0 "LWPOLYLINE") 
      (cons 100 "AcDbEntity") 
      (cons 100 "AcDbPolyline")) 
      aa7 (append (list (cons 90 (length aa7)) 
         (cons 70 1)) 
        aa7) 
      aa1 '()) 

(entmake (append aa3 aa7)) 

(mapcar '(lambda (q) 

(if (= (car q) 10) 
(setq aa1 (cons (trans (cdr q) 0 1) aa1))) 

) aa7) 

(if aa5 
(setq aa8 (ssadd (entlast)(ssadd))) 
(setq aa4 (entlast) 
      aa8 (ssadd)) 
) 

(setvar "OSMODE" 0) 
(setvar "LTSCALE" 0.0001) 

(command "_.shademode" 2 
    "_.zoom" "_o" (entlast) "" 
    "_.offset" (/ (getvar "VIEWSIZE") 2e4)(entlast)(getvar "VSMAX") "" 
    "_.zoom" "_o" (setq aa5 (entlast) aa6 aa5) "") 

(setvar "EXPLMODE" 1) 

(while aa3 
(setq aa3 (ssget "_CP" aa1 '((0 . "INSERT")))) 

(if aa3 
(repeat (setq aa7 (sslength aa3)) 
(command "_.explode" (ssname aa3 (setq aa7 (1- aa7)))) 
)) 

(setq aa3 nil) 

(while (entnext aa6) 
(setq aa6 (entnext aa6) 
      aa3 T) 
) 
) 

(if (setq aa3 (ssget "_F" aa1 '((-4 . "<OR") 
            (0 . "ACAD_TABLE") 
;;;            (0 . "*DIMENSION") 
;;;            (0 . "LEADER") 
            (-4 . "OR>")    
))) 
(repeat (setq aa7 (sslength aa3)) 
(command "_.explode" (ssname aa3 (setq aa7 (1- aa7)))) 
)) 

(if (setq aa3 (ssget "_CP" aa1 '((0 . "HATCH"))))(progn 

(setq aa6 (entlast) 
      aa7 (sslength aa3)) 

(repeat aa7 

(setq aa10 (ssname aa3 (setq aa7 (1- aa7))) 
      aa9 (assoc 450 (entget aa10))) 

(if (= (cdr aa9) 1) 
(entmod (subst (cons 450 0) aa9 (entget aa10)))) 

(command "_-hatchedit" aa10 "_b" "_r" "_n") 

(if (null (entnext aa6))(progn 
(command "_-hatchedit" aa10 "_b" "_p" "_n" 
    "_-hatchedit" aa10 "_di" 
    "_-hatchedit" aa10 "_as" "_s") 

(while (entnext aa6) 
(setq aa6 (entnext aa6) 
      aa8 (ssadd aa6 aa8)) 
(command aa6) 
) 

(command "" "" 
    "_-hatchedit" aa10 "_b" "_r" "_n") 
)) 

(if (entnext aa6)(progn 
(setq aa6 (entnext aa6) 
      aa8 (ssadd aa6 aa8)) 
(command "_-hatchedit" aa10 "_di" 
    "_-hatchedit" aa10 "_as" "_s" aa6 "" "") 
)) 

(if (= (cdr aa9) 1)(progn 
(setq aa9 (entget aa10))            
(entmod (subst (cons 450 1) (assoc 450 aa9) aa9)) 
)) 

) 
)) 

(if (setq aa3 (ssget "_CP" aa1 '((0 . "REGION"))))(progn 

(command "_.copy" aa4 "" '(0 0 0) '(0 0 0) 
    "_.region" (entlast) "") 

(setq aa7 (sslength aa3) 
      aa6 (entlast) 
      aa8 (ssadd aa6 aa8)) 

(repeat aa7 
(command "_.copy" aa6 "" '(0 0 0) '(0 0 0)) 
(setq aa8 (ssadd (entlast) aa8)) 
(command "_.intersect" (ssname aa3 (setq aa7 (1- aa7))) (entlast) "") 
) 
)) 

;;;(if (setq aa3 (ssget "_F" aa1 '((0 . "IMAGE")))) 
;;;(repeat (setq aa7 (sslength aa3)) 
;;;(command "_.imageclip" (ssname aa3 (setq aa7 (1- aa7))) "_n" "_p") 
;;;(repeat (setq aa6 (length aa1))(command (nth (setq aa6 (1- aa6)) aa1))) 
;;;(command "_c") 
;;;)) 

(setq aa3 (ssget "_CP" aa1) 
      aa6 '()) 

(mapcar '(lambda (q) 

(if (= (car q) 10) 
(setq aa6 (cons (trans (cdr q) 0 1) aa6))) 

)(entget aa5)) 

(setq aa6 (cons (last aa6) aa6)) 

(command "_.move" aa3 "" '(0 0 0) '(0 0 0)) 

(repeat 4 
(command "_.trim" aa4 "" "_f") 

(repeat (setq aa5 (length aa6)) 
(command (nth (setq aa5 (1- aa5)) aa6)) 
) 

(while (= (getvar 'cmdactive) 1)(command "")) 
) 

(if (setq aa5 (ssget "_CP" aa6 '((0 . "*POLYLINE"))))(progn 
(vl-cmdf "_.pedit" "_m" aa5 "" "_w" 0 "") 
(setq aa5 (ssget "_F"  aa6 '((0 . "*POLYLINE")))) 
(command "_.undo" 1) 
)) 

(setq aa6 (ssget "_F" aa6 '((-4 . "<OR")(-4 . "<NOT")(-4 . "<OR") 
             (0 . "HATCH") 
             (0 . "*POLYLINE") 
             (0 . "*TEXT") 
             (0 . "REGION") 
;;;             (0 . "IMAGE") 
             (-4 . "OR>")(-4 . "NOT>") 
             (0 . "*DIMENSION,LEADER");Без размеров 
             (-4 . "OR>") 
             ))) 

(command "_.erase" aa8) 
(if aa6 (command aa6 )) 
(if aa5 (command aa5 )) 
(command "") 

(setq aa3 (ssget "_CP" aa1) 
      aa6 "den") 
   
(while (or (tblsearch "block" aa6) 
      (findfile (setq aa1 (strcat (getvar "tempprefix") aa6 ".dwg")))) 
(setq aa6 (strcat aa6 "1"))) 

(command "_.wblock" aa1 "" (trans aa2 0 1) aa3 aa4 "" 
    "_.undo" "_b" 
    "_.insert" aa1 "_none" (trans aa2 0 1)) 

(while (= (getvar 'cmdactive) 1) 
(command "")) 

(vl-file-delete aa1) 

(setq aa2 (trans aa2 0 1) 
      aa5 (entlast) 
      aa3 1.0) 

(while aa2 

(vl-cmdf "_.move" aa5 "" "_none" aa2) 

(princ (strcat "\nУкажите положение элемента или <Масштаб>:")) 

(setq aa1 (vl-cmdf pause)) 

(if (and aa1 (equal aa2 (getvar "LASTPOINT") 1e-6))(progn 

(setq aa1 (getvar 'lastprompt) 
      aa1 (substr aa1 (+ (vl-string-search ">:" aa1) 3))) 

(if (= aa1 "0") 
(setq aa2 nil)(progn 
(command "_.erase" aa5 "" 
    "_.insert" aa6 "_none" (setq aa2 (cadr (grread 1 1))) aa3) 
(while (= (getvar 'cmdactive) 1) 
(command "")) 

(princ "\nМасштаб <")(princ aa3)(princ ">:") 
(initget 128) 
(if (vl-catch-all-error-p 
(setq aa7 (vl-catch-all-apply 'getkword))) 
(setq aa7 "")) 

(if (null aa7)(setq aa7 "")) 

(setq aa7 (vl-string-translate ",:" "./" aa7) 
      aa4 (atof aa7)) 

(if (setq aa5 (vl-string-search "/" aa7)) 
(if (= (setq aa5 (atof (substr aa7 (+ aa5 2)))) 0) 
(setq aa4 aa3) 
(setq aa4 (/ aa4 aa5)) 
)) 

(if (= aa4 0)(setq aa4 aa3)) 

(setq aa7 (* (/ 1.0 aa3) aa4) 
      aa3 aa4 
      aa5 (entlast)) 

(vl-cmdf "_.scale" aa5 "" "_none" aa2 aa7) 
))) 
(setq aa2 nil) 
) 
) 

(setq aa4 (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object))) 
      aa1 (getvar "EXPLMODE")) 
(setvar "EXPLMODE" 1) 
(command "_.explode" aa5) 
(setvar "EXPLMODE" aa1) 

(if (eq (type (vl-catch-all-apply 'vla-Item (list aa4 aa6))) 'VLA-OBJECT) 
(vl-catch-all-apply 'vla-Delete (list (vla-Item aa4 aa6)))) 

(while (entnext aa5) 
(setq aa5 (entnext aa5) 
      aa1 (entget aa5)) 

(if (/= aa3 1)             ;Если вместо "(/= aa3 1)" "nil", то 
;   без сохранения масштаба штриховки и глоб.толщины полилиний 
(if (= (cdr (assoc 0 aa1)) "HATCH") 
(if (setq aa2 (assoc 41 aa1))(progn 

(entmod (subst (cons 41 (/ (cdr aa2) aa3)) aa2 aa1)) 

(command "_-hatchedit" aa5 "_p") 
(while (= (getvar 'cmdactive) 1)(command "")) 

))(if (wcmatch (cdr (assoc 0 aa1)) "*POLYLINE") 
(if (setq aa2 (assoc 43 aa1)) 
(vl-cmdf "_.pedit" "_m" aa5 "" "_w" (/ (cdr aa2) aa3) "") 
)) 
)) 
) 
)) 

(setvar "CMDECHO" 1) 
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) 

) 
(princ "\nДля AutoCAD с 2006 версии") 
) 
(princ) 
)

[Кулик Алексей aka kpblc]

skkkk, ссылочку-то подправь. Она в имеющемся виде ведет в никуда

[Olga_@@@]

Pain, задача легко решается в Autodesk Map с помощью запросов.

[Хмурый]

Olga_@@@, Pain отвалил от этого вопроса 2,5 года назад

[Olga_@@@]

Хмурый, и слава богу.
Но, тему не я реанемировала.

[VVA]

Есть еще хороший лисп CookieCutter2 - more fun with ET extrim
Описание

Along the lines of improving on antiquated ExpressTools commands here's CookieCutter2. From the header comments: ;; What does CC2 do which ExpressTools extrim, AKA CookieCutter, doesn't? ;; Works with blocks, hatches and regions by exploding them. ;; Other object types which cannot be trimmed are left intact. ;; Works with objects which do not use a Continuous linetype. ;; Offers an option to delete all objects on visible layers either ;; inside or outside the selected trim object. Read the header comments for more info. The shortcut is CC. Hope you like it.

Краткий перевод: Короткая команда CC. Вырезает из чертежа фрагмент (внутренний или внешний) по выбранному контуру (С подрезкой блоков и т.п.)
Так как там требуется регистрация, то лисп тоже размещу здесь

PS. Еще версия http://forum.dwg.ru/showthread.php?t=42985

[skkkk]

Сообщение от Кулик Алексей aka kpblc skkkk, ссылочку-то подправь. Она в имеющемся виде ведет в никуда

Подправил.
Поразительно! Ни одна мелочь не ускользнет от твоего зоркого взгляда. Тебя пора номинировать на звание Модератор века
Offtop: Не пойму,что-то изменилось - мой браузер или форум - не могу теперь изменить название ссылки, а теги не очень-то понимаю. Еще и ник не выходит вставить в сообщение никак

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

[Кулик Алексей aka kpblc]

Сообщение от skkkk http://www.caduser.ru/forum/index.ph...D=44&TID=44865 Хотя, пожалуй лучше опубликую тут - ссылки иногда теряются:<...>

Попробуй так:
[url=http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=44865]Нужный текст[/url]

[АлексЮстасу]

Один вопрос, похоже, риторический: в самом базовом Автокаде так и нет возможности выбора объектов внутри указанного существующего контура?

Второе: по поводу отличной программы VVA из п.2 в #4, которая выделяет все объекты в указанном контуре.
Один в ней недостаток - на мой взгляд. Или спорный момент. Программа по команде SCWP (выделить объекты внутри контура) не выделяет те тексты и блоки, части которых выходят за пределы контура, но чьи точки вставки попадают в контур.
Да, по команде SCCP (выделить объекты хоть частично попадающие в контур) эти тексты и блоки выделятся. но вместе с ними выделятся и другие элементы, попадающие хоть частично на контур.
Т.е., по-моему, при выделении объектов внутри контура (SCWP) нужно выделять и тексты, блоки, чьи точки вставки попадают в контур. Даже если их общие габариты выходят за его пределы.

[skkkk]

Сообщение от АлексЮстасу в самом базовом Автокаде так и нет возможности выбора объектов внутри указанного существующего контура?

Насколько мне известно - нет, могу ошибаться.

Сообщение от АлексЮстасу по-моему, при выделении объектов внутри контура (SCWP) нужно выделять и тексты, блоки, чьи точки вставки попадают в контур. Даже если их общие габариты выходят за его пределы.

Наверное, для такой цели логичнее сделать третью команду, которая включит в набор тексты и блоки, не попавшие целиком внутрь контура. Первые две ведь работают полностью по аналогии со штатными рамкой и секрамкой.

[АлексЮстасу]

Сообщение от skkkk Насколько мне известно - нет, могу ошибаться.

Немного мечтаний... В кад-MicroStation отродясь, т.е. с конца 80-х - точно, есть волшебный инструмент Fence. Это не тип элемента, хотя его форму можно редактировать, а отдельная сущность - граница обработки данных. Fence можно задать рамкой, окружностью, им можно начертить произвольный замкнутый контур, назначить им существующий замкнутый контур, текущий экран, границы файла и границы площади, которую ограничивают линии файла вокруг указанной точки. В нем можно выставить режимы: внутри, внутри и пересекает, вырезаемое внутри границей (Clip), снаружи, снаружи и пересекает, вырезаемое снаружи границей (Void-Clip). И набор специальных команд для элементов с учетом Fence: удалить, разбить, перенести, скопировать и пр. В т.ч. перенести или скопировать в другой файл.
Кроме того, практически для всех обычных команд, действий существует опция Use Fence и настройка его режима в каждой из команд. Т.е. Fence - это потенциальное выделение в указанной границе, которое, задав, можно использовать или не использовать в любой момент и для любого нужного действия с элементами, соответствующими этой границе и заданному режиму. При этом, его можно использовать любое количество раз - просто включить опцию Use Fence при нужных действиях и подстраивать режим. Живет Fence до тех пор, пока его не отменят или не назначат другое. Эффективно чрезвычайно.
А рамка, секрамка, выделение/отмена штучные и пр. в MicroStation тоже есть

Сообщение от skkkk Наверное, для такой цели логичнее сделать третью команду, которая включит в набор тексты и блоки, не попавшие целиком внутрь контура. Первые две ведь работают полностью по аналогии со штатными рамкой и секрамкой.

В смысле - включит в набор тексты и блоки, чьи точки вставок попали внутрь контура.
Гм... Вы правы - SCWP и SCCP работают именно так, как рамка и секрамка! Я как-то в пылу сражения об этом не подумал
Offtop: Я теоретизировал так:
- во-первых, геометрически блоки и тексты характеризуются в первую очередь точкой вставки.
- во-вторых, если бы существовал выбор не только элементов внутри многоугольника (контура), но и выбор вне контура, то они должны быть обратны друг другу. А это возможно только по точкам вставки. Т.е. при выборе внутри контура тексты и блоки, чьи точки вставки попадают внутрь, выделяются, а при выборе всего снаружи контура - не выделяются. Иначе они не выделятся ни при выборе внутри контура, ни снаружи, что, по-моему, нонсенс.
Но, возможно, я вообще не прав. Кстати, в том же MicroStation выделение делается так же, как в Автокаде - попадающие на контур/Fence тексты и блоки не выделяются ни при Inside, ни при Void

[АлексЮстасу]

В целом реализовано выделение внутри/вне контуров с учетом только точек вставки блоков и текстов.
Заодно, еще шесть вариантов выделения по контурам.
И с учетом предварительного выбора.
И выбор сразу по множеству контуров.
И контуры можно собирать из множества отдельных элементов.
И есть выделение элементов на линиях или пересекающих линии с учетом 3D.
Хотя, и пока только под 2010-2012, и контуры не могут быть криволинейными.

[АлексЮстасу]

Такая засада - и лисп SelectContour, и arx Psi_Sel при определенных условиях не отображают на экране выделение элементов. Хотя, в панели свойств пишется, что выбраны элементы.
Происходит так:
1. Обе программы выбирают указанное относительно контура и этот выбор отображается на экране голубыми ручками элементов.
2. Выключаю или замораживаю какой-то слой.
3. Обе программы выбирают указанное относительно контура, но на экране это не отображается. Хотя в панели свойств пишет о числе выбранных элементов.
Сколько раз программы ни вызывай - на экране выбранное не видно.
Если же просто ткнуть мышкой в экран, то выбор отобразится на экране включенными ручками.
Или если после выключения слоя сделать общий вид или regenall, то выбранное SelectContour или Psi_Sel сразу отображается на экране.
В чем проблема в отображении выбранного после выключения слоев?
Проверял на 2012 и 2014.

[Миксер]

VVA, или другой кто умеет писать на LISP, сделайте плиз программе SCWP и SCCP возможность выделять несколько контуров ну и соответственно объекты в них. Ооочень нужно. Ну или как -то направьте

[АлексЮстасу]

Сообщение от Миксер ... сделайте плиз... возможность выделять несколько контуров ну и соответственно объекты в них.

Это, правда, не SCWP и SCCP, но

Сообщение от АлексЮстасу выделение внутри/вне контуров... И выбор сразу по множеству контуров.

[Миксер]

АлексЮстасу, спасибо. Но мне нужна для более поздних версий. Возможно ее. как то использовать хотя бы в автокад 2015?

[АлексЮстасу]

Сообщение от Миксер возможность выделять несколько контуров ну и соответственно объекты в них.

... Шли годы. А воз и ныне там...
Вариант InOutSel с применением многих функций VVA (да будет ему всяко хорошо!) из его же оч. хорошей не раз в этой теме упомянутой SelectContour.lsp.
Вариант на lisp, т.е. должен бы работать во всех AutoCAD.
Благодаря функциям VVA, контуры выбора могут быть любыми типами полилиний, сплайнами, окружностями, дугами, эллипсами. Контуры могут быть разомкнутыми.
Нет ограничений на выпуклость контуров выбора. Контуры могут быть и вогнутыми, и разветвленными.
Отличия:
1. Вроде бы, если предварительное увеличение было не до нанометров, то не требуется, чтобы контуры выбора были полностью видны на экране. И вообще видны.
2. 6 способов выбора:
Внутри (аналог _WP), внутри и касаются, внутри и пересекаются (аналог _CP), извне, извне и касаются, извне и пересекаются.
3. Выбор производится сразу для всех указанных контуров. Предварительный или последующий выбор нужных контуров.
4. Выбор производится для указанных объектов. Enter означает - для всех.

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

О странном. Выяснилось, что в AutoCAD точность выбора и штатной _SELECT (ВЫБРАТЬ), и функций lisp ssget и vla-selectbypolygon всего лишь 0.001. А на этих функциях написаны все lisp выбора, в т.ч. и SelectContour.lsp, да и остальные. И наш вариант так же.
Поэтому, если в dwg координаты (которые внутри хранятся до 12 знаков, кажется) не округлены хотя бы до 0.001, то будут и не выбранные объекты, и ошибочно выбранные. Т.е. такими программами без внимательного ручного контроля и ручной же доработки пользоваться опасно.

Есть ли альтернативы другими, точными инструментами?

[АлексЮстасу]

В SelectContour.lsp VVA есть функция получения для сплайна списка точек с заданной степенью подробности его передачи.

Код:

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

  (defun TraceSpline (obj / startparam endparam ncpts inc param
                            fd ptlst pt1 pt2 ang1 ang2 a)
    (setq startparam (vlax-curve-getStartParam obj)
          endparam (vlax-curve-getEndParam obj)
          ncpts (vlax-get obj 'NumberOfControlPoints)
          inc (/ (- endparam startparam) (* ncpts 7))
          param (+ inc startparam)
          fd (vlax-curve-getfirstderiv obj param)
          ptlst (cons (vlax-curve-getStartPoint obj) ptlst))
    (while (< param endparam)
      (setq pt1 (vlax-curve-getPointAtParam obj param)
            ang1 fd
            param (+ param inc)
            pt2 (vlax-curve-getPointAtParam obj param)
            fd (vlax-curve-getfirstderiv obj param)
            ang2 fd
            a (abs (3d_angw1w2 ang1 ang2)))
      (if (> a 0.00218166)(setq ptlst (cons pt1 ptlst))))
    (if (not (equal
          (setq pt1 (vlax-curve-getEndPoint obj)) (car ptlst) 1e-8))
      (setq ptlst (cons pt1 ptlst)))
    (reverse ptlst)) ;end

Степень подробности здесь определяет, предположу, число 7. Избыточные вершины, предположу, убираются по критерию угла, число 0.00218166. (В функции всего два числа )
Но эта степень подробности связывается с количеством вершин в сплайне. При том, что сплайны одинаковой формы могут быть со всего несколькими вершинами, а могут быть и с сотнями вершин.

Для управления степенью подробности нужен параметр, связанный с величиной отклонения сплайна от линии между соседними полученными точками.
Если не прямой, то хотя бы косвенный - минимальное расстояние между точками. (Т.к. если меньше это расстояние - меньше возможное отклонение).
Хорошо бы сам мастер эту функцию так изменил. Сохранив прореживание избыточных точек.
Или другие программисты...

Поскольку я не программист, то задам еще такой вопрос: в коде есть строка

Код:

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

pt2 (vlax-curve-getPointAtParam obj param)

Это pt2 в этой функции встречается только здесь. Это атавизм или что-то сакральное?

[АлексЮстасу]

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

Вроде бы удалось сделать с учетом задаваемой точности - величины линейного отклонения.
Пришлось переделать и обработку окружностей-эллипсов, и дуговых сегментов, и полностью - сплайнов.
Со сплайнами пока по-настоящему не получается. На сплайнах длинных и с большим количеством вершин все очень медленно. На крутых поворотах точность падает раза в два, минимум. Сделать точнее можно, но делать будет совсем долго. И может вообще отказаться делать или появятся "самоперересечения", которых на самом деле нет, или т.п.

Добавили выбор относительно всех указанных линий: на линиях, на и пересекаемые линиями, вне линий.

[АлексЮстасу]

К оч. грубой точности выбора в 0.001 добавились еще поразительные открытия о штатном выборе _SELECT, ssget - учитывается размер точек в PDSIZE, ширина линий и габариты типов линий.
Т.е. анализ идет не только координат, но и способа отображения объектов на экране. Если изображение точек или линий с габаритным типом выходит за границу контура выбора, то эти объекты не выберутся. А если при выборе учитывать заданные размеры отображения точек и ширину от оси типов линий, то нужно ожидать, что выберутся и ненужные объекты.
Это CAD или Paint?..

Версия 3, лучше учитывающая выбор объектов с точками вставки: блоков, надписей, размеров.
И для удобства и ускорения добавлено окно: