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

Red Nova · 20.07.2008, 20:12

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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

_____________________________________________________________________________________________________________

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

dirge · 28.09.2011, 11:21

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

Код:

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

 (setq dict_ACAD_LAYERFILTERS
       (dictsearch
	 (cdr
	   (assoc
	     360
	     (entget
	       (cdr (assoc
		      330
		      (entget (tblobjname "LAYER" "0"))
		    )
	       )
	     )
	   )
	 )
	 "ACAD_LAYERFILTERS"
     )
)

Этой процедурой получается узнать все внешние фильтры, но не получается узнать свойств и имён вложенных фильтров. Как будто их вообще нет. Подскажите как решить задачу?

Andru1968 · 30.09.2011, 10:49

Всем привет! Ребята, подскажите при выполнении функции получил значение переменной Result: (("zona_n" "login_user") (3 "chaa")), далее идет строка

Код:

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

 (setq SQLFetch (cdr Result))

получаю результат: ((3 "chaa"))
Как из этого получить (3 "chaa")?

gomer · 30.09.2011, 10:52

Цитата:

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

получаю результат: ((3 "chaa"))
Как из этого получить (3 "chaa")?

Код:

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

 (nth 0 '((3 "chaa")))

TararykovDG · 30.09.2011, 11:05

Или может лучше сразу так

Код:

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

 
(setq SQLFetch (cadr Result))
(setq SQLFetch (assoc 3 Result))

alex8888 · 30.09.2011, 11:06

Цитата:

Как из этого получить (3 "chaa")

а просто (car '((3 "chaa"))) недостаточно?

Или во всей строке: (setq SQLFetch (cadr Result))

Andru1968 · 30.09.2011, 11:11

Когда делаю так

Код:

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

 (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 и идет сообщение "Строка в базе не найдена" хотя она там есть

TararykovDG · 30.09.2011, 16:03

Цитата:

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

а если делаю так

Код:

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

 (setq SQLFetch (cadr Result))
(setq SQLFetch (assoc 3 Result))

получаю SQLFetch = nil и идет сообщение "Строка в базе не найдена" хотя она там есть

Имелось ввиду, что нужно делать или так (setq SQLFetch (cadr Result)) или так (setq SQLFetch (assoc 3 Result)), а не одновеременно

dirge · 30.09.2011, 16:51

Так, я ни на шаг не приблизился к пониманию того, можно ли вытащить подгруппы фильтров слоёв через лисп. Ребята, есть у кого какие идеи?

gross · 30.09.2011, 19:42

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

VVA · 01.10.2011, 10:53

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 файла, указать версию Автокада. Я, например, пока не понимаю, что такое подгруппы фильтров слоёв

baaba · 02.10.2011, 17:40

dirge · 03.10.2011, 09:50

Цитата:

Сообщение от 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 прилагаю.

Буду признателен в помощи.

Redj-ЭС · Регистрация: 08.08.2007

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

имеется мультивыноска с целым числовым значением, и я её размножаю коммандой _copy...
как сделать, чтоб при каждой вставке этой коммандой, значение увеличивалось... а...?
на 1...

engngr · 04.10.2011, 08:01

2025
... а... работает?.. поиск... не ?.. ну...

TararykovDG · 04.10.2011, 11:50

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. можно добавить в автозагрузку, и тогда будет работать автоматически на любом чертеже, но ИМХО лучше загружать самому когда это необходимо, а то вдруг надо будет просто скопировать мультивыноску без инкрементирования.

Redj-ЭС · 04.10.2011, 14:59

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

спасибо за информацию... буду изучать.

Pavel_GP · 12.10.2011, 13:10

Здравствуйте!
Подскажите плз, как написать 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">:

Кулик Алексей aka kpblc · 12.10.2011, 13:46

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

Pavel_GP · 12.10.2011, 14:13

Цитата:

Сообщение от Кулик Алексей 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")
)

Все так же, не изменилось.

В ручную я эту линию могу нарисовать, а код не пишится...

Кулик Алексей aka kpblc · 12.10.2011, 14:23

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

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
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

20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу) Red Nova ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ. Торонто Регистрация: 23.10.2007 Сообщений: 1,980 Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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.
Просмотров: 1972459