Научите лиспу на примере (или как 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

_____________________________________________________________________________________________________________

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

Alaspher · 30.07.2008, 11:48

Цитата:

Сообщение от Red Nova

VVA,
Вот вариант команды одновременно и отключающей и включающей привязки. Работает.

Код:

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

(defun c:disable_enable_osmode ()
    (if (< (getvar "osmode") 16384) 
      (setvar "osmode" (+ (getvar "osmode") 16384)) 
      (setvar "osmode" (- (getvar "osmode") 16384))
    )
)

Тогоже результата можно добиться без предварительной проверки значения:

Код:

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

(defun demo ()
      (setvar "osmode" (boole 6 16384 (getvar "osmode")))
)

но полезность такого решения весьма сомнительна - лично я ни разу не сталкивался с ситуацией, когда наличие привязки надо было бы изменить на пртивоположное. Как правило, надо бывает выключить привязку в нужное время и вернуть в первоначальное состояние, по окончании. В редких случаях бывает надо включить конкретную привязку, но опять же вне зависимости от её состояния ДО начала выполнения программы.

Red Nova · 30.07.2008, 11:50

Олег К.,
А как командами это сделат? Хоть намекни что надо использовать.

VVA · 30.07.2008, 12:51

Цитата:

Сообщение от Red Nova

Олег К.,
А как командами это сделат? Хоть намекни что надо использовать.

Если хочешь обучаться, тщательно штудируй оставленные тебе сообщения.

#235 для кого писалось?

Олег К. · 30.07.2008, 13:57

Цитата:

А как командами это сделат? Хоть намекни что надо использовать.

А как ты полилинию и окружность делал? Набираешь в командной строке и смотришь, какие запросы идут. Потом пробуешь повторить это лиспом. Что набирать уже сказано в #235.
Вас тут двое обучающихся, но даже если сообщение адресуется одному, другому тоже рекомендуется читать.

andery · 30.07.2008, 14:23

Если с полилинией, кругом понятно, т.к. запросы идут в командной строке, более менее догататься можна.
А вот _layer вызывает диалоговое окно....
Где можна найти подробной описание команд ?

VVA · 30.07.2008, 14:38

andery, Разве в #235 написано _layer? Там написано _-layer
Найди разницу и почитай предпоследний пост здесь.

andery · 30.07.2008, 14:40

Протупил...не читаем предыдущий пост

Red Nova · 30.07.2008, 16:19

VVA,

Цитата:

Если хочешь обучаться, тщательно штудируй оставленные тебе сообщения.
#235 для кого писалось?

Дык #235 было адресовано andery, вот я и пропустил.

andery · 30.07.2008, 16:21

Получилось вот такое:

Код:

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

(defun c:колонна (/)
      	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

  

	(setq oldOsnapcoord (getvar "osnapcoord"))
	(setq oldLayer (getvar "clayer"))
	(setvar "osnapcoord" 1)       
  	(command "_.-layer" "_make" "колонна" "_color" "_red" "" "_L" "continuous" "" "")  

    	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
    	(Setq object (entlast))
  	(command "_circle" p (/ a 2))
 	(command "_rotate" object "" p pause)
  	(setvar "clayer" oldLayer)
	(setvar "osnapcoord" oldOsnapcoord)  
  )

VVA · 30.07.2008, 16:29

andery, В общем хорошо кроме одного: если при запросе угла поворота нажать ESC, то не восстановится ни слой, ни osnapcoord
Прочитай пост #192 , пример #194 и 196. Хочу чтобы кодга нажму ESC все осталось как было.

*** Добавлено
Еще хочу чтобы круг был синим. См. команды _CHANGE и _CHPROP

andery · 30.07.2008, 17:20

VVA,
Спасибо, я пока сознательно не применяю *error*
Вот так можна пока в нашем случае пока обойтись без эррора (я так думаю).
Круг синий.

Код:

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

 
(defun c:колонна (/)
      	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

	(setq oldOsnapcoord (getvar "osnapcoord"))
	(setq oldLayer (getvar "clayer"))
	(setvar "osnapcoord" 1)       
  	(command "_.-layer" "_make" "колонна" "_color" "_red" "" "_L" "continuous" "" "")  

    	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
    	(Setq object (entlast))
  	(command "_circle" p (/ a 2))
  	(command "_change" (entlast) "" "_P" "_C" "_blue" "")
  	(setvar "clayer" oldLayer)
	(setvar "osnapcoord" oldOsnapcoord)  
 	(command "_rotate" object "" p pause)
  
  )

VVA · 30.07.2008, 17:39

andery, Зачтено.
Теперь синим пусть будут и полилиния и круг. Будем учиться работать с наборами. Наборы - это коробочка с именами примитивов (типа entlast), которую тоже можно указывать в ответ на запрос "Выберите объекты". Туда можно по мере отрисовки примитивов их складывать, чтобы скормить какой-либо команде за один раз.
В общем с наборами работают следующие ф-ции лиспа:
ssadd , ssdel ,sslength, ssname
Нам здесь понадобится ssadd

Код:

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

(setq ss (ssadd)) ;_ Создаем пустой набор
(ssadd (entlast) ss) ;_Помещаем в ss последний отрисованный примитив

andery · 30.07.2008, 17:57

Вроде так:

Код:

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

(defun c:колонна (/)
      	(initget (+ 1 2 4))
	(setq a (getdist"\nВведите ширину колонны:"))
	(initget (+ 1 2 4))
	(setq b (getdist"\nВведите высоту колонны:"))
	(setq p (getpoint "\nУкажите центр колоны:<по умолчанию (0,0)>"))
	(if (null p) (setq p '(0 0 0))
	)
	(setq x1 (- (car p) (/ a 2))) 
	(setq y1 (- (car (cdr p)) (/ b 2)))
	(setq x2 (+ (car p) (/ a 2)))
	(setq y2 (+ (car (cdr p)) (/ b 2)))

	(setq oldOsnapcoord (getvar "osnapcoord"))
	(setq oldLayer (getvar "clayer"))
	(setvar "osnapcoord" 1)       
  	(command "_.-layer" "_make" "колонна" "_color" "_red" "" "_L" "continuous" "" "")
  	(setq nabor (ssadd)) 
	(command "_circle" p (/ a 2))
  	(ssadd (entlast) nabor)
    	(command "._pline"
		(list x1 y1)
		(list x1 y2)
		(list x2 y2)
		(list X2 y1)
		"_close"
	)
    	
  	(ssadd (entlast) nabor)
  	(command "_change" nabor "" "_P" "_C" "_blue" "")
  	(setvar "clayer" oldLayer)
	(setvar "osnapcoord" oldOsnapcoord)  
 	(command "_rotate" (entlast) "" p pause)
  
  )

Red Nova · 31.07.2008, 09:26

Пока я справлял день рождения вы ушли вперед. Будем догонять.

Рyslan · 31.07.2008, 09:57

учиться, учиться и учиться!

andery · 31.07.2008, 10:02

Вот эту строчку
(command "_rotate" (entlast) "" p pause)
можна заменить вот этой.
(command "_rotate" (ssname nabor 1) "" p pause)

Red Nova · 31.07.2008, 10:25

VVA,
Вот код по заданию с #230

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R object oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))
 (setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
 (setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )

 (Setq  R  ( / dimensionX  2.0 ))

 (command "_-LAYER" "_make" "Колонны" "_color" "red" "" "ltype" "" "" "_set" "Колонны" "")

 (command "_pline" pt1 pt2 pt3 pt4 "_c")

 (Setq object (entlast))

 (command "_circle" base R)

 (command "_rotate" object "" base pause)

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

Тут меня смущает только undo. После выполнения команды, если нажать undo, то действия отменяются пошагово. Видел как это сделать при помощи vla команд, но Autolisp - ом не умею.

Red Nova · 31.07.2008, 10:35

Догоняю дальше. Вот с заданием кругу синего цвета.

Код:

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

(defun C:Колонна (/ dimensionX dimensionY base R object oldOSM OldLAY)

 (defun *error*(msg) 
 (princ msg) ; Отменено пользователем
 (if oldOSM (setvar "OSMODE" oldOSM)) 
 ) 

 (setq OldLAY (getvar "clayer"))

 (setq oldOSM (getvar "osmode"))

 (setvar "osmode" 0)

 (initget 7)
 (setq dimensionX (getreal "Введите ширину колонны: "))
 (initget 7)
 (setq dimensionY (getreal "Введите толщину колонны: "))
 (setq base 
    (cond
         ((getpoint "\Введите точку вставки колонны <0,0,0> :"))
         (t '(0. 0. 0.)))
     ) 
 (setq pt1
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt2
     ( list ( - ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt3
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( + (cadr base ) ( / dimensionY  2.0 ) )
     )
 )
 (setq pt4
     ( list ( + ( car base ) ( / dimensionX  2.0 ) )
            ( - (cadr base ) ( / dimensionY  2.0 ) )
     )
 )

 (Setq  R  ( / dimensionX  2.0 ))

 (command "_-layer" "_make" "Колонны" "_color" "red" "" "ltype" "" "" "_set" "Колонны" "")

 (command "_pline" pt1 pt2 pt3 pt4 "_c")

 (Setq object (entlast))

 (command "_circle" base R)

 (command "_chprop" "_l" "" "_color" "blue" "")

 (command "_rotate" object "" base pause)

 (setvar "clayer" OldLAY)

 (setvar "osmode" oldOSM)
)

VVA · 31.07.2008, 10:45

До undo еще дойдем. В этой строке (пост #257)

Код:

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

(command "_-LAYER" "_make" "Колонны" "_color" "red" "" "ltype" "" "" "_set" "Колонны" "")

ты ДВАЖДЫ нарушил п.2 правил В локализованной версии работать не будет.
И еще:
1. Опция _make команды _-LAYER создает слой и делает его текущим. Позтому _set можно не применять
2. Тип линии слою мы не задаем. Тогда зачем вызывать опцию ltype да еще с нарушением п.2 правил

andery · 31.07.2008, 11:08

Цитата:

2. Тип линии слою мы не задаем.

Почему? Если у нас уже существовал слой "колонна" с другим типом линии, а нам надо тип линии "continuous", то если не задавать тип линии - тип будет такой как был у существовавшего слоя колонна.

....
Можна усложнять дальше...

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