Мою предыдущую программу фтопку
вот ее код
Код
(defun C:SCtrim ( / *error* oldecho
notrim
ss
yestrim znachenie_samocad zaprosznachenie_samocad
varsectpoint sectpoint ename-circle vla-circle)
(setq oldecho (getvar "cmdecho"))
(defun *error* (msg)
(setvar "cmdecho" oldecho)
(setq ss nil)
(command)
(princ)
)
(while (null (setq notrim (car (entsel "\nВыберите объект который не будет обрезаться : ")))))
(setq ss (ssadd notrim))
(while t
(progn
(sssetfirst nil ss)
(while (null (setq yestrim (car (entsel "\nВыберите объект который БУДЕТ обрезаться : ")))))
(ssadd yestrim ss)
(sssetfirst nil ss)
(if (null(numberp znachenie_samocad))
(setq znachenie_samocad 1))
(setq zaprosznachenie_samocad (getdist (strcat
"\nСкоко резать? <"
(vl-prin1-to-string znachenie_samocad)
"> : ")))
(if (null zaprosznachenie_samocad)
(princ)
(setq znachenie_samocad zaprosznachenie_samocad))
;;;(setq znachenie_samocad nil)
(setq varsectpoint (vla-intersectwith
(vlax-ename->vla-object notrim)
(vlax-ename->vla-object yestrim)
0))
(setq sectpoint (vlax-safearray->list (vlax-variant-value varsectpoint)))
(setvar "cmdecho" 0)
(command "_.circle" sectpoint znachenie_samocad)
(setq ename-circle (entlast))
(setq vla-circle (vlax-ename->vla-object ename-circle))
(command "_.trim")
(command ename-circle)
(command "")
(command (list yestrim sectpoint))
(command)
(setvar "cmdecho" oldecho)
(vla-delete vla-circle)
(vlax-release-object vla-circle)
(ssdel yestrim ss)
))
(command)
(princ)
)
Новая программа:
================================================================
Выбирается только 1 объект который надо порезать. базовую точку легко найти по привязкам.
Команда sctrim
там все просто и понятно
объекты любые кроме составных и ссылок
Точку можно указывать НЕ на объекте, несмотря на запрос команды. Чтоб все линии, которые выбраны, но не доходят до центра окружности также обрезались[-BuTeK-].
Если окружность в итоге не будет пересекать объект, то за результат не ручаюсь.
по умолчанию предлагаемый радиус предлагается равным радиусу последней нарисованной окружности, зависит от системной переменной CIRCLERAD. Тоесть если вы гдето самостоятельно нарисовали Circle, то программа будет предлагать ее радиус. Следите за значениями в сообщениях заключенные в
<x.x
>Если радиус окружности в циклической обработке примитивов менять не надо, то просто жмите ентер.
=================================================================
Команда qsctrim
делаем командную строку пошире чтобы видеть подсказку.
Радиус не запрашивает, он сохраняется в глобальной LISP-переменной SCTRIMCIRC-SAMOCAD(не путать с системными), значение которой можно поменять командой CIRCLESAMOCAD
Также этой переменной присваивается последнее значение радиуса использованое в команде sctrim.
=================================================================
К сожалению ничего не могу придумать для команды UNDO, будьте внимательны, при откатах рисуется воображаемая окружность. Мелкие можно не заметить и они пойдут в печать. Выполняйте команды порезки на слоях запрещенных к печати тк вспомогательные примитивы рисуются на текущих слоях. Не выполняйте программу на отключенных, заблокированых, замороженных слоях.
=================================================================
(vl-load-com) не прописана
=================================================================
Если при использовании программы вдруг пропали буквы в командной строке скопируйте в нее команду (setvar "nomutt" 0) и сообщите мне при каких обстоятельствах она пропадает.
Те кто использует динамическую строку, и вдруг заметил, что она стала меньше болтать (setvar "dynprompt" 1).Также сообщайте о всех других глюках. Предполагаются глюки на несоответствие сохраненных значений радиусов.
=================================================================
В архиве два файла. 2005 работает в любых версиях. 2006 в предыдущих работать не будет.
При использовании 2005 в версииях 2006+ в динамической командной строке может выводиться неточная информация.
при использовании 2006 в версиях 200 6 7 вывод сообщений в динамическую строку временно отключается.
Про автокад 2008 ничего сказать не могу, но думаю что все будет нормально.
=================================================================
планируется добавить отдельную команду для порезки примитивов пересекающих самих себя.
>>
kpblchighlight рулит.
На ssget решил не заморачиваться. Если надо выбрать только 1 объект то помогает только
Код
(while (null (setq ent (car (entsel)))))
но такой способ не дает выйти Ентером, а если НЕ зациклить то при промахе выдает nil получается, что нельзя промахиваться. Нет тут золотой середины как в get-функциях.
sssetfirst включает ручки-прямоугольники, погано получается. Не помню как в предыдущих версиях, в 2007 линии становятся просто пунктирными без ручек.
Еще вопрос остается открытым:
Код
(defun c:cmd ()
(lisp 1)
(lisp 2)
(lisp 3)
)
В программе создаются временные опорные примитивы, которые удаляются после использования. И эти заразы восстанавливаются командой UNDO. причем независимо от того каким способом рисовались (command entmake vla-add). Как сделать так чтобы Undo отменяла действие всей пользовательской команды c:cmd? А то она их отменяет по отдельным выражениям внутри функции (с:cmd).
Код
(defun c:cmd ()
(while t
(lisp 1)
(lisp 2)
(lisp 3)
)
)
В такой ситуации будет отменять выполненные циклы, а иногда еще и поотдельности действия внутри циклов.
vlax-release-object не помогает
Получается ситуация: пользователь порезал примитивы и решил парочку последних отменить. Жмет стрелку "назад", а там бах, какаято окружность появилась, которую он даже мельком не видел, потом внутри окружности стало все зарастать порезанными лниями, и только при третьем нажатии окружность изчезла.
попробую vlax-add-cmd помучать может поможет.