| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны | Справка по форуму | Файлообменник | |
|
Поиск в этой теме |
|
||||
Регистрация: 12.09.2005
Барнаул
Сообщений: 77
|
Уважаемые мастера и гуру по AutoCAD не сможете ли вы объяснить как на LISP написать функцию в которой указываешь примитивы (не только Line, PLine но и Cirle, Arc..) а она выдает точки пересечения этих примитивов. Для отрезков я как понимаю есть стандартная функция, [ insers ] а для других примитивов?
|
|||
|
||||
сисадмин Регистрация: 26.08.2003
Самара
Сообщений: 1,022
|
> Ratmir
Для других примитивов есть метод IntersectWith, он доступен через vla- функции. Иногда глючит. Есть еще довольно безглючный метод, его описание можно найти в школьных учебниках геометрии > Krieger Можно удалить из списка все ненужные группы, тогда останутся нужные Функция vl-remove-if-not вполне годится для этого. Либо, передать нужные группы в отдельный список Код:
|
|||
|
||||
Project Engineer Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392
|
Цитата:
Код:
|
|||
|
||||
Регистрация: 12.09.2005
Барнаул
Сообщений: 77
|
Лентяй спасибо за функцию.
Возможно у меня кривые руки (Lisp не так давно занимаюсь, а изучал его институте так давно –(, что все забыл ), но как vla- функции заставить работать? Ниже привожу код и сообщение об ошибке. Данный пример я для себя делаю чтобы разобраться как работают некоторые функции и немного научится Lisp. ;;; ----------------------------------------------------------------------------------------------- ;;; Функция объединяющая "Extend" и "Trim" если необходимо работать с несколькими примитивами ;;; Сначала выбираем с какой функцией работать ("Trim" - по умолчанию) ;;; Указываем границу (выбирается только одна граница) до которой примитивы будут редактироваться ;;; Линией указываем какие примитивы пересекающие ее будут редактироваться ;;; ;;; Аналог функций "Extrim" в "Express Tolls" ;;; ;;; Trim and Extend.LSP ;;; ;;; Исходник взят из книги "The ABC's of AutoLISP" Автор: George Omura. ;;; Функцию IntPtLst разработал Лентяй (Сан-Франциско) - сайт www.DWG.ru ;;; Пояснения и изменения: Ratmir ;;; ;;; ----------------------------------------------------------------------------------------------- (defun c:ExTr (/ x y u sset1 count mcount icount imcount int1 obj sa PtLst) (graphscr) (grclear) (initget "Extend Trim") (setq EorT (getkword "\Extend или <Trim>: ")) (if (equal EorT "")(setq EorT "Trim")) (princ "\n Выбирите границу...") (setq obj (car (entsel))) (setq x (getpoint "\n Укажите начальную точку оси которая будет пересекать примитивы для редактирования: ")) (setq y (getpoint x "\n Укажите конечную точку оси: ")) (setq sset1 (ssget "c" x y)) (setq count 0) (if (/= sset1 nil) (progn (setq mcount (sslength sset1)) (while (< count mcount) (setq elst (ssname sset1 count) );конец setq ;;; ---------------------- ;;; -- Функция IntPtLst -- ;;; ---------------------- (setq sa (vlax-variant-value (vla-IntersectWith elst obj acExtendNone)) n 0) (cond (sa (while (< n (vlax-safearray-get-u-bound sa 1)) (setq PtLst (cons (mapcar '(lambda (m) (vlax-safearray-get-element sa m)) (list n (1+ n) (+ 2 n))) PtLst) n (+ 3 n))));sa (T nil) );cond (reverse PtLst) ;;; ---------------------- (setq icount 0) (setq imcount (length PtLst)) (while (< icount imcount) (setq int1 (nth (icount- 1) PtLst)) (if (equal EorT "Extend") (command "_.extend" obj "" int1 "") (command "_.trim" obj "" int1 "") );конец if (setq icount (1+ icount)) );конец while (setq count (1+ count)) );конец while );конец progn );конец if );конец функции ExTr ;;; ----------------------------------------------------------------------------------------------- Выдает сообщение --------------------------------- Command: extr Extend или <Trim>: Выбирите границу... Select object: Укажите начальную точку оси которая будет пересекать примитивы для редактирования: Укажите конечную точку оси: ; error: bad argument type: VLA-OBJECT <Entity name: 7ef65e98> Command: --------------------------------- |
|||
|
||||
Регистрация: 12.09.2005
Барнаул
Сообщений: 77
|
У меня вопрос как избавиться, что бы некоторые размеры не оставались на месте, если их с объектом перемещать или копировать (слой не заморожен). Иногда при создании копии одного пространства листа, на нем изменить расположения размеров, то на источники они отображаются как на новом, но при изменении стиля они отображаются нормально
|
|||
|
||||
Project Engineer Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392
|
Ratmir, в вашей прграмме используются vla-функции, которые работают с ОБЪЕКТАМИ, вперемешку с LISP-функциями, которые работают с ПРИМИТИВАМИ. Поскольку вы не обеспечили преход от одного типа к другому, АвтоКАД выдает сообщение об ошибке.
С другой стороны, если вы собираетесь использовать свою программу только для отрезков (LINES), то вам моя функция не нужна, потому что она предназначена для определния точек множественных пересечений, например круг с прямоугольником или две извилистых полилинии. Ниже приводится вариант, написанный на ActiveX, т.е. с использованием vla-функций для "подравнивания" линий. Извините за английский, но при копировании русский текст крякозябрится. Код:
Успехов! |
|||
|
||||
Регистрация: 12.09.2005
Барнаул
Сообщений: 77
|
Лентяй спасибо за ответы. Функция, которую вы дали, иногда странно обрезает Line. Для обрезания и удлинения только примитивов Line я использую следующую функцию.
;; ------------------------- (defun c:ExTr (/ x y u sset1 count mcount icount pt1 pt2 int1 obj) (graphscr) (grclear) (initget "Extend Trim") (setq EorT (getkword "\Extend или <Trim>: ")) (if (equal EorT "")(setq EorT "Trim")) (princ "\n Выбирите границу...") (setq obj (car (entsel))) (setq x (getpoint "\n Укажите начальную точку оси которая будет пересекать примитивы для редактирования: ")) (setq y (getpoint x "\n Укажите конечную точку оси: ")) (setq sset1 (ssget "c" x y)) (setq count 0) (if (/= sset1 nil) (progn (setq mcount (sslength sset1)) (while (< count mcount) (setq elst (entget (ssname sset1 count)) mtypeLine (cdr (assoc 0 elst)) ) (if (= mtypeLine "LINE") (progn (setq pt1 (cdr (assoc 10 elst)) pt2 (cdr (assoc 11 elst)) int1 (inters x y pt1 pt2 T) ) (if (equal EorT "Extend") (command "_.extend" obj "" int1 "") (command "_.trim" obj "" int1 "") ) ) (princ "\n Выбран не Line") ) (setq count (1+ count)) ) ) ) ) ;; ------------------------- Но не для всех примитивов можно использовать функцию assoc и inters. Вычислять с помощью формул геометрии, точки пересечения разных примитивов утяжеляет функцию (для меня). Вопрос не подскажите сайт или литературу (в свободном распространении) по LISP, где много примеров и подробно их разбирают, а то если и нахожу по одно и тоже (рисование дорожки с плиткой). Хотелось более лучше изучить LISP, сейчас разбираюсь по книге George Omula “The ABC’s of AutoLISP” (с трудом ). P.S. Поздравляю всех девушек сайта www.DWG.ru с наступающем 8 МАРТА (по новому стилю) и всех кто празднует 23 февраля по старому стилю. :P |
|||
|
||||
инженер (КМ) Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825
|
Как узнать на лиспе, выбраны элементы в данный момент или нет? В зависимости от того выбраны они или нет должно выполняться то или иное действие. Если элемент выбран, то его слой будет меняться, если нет будет устанавливаться другой слой текущим.
|
|||
|
||||
Moderator
LISP, C# (ACAD 200[9,12,13,14]) Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787
|
Проверяй длину и наличие выбора:
Код:
__________________
Моя библиотека lisp-функций --- Обращение ко мне - на "ты". Все, что сказано - личное мнение. |
|||
|
||||
Moderator
LISP, C# (ACAD 200[9,12,13,14]) Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787
|
Я бы попробовал примерно так:
Код:
__________________
Моя библиотека lisp-функций --- Обращение ко мне - на "ты". Все, что сказано - личное мнение. |
|||