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

Вернуться   Форум 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.
Просмотров: 1965708
 
Непрочитано 12.05.2023, 10:50
#4381
name02


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


posetitel, для получения текста из ячейки используй nentsel.
А для создания слоя уже на форуме было - https://forum.dwg.ru/showthread.php?t=80531
name02 вне форума  
 
Непрочитано 12.05.2023, 10:56
#4382
koMon


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


Цитата:
Сообщение от name02 Посмотреть сообщение
для получения текста из ячейки используй nentsel.
очень и очень сомнительно
__________________
K Lisp
koMon вне форума  
 
Непрочитано 12.05.2023, 11:03
#4383
name02


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


Цитата:
Сообщение от koMon Посмотреть сообщение
очень и очень сомнительно
А почему? Вроде там есть группа с текстом
name02 вне форума  
 
Непрочитано 12.05.2023, 15:24
1 | #4384
koMon


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


Offtop:
we all have learned a better something
in every possible mistake

posetitel,
ну это конечно не подправить

Код:
[Выделить все]
 
;*****************************************************************************************************************************

(defun set_layer (layer_name / added_layer)
	(if (vl-catch-all-error-p
			(setq added_layer
		       	(vl-catch-all-apply
			   	 'vla-item
			   		(list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
			   			layer_name
			   		)
	   			)
			)
		)
		(setq added_layer
				(vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
					     layer_name
				)
		)
		(if (minusp (vlax-get added_layer 'freeze))
				(vla-put-freeze added_layer :vlax-false)
				(if (minusp (vlax-get added_layer 'lock))
					(vla-put-lock added_layer :vlax-false)
				)
		)
	)
	(vla-put-activelayer (vla-get-activedocument (vlax-get-acad-object)) added_layer)
)

;*****************************************************************************************************************************

(defun get_cell_value (_prompt / cell_picked table_selected_object row_number column_number checking_vector result table_sset)
	(setq checking_vector (vlax-3d-point (getvar 'viewdir)))
	(while (null cell_picked)
		(setq picked_point (vl-catch-all-apply 'getpoint (list (strcat "\n" _prompt ": "))))
		(cond
			(
				(vl-catch-all-error-p picked_point)
					(setq cell_picked t
					      result 'cancel
					)
			)
			(
				(null picked_point)
			)
			(
				t
					(setq table_sset (ssget "_f" (list
									  					(list (car picked_point) (- (cadr (getvar 'viewctr)) (/ (getvar 'viewsize) 2.0)))
									  					(list (car picked_point) (+ (cadr (getvar 'viewctr)) (/ (getvar 'viewsize) 2.0)))
								 				 )
								 				'((0 . "ACAD_TABLE"))
									 )
					)
					(cond
						(
							(null table_sset)
						)
						(
							(< 1 (sslength table_sset))
						)
						(
							(and
								(= :vlax-true (vla-hittest (setq table_selected_object (vlax-ename->vla-object (ssname table_sset 0)))
														   (vlax-3d-point picked_point) checking_vector 'row_number 'column_number
											  )
								)
								(or
									(= :vlax-true (vla-get-titlesuppressed table_selected_object))
									(and
										 (= :vlax-false (vla-get-titlesuppressed table_selected_object))
										 (not (zerop row_number))
									)
								)
							)
								(setq cell_picked t
								      result (list (vlax-variant-value (vla-getcellvalue table_selected_object row_number column_number))
												   table_selected_object
												   row_number
												   column_number
											 )
								)
						)
						(
							t
						)
					)
			)
		)
	)
	result
)

;*****************************************************************************************************************************

(defun c:make_cell_layer_pline (/ done cell_data)
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(if (and
			 (setq cell_data (get_cell_value "Выберите ячейку таблицы с текстом"))
			 (= 'str (type (car cell_data)))
			 (snvalid (car cell_data))
		)
			(progn
				(set_layer (car cell_data))
				(vl-catch-all-apply 'vla-deletecellcontent (cdr cell_data)) 
				(command "_pline" pause)
			)
			(princ "\nНеверное имя слоя или отмена команды.")
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)

;*****************************************************************************************************************************
__________________
K Lisp

Последний раз редактировалось koMon, 07.07.2023 в 12:58.
koMon вне форума  
 
Непрочитано 14.05.2023, 16:30
#4385
Browning Zed


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


Привет всем!
Есть задача - сформировать новый список на основе другого списка, в соответствии с заданным целым числом. Число - количество элементов исходного списка, идущих от его начала.
Таким образом, если мы передадим в функцию, в качестве аргументов, число 3 и список '(1 2 3 4 5 6), функция должна будет вернуть нам '(1 2 3).
В свое время, написал для решения этой задачи итеративную функцию:
Код:
[Выделить все]
 (defun CollectItemSeq ( num lst / seq lst)
	(setq seq nil)
	(repeat num (setq seq (cons (car lst) seq) lst (cdr lst)))
	(reverse seq)
)
И вот теперь, решил создать аналогичную вышеуказанной функции рекурсию, и споткнулся:
Код:
[Выделить все]
 (defun CollectItemSeq ( num lst / seq)
	(if (> 0 num)
		(reverse seq)
		(progn
			(setq seq (cons (car lst) seq))
			(CollectItemSeq (1- num) (cdr lst))
		)
	)
)
I'm so stupid. ЧЯДНТ?
Browning Zed вне форума  
 
Непрочитано 14.05.2023, 18:34
1 | #4386
koMon


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


Browning Zed,

можно так

Код:
[Выделить все]
 
(defun CollectItemSeq (num lst / seq)
  	(if (> num 0)
		(setq seq (cons (car lst) (CollectItemSeq (setq num (1- num)) (setq lst (cdr lst)))))
	)
  	seq
)
__________________
K Lisp
koMon вне форума  
 
Непрочитано 14.05.2023, 19:02
| 1 #4387
Browning Zed


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


koMon, круто, спасибо. Теперь все встало на свои места.

Сразу не допер, что (cons (car нужно применять не к списку, а к рекурсии возвращающей список.
С твоего позволения, немного модифицировал твой код, убрав из него ненужные setq, так как аргументы входящие в функцию рекурсивно, сами меняют свое значение при каждом новом вызове функции (разумеется, если изменение значения аргумента прописано в теле функции).
Итого, получилось:
Код:
[Выделить все]
 (defun CollectItemSeq (num lst / seq)
  	(if (> num 0)
		(setq seq (cons (car lst) (CollectItemSeq (1- num) (cdr lst))))
	)
  	seq
)
Еще раз, спасибо коммандеру koMon'у.
Browning Zed вне форума  
 
Непрочитано 15.05.2023, 09:46
#4388
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 451


Маленькое примечание.

Рекурсию при обработке списков нужно использовать очень
осторожно - можно натолкнуться на "переполнение стека".
Если список очень большой. Такие ошибки очень трудно
потом отлавливать. Я, например, в принципе отказался
от неё при обработке списков непредсказуемой длины.

foreach - "наше всё" :-)
__________________
Счастливо, Алексей!
===AAA=== вне форума  
 
Непрочитано 15.05.2023, 13:21
#4389
Browning Zed


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


===AAA===
Безусловно, такая проблема существует. Но на практике, со stack overflow пока не сталкивался, возможно по причине того, что рекурсивные функции использую не так часто.
При этом, неоднократно сталкивался с мнением, что LISP, это как раз тот язык, из всех прочих языков, где рекурсивные алгоритмы перебора списков (коллекций, последовательностей) смотрятся органичнее всего.
Да и foreach, далеко не панацея. Так же, как панацеей могут не оказаться mapcar, или все семейство vl- функций относящихся к обработке списков.
То есть, решить задачу с помощью foreach, наверное, можно любую, но иногда куда как проще (а также понятней, и логичней), к примеру, взять и использовать цикл while, пролистывая в его теле список при помощи cdr, и одновременно совершая кучу других действий. Ну, или воспользоваться рекурсивным алгоритмом.
Browning Zed вне форума  
 
Непрочитано 15.05.2023, 14:01
#4390
===AAA===


 
Регистрация: 15.08.2005
г. Норильск
Сообщений: 451


Дык одно дело сам LISP, другое - его реализация на конкретной программно-аппаратной платформе.
Я однажды столкнулся. Правда - давно. И памяти в компах с тех пор изрядно добавилось и версия
Автокада поменялась. Однако с тех пор - ну её нафиг, эту рекурсию...
Как элемент непредсказуемости.
__________________
Счастливо, Алексей!
===AAA=== вне форума  
 
Непрочитано 16.05.2023, 05:11
#4391
SetQ

конструктор
 
Регистрация: 21.07.2007
Петрозаводск
Сообщений: 1,971


Промежуточное решение с помощью Функции "рекурсивирования" или рекурсивной lambda:

Код:
[Выделить все]
 (defun recurs (p f x);создает рекурсивный список до выполнения условия p функции f с начальным аргументом х
  (if (p x)
      (cons x nil)
      (cons x (recurs p f (f x)))))
(setq  lst '(1 2 3 4 5 6) num 3)
(reverse (last (recurs (lambda (x) (>= num (length x))) cdr (reverse lst))))
SetQ вне форума  
 
Непрочитано 18.05.2023, 11:11
#4392
Andrey55


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


Здравствуйте. Тема изъезженная, понимаю. Необходимо создать LISP для импорта координат точек в AutoCAD и последующего построения точек по ним (с точками совсем не скоро). Исходник координат в Excel, перевожу в txt с разделением табуляцией.
Пока дошел вот до этого с выводом координат в командную строку (для наглядности, чтобы я понимал что КАД вообще этот файл видит и читает):
Код:
[Выделить все]
(defun c:FF ()
(setq 	f1 (open "d:\\lisp\\coor.txt" "r")
	a (read-line f1)
	b (read-line f1)
	c (read-line f1)
	d (read-line f1)
	e (read-line f1)
	f (read-line f1)
	)
  	        (close f1)
(print (strcat "" a ""))
(print (strcat "" b ""))
(print (strcat "" c ""))
(print (strcat "" d ""))
(print (strcat "" e ""))
(print (strcat "" f ""))
(print)
)
В комадную строку выводит текст вида:
"1254.65\t654.26\t6589.21"
"206646.26\t5486.15\t164.25"
"15.2664\t201.16\t023.254"
"154.10\t2168.489\t456.15"
"18.20\t45632.15\t2031.22"
"1648.25\t20.15\t254.16"
Условных 6 точек просто пока для эксперимента. Теперь цель заставить автокад понять что от нуля до первой табуляции это Х, от первой табуляции это Y, и последнее соотвественно Z. Вроде как должно решаться strlen и ascii, но в справочниках пишут "функция возвращает длину строковой константы...", если кто может разжевать как это понять и что есть константа в моем примере?

Предупреждая вопросы - осваиваю это дело по учебе, интересно, но нифига не понятно, поэтому использовать чужой "импорт XYZ" не могу.
Andrey55 вне форума  
 
Непрочитано 18.05.2023, 12:03
2 | #4393
Кулик Алексей aka kpblc
Moderator

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


Все что сейчас напишу - сугубо личное мнение.
Первое и самое главное - имена. Имена функций, переменных и т.д. Когда код даже на 10 строк, понять, что в переменной q хранится, может быть затруднительно.
Далее. LISP - язык списков, и этим желательно пользоваться. Соответственно чтение файла можно сделать так:
Код:
[Выделить все]
 (setq file   "d:\\lisp\\coor.txt"
      handle (open file "r")
)
(while (setq str (read-line handle)) 
  (setq res (cons str res))
)
(close handle)
(setq res (reverse res))
В переменной res будет содержимое файла списком, независимо от длины файла. К примеру:
Код:
[Выделить все]
 '("1254.65\t654.26\t6589.21"
 "206646.26\t5486.15\t164.25"
 "15.2664\t201.16\t023.254" 
 "154.10\t2168.489\t456.15"
 "18.20\t45632.15\t2031.22" 
 "1648.25\t20.15\t254.16"
)
Теперь надо каждую строку разбить по символу табуляции на список (например, https://forum.dwg.ru/showthread.php?t=63867). Но, поскольку lambda вряд ли сразу "зайдут", исходный код можно переделать:
Код:
[Выделить все]
 (defun str-str-lst (str pat / i)  ;Evgeny Elpanov
  (cond 
    ((= str "") nil)
    ((setq i (vl-string-search pat str))
     (cons (substr str 1 i) 
           (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
     ) ;_  cons
    )
    (t (list str))
  ) ;_  cond
) ;_  defun

(setq file   "d:\\lisp\\coor.txt"
      handle (open file "r")
)
(while (setq str (read-line handle)) 
  (setq res (cons (str-str-lst str "\t") res))
)
(close handle)
(setq res (reverse res))
В res теперь будет нечто типа
Код:
[Выделить все]
 '(("1254.65" "654.26" "6589.21") 
  ("206646.26" "5486.15" "164.25")
  ("15.2664" "201.16" "023.254)(154.10" "2168.489" "456.15")
  ("18.20" "45632.15" "2031.22")
  ("1648.25" "20.15" "254.16")
)
Преобразовать строку в число - функция atof. Чтобы "было все и сразу":
Код:
[Выделить все]
 (defun str-str-lst (str pat / i)  ;Evgeny Elpanov
  (cond 
    ((= str "") nil)
    ((setq i (vl-string-search pat str))
     (cons (substr str 1 i) 
           (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
     ) ;_  cons
    )
    (t (list str))
  ) ;_  cond
) ;_  defun

(setq file   "d:\\lisp\\coor.txt"
      handle (open file "r")
)
(while (setq str (read-line handle)) 
  (setq res (cons (mapcar (function atof) (str-str-lst str "\t")) res))
)
(close handle)
(setq res (reverse res))
Теперь в res будет нечто типа:
Код:
[Выделить все]
 '((1254.65 654.26 6589.21) 
  (206646.26 5486.15 164.25)
  (15.2664 201.16 023.254)
  (154.10 2168.489 456.15)
  (18.20 45632.15 2031.22)
  (1648.25 20.15 254.16)
)
И теперь можно делать точки - хоть командными методами, хоть как.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.

Последний раз редактировалось Кулик Алексей aka kpblc, 18.05.2023 в 15:34.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 18.05.2023, 12:47
1 | #4394
koMon


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


Цитата:
Сообщение от Andrey55 Посмотреть сообщение
Теперь цель заставить автокад понять что от нуля до первой табуляции это Х,
(print (read (strcat "(" a ")"))) -> (1254.65 654.26 6589.21), то есть (list x y z)
__________________
K Lisp
koMon вне форума  
 
Непрочитано 18.05.2023, 13:32
#4395
Andrey55


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
И теперь можно делать точки - хоть командными методами, хоть как.
Спасибо
Выдает ошибку - слишком много аргументов. Остальные лиспы отключил, проблема не ушла.

----- добавлено через ~24 мин. -----
Цитата:
Сообщение от koMon Посмотреть сообщение
(print (read (strcat "(" a ")"))) -> (1254.65 654.26 6589.21), то есть (list x y z)
Код:
[Выделить все]
(print (read (strcat "(" a ")"))) (list x y z)
Такого вида?
В командную строку выводит как вы и написали 3 значения в скобках, тут ок. Оно благодаря этому кусочку кода теперь понимает, что x=1254.65 y=654.26 z=6589.21? Подозреваю что нет.
Andrey55 вне форума  
 
Непрочитано 18.05.2023, 14:12
1 | #4396
koMon


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


Цитата:
Сообщение от Andrey55 Посмотреть сообщение
Оно благодаря этому кусочку кода теперь понимает, что x=1254.65 y=654.26 z=6589.21?
именно понимает. если сохранить этот список в переменную или составить список из таких точек, то можно обращаться к индивидуальным точкам такого списка.

----- добавлено через ~15 мин. -----
Код:
[Выделить все]
 
(defun c:FF (/ f1 point point_list)
	(setq f1 (open "d:\\lisp\\coor.txt" "r"))
	(while (setq point (read-line f1))
		(setq point_list (append point_list (list (read (strcat "(" point ")")))))
	)
	(print point_list)
  	(close f1)
)
1-я точка из списка -> (nth 0 point_list)
координата X 1-й точки (car (nth 0 point_list))
координата Y 1-й точки (cadr (nth 0 point_list))
координата Z 1-й точки (caddr (nth 0 point_list))
и т.д.
__________________
K Lisp

Последний раз редактировалось koMon, 18.05.2023 в 14:58.
koMon вне форума  
 
Непрочитано 18.05.2023, 14:44
#4397
1958


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


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
(setq res (cons (mapcar (functino atof) (str-str-lst str "" "")) res))
functino - это function ?
И всё-равно не работает. А очень интересно!
1958 вне форума  
 
Непрочитано 18.05.2023, 15:07
1 | #4398
Browning Zed


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


Цитата:
Сообщение от Andrey55 Посмотреть сообщение
Оно благодаря этому кусочку кода теперь понимает, что x=1254.65 y=654.26 z=6589.21? Подозреваю что нет.
Обратите внимание, оба представленных решения по преобразованию координат: от Кулик Алексей aka kpblc, и от koMon на выходе дают вам список координат: три цифры заключенные в скобки.
Список - это основная структура данных в LISP, и если вы планируете начать изучать программирование вам потребуется понять как устроен список, как он формируется и как его обрабатывать.
Чтобы передать программе сведения о том, что в списке у вас какие-то данные нужно обратиться к элементам списка. Это осуществляется через определенные функции, например: car, cadr, nth, last.

Но в данном случае, у вас список координат, а это значит, что вы вообще можете не указывать какая цифра является той или иной координатой.
Вы просто передаете этот список соответствующей функции, которая без ваших дополнительных подсказок понимает что первый элемент списка это x, второй y, а третий z.
Например, функция создания точки:
Код:
[Выделить все]
 (entmakex (list (cons 0 "POINT") (cons 10 '(1254.65 654.26 6589.21))))
После выполнения этого кода будет создана точка с координатами указанными в скобках.
Browning Zed вне форума  
 
Непрочитано 18.05.2023, 15:35
1 | #4399
Кулик Алексей aka kpblc
Moderator

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


Исправил опечатки. Offtop: Странно как-то код из VSCode копируется - то так, то этак.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 18.05.2023, 19:12
#4400
1958


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


Алексей! А как подправить лисп, чтобы он выдавал результат такого типа:
(("1" 4255443.36 12245413.22 623.56 "ладно") ("2" 4255426.09 12245409.77 626.62 "низ")...

Код:
[Выделить все]
 (defun str-str-lst (str pat / i) ;Evgeny Elpanov
 (cond ((= str "") nil)
       ((setq i (vl-string-search pat str))
        (cons (substr str 1 i) (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)) ;_  cons
       )
       (t (list str))
 ) ;_  cond
) ;_  defun
(defun c:22 (/)
 (setq res nil)
 (setq file (getfiled "Выбор файла :" (getvar 'dwgprefix) "csv" 16)
       handle (open file "r")
 )
 (while (setq str (read-line handle))
;;;  (setq res (cons (mapcar (function atof) (str-str-lst str ";")) res))
    (setq res (cons (str-str-lst str ";") res))
 )
 (close handle)
 (setq res (reverse res))
)
Данные читаются из файла с расширением *.csv
Вложения
Тип файла: zip Pickets_№_XYH_C.zip (313 байт, 17 просмотров)
1958 вне форума  
Ответ
Вернуться   Форум 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