Как быстро вырезать фрагмент чертежа??!!!

vitamin · 28.06.2005, 09:22

Так чтобы просто выделил ужную часть - и отрезал то, что выделил....
Мож какие модули есть или че-нить???

Chief Justice · 28.06.2005, 09:50

В смысле вырезал или удалил?...
Для выноса узла в СПДС есть хороший инструмент...

vitamin · 28.06.2005, 10:02

Что такое СПДС и что за инструмент??? Если можно поподробнее!
В смысле скопировал нужную часть чётко по границам выделения -> и сделал из нее отдельный чертёж;-)

Apelsinov · 28.06.2005, 10:26

>vitamin

В СПДС графикс (это такая примочка к акаду см. http://www.autocad.ru/application/prod_931.htm ) в версии для асад 2002 есть команда SPGRFFRAGM , она и "вырезает".

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

Но все это в общем-то никому не надо (ИМХО) , потому как есть замечательная вещь viewport, позволяющая вставиль в лист любой узел ничего не обрезая, и есть команда xclip , задающая видимый контур внешней ссылки.

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

vitamin · 28.06.2005, 12:23

Вот xclip то, что надо!!

Vook · 28.06.2005, 15:01

А может проще видовым экраном воспользоваться?

Vova · 02.07.2005, 17:33

Вот что нашлось в моей коллекции. Может, кто из программистов осовременит. Вызывается набором слова DTL

Цитата:

;=======================================================================
; Allegro TABLET TOOLS LISP file
; DTL.LSP
;
; Extracts a section of a drawing for a detail.
; Lines, Arcs, & Circles are trimmed to the box boundary.
; P-LINES and equal scale blocks are exploded one level in the detail
; before trimming.
;
; (c) 1988 Robert McNeel & Assoc., 1310 Ward St., Seattle, WA, 98109
; This routine is submitted for private non-resale use by end users.
;=======================================================================
(princ "\nInitial load .. please wait\n")
;=======================================================================
(defun val (x e) (cdr (assoc x e)))
(defun enttype (e) (cdr (assoc 0 e)))
(defun entname (e) (cdr (assoc -1 e)))
(setq >90 (/ pi 2) >270 (* 3 (/ pi 2)))
;=======================================================================
; Find the 'endpoints ' of the LINES, ARCS, & CIRCLES in ss that are
; outside a rectangle described by the opposite corners pll and pur.
; and submits them to the command function.
;-----------------------------------------------------------------------
(defun osends (ss pll pur / z eps)
(ends ss) ;this puts the 'endpoints' in a list, eps
(foreach z eps ;this checks if they are outside the rectangle
(if (or (< (caadr z) (car pll))
(< (cadadr z) (cadr pll))
(> (caadr z) (car pur))
(> (cadadr z) (cadr pur))
)
(command z)
)
)
)
;-----------------------------------------------------------------------
; Finds the 'endpoints' of LINES, ARCS, & CIRCLES in ss.
; 'Endpoints' are:
; LINES: endpoints
; ARCS: endpoints and quadrant points
; CIRCLES: quadrant points
; The endpoint lists are consed into the list eps (global).
;-----------------------------------------------------------------------
(defun ends (ss / i ent cen)
(setq len (sslength ss) i 0) ;get number of entities
(while (< i len) ;loop thru them
(setq ent (entget (ssname ss i))) ;get assoc list
(cond ;Check for LINES, ARCS, & CIRCLES and cons
; the appropriate points into eps.
;Other entity types are ignored.
;LINES
((= (enttype ent) "LINE")
(setq eps (cons (list (entname ent) (val 10 ent)) eps))
(setq eps (cons (list (entname ent) (val 11 ent)) eps)) )
;ARCS
((= (enttype ent) "ARC")
(setq cen (val 10 ent))
(setq eps (cons
(list (entname ent)
(polar cen 0 (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen >90 (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen pi (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen >270 (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen (val 50 ent) (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen (val 51 ent) (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(osnap (polar cen (val 51 ent) (val 40 ent)) "mid")) eps)) )
;CIRCLES
((= (enttype ent) "CIRCLE")
(setq cen (val 10 ent))
(setq eps (cons
(list (entname ent)
(polar cen 0 (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen >90 (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen pi (val 40 ent))) eps))
(setq eps (cons
(list (entname ent)
(polar cen >270 (val 40 ent))) eps)) )
)
(setq i (1+ i)) ;Next entity
)
)
;-----------------------------------------------------------------------
;Explodes all p-lines in selection set s
;-----------------------------------------------------------------------
(defun exp_pl (s / i len ent)
(setq i 0 len (sslength s))
(while (< i len)
(setq ent (entget (ssname s i)))
(cond
((= (enttype ent) "POLYLINE")
(command "explode" (entname ent))
)
;((= (enttype ent) "INSERT")
;(if (= (val 41 ent) (val 42 ent) (val 43 ent)) ;check equal scale
;(command "explode" (entname ent))

)
(setq i (+ 1 i))
)
)
;-----------------------------------------------------------------------
;erases parts of exploded p-lines that are outside target area
;-----------------------------------------------------------------------
(defun era_xtra (e)
(setq ssx (ssadd))
(while (setq e (entnext e))
(if (not (ssmemb e ss))
(ssadd e ssx)
)
)
(command "erase" ssx "")
)
;-----------------------------------------------------------------------
; Gets the geometry and calls routines to do the trimming.
;-----------------------------------------------------------------------
(defun c:dtl (/ px py pxx pyy xs ss b ssx)
(setvar "cmdecho" 0)
(command "undo" "begin")
(if (and
;This defines a rectangle to be copied out to a detail
(setq px (getpoint "\nFirst corner: "))
(setq py (getcorner px "\nOther corner: "))
;This is the position of the lower left corner of the detail
(setq pxx (getpoint px "\nNew first corner position: "))
;This is a size adjust factor for scaling the detail
(setq xs (getreal "\nScale factor for detail: ")) )
(progn
;copy out the stuff selected
(command "copy" "c" px py "" px pxx)
(command "pline" px (list (car px) (cadr py)) ;draw an outline of
py (list (car py) (cadr px)) "c") ; the base area.
;these are the new entities that may need trimming.
(setq ss (ssget "c" pxx (polar pxx (angle px py) (distance px py))))
;first explode p-lines because if you trim them, you get too
;many new entities to deal with. (could do blocks to)
(setq last (entlast)) ;save end of database
(exp_pl ss) ;this explodes them
;then get all the new parts into ss
(setq ss (ssget "c" pxx (polar pxx (angle px py) (distance px py))))
;and erase ones that are clear outside rectangle
(era_xtra last)
(command "scale" ss "" pxx xs) ;Scale the detail
;new other corner point of detail
(setq pyy (polar pxx (angle px py) (* xs (distance px py))))
(command "pline" pxx (list (car pxx) (cadr pyy)) ;Box around the
pyy (list (car pyy) (cadr pxx)) "c") ;detail
(command "trim" (setq b (entlast)) "") ;Last P-line is cutting edge
(osends ss pxx pyy) ;This finds the ends that are outside the box
; and trims them.
(command "") ;Terminate trim
(redraw b)
)
)
(command "undo" "end")
(setvar "cmdecho" 1)
(princ)
)

Startrek · 03.07.2005, 03:47

ctrl+c
выделить (выбрать) что надо и
ctrl+v
в этот же чертеж или в любой другой
(clipboard function)

Perezz!! · 03.07.2005, 23:31

Рисуешь рамку -> Extrim (это из Express Tools) -> на выбор удалить не нужное или скопировать в буфер нужное.

Snoker · 16.01.2007, 16:23

А если screenshot а потом обратно всунуть как изображение?

Огурец · 16.01.2007, 17:09

Цитата:

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

А если screenshot а потом обратно всунуть как изображение?

screenshot - это будет вставка растра в векторную графику.

Snoker · 16.01.2007, 18:59

Угу! Но в некоторых архитектурных изваяниях на autocad-е при помощи Super Hatch, например. заливаются окна небесами из разных jpg-ов. К сожалению Viewport в Super Hatch не вставить - вот и приходится выдумывать :?
Было бы хорошо обвести произвольным контуром шматочек сложного и хитрого узла и превратить его тут же в блок. А потом уж че угодно делай

nikolaev · 17.01.2007, 08:20

В марте 2006г я поместил на форуме простенький лисп C:frag (поищите поиском), который вырезает фрагмент чертежа в модели.
Но тут же был заклеван любителями лайутов.
Я конструктор - механик, черчу в модели, а этот лисп очень полезен для черчения выносных фрагментов чертежа.

Snoker · 19.01.2007, 11:56

Да, для примитивов все нормально, но нужно не удалить все лишнее вогруг фрагмента а скопировать его в буфер. Команда extrim не имеет опции копирования - она портит исходный чертеж. Приходится делать копию чертежа, открывать его в другом окне и т.д. и так для каждого кусочка

Вот если бы в экспресс была команда excopy 8) !

Perezz!! · 19.01.2007, 12:08

Вот если бы в экспресс была комманда "сделать нужный мне чертёж", вот это была бы жизнь.

Snoker · 19.01.2007, 12:32

Видать достали юзеры...
Хотелось пригласить продолжить тему - каждый раз, делая лишние операции или изобретая велосипед, мы отнимаем у себя время. Может есть все-таки такая примочка?
Я вовсе не противник viewport-ов и прочих прелестей acadа - использую постоянно. Но бывает надо и так.
И в конце концов, если кто-то придумал тот же extrim, значит это кому-нибудь нужно?

mmax · 19.01.2007, 19:10

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

Vova · 19.01.2007, 20:38

Кто-нить пробовал пост 7? Он ведь работающий

den001 · 20.01.2007, 10:16

Цитата:

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

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

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

forMA · 20.01.2007, 12:19

Цитата:

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

Можно еще одним корявым и смешным способом это оуществить. Исходный фрагмент отчикать Break at Paint, оформить блоком и копировать с любым масштабом в любое место в любом количестве. При корректировке исходного фрагмента соответственно автоматически изменяются копируемые блоки.

Anuta · 20.01.2007, 13:24

Цитата:

Сообщение от Perezz!!

Вот если бы в экспресс была комманда "сделать нужный мне чертёж", вот это была бы жизнь.

Да-а... (мечтательно)

Apelsinov · 23.01.2007, 11:59

Есть еще один способ, в некоторых случаях очень удобный:

сделать из вырезаемого фрагмента блок (быстро - скопировать в буфер и вставить как блок), вырисовать поверх обрезаемый контур, и обрезать блок xclip.

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

nikolaev · 24.01.2007, 08:30

Господа двугушники! Не поленюсь выложить вторично лисп, а то Вам лень копаться в поиске.
(defun C:frag (/)
(SETQ sna (GETVAR "osmode"))
(setq cmd (getvar "cmdecho"))
(setq la (getvar "Clayer"))
(setq co (getvar "cecolor"))
(setvar "osmode" 0)
(setvar "clayer" "0")
(setvar "cmdecho" 1)
(setvar "cecolor" "1")
(setq
pt1 (getpoint
"\n Рамка выбора - слева вверх направо>> Первая точка: "
)
)
(command "rectang" pt1 pause)
(Setq na (entlast))
(COMMAND "line" "@" pt1 "")

(setq SS (entget (entlast)))
(setq pt2 (cdr (assoc 10 SS)))

(setq pt3 (list (car pt1) (cadr pt2)))
(setq pt4 (list (car pt2) (cadr pt1)))
(entdel (entlast))
(setq pt5 (list (- (car pt1) 1) (- (cadr pt1) 1)))
(setq pt6 (list (+ (car pt2) 1) (+ (cadr pt2) 1)))
(setq pt7 (list (- (car pt3) 1) (+ (cadr pt3) 1)))
(setq pt8 (list (+ (car pt4) 1) (- (cadr pt4) 1)))
(command "trim" na "")
(command "F" pt5 pt7 "" "F" pt7 pt6 "" "F" pt6 pt8 "" "F" pt8 pt5 "")
(Command "")
(setq ss1 (ssget "w" pt1 pt2))
(command "copybase" pt1 ss1 "")
(command "undo" 2)
(entdel na)
(setq pt4 (getpoint "\n Место вставки фрагмента\n"))
(command "pasteclip" pt4)
(SETVAR "osmode" sna)
(setvar "cmdecho" cmd)
(setvar "Clayer" la)
(setvar "Cecolor" co)
(princ)
)
Как видите, в нем используется не extrim, а простой trim, но вставка производится через буфер.

Кулик Алексей aka kpblc · 24.01.2007, 09:10

Хотя лично мне эта тема и не особо близка, позволю себе немного покритиковать последний лисп.
1. Не учитывается вариант локализации.
2. Все переменные глобальные - это чем-то объясняется?
3. Нет обработки ошибок.
4. Визуально не контролируется "куда" вставляется обрезанный фрагмент
5. Функция _trim с опцией _fence иногда некорректно обрабатывает полилинии, пересекающие границу (обрезка выполняется только 1 раз, независимо от количества пересечений).
6. Если границу "визуально" пересекают блоки или примитивы, лежащие не в текущей системе координат или имеющие высоту, отличную от elevation, обрезка может быть выполнена некорректно.
7. Не отслеживается состояние слоя "0" - он может быть выключен, заблокирован, заморожен...
8. Не отслеживается вариант отказа пользователя от продолжения работы в момент выбора pt1 или выполнения _rectang.
Если писать лисп, учитывающий все эти нюансы, его длина явно будет раз этак в 5-6 больше представленной

Snoker · 24.01.2007, 11:49

Apelsinov

Цитата:

Но все это в общем-то никому не надо (ИМХО) , потому как есть замечательная вещь viewport, позволяющая вставиль в лист любой узел ничего не обрезая, и есть команда xclip , задающая видимый контур внешней ссылки.

Хочу напомнить, что речь идет о модели.
"Замечательная вещь" viewport в модельном пространстве не может принимать произвольную форму, а xclip работает только с блоками или внешними чертежами причем в качестве ссылки не получается взять текущий же чертеж.

ShaggyDoc · 24.01.2007, 13:43

Цитата:

Хочу напомнить, что речь идет о модели.
"Замечательная вещь" viewport в модельном пространстве не может принимать произвольную форму

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

Если бы эта тема обсуждалась в эпоху Автокад-10, цены бы ей не было...

Snoker · 29.01.2007, 13:47

Понял, иду в 10-й автокад :roll:

T-Yoke · 30.01.2007, 14:00

Цитата:

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

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

Я пробовал только MechaniKS, даже в бесплатной версии 2.0, есть команда по выделению окружностью участка чертежа, и переносом копии в любое место чертежа, с возможностю масштабирования.
Сечас уже кажется есть версия 5.5 для Автокада.

skkkk · 03.07.2008, 00:04

Вот тут и есть кое-что по этой теме.
Добавлено:
Тут появилась новая программка от Дениса Флюстикова "Фрагмент чертежа по прямоуг. или кругл. границе". Самый простой способ из всех, что я видел. Работает безотказно. Может как выбрать существующий контур фрагмента (произвольной формы), так и отрисовать новый круг, прямоугольник или ломаную полилинию.
Ссылки иногда слетают, поэтому расположу текст последней, проверенной мною версии программы здесь:

Код:

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

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

Программа Дениса Флюстикова "Fragm_Den" от 14.09.09: 
Возможность обработки блоков через "_.xclip" 

Макрос для кнопки: 
^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 aa11 aa12 aa13 aa14 aa15) 

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

(initget 128 "К Л") 

(setq aa10 "Размер" ; Слой построения контура 
      aa15 0        ; 1- Расчленение блоков, 0- через "_.xclip" 
      aa8 (ssadd) 
      aa2 nil 
      aa5 nil 
      aa1 (getpoint "\nПервая точка прямоугольной области или [Круглая/Ломаная]:")) 

(vl-load-com) 

(cond 
((= (type aa1) 'LIST) 
   (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") 

) 
)) 
((= aa1 "К") 

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

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

(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)))) 
      aa1 (+ aa1 aa5)) 
) 

))) 
(T 

(setq aa1 (getpoint "\nПервая точка ломаной границы или <Выбрать>:")) 

(if aa1 (progn 

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) 
(setvar "CMDECHO" 0) 
(command "_.undo" "_m") 

(princ "\nСледующая точка границы:") 

(if (vl-cmdf "_.line" aa1 pause)(progn 

(setq aa1 (list aa1)) 
(princ "\nСледующая точка границы или <Прервать>:") 

(while (= (getvar 'cmdactive) 1) 
(setq aa3 (getvar "lastpoint") 
      aa7 (car aa1) 
      aa6 aa1 
      aa1 (cons aa3 aa1) 
      aa8 (ssadd (entlast) aa8)) 

(if (equal (last aa1) aa3 1e-6) 
(vl-cmdf "")(progn 

(while (> (length aa6) 2) 
(setq aa6 (cdr aa6)) 
(if (or (inters aa3 aa7 (car aa6)(cadr aa6) t) 
   (equal (angle aa3 aa7)(angle (caddr aa1) aa7) 1e-6) 
   (equal aa3 aa7 1e-6))(progn 
(vl-cmdf "_u") 
(princ "\nСамопересечение границы\nСледующая точка границы или <Прервать>:") 
(setq aa1 (cdr aa1) 
      aa6 nil))) 
) 
(setq aa3 (vl-cmdf pause)) 
)) 
) 
)) 

(if (and aa3 (> (length aa1) 2)) 
(setq aa2 (trans (getvar "lastpoint") 1 0) 
      aa7 '())(progn 
(setq aa2 nil) 
(command "_.undo" "_b") 
)) 

(mapcar '(lambda (q) (setq aa7 (append aa7 (list (cons 10 (trans q 1 0)))))) aa1) 
)(progn 

(setq aa1 (entsel "\nВыберите полилинию или <Выход>:")) 

(if aa1 (progn 

(setq aa2 (trans (cadr aa1) 1 0) 
      aa4 (car aa1) 
      aa5 (entget aa4) 
      aa11 aa4 
      aa7 '()) 

(if (wcmatch (cdr (assoc 0 aa5)) "*POLYLINE")(progn 
(if (= (cdr (assoc 0 aa5)) "POLYLINE")(while aa11 

(setq aa11 (entnext aa11) 
      aa9 (entget aa11)) 

(if (= (cdr (assoc 0 aa9)) "VERTEX") 
(setq aa7 (append aa7 (list (assoc 10 aa9))) 
      aa7 (append aa7 (list (assoc 42 aa9)))) 
) 
(if (= (cdr (assoc 0 aa9)) "SEQEND") 
(setq aa11 nil 
      aa5 aa7 
      aa7 '()) 
))) 

(setq aa5 (append aa5 (list '(10))) 
      aa9 nil 
      aa11 (vlax-ename->vla-object aa4)) 

(mapcar '(lambda (q) 
(if (= (car q) 10)(if aa9 (progn 

(if (cdr q) 
(setq aa12 (vlax-curve-getDistAtPoint aa11 (cdr q))) 
(setq aa12 (vlax-curve-getDistAtParam aa11 (vlax-curve-getEndParam aa11))) 
) 

(if (null (setq aa13 (vlax-curve-getDistAtPoint aa11 (cdr (last aa7))))) 
(setq aa13 0)) 
(setq aa9 (fix (abs (/ (atan aa9) pi 1e-3))) 
      aa12 (/ (- aa12 aa13) aa9)) 

(repeat aa9 
(setq aa13 (+ aa13 aa12) 
      aa7 (append aa7 (list (cons 10 (vlax-curve-getPointAtDist aa11 aa13))))) 
) 
)(if (cdr q)(setq aa7 (append aa7 (list q))))) 
(if (= (car q) 42)(if (= (setq aa9 (cdr q)) 0)(setq aa9 nil) 
)))) aa5) 

(if (< (length aa7) 3)(progn 
(setq aa2 nil) 
(princ "\nВыбранная полилиния имеет меньше трех вершин") 
)) 
)(progn 
(setq aa2 nil) 
(princ "\nВыбранный объект не является полилинией") 
)) 
)) 

(vla-startundomark (vla-get-activedocument (vlax-get-acad-object))) 
(setvar "CMDECHO" 0) 
(command "_.undo" "_m") 

) 
) 
) 
) 

(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") 
) 

(if aa10 (if (tblsearch "Layer" aa10)(setvar "CLAYER" aa10))) 

(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) aa8)) 
(setq aa4 (entlast)) 
) 

(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) 

(if (= aa15 0)(progn 

(setq aa3 (ssget "_F" aa1 '((0 . "INS ERT"))) 
      aa9 aa6) 

(if aa3 
(repeat (setq aa7 (sslength aa3)) 

(setq aa10 (ssname aa3 (setq aa7 (1- aa7))) 
      aa11 (entget aa10)) 

(command "_.xclip" aa10 "" "_n") 

(if (and (setq aa11 (member '(102 . "{ACAD_XDICTIONARY") aa11)) 
    (setq aa11 (cdr aa11)) 
    (setq aa10 (cdr (assoc 360 aa11))) 
    (setq aa11 (entget aa10)) 
    (assoc 360 (member '(3 . "ACAD_FILTER") aa11)) 
    ) 
(command "_y") 
) 
(command "_p") 
(repeat (setq aa10 (length aa1)) 
(command (nth (setq aa10 (1- aa10)) aa1)) 
) 
(command "") 
)) 

) 
(while aa3 
 ; Блоки расчленить: "_CP" - все в выбранной области, "_F" - на границе: 
(setq aa3 (ssget "_F" aa1 '((0 . "INS ERT"))) 
      aa9 aa6) 

(if aa3 
(repeat (setq aa7 (sslength aa3)) 

(setq aa10 (ssname aa3 (setq aa7 (1- aa7))) 
      aa11 (entget aa10) 
      aa12 aa10 
      aa13 '()) 

(if (= (cdr (assoc 66 aa11)) 1)(progn 

 ;(command "_.attsync" "_s" aa10 "_y") 

(while (/= "SEQEND" (cdr (assoc 0 aa11))) 

(if (= (cdr (assoc 0 aa11)) "ATTRIB")(progn 

(setq aa14 '()) 

(foreach aa15 '(2 1 7 8 10 11 39 40 41 50 51 62 71 73)(progn 
(if (/= (assoc aa15 aa11) nil) 
(setq aa14 (append aa14 (list (assoc aa15 aa11))))))) 

(setq aa13 (cons aa14 aa13)) 

)) 

(setq aa12 (entnext aa12) 
      aa11 (entget aa12)) 

) 
)) 

(command "_.explode" aa10) 

(while (entnext aa9) 
(setq aa9 (entnext aa9) 
      aa11 (entget aa9)) 

(if (= (cdr (assoc 0 aa11)) "ATTDEF")(progn 

(setq aa8 (ssadd aa9 aa8) 
      aa14 (assoc 2 aa11) 
      aa15 (cdr (assoc aa14 aa13))) 

(if aa15 (if (/= (vl-string-trim " " (cdar aa15)) "") 
(entmake (cons '(0 . "TEXT") aa15)) 
)) 

)) 
) 
)) 

(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 aa12 (ssadd) 
     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) 
      aa12 (ssadd aa6 aa12) 
      ) 
(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")))) 
(repeat (setq aa11 (sslength aa3)) 
(setq aa11 (1- aa11) 
      aa12 (ssadd (ssname aa3 aa11) aa12)) 
)) 

(if (> (sslength aa12) 0)(progn 
(command "_.copy" aa4 "" '(0 0 0) '(0 0 0) 
    "_.region" (entlast) "") 

(setq aa7 (sslength aa12) 
      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 aa12 (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)) 

(if aa3 (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 "")) 
) 

(setq aa10 (entdel aa4)) 

(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 aa9 (ssget "_F" aa6 '((-4 . "<OR")(-4 . "<NOT")(-4 . "<OR") 
             (0 . "HATCH") 
             (0 . "*POLYLINE") 
             (0 . "*TEXT") 
             (0 . "REGION") 
             (0 . "INS ERT") 
;;;             (0 . "IMAGE") 
             (-4 . "OR>")(-4 . "NOT>") 
             (0 . "*DIMENSION,LEADER");Без размеров 
             (-4 . "OR>") 
             ))) 

(entdel aa10) 
(command "_.erase" aa8) 
(if aa9 (command aa9 )) 
(if aa5 (command aa5 )) 
(command "") 

(setq aa3 (ssget "_CP" aa6) 
      aa10 (getvar "FIELDEVAL") 
      aa6 "den") 

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

(if aa3 (progn 

(command "_.wblock" aa1 "" (trans aa2 0 1) aa3 aa4 "" 
    "_.undo" "_b" 
;;;    "_fieldeval" 0 
    "_.ins ert" 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) 
      aa8 (getvar 'lastprompt)) 

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

(if (setq aa1 (vl-string-search ">:" aa8)) 
(setq aa1 (substr aa8 (+ aa1 3)))) 

(if (= aa1 "0") 
(setq aa2 nil)(progn 
(command "_.erase" aa5 "" 
    "_.ins ert" 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 aa2 nil 
      aa8 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) 
(se tvar "FIELDEVAL" aa10) 

(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) 
(se tq aa5 (entnext aa5) 
      aa1 (entget aa5)) 

(if (/= aa3 1)             ;Если вместо "(/= aa3 1)" "nil", то 
 ;  без сохранения масштаба штриховки и глоб.толщины полилиний 
(if (= (cdr (assoc 0 aa1)) "HATCH") 
(if (se tq 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 (se tq aa2 (assoc 43 aa1)) 
(vl-cmdf "_.pedit" "_m" aa5 "" "_w" (/ (cdr aa2) aa3) "") 
)) 
)) 
) 
) 
(command "_.undo" "_b") 
) 
)) 

(se tvar "CMDECHO" 1) 
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) 
(if (null aa8)(command "_.undo" 1)) 

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

28.06.2005, 09:22		#1
Как быстро вырезать фрагмент чертежа??!!! vitamin Регистрация: 28.06.2005 Сообщений: 3 Так чтобы просто выделил ужную часть - и отрезал то, что выделил.... Мож какие модули есть или че-нить???
Просмотров: 85175

	Реклама i