Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Вопросы по Lisp

Вопросы по Lisp

Ответ
Поиск в этой теме
Непрочитано 24.01.2006, 07:51
Вопросы по Lisp
Krieger
 
инженер (КМ)
 
Красноярск
Регистрация: 30.10.2004
Сообщений: 3,825

Такой вопросик:
Как сделать набор элементов состоящих, допустим, только из линии?
Т.е. ssget, только выбирать функция должна только то что надо.
Просмотров: 33193
 
Непрочитано 24.01.2006, 12:32
#21
Елпанов Евгений

программист
 
Регистрация: 20.12.2005
Москва
Сообщений: 1,439
Отправить сообщение для Елпанов Евгений с помощью Skype™


Код:
[Выделить все]
(setq ss (ssget)
      name(ssname ss 0)
      )
Елпанов Евгений вне форума  
 
Непрочитано 20.02.2006, 07:19
#22
Ratmir


 
Регистрация: 12.09.2005
Барнаул
Сообщений: 77


Уважаемые мастера и гуру по AutoCAD не сможете ли вы объяснить как на LISP написать функцию в которой указываешь примитивы (не только Line, PLine но и Cirle, Arc..) а она выдает точки пересечения этих примитивов. Для отрезков я как понимаю есть стандартная функция, [ insers ] а для других примитивов?
Ratmir вне форума  
 
Автор темы   Непрочитано 20.02.2006, 08:20
#23
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


И от меня вопросик:
В DXF коде (по entget) полилинии имеем координаты вершин, как их от туда вытащить, ведь все имеют один ключ? По assoc выдается только первая вершина, а как с остальными?
Krieger вне форума  
 
Непрочитано 20.02.2006, 09:27
#24
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
<phrase 1=


> Ratmir

Для других примитивов есть метод IntersectWith, он доступен через vla- функции. Иногда глючит.
Есть еще довольно безглючный метод, его описание можно найти в школьных учебниках геометрии


> Krieger

Можно удалить из списка все ненужные группы, тогда останутся нужные
Функция vl-remove-if-not вполне годится для этого.

Либо, передать нужные группы в отдельный список
Код:
[Выделить все]
           (setq ptl (apply 'append ;_ список точек для вывода
                            (mapcar '(lambda (el)
                                       (if (= 10 (car el))
                                         (list (cdr el))
                                       ) ;_  if
                                     ) ;_  lambda
                                    (entget e)
                            ) ;_  mapcar
                     ) ;_  apply
           ) ;_  setq
vk вне форума  
 
Непрочитано 20.02.2006, 10:07
#25
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Или так
Код:
[Выделить все]
(while (setq el (member (assoc 10 el) el))
  (setq ptl (append ptl (list (cdar el))))
  (setq el (cdr el))
)
VVA вне форума  
 
Непрочитано 20.02.2006, 10:29
#26
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Цитата:
Сообщение от Ratmir
Уважаемые мастера и гуру по AutoCAD не сможете ли вы объяснить как на LISP написать функцию в которой указываешь примитивы (не только Line, PLine но и Cirle, Arc..) а она выдает точки пересечения этих примитивов. Для отрезков я как понимаю есть стандартная функция, [ insers ] а для других примитивов?
Ну хрена ли мне с вами делать - держите прогу. Для себя писал, теперь вот вам отдаю ... Пользуйтесь на здоровье, да не забывайте денно и нощно сугубо и трегубо багодарить меня, любимого, за то, что я есть.
Код:
[Выделить все]
(defun IntPtLst (Fst Nxt / sa PtLst)
  (setq sa (vlax-variant-value (vla-IntersectWith fst nxt 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)
Fst, nxt - объекты, соотно первый т второй. PtLst - список трехмерных точек пересечения объектов.[/code]
Лентяй вне форума  
 
Автор темы   Непрочитано 20.02.2006, 11:00
#27
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


vk
Цитата:
; error: bad argument type: lentityp nil
VVA
Цитата:
((40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
Krieger вне форума  
 
Непрочитано 20.02.2006, 11:18
#28
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
VVA
Цитата:
((40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.
0 1.0))
Так это остаток от списка, а список точек накапливается в ptl
Код:
[Выделить все]
(while (setq el (member (assoc 10 el) el)) 
  (setq ptl (append ptl (list (cdar el)))) 
  (setq el (cdr el)) 
)
(princ "\nКоординаты:")(princ ptl)(princ)
VVA вне форума  
 
Непрочитано 20.02.2006, 11:55
#29
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
<phrase 1=


Цитата:
Сообщение от Krieger
vk
Цитата:
; error: bad argument type: lentityp nil
Ename примитива в переменную е не запихнули наверно...
vk вне форума  
 
Непрочитано 28.02.2006, 06:41
#30
Ratmir


 
Регистрация: 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:
---------------------------------
Ratmir вне форума  
 
Непрочитано 28.02.2006, 06:42
#31
Ratmir


 
Регистрация: 12.09.2005
Барнаул
Сообщений: 77


У меня вопрос как избавиться, что бы некоторые размеры не оставались на месте, если их с объектом перемещать или копировать (слой не заморожен). Иногда при создании копии одного пространства листа, на нем изменить расположения размеров, то на источники они отображаются как на новом, но при изменении стиля они отображаются нормально
Ratmir вне форума  
 
Непрочитано 28.02.2006, 11:26
#32
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Ratmir, в вашей прграмме используются vla-функции, которые работают с ОБЪЕКТАМИ, вперемешку с LISP-функциями, которые работают с ПРИМИТИВАМИ. Поскольку вы не обеспечили преход от одного типа к другому, АвтоКАД выдает сообщение об ошибке.
С другой стороны, если вы собираетесь использовать свою программу только для отрезков (LINES), то вам моя функция не нужна, потому что она предназначена для определния точек множественных пересечений, например круг с прямоугольником или две извилистых полилинии. Ниже приводится вариант, написанный на ActiveX, т.е. с использованием vla-функций для "подравнивания" линий. Извините за английский, но при копировании русский текст крякозябрится.
Код:
[Выделить все]
(defun c:ExTr (/ vars adoc utl ass EorT mode ln0 ln pt)
  (vl-load-com)
  (setq vars (mapcar 'getvar '("CMDECHO" "OSMODE"))
        adoc (vla-get-activedocument (vlax-get-acad-object))
        utl (vla-get-utility adoc)
        ass (vla-get-ActiveSelectionSet adoc));setq
  (if (/= (vla-get-count ass) 0) (vla-clear ass))
  (vla-InitializeUserInput utl 128 "Extend Trim")
  (setq EorT (vla-getKeyWord utl "\Select Mode [Extend/Trim]: <Trim>"))
  (if (= EorT "") (setq EorT "Trim"))
  (setq mode (if (= EorT "Trim") acExtendNone acExtendOtherEntity))
  (vla-getEntity utl 'ln0 nil "Select Line to Extend to or Trim at: ")
  (vla-highlight ln0 t)         
  (prompt "\nSelect Line(s) to Extend or Trim: ")
  (vla-SelectOnScreen ass)
  (princ (strcat "\nSelected " (itoa (vla-get-count ass)) " lines"))
  (vlax-for ln ass
    (setq pt (vlax-invoke ln0 'IntersectWith ln mode))
    (if (= (vla-get-ObjectName ln) "AcDbLine")
      (if (= Eort "Trim")
        (vlax-put-property ln (if (< (vlax-curve-getParamAtPoint ln pt)
           (/ (vla-get-length ln) 2)) 'StartPoint 'EndPoint) (vlax-3d-point pt))
        (mapcar '(lambda (x) (if (equal (vlax-curve-getClosestPointTo ln pt) (vlax-get ln x))
                   (vlax-put-property ln x (vlax-3d-point pt)))) '(Startpoint EndPoint)));if
      (alert "\nThis Service for Lines Only!")));vlax
  (vla-update ln0)
  (vla-clear ass)
  (mapcar '(lambda (x y) (setvar x y)) '("CMDECHO" "OSMODE") vars)
);end
Если вам нужен вариант для полилиний, сообщите и я что-нить придумаю.
Успехов!
Лентяй вне форума  
 
Непрочитано 28.02.2006, 12:27
#33
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
<phrase 1=


Цитата:
но при копировании русский текст крякозябрится
Известный глюк Виндовс. Перед копированием надо переключить раскладку клавиатуры на RU.
vk вне форума  
 
Непрочитано 28.02.2006, 20:12
#34
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,392


Спасибо, в следующий раз обязательно попробую.
Лентяй вне форума  
 
Непрочитано 07.03.2006, 06:22
#35
Ratmir


 
Регистрация: 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
Ratmir вне форума  
 
Автор темы   Непрочитано 20.03.2006, 06:59
#36
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Как узнать на лиспе, выбраны элементы в данный момент или нет? В зависимости от того выбраны они или нет должно выполняться то или иное действие. Если элемент выбран, то его слой будет меняться, если нет будет устанавливаться другой слой текущим.
Krieger вне форума  
 
Непрочитано 20.03.2006, 08:07
#37
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Проверяй длину и наличие выбора:
Код:
[Выделить все]
(if (setq selset (ssget "_I"))
;;; Бла-бла-бла
)
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 20.03.2006, 09:39
#38
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Почему такой код, если его вставить в ком строку работает, а с кнопки нет?
Код:
[Выделить все]
(vl-cmdf "change" "Previous" "" "Properties" "layer" "NewLayer" "")
Krieger вне форума  
 
Автор темы   Непрочитано 26.04.2006, 12:23
#39
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Вставляем блок, потом взрываем. Как потом выбрать объекты которые были в блоке?
Krieger вне форума  
 
Непрочитано 26.04.2006, 12:27
#40
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Я бы попробовал примерно так:
Код:
[Выделить все]
;|=============================================================================
*    Функция возвращает список имен примитивов, входящих в блок.
*    Параметры вызова:
*	block-name	имя блока. Если блока с таким именем в базе нет,
*			возвращает nil
*    Примеры вызова:
(_kpblc-get-block-content (cdr (assoc 2 (entget(car(entsel))))))
=============================================================================|;
(defun _kpblc-block-get-content (block-name / result item block_cont_next)
  (if (setq item (tblsearch "block" block-name))
    (progn
      (setq block_cont_next (cdr (assoc -2 item)))
      (while block_cont_next
	(setq result	      (cons block_cont_next result)
	      block_cont_next (entnext block_cont_next)
	      ) ;_ end of setq
	) ;_ end of while
      ) ;_ end of progn
    ) ;_ end of if
  result
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Вопросы по Lisp

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск