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

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

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

Ответ
Поиск в этой теме
Непрочитано 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.
Просмотров: 1965848
 
Непрочитано 21.05.2018, 15:52
#3581
gnuvse


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
gnuvse, пример какого кода? Изменения выравнивания, что ли?

----- добавлено через ~8 мин. -----
Говорит, что

Вот интересно, какие дополнения установлены и в каком количестве?

C vla-put..., если можно законченный пример, чтобы можно было запустить и посмотреть. Не обязательно на TextJustify

Спасибо.
gnuvse вне форума  
 
Непрочитано 21.05.2018, 16:12
#3582
1958


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


Цитата:
Сообщение от BithSachs Посмотреть сообщение
Мне просто нужна стандартная команда, только, чтобы она сразу строила по опорному углу
Что вы хотите строить? Отрезок, линию? Вы уж определитесь. В самом начале у вас речь шла о повороте выбранных объектов по указанным двум точкам.
Попробуйте так:

Код:
[Выделить все]
 (defun c:rt (/)
 (setq ss (ssget))
 (setq p1 (getpoint "\nПервая точка"))
 (setq p2 (getpoint "\nВторая точка"))
 (setq ang (angtos (angle p1 p2)))
 (command "_rotate" ss "" p1 ang)
)
1958 вне форума  
 
Непрочитано 21.05.2018, 19:56
1 | #3583
Кулик Алексей aka kpblc
Moderator

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


BithSachs, масса слов написано, а ответа на вопрос "работает код или нет" так и не получено. Offtop: Не нравится - не используй. Лень анализировать - я снесу код, не проблема ни разу.
Я начинаю подозревать, что удаление приложений (кстати, каких - это что, военная тайна?) из автозагрузки ничего не дало: есть масса вариантов принудительной тихой загрузки дополнений. Тот факт, что у тебя не работает штатная функция лиспа, может означать что угодно - вплоть до того, что ACAD надо будет полностью переустанавливать.

----- добавлено через 43 сек. -----
Цитата:
Сообщение от gnuvse Посмотреть сообщение
C vla-put..., если можно законченный пример, чтобы можно было запустить и посмотреть. Не обязательно на TextJustify
Код:
[Выделить все]
 (vl-load-com)
