[ASLYS]

может кто-то сталкивался с подобной проблемой

в чертеж вставлен image(растр)-карта, замкнутыми полилиниями обведены контуры областей. Необходимо оставить на чертеже только то, что находится внутри полилиний (хотя бы одной). Команда _imageclip предлагает указать 1 точку, 2 точку ... У меня каждая полилиния состоит минимум из 150 точек!
wipeout-не подходит, с Photoshop связываться не хочется-растры много весят
остается только _imageclip.
если в ACADe нельзя выбрать полилинию, как это сделать на Lisp?

[VVA]

Код:

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

(defun get-pline-vx-coors ( pl / ent_data tmp_ent crs)
(defun dxf (n ent)(cdr (assoc n (entget ent))))
(vl-load-com)
(if (= (type pl) 'VLA-OBJECT)(setq pl (vlax-vla-object->ename pl)))
  (setq ent_data (entget pl))
  (cond ((= (dxf 0 pl) "LWPOLYLINE")
         (setq crs (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= 10 (car x)))) ent_data)))
   )
  (t (setq tmp_ent pl)
   (while (/= "SEQEND" (dxf 0 (setq tmp_ent (entnext tmp_ent))))
           (setq crs (append crs (list (dxf 10 tmp_ent)))))
   )
   )
  crs
  )

;На основе ru-ssentget-by-type
;http://forum.dwg.ru/showthread.php?p=132540#post132540
(defun mip-ssentget-by-type (msg types bits / sel cmd_lst) 
;;; 
;;; Параметры: 
;;; msg - краткое приглашение для выбора, допускается NIL 
;;; bits - целое от 0 до 15, битовый переключатель, значения битов: 
;;;    1 - разрешение выбора на заблокированном слое 
;;;    2 - разрешение многократного выбора 
;;;    4 - разрешение выбора рамкой / секрамкой 
;;;    8 - возвращать набор 
;;; types - список имен допустимых типов примитивов, допускается NIL 
;;; 
;;; Пример: 
;;; (mip-ssentget-by-type "Выбери отрезок или полилинию" '("LINE" "LWPOLYLINE") 0) 
;;; 
;;; Возвращает имя _первого_ примитива из попавших в набор, при удачном выборе 
;;; или NIL при отказе с помощью Enter или прерывании по Esc, в последнем случае, 
;;; одновременно выводит сообщение о прерывании в командную строку. 
;;; 
;;; При наличииии любого из битов: 2, 4 или 8 и при успешном выборе, возвращает 
;;; не имя примитива, а набор. 
;;; 
  (setq msg     (strcat "\n" 
                        (if msg 
                          (strcat msg " ") 
                          "" 
                        ) 
                        (if (= (strcase (getvar "SYSCODEPAGE")) "ANSI_1251") 
                          "<Выход>" 
                          "<Exit>" 
                        ) 
                ) 
        cmd_lst (if (= (logand bits 2) 0) 
                  ":S" 
                  "" 
                ) 
        cmd_lst (if (= (logand bits 4) 0) 
                  (strcat cmd_lst ":E") 
                  cmd_lst 
                ) 
        cmd_lst (if (= (logand bits 1) 0) 
                  (strcat cmd_lst ":L") 
                  cmd_lst 
                ) 
        cmd_lst (if (/= cmd_lst "") 
                  (list (strcat "_" cmd_lst)) 
                ) 
        types   (mapcar (function (lambda (x) (cons 0 x))) types) 
  ) 
  (if (and types (> (length types) 1)) 
    (setq types (append (cons '(-4 . "<OR") types) '((-4 . "OR>")))) 
  ) 
  (if types 
    (setq cmd_lst (append cmd_lst (list types))) 
  ) 
  (setvar "ERRNO" 0) 
  (while (and (/= (getvar "ERRNO") 52) (not sel)) 
    (princ msg) 
    (setvar "nomutt" 1) 
    (vl-catch-all-error-p (setq sel (vl-catch-all-apply 'ssget cmd_lst))) 
    (setvar "nomutt" 0) 
    (if (and (not sel) (= (logand bits 2) 2)) 
      (setq sel t) 
    ) 
  ) 
  (cond ((not sel) nil) 
        ((= (type sel) 'pickset) 
         (if (= (logand bits 14) 0) 
           (ssname sel 0) 
           sel 
         ) 
        ) 
        ((= (type sel) 'vl-catch-all-apply-error) (princ (vl-catch-all-error-message sel)) nil) 
        (t nil) 
  ) 
)
(defun mip_imageclip ( var / pl coors osm)
;;;var - вариант подрезки
;;; _R - прямоугольная
;;; _P - полярная
;;; _GET - взять из полилинии
(if (= var "_GET")
(progn
(setq pl (mip-ssentget-by-type "Выбери полилинию" '("LWPOLYLINE") 0))
(setq coors (get-pline-vx-coors pl))
(setq coors (mapcar '(lambda(x)(trans x 0 1)) coors))
(princ "\nВыберите изображение :")
(while (null (setq PICK1 (ssget "_+.:S:E:L" '((0 . "IMAGE")))))
(princ "\nВыберите изображение :")
 )
(setvar "CMDECHO" 0)
(SSSETFIRST PICK1 PICK1)
(command "_.IMAGECLIP" "_D")
(SSSETFIRST PICK1 PICK1)
(command "_.IMAGECLIP" "_N" "_P")
(setq osm (getvar "OSMODE"))
(setvar "OSMODE" 0)
(foreach pt coors (command pt))
(while (> (getvar "CMDACTIVE") 0)(command ""))
(setvar "OSMODE" osm)
    )
  (if (member var '("_R" "_P"))
(progn
(setq PICK1 nil)
(princ "\nВыберите изображение :")
(while (null (setq PICK1 (ssget "_+.:S:E:L" '((0 . "IMAGE")))))
(princ "\nВыберите изображение :")
 )
(setvar "CMDECHO" 1)
(SSSETFIRST PICK1 PICK1)
(command "_.IMAGECLIP" "_D")
(SSSETFIRST PICK1 PICK1)
(command "_.IMAGECLIP" "_N" var)
(while (> (getvar "CMDACTIVE") 0)(command pause))

))
  )
(setq PICK1 nil)(princ))


(defun C:TEST1 ()(mip_imageclip "_GET"))
(defun C:TEST2 ()(mip_imageclip "_P"))
(defun C:TEST3 ()(mip_imageclip "_R"))

[ASLYS]

VVA, спасибо, то что надо!!!