[Alea]

Может у кого есть такая программка на лиспе, очень нужно, а сама программировать не умею(((
На чертеже много линий или полилиний (у меня - сетка из вертикальных и горизонтальных линий), их пересекают замкнутые полилинии (у меня - прямоугольники). Нужно обрезать все линии, которые находятся внутри этих прямоугольников, не выделяя линии внутри каждого прямоугольника отдельно.

Спасибо!

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

Сообщение от VVA Обновил #8. Сделал 2 команды (с удалением и без удаления исходных полилиний)

Здорово! Работает!
1. Я присоединяюсь к просьбе

Сообщение от Alea часть маскировки уходит назад, часть остается впереди.... нервирует. Нет ли возможности в автокаде зафиксировать порядок слоев

- как я ее понимаю. Можно сделать так, чтобы исходные полилинии сразу оказывались выше масок?
2. Что в тексте подправить, чтобы маски делались не только в замкнутых полилиниях, но и в разомкнутых тоже? (Раньше в #8 было указание, но оно теперь исчезло).

[VVA]

Пробуй. Убрал vlisp ф-ции. По идее должно работать и в клонах (Bricscad и проч). Снабдил коментариями

Код:

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

 
 
(defun c:WFP (/ ss)
;;;Wipeout From Polyline
  (setq ss
         (ssget "_I"
                (list
                  (cons 0 "LWPOLYLINE")
;;;  (cons 70 1) ;_Раскомментировать, если нужны замкнутые полилинии
                ) ;_ end of list
         ) ;_ end of ssget
  ) ;_Предварительный выбор
  (sssetfirst)
  (and
    (or ss
        (setq ss
               (ssget
                 (list
                   '(0 . "LWPOLYLINE")
;;;  '(70 . 1) ;_Раскомментировать, если нужны замкнутые полилинии
                 ) ;_ end of list
               ) ;_ end of ssget
        ) ;_ end of setq
    ) ;_ end of or
    (wipe-from-pl ss nil)
  ) ;_ end of and
  (princ)
) ;_ end of defun
(defun c:WFPD (/ ss)
;;;Wipeout From Polyline with Delete Polyline
  (setq ss
         (ssget "_I"
                (list
                  (cons 0 "LWPOLYLINE")
;;;  (cons 70 1) ;_Раскомментировать, если нужны замкнутые полилинии
                ) ;_ end of list
         ) ;_ end of ssget
  ) ;_Предварительный выбор
  (sssetfirst)
  (and
    (or ss
        (setq ss
               (ssget
                 (list
                   '(0 . "LWPOLYLINE")
;;;  '(70 . 1) ;_Раскомментировать, если нужны замкнутые полилинии
                 ) ;_ end of list
               ) ;_ end of ssget
        ) ;_ end of setq
    ) ;_ end of or
    (wipe-from-pl ss t)
  ) ;_ end of and
  (princ)
) ;_ end of defun
(defun wipe-from-pl (ss del / cnt e1 osm clay ssmask *error* echo)
;;; ss - набор с полилиниями 
;;; del - t - удалять полилинии
;;; nil - нет
  (vl-load-com)
  (defun *error* (msg)
    (while (> (getvar "CMDACTIVE") 0) (command))
    (command "_.UNDO" "_E")
    (setvar "CLAYER" clay)
    (setvar "OSMODE" osm)
    (setvar "CMDECHO" echo)
    (princ msg)
    (princ)
  ) ;_ end of defun
  (setq osm (getvar "OSMODE")
       clay (getvar "CLAYER")
       echo (getvar "CMDECHO")
        )
  (
   (lambda (m)
     (cond
       ((= (logand m 1) 0) (command "_.UNDO" "_All"))
       ((= (logand m 3) 3) (command "_.UNDO" "_Control" "_All"))
       (t nil)
     ) ;_ end of cond
   ) ;_ end of lambda
    (getvar "UNDOCTL")
  )
  (command "_.UNDO" "_BE")
  (setvar "OSMODE" 0)
  (setvar "CMDECHO" 0)
  (command "_.LAYER" "_M" "Маскировка" "")
  (setq ssmask (ssadd))
  (repeat (setq cnt (sslength ss))
    (setq e1 (ssname ss (setq cnt (1- cnt))))
    (setq ptlist (apply 'append
                        (mapcar '(lambda (x)
                                   (if (= (car x) 10)
                                     (list (cdr x))
                                     nil
                                   ) ;_ end of if
                                 ) ;_ end of lambda
                                (entget e1)
                        ) ;_ end of mapcar
                 ) ;_ end of apply
    ) ;_ end of setq
    (if (> (length ptlist) 2) ;_Пропускаем полилинии с 2 вершинами
      (progn
        (command "_WIPEOUT")
        (foreach pt ptlist (command (trans pt 0 1)))
        (command "")
        (ssadd (entlast) ssmask)
	(if (not del)
	  (command "_-group" "_c" "*" "" (entlast) e1 "")
	  )
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of repeat
  (setvar "PICKSTYLE" 0)
  (if (> (sslength ssmask) 0)
    (command "_DRAWORDER" ssmask "" "_F") ;_Помещаем набор WIPEOUT на передний план
  ) ;_ end of if
  (command "_DRAWORDER" ss "" "_F") ;_Помещаем набор полилиний на передний план
  (if del
    (command "_.ERASE" ss "")
  ) ;_ end of if
  (setvar "PICKSTYLE" 1)
  (command "_.UNDO" "_E")
  (command "_WIPEOUT" "_F" "_OFF") ;_Отключаем контур у WIPEOUT
  (setvar "CLAYER" clay)
  (setvar "OSMODE" osm)
  (setvar "CMDECHO" echo)
  (princ "\nОбработано ")
  (princ (sslength ssmask))
  (princ " полилиний")
  (setq ss nil
        ssmask nil
  ) ;_ end of setq
  (princ)
) ;_ end of defun
(princ "\nType WFP or WFPD in command line")

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

Сообщение от VVA Пробуй. Убрал vlisp ф-ции. По идее должно работать и в клонах (Bricscad и проч). Снабдил коментариями

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

Есть еще одна проблемка, типичная для масок - усложняется редактирование, т.к. нужно изменять не только границы контуров, но и синхронно изменять форму масок.
А что если создаваемые маски сразу объединять с исходными полилиниями в группы? Как это делает Экспресс, объединяя текст со своими масками?

[VVA]

Добавил в #22 группировку

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

Сообщение от VVA Добавил в #22 группировку

Отлично!
То, что нужно!
А можно сразу принудительно включить режим отображения групп (который вручную включается/выключается Ctrl+H) - чтобы сразу при редактировании границ случайно не рассогласовать их с масками?

[VVA]

Там так и делается. см (setvar "PICKSTYLE" 1)

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

Сообщение от VVA Там так и делается. см (setvar "PICKSTYLE" 1)

А! Разглядел!
Вообще - мечта

[ES]

Сообщение от VVA Пробуй. Убрал vlisp ф-ции. По идее должно работать и в клонах (Bricscad и проч). Снабдил коментариями

Ну для Bricscad сие и не надо было делать. VL-функции поддерживаются в нем еще с V8. А сейчас уже V11 как никак. Да и не клон это, а альтернативный софт, заменяющий AutoCAD.

[Astartes]

АлексЮстасу, У тебя при растягивании за любую ручку полилинии тянется маска или только за угловые?
У меня растягивается только когда тяну за угловые.