(defun test1 (/ ent ins a b ta)
  (if (and (= (type
                (setq ent (vl-catch-all-apply
                            (function (lambda () (vlax-ename->vla-object (ssname (ssget "_+.:S:E:L" '((0 . "TEXT"))) 0))))
                            ) ;_ end of VL-CATCH-ALL-APPLY
                      ) ;_ end of setq
                ) ;_ end of type
              'vla-object
              ) ;_ end of =
           (member (setq a (vla-get-alignment ent))
                   (list acalignmentleft acalignmentright acalignmenttopleft acalignmenttopright acalignmentmiddleleft acalignmentmiddleright acalignmentbottomleft acalignmentbottomright)
                   ) ;_ end of member
           ) ;_ end of and
    (progn (setq ins (vla-get-insertionpoint ent)
                 ta  (vla-get-textalignmentpoint ent)
                 ) ;_ end of setq
           (vla-put-alignment
             ent
             (cond ((= a acalignmentleft) acalignmentright)
                   ((= a acalignmentright) acalignmentleft)
                   ((= a acalignmenttopleft) acalignmenttopright)
                   ((= a acalignmenttopright) acalignmenttopleft)
                   ((= a acalignmentmiddleleft) acalignmentmiddleright)
                   ((= a acalignmentmiddleright) acalignmentmiddleleft)
                   ((= a acalignmentbottomleft) acalignmentbottomright)
                   ((= a acalignmentbottomright) acalignmentbottomleft)
                   ) ;_ end of cond
             ) ;_ end of vla-put-Alignment
           (vl-catch-all-apply (function (lambda () (vla-put-textalignmentpoint ent ta))))
           (vla-put-insertionpoint ent ins)
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 21.05.2018, 21:05
#3584
BithSachs


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
кстати, каких - это что, военная тайна?
Все от Ли Мака
1 Реактор на Орто
2 Layer Director
3 Смена фона

Сама по себе ssget работает, но в тех строках с функцией command она не работала, и я у хотел узнать почему. (Ну серьезно, почему у тебя не возникает никаких вопросов, почему эти 8 несчастных строчек не работают?)

Твой код почему-то странно поворачивает объект (мгновенно), но до момента выбора второй точки все идет как я и хотел.
Вложения
Тип файла: lsp LayerDirector.lsp (16.8 Кб, 4 просмотров)
Тип файла: lsp ChangeBackgroundColour.lsp (758 байт, 6 просмотров)
Тип файла: lsp Reactor.lsp (2.9 Кб, 6 просмотров)

Последний раз редактировалось BithSachs, 21.05.2018 в 21:22.
BithSachs вне форума  
 
Непрочитано 21.05.2018, 21:43
#3585
Кулик Алексей aka kpblc
Moderator

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


Цитата:
Сообщение от BithSachs Посмотреть сообщение
Ну серьезно, почему у тебя не возникает никаких вопросов, почему эти 8 несчастных строчек не работают?
Потому что я помню тему (за точность названия не поручусь) "Применить explode к набору". И потому, что команды в лиспе могут срабатывать совсем не так, как в обычном режиме.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 21.05.2018, 21:49
#3586
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от BithSachs Посмотреть сообщение
Что я делаю не так?
ssget не хочет работать
Код:
Код:
[Выделить все]
 (defun c:ВРАЩАТЬ ()
   	(setq ss (ssget "_P")
   	(setq p1 (getpoint "/nПервая точка"))
   	(setq p2 (getpoint "/nВторая точка"))
   	(command "ПОВЕРНУТЬ" ss p1 "О" p1 p2)
   	)
)
После "command", думаю, понятно, что я хочу сделать
Так будет работать задуманная команда.
Причём, как verb->noun, так и noun<-verb)

Код:
[Выделить все]
  
(defun c:ВРАЩАТЬ ()
   	(setq ss (ssget))
	(setq p1 (getpoint "/nПервая точка"))
	(setq p2 (getpoint "/nВторая точка"))
	(command "_Rotate" "_P" ""  p1 "О" p1 p2)
)

Последний раз редактировалось koMon, 21.05.2018 в 22:08.
koMon вне форума  
 
Непрочитано 22.05.2018, 09:29
1 | #3587
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


Цитата:
Сообщение от gnuvse Посмотреть сообщение
Хочу написать программу, которая просто меняет Justify на right<->left
я тоже хотел… но не то, чтобы left-right, а вообще перебор всего… не думаю, что подойдёт в качестве примера, но может пригодится!?-)
Offtop: да простит меня setvar
Вложения
Тип файла: lsp Change_Text_Alignment.lsp (23.9 Кб, 10 просмотров)

Последний раз редактировалось koMon, 22.05.2018 в 09:42.
koMon вне форума  
 
Непрочитано 23.05.2018, 19:49
#3588
BithSachs


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


koMon, работает, действительно. Но я не понимаю, почему присваиваем ss набор, но потом его не используем, а просто пишем _P
И зачем пустые кавычки после этого самого _P?

А в одной строчке это нельзя сделать?

Код:
[Выделить все]
 (defun c:ТЕСТ ()
   	(setq ss (ssget))
	(command "_Rotate" "_P" ""  getpoint "О" getpoint "@")
)
(чтобы появлялась эта желтенькая пунктирная линия, как по умолчанию в команде)

Последний раз редактировалось BithSachs, 23.05.2018 в 19:55.
BithSachs вне форума  
 
Непрочитано 23.05.2018, 20:58
#3589
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


BithSachs,

Цитата:
Сообщение от BithSachs Посмотреть сообщение
почему присваиваем ss набор, но потом его не используем
мы его испотльзуем, но косвенно. команда будет работать только с последним/первым? примитивом из такого пиксета.


Цитата:
Сообщение от BithSachs Посмотреть сообщение
И зачем пустые кавычки после этого самого _P?
в команду передаётся селекшн сет, команда ожидает дальнейшшего добавления объектоа, чтобы завершить выбор нужен "", эквивалент <Enter>

Цитата:
Сообщение от BithSachs Посмотреть сообщение
А в одной строчке это нельзя сделать?
можно.
Код:
[Выделить все]
 (command "_Rotate" "_P" "" (getpoint) "_R" "@")

Последний раз редактировалось koMon, 23.05.2018 в 21:08.
koMon вне форума  
 
Непрочитано 23.05.2018, 21:39
#3590
BithSachs


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


koMon, спасибо большое!
BithSachs вне форума  
 
Непрочитано 24.05.2018, 09:54
#3591
koMon


 
Блог
 
Регистрация: 26.09.2017
Сообщений: 1,665


BithSachs,
по ходу я был не прав, я посмотрел и так тоже работает), всё короче и короче...

Код:
[Выделить все]
 (command "_Rotate" (ssget) "" (getpoint) "_R" "@")
koMon вне форума  
 
Непрочитано 29.05.2018, 09:17
#3592
sathalex


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


Привет всем.
Есть функция по выбору объектов на слое:
Код:
[Выделить все]
 (defun sel_obj (etype msg lay / e el)
	(setvar 'errno 0)
	(if
	  (setq e (car (entsel msg)))
	  (setq el (entget e))
	  )
	(cond
	   ((= (getvar 'errno) 7)
	   (princ "\nМимо.. Попробуйте ещё раз.")
	   (sel_obj etype msg lay)
	   )
	  ((not e) nil)
	  ((not (wcmatch (strcase (cdr (assoc 0 el))) (strcase etype)))
	   (princ (strcat "\nВыбранный объект не является " etype "... Попробуйте ещё раз."))
	   (sel_obj etype msg lay)
	   )
	  
	  ((eq (vla-get-lock (vla-item (vla-get-Layers (vla-get-activedocument(vlax-get-acad-object))) (cdr (assoc 8 el)))) :vlax-true)
	   (princ "\nСлой заблокирован.. Попробуйте ещё раз.")
	   (sel_obj etype msg lay)
	   )
	  ((and lay (wcmatch (strcase (cdr (assoc 8 el))) (strcase lay)))
	   (princ "\nСлой уже был выбран.. Попробуйте ещё раз.")
	   (sel_obj etype msg lay)
	   )
	   (T (cdr (assoc 8 el)))
	)
)
Пытаюсь добавить в функцию переменную, которая бы хранила имя слоя, на котором объекты были выбраны:
Код:
[Выделить все]
 (if
	  (setq e (car (entsel msg)))
          (setq layname (cdr (assoc 8 e)))
          (setq el (entget e))
	  )
но ничего не получается.
Помогите пожалуйста советом.
sathalex вне форума  
 
Непрочитано 29.05.2018, 10:57
#3593
Кулик Алексей aka kpblc
Moderator

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


А не проще ли фильтры ssget использовать?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 29.05.2018, 11:02
#3594
frostmourn


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


Так можно
Код:
[Выделить все]
 
(if
  (setq e (car (entsel msg)))
         (setq layname (cdr (assoc 8 e))
                  el (entget e))
  )

frostmourn вне форума  
 
Непрочитано 29.05.2018, 11:28
#3595
sathalex


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


Цитата:
Сообщение от frostmourn Посмотреть сообщение
Так можно
Код:
[Выделить все]
 
(if
  (setq e (car (entsel msg)))
         (setq layname (cdr (assoc 8 e))
                  el (entget e))
  )

Получаю ошибку:
неверный тип аргумента: listp <Имя объекта: 1b25f35be70>
sathalex вне форума  
 
Непрочитано 29.05.2018, 12:45
#3596
Кулик Алексей aka kpblc
Moderator

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


В каком месте ошибка?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 29.05.2018, 13:54
#3597
frostmourn


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


Цитата:
Сообщение от sathalex Посмотреть сообщение
Получаю ошибку:
неверный тип аргумента: listp <Имя объекта: 1b25f35be70>
Ну да, не проверил написанное. Надо чуть поменять
Код:
[Выделить все]
 
(if
  (setq e (car (entsel msg)))
         (setq el (entget e)
             layname (cdr (assoc 8 el)))
  )
frostmourn вне форума  
 
Непрочитано 30.05.2018, 00:55
#3598
sathalex


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


Цитата:
Сообщение от frostmourn Посмотреть сообщение
Ну да, не проверил написанное. Надо чуть поменять
Спасибо большое, всё получается как надо!
sathalex вне форума  
 
Непрочитано 22.06.2018, 22:37
#3599
gnuvse


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
BithSachs, масса слов написано, а ответа на вопрос "работает код или нет" так и не получено. Offtop: Не нравится - не используй. Лень анализировать - я снесу код, не проблема ни разу.
Я начинаю подозревать, что удаление приложений (кстати, каких - это что, военная тайна?) из автозагрузки ничего не дало: есть масса вариантов принудительной тихой загрузки дополнений. Тот факт, что у тебя не работает штатная функция лиспа, может означать что угодно - вплоть до того, что ACAD надо будет полностью переустанавливать.

----- добавлено через 43 сек. -----

Код:
[Выделить все]
 (vl-load-com)
(defun test1 (/ ent ins a b ta)
  (if (and (= (type
                (setq ent (vl-catch-all-apply
                            (function (lambda () (vlax-ename->vla-object (ssname (ssget "_+.:S:E:L" '((0 . "TEXT"))) 0))))
                            ) ;_ end of VL-CATCH-ALL-APPLY
                      ) ;_ end of setq
                ) ;_ end of type
              'vla-object
              ) ;_ end of =
           (member (setq a (vla-get-alignment ent))
                   (list acalignmentleft acalignmentright acalignmenttopleft acalignmenttopright acalignmentmiddleleft acalignmentmiddleright acalignmentbottomleft acalignmentbottomright)
                   ) ;_ end of member
           ) ;_ end of and
    (progn (setq ins (vla-get-insertionpoint ent)
                 ta  (vla-get-textalignmentpoint ent)
                 ) ;_ end of setq
           (vla-put-alignment
             ent
             (cond ((= a acalignmentleft) acalignmentright)
                   ((= a acalignmentright) acalignmentleft)
                   ((= a acalignmenttopleft) acalignmenttopright)
                   ((= a acalignmenttopright) acalignmenttopleft)
                   ((= a acalignmentmiddleleft) acalignmentmiddleright)
                   ((= a acalignmentmiddleright) acalignmentmiddleleft)
                   ((= a acalignmentbottomleft) acalignmentbottomright)
                   ((= a acalignmentbottomright) acalignmentbottomleft)
                   ) ;_ end of cond
             ) ;_ end of vla-put-Alignment
           (vl-catch-all-apply (function (lambda () (vla-put-textalignmentpoint ent ta))))
           (vla-put-insertionpoint ent ins)
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Уважаемый Кулик Алексей, я еще новичок в программирование.
Пытаюсь запускать ваш код, выделяю текст и не работает(mtext, text и то и то попробовал).
При отладке понимаю, что в ent передается nil. При помощи vl-catch-all-error-message выявил ошибку - bad argument type - lselsetp nil

Значит у нас не проходит проверка по типу (type) из этого следует, что я выделяю не тот объект какой надо.

Поясните пожалуйста.

Если вам не сложно, я хотел бы задать вопросы насчет программы.

UPD. Я понял. Мы сравниваем с 'vla-object значит мой текст не является vla объектом.

Последний раз редактировалось gnuvse, 22.06.2018 в 22:46.
gnuvse вне форума  
 
Непрочитано 24.06.2018, 17:35
1 | #3600
Кулик Алексей aka kpblc
Moderator

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


Строка
Код:
[Выделить все]
 (ssget "_+.:S:E:L" '((0 . "TEXT")))
дословно означает следующее:
- выбирать только объекты TEXT
- исключить выбор на заблокированных слоях
- выбирать только один примитив
- выбирать примитив под курсором
Проверь, что у тебя с состоянием слоев. Ну или образец файла в студию. Сейчас у меня нет возможности проверять код. Может быть, позже - если не забуду.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей 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