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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Ответ
Поиск в этой теме
Непрочитано 20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,977

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.


Код:
[Выделить все]
(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun
_____________________________________________________________________________________________________________

Прошло много лет и топик теперь представляет из себя площадку для обучения азов программирования для многих начинающих.
Так что начинающие лиспогрызы приветствуются .
__________________
Блог

Последний раз редактировалось Red Nova, 12.07.2017 в 05:43.
Просмотров: 1722256
 
Непрочитано 28.09.2011, 11:21
#1641
dirge


 
Регистрация: 05.09.2011
Сообщений: 38


Всем привет! Ребята, подскажите как можно достучаться до вложенных фильтров слоёв один в другом? Фильтров может быть много.

Код:
[Выделить все]
 (setq dict_ACAD_LAYERFILTERS
       (dictsearch
	 (cdr
	   (assoc
	     360
	     (entget
	       (cdr (assoc
		      330
		      (entget (tblobjname "LAYER" "0"))
		    )
	       )
	     )
	   )
	 )
	 "ACAD_LAYERFILTERS"
     )
)
Этой процедурой получается узнать все внешние фильтры, но не получается узнать свойств и имён вложенных фильтров. Как будто их вообще нет. Подскажите как решить задачу?

Последний раз редактировалось Кулик Алексей aka kpblc, 28.09.2011 в 11:52.
dirge вне форума  
 
Непрочитано 30.09.2011, 10:49
#1642
Andru1968


 
Регистрация: 29.08.2011
г. Балаково
Сообщений: 48


Всем привет! Ребята, подскажите при выполнении функции получил значение переменной Result: (("zona_n" "login_user") (3 "chaa")), далее идет строка
Код:
[Выделить все]
 (setq SQLFetch (cdr Result))
получаю результат: ((3 "chaa"))
Как из этого получить (3 "chaa")?
Andru1968 вне форума  
 
Непрочитано 30.09.2011, 10:52
#1643
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,550


Цитата:
Сообщение от Andru1968 Посмотреть сообщение
получаю результат: ((3 "chaa"))
Как из этого получить (3 "chaa")?
Код:
[Выделить все]
 (nth 0 '((3 "chaa")))
gomer вне форума  
 
Непрочитано 30.09.2011, 11:05
#1644
TararykovDG

Программист-энтузиаст
 
Регистрация: 17.07.2009
Воронеж
Сообщений: 571


Или может лучше сразу так
Код:
[Выделить все]
 
(setq SQLFetch (cadr Result))
(setq SQLFetch (assoc 3 Result))
__________________
cadtools
TararykovDG вне форума  
 
Непрочитано 30.09.2011, 11:06
#1645
alex8888

Инженер
 
Регистрация: 27.04.2009
Deutschland
Сообщений: 207


Цитата:
Как из этого получить (3 "chaa")
а просто (car '((3 "chaa"))) недостаточно?

Или во всей строке: (setq SQLFetch (cadr Result))
alex8888 вне форума  
 
Непрочитано 30.09.2011, 11:11
#1646
Andru1968


 
Регистрация: 29.08.2011
г. Балаково
Сообщений: 48


Когда делаю так
Код:
[Выделить все]
 (setq SQLFetch (cadr Result))
получаю SQLFetch = (3 "chaa") и далее можно работать со списком

Код:
[Выделить все]
 (if (not SQLFetch)
	(alert "Строка в базе не найдена")
	(progn
	  (setq  zona_n ( car SQLFetch)
                  SQLFetch ( cdr SQLFetch)
                login_user ( car SQLFetch)
                  SQLFetch ( cdr SQLFetch))
получаю zona_n = 3, login_user = "chaa"

а если делаю так
Код:
[Выделить все]
 (setq SQLFetch (cadr Result))
(setq SQLFetch (assoc 3 Result))
получаю SQLFetch = nil и идет сообщение "Строка в базе не найдена" хотя она там есть

Последний раз редактировалось Andru1968, 30.09.2011 в 11:40.
Andru1968 вне форума  
 
Непрочитано 30.09.2011, 16:03
1 | #1647
TararykovDG

Программист-энтузиаст
 
Регистрация: 17.07.2009
Воронеж
Сообщений: 571


Цитата:
Сообщение от Andru1968 Посмотреть сообщение
а если делаю так
Код:
[Выделить все]
 (setq SQLFetch (cadr Result))
(setq SQLFetch (assoc 3 Result))
получаю SQLFetch = nil и идет сообщение "Строка в базе не найдена" хотя она там есть
Имелось ввиду, что нужно делать или так (setq SQLFetch (cadr Result)) или так (setq SQLFetch (assoc 3 Result)), а не одновеременно
__________________
cadtools
TararykovDG вне форума  
 
Непрочитано 30.09.2011, 16:51
#1648
dirge


 
Регистрация: 05.09.2011
Сообщений: 38


Так, я ни на шаг не приблизился к пониманию того, можно ли вытащить подгруппы фильтров слоёв через лисп. Ребята, есть у кого какие идеи?
dirge вне форума  
 
Непрочитано 30.09.2011, 19:42
#1649
gross

Конструктор КМД
 
Регистрация: 27.05.2010
Ижевск
Сообщений: 68


Здравствуйте. Есть такой вопрос, я в настройках отключил контекстное, т к использую его редко, можно ли повесить на кнопу команду чтоб оно выходило?, в привычном виде, или когда вызываю команду ПСК _ucs, выходит необычное меню (не знаю как оно правильно называется) - хотя бы такого вида чтоб выходило/
Подскажите пожалуйста

Последний раз редактировалось gross, 30.09.2011 в 22:01.
gross вне форума  
 
Непрочитано 01.10.2011, 10:53
#1650
VVA

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


dirge, Не самая подходящая тема для твоего сообщения.
Было много тем про фильтры слоев. На вскидку
http://forum.dwg.ru/showthread.php?t=52142
http://forum.dwg.ru/showthread.php?t=3825
http://forum.dwg.ru/showthread.php?t=58915
Лучше задать вопрос в одной из более подходящих тем или создать новую. Так же более четко сформулировать вопрос, приложить пример в виде dwg файла, указать версию Автокада. Я, например, пока не понимаю, что такое подгруппы фильтров слоёв
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 02.10.2011, 17:40
#1651
baaba

архитектор
 
Регистрация: 07.07.2007
Москва
Сообщений: 624
<phrase 1= Отправить сообщение для baaba с помощью Skype™


null

Последний раз редактировалось baaba, 02.10.2011 в 18:28. Причина: вопрос снят - я был невнимателен
baaba вне форума  
 
Непрочитано 03.10.2011, 09:50
#1652
dirge


 
Регистрация: 05.09.2011
Сообщений: 38


Цитата:
Сообщение от VVA Посмотреть сообщение
dirge, Не самая подходящая тема для твоего сообщения.
Было много тем про фильтры слоев. На вскидку
http://forum.dwg.ru/showthread.php?t=52142
http://forum.dwg.ru/showthread.php?t=3825
http://forum.dwg.ru/showthread.php?t=58915
Лучше задать вопрос в одной из более подходящих тем или создать новую. Так же более четко сформулировать вопрос, приложить пример в виде dwg файла, указать версию Автокада. Я, например, пока не понимаю, что такое подгруппы фильтров слоёв

Спасибо, за ссылки. Вот в этой теме последнее сообщение такой же вопрос по сути:
http://www.caduser.ru/forum/index.ph...#message252725

Версия AutoCAD 2009.
Хорошо, поясню чуть более корректней. Под подгруппами я имею ввиду, что внутри New Property Filter можно создать ещё один и ещё и т.д, соответственно можно образовывать ветвление фильтров внутри одного единственного. Так вот, готовые процедуры по поиску фильтров слоёв которые я нашёл на форумах возвращают только один фильтр и не видят то, что внутри него. Вот собственно и суть вопроса была. Как добраться до 2го, 3го уровня фильтров не понятно. На всякий случай, dwg прилагаю.

Буду признателен в помощи.
Вложения
Тип файла: dwg
DWG 2004
Drawing1.dwg (54.6 Кб, 3122 просмотров)
dirge вне форума  
 
Непрочитано 04.10.2011, 04:31 я тоже решил применять Лисп... Буду спрашивать как...? тут...
#1653
Redj-ЭС


 
Регистрация: 08.08.2007
г. Подольск
Сообщений: 531


2011
вот и первый вопрос...

имеется мультивыноска с целым числовым значением, и я её размножаю коммандой _copy...
как сделать, чтоб при каждой вставке этой коммандой, значение увеличивалось... а...?
на 1...
Redj-ЭС вне форума  
 
Непрочитано 04.10.2011, 08:01
#1654
engngr

сети
 
Регистрация: 03.11.2008
Московия*
Сообщений: 5,265


2025
... а... работает?.. поиск... не ?.. ну...
engngr вне форума  
 
Непрочитано 04.10.2011, 11:50
1 | #1655
TararykovDG

Программист-энтузиаст
 
Регистрация: 17.07.2009
Воронеж
Сообщений: 571


Redj, попробуй так (Используется реактор)
Код:
[Выделить все]
 
; ----------------------------------------------------------------------------------------------------------------------------------------------
(vl-load-com)
(setq *flag_copy* nil
      *flag_append* nil
      *index* nil
      *step* 1 ; здесь можно задать свой шаг инкремента
      )
; ----------------------------------------------------------------------------------------------------------------------------------------------
(defun objectAppended(reac data / ) ; примитив добавлен
  (if *flag_copy*
    ((lambda(obj)
       (if obj
         ((lambda(ed)
            (if (= (cdr (assoc 0 ed)) "MULTILEADER")
              ((lambda(new_str_value)
                 (if (and (not *flag_append*)
                          (/= new_str_value "")
                          )
                   (progn
                     (setq *flag_append* (not *flag_append*)
                           ed (subst (cons 304 new_str_value) (assoc 304 ed) ed)
                           )
                     (entmod ed)
                     )
                   (setq *flag_append* (not *flag_append*))
                   )
                 )
                (if (not *index*)
                  ((lambda(str_value)
                     (cond ((Is-Str->Value str_value nil T)
                            (if (= (type *step*) 'INT)
                              (itoa (setq *index* (+ *step* (atoi str_value))))
                              (rtos (setq *index* (+ *step* (atoi str_value))))
                              )
                            )
                           ((Is-Str->Value str_value nil nil)
                            (rtos (setq *index* (+ *step* (atof str_value))))
                            )
                           (T "")
                           )
                     )
                    (cdr (assoc 304 ed))
                    )
                  (cond ((= (type *index*) 'INT) (itoa (setq *index* (if (not *flag_append*) *index* (+ *step* *index*)))))
                        ((= (type *index*) 'REAL) (rtos (setq *index* (if (not *flag_append*) *index* (+ *step* *index*)))))
                        (T "")
                        )
                  )
                )
              )
            )
           (entget obj)
           )
         )
       )
      (cadr data)
      )
    )
)
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(setq AcDb_Reac (vlr-acdb-reactor "Реактор базы: "
          (list '(:VLR-objectAppended . objectAppended)
            )
          )
      )
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(defun commandWillStart(reac data / )
  (if (= (car data) "COPY")
    (setq *flag_copy* T)
    )
  )
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(defun commandEnded(reac data / )
  (if (= (car data) "COPY")
    (setq *index* nil
          *flag_copy* nil
          )
    )
  )
; ----------------------------------------------------------------------------------------------------------------------------------------------

; ----------------------------------------------------------------------------------------------------------------------------------------------
(setq CmdReac (vlr-command-reactor "Реактор команд: "
            (list '(:vlr-commandWillStart . commandWillStart)
                      '(:vlr-commandEnded . commandEnded)
              )
            )
    )
; ----------------------------------------------------------------------------------------------------------------------------------------------


; Проверка является ли строка числом (если not_null = T - проверка на неравенство нулю; если int = T - проверка является ли число целым)
(defun Is-Str->Value(str not_null int / lst lst_memb)
  (if (= (substr str 1 1) "-")
    (setq str (substr str 2))
  )
  (setq lst (vl-string->list (vl-string-translate ",e" ".E" str)))
  (if int
    (setq lst_memb (list 45 48 49 50 51 52 53 54 55 56 57 69))
    (setq lst_memb (list 45 46 48 49 50 51 52 53 54 55 56 57 69))
  )
  (if (and (vl-every '(lambda(x) (member x lst_memb)) lst)
           (< (length (vl-remove-if-not '(lambda(x) (= x 46)) lst)) 2)
       (if (vl-position 69 lst)
         (and (> (vl-position 69 lst) 0)
          (< (vl-position 69 lst) (1- (length lst)))
          (< (length (vl-remove-if-not '(lambda(x) (= x 69)) lst)) 2)
          )
         T
         )
           (if (vl-position 45 lst)
             (and (< (length (vl-remove-if-not '(lambda(x) (= x 45)) lst)) 2)
                  (< (vl-position 45 lst) (1- (length lst)))
                  (= (nth (1- (vl-position 45 lst)) lst) 69)
                  )
             T
             )
           )
    (if not_null
      (> (length (vl-remove-if '(lambda(x) (or (= x 45) (= x 46) (= x 48) (= x 69))) lst)) 0)
      T
      )
    nil
  )
); End Is-Str->Value
P. S. можно добавить в автозагрузку, и тогда будет работать автоматически на любом чертеже, но ИМХО лучше загружать самому когда это необходимо, а то вдруг надо будет просто скопировать мультивыноску без инкрементирования.
__________________
cadtools

Последний раз редактировалось TararykovDG, 04.10.2011 в 12:08. Причина: Подправил код, а то до этого инкрементирование происходило не только при копировании, но и созданиии новой мультивыноске
TararykovDG вне форума  
 
Непрочитано 04.10.2011, 14:59
#1656
Redj-ЭС


 
Регистрация: 08.08.2007
г. Подольск
Сообщений: 531


во...
такая простая идея... вроде...
и такой длинный код... о как...

спасибо за информацию... буду изучать.
Redj-ЭС вне форума  
 
Непрочитано 12.10.2011, 13:10
#1657
Pavel_GP

Инженер-гидрограф
 
Регистрация: 15.09.2011
г.г. Ленинград
Сообщений: 170


Здравствуйте!
Подскажите плз, как написать LISP (стараюсь - не получается) - построение линии по географическим координатам.

П.С. AutoCad civil 3d 2012

Пример
Код:
[Выделить все]
 
  (defun C:setka_gk ()
  (command "_.line" "_'LL")
  (command "67 27 10")
  (command "86 30 00")
  (command "67 27 50")
  (command "86 30 00")
  )
Этот код не работает ((, что-то делаю не так.
Первая точка строится, а вот вторая нет, ругается...:

Вставка из командной строки:
Команда: SETKA_GK
_.line Первая точка:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 00' 00.00">: 67 27 10
>>Введите долготу <В027° 00' 00.00">: 86 30 00
Возобновляется команда SETKA_GK.
Первая точка: 67 27 50
Неверная точка.
; ошибка: Функция отменена
Первая точка:
(478597.0 7.48494e+006 0.0)
Следующая точка или [оТменить]:
Текущая единица изменения широты/долготы: градусы; ввод: ГГ° ММ' СС.СС" (с
пробелами)
>>Введите широту <С067° 27' 10.00">:
Pavel_GP вне форума  
 
Непрочитано 12.10.2011, 13:46
#1658
Кулик Алексей aka kpblc
Moderator

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


Привязку снять забыл.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 12.10.2011, 14:13
#1659
Pavel_GP

Инженер-гидрограф
 
Регистрация: 15.09.2011
г.г. Ленинград
Сообщений: 170


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Привязку снять забыл.
Код:
[Выделить все]
 (defun C:setka_sk ()
  (command "_.osnap" "_none")
  (command "_.line" "_'LL")
  (command "67 27 10")
  (command "86 30 00")
  (command "67 27 50")
  (command "86 30 00")
)
Все так же, не изменилось.

В ручную я эту линию могу нарисовать, а код не пишится...
Pavel_GP вне форума  
 
Непрочитано 12.10.2011, 14:23
#1660
Кулик Алексей aka kpblc
Moderator

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


(command "_.line" "_none" '(67 27 10) "_none" '(86 30 0) "_none" '(67 27 50) "_none" '(86 30 0))
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 272 06.06.2021 23:12
Сейсмозащита и сейсмоизоляция существующих, построенных зд. IANationalInformAgentstvo Прочее. Архитектура и строительство 216 20.01.2015 16:51
Мониторы LCD CRT Разное 94 17.06.2008 10:51
ЮМОР 2006 =) Perezz!! Разное 1122 04.01.2007 00:46