[Red Nova]

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

_____________________________________________________________________________________________________________

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

[Jerald]

Не знаю, может неправильно его "одел"?

(defun C:77 (/)
Command: filedia
Enter new value for FILEDIA <1>: 0
Command: saveas
Current file format: AutoCAD 2007 Drawing
Enter file format [R14(LT98&LT97)/2000(LT2000)/2004(LT2004)/2007(LT2007)/Standards/DXF/Template] <2007>: dxf
Current DXF settings: Precision= 16 Format= ASCII Preview= No Version= 2007
Enter decimal places of accuracy (0 to 16) or [Binary/select Objects/Preview/Version] <16>: 16
Save drawing as <C:\Users\a.kulik\Documents\Drawing1.dxf>:
Command: filedia
Enter new value for FILEDIA <0>: 1
)

Команда: 77
; ошибка: no function definition: LT98&LT97

[Кулик Алексей aka kpblc]

Код:

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

 (defun ss (/ filename sysvar)
  (if (setq filename (getfiled "Path to save" "" "dxf" 1))
    (progn (setq sysvar (vl-remove nil
                                   (mapcar (function (lambda (x / tmp)
                                                       (if (setq tmp (getvar (car x)))
                                                         (progn (setvar (car x) (cdr x)) (cons (car x) tmp))
                                                         ) ;_ end of if
                                                       ) ;_ end of lambda
                                                     ) ;_ end of function
                                           '(("sysmon" . 0) ("filedia" . 0))
                                           ) ;_ end of mapcar
                                   ) ;_ end of vl-remove
                 ) ;_ end of setq
           (vl-catch-all-apply (function (lambda () (vl-cmdf "_.saveas" "dxf" "16" filename))))
           (foreach item sysvar (setvar (car item) (cdr item)))
           ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

----- добавлено через 48 сек. -----
Код не проверял, не до того как-то (

[Red Nova]

Помогите отфильтровать список пожалста.
Имею список такого типа:

(("1" "1a" "4" "18'-2 3/4"" "#5" "19") ("1" "1b" "3" "32'-4 1/4"" "#5" "19") ("2" "1a" "11" "20'-10 1/4"" "#5" "19") ("2" "1b" "4" "14'-2 1/4"" "#5" "19") ("2" "1c" "2" "9'-1 1/4"" "#5" "19") ("3" "1c" "2" "9'-1 1/4"" "#5" "19") ("3" "1d" "4" "9'-4 1/2"" "#5" "19") ("3" "1d" "1" "9'-4 3/4"" "#5" "19"))

Требуется удалить все элементы списка кроме тех что начинаются на определенное значение. К примеру если это 2, то от списка нужно оставить:

(("2" "1a" "11" "20'-10 1/4"" "#5" "19") ("2" "1b" "4" "14'-2 1/4"" "#5" "19") ("2" "1c" "2" "9'-1 1/4"" "#5" "19"))

[Кулик Алексей aka kpblc]

Код:

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

 (vl-remove-if-not (function (lambda(x) (= (car x) "2"))) '(("1" "1a" "4" "18'-2 3/4"" "#5" "19") ("1" "1b" "3" "32'-4 1/4"" "#5" "19") ("2" "1a" "11" "20'-10 1/4"" "#5" "19") ("2" "1b" "4" "14'-2 1/4"" "#5" "19") ("2" "1c" "2" "9'-1 1/4"" "#5" "19") ("3" "1c" "2" "9'-1 1/4"" "#5" "19") ("3" "1d" "4" "9'-4 1/2"" "#5" "19") ("3" "1d" "1" "9'-4 3/4"" "#5" "19")) )

[Red Nova]

Спасибо, работает.
Тогда задачка по сложнее. Застрял ...
В списке следующего вида нужно перемножить каждый второй элемент подсписка на каждый третий и записать результат в конец списка.

(("1" "4" "18'-2 3/4\"" "#5" "19") ("2" "11" "20'-10 1/4\"" "#5" "19") ("3" "2" "9'-1 1/4\"" "#5" "19"))

Так что в результате будет:

(("1" "4" "18'-2 3/4\"" "#5" "19" "72' 11\"") ("2" "11" "20'-10 1/4\"" "#5" "19" "229' 43/4\"") ("3" "2" "9'-1 1/4\"" "#5" "19" "18' 21/2\""))

Скорее всего нужно копать mapcar, lambda и foreach. Погрызу их пока тут нет отзыва.
Длины у меня в футах и дюймах. Надеюсь это не критично при математических вычислениях.

И еще вопрос скажем так общеобразовательного толка. Как правильно называть лист в котором каждый элемент представляет из себя лист сам по себе. То есть такие как у меня. А-то все что я нахожу для работы с листами в основном для обычных листов. Может не так ищу.... ?

----- добавлено через ~3 ч. -----
Вот к чему я пока пришел.

Код:

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

 (defun testit (/ nxl lst newlst)
;(setq lst '(("1" "4" "18'-2 3/4\"" "#5" "19") ("2" "11" "20'-10 1/4\"" "#5" "19") ("3" "2" "9'-1 1/4\"" "#5" "19")))
 (setq lst '(("1" "4" "18" "#5" "19") ("2" "11" "20" "#5" "19") ("3" "2" "9" "#5" "19")))
 (setq lst
 (foreach n lst
  (setq nxl (list (princ (* (read (nth 1 n)) (read (nth 2 n))))))
  (append n nxl)
 )
 )
  (princ lst)
)
)

Вопрос 1. Вычисление провел, но не пойму как при записи результата обратно в лист добавить двойные кавычки. К примеру сейчас у меня лист получается такой
(("1" "4" "18" "#5" "19" 72) ("2" "11" "20" "#5" "19" 220) ("3" "2" "9" "#5" "19" 18))
а нужно так
(("1" "4" "18" "#5" "19" "72") ("2" "11" "20" "#5" "19" "220") ("3" "2" "9" "#5" "19" "18"))

Вопрос 2. foreach провел нужные действия, но на выходе я имею только последний элемент листа ("3" "2" "9" "#5" "19" 18), как вернуть весь лист?

Вопрос3. Как видите в коде я закомментил лист где длина в футах и дюймах, так как они не считались. Есть вариант проводить вычисления в империальном виде?

[Кулик Алексей aka kpblc]

1. Изучай значение символа "\"
2. Преобразовывай неметрические данные в метрические, потом умножай - дели - складывай - вычитай, и результат обратно в дюймы/футы/ярды

[Red Nova]

Спасибо
По пункту 1 из моих вопросов.
Для добавления двойных кавычек мне нужно было понять что элемент с кавычками это string а без оных это integer. Дальше поиском нашел функцию itoa, которая и производит соответствующую конвертацию.

По пункту 2 из моих вопросов. Ты его пропустил, у тебя сразу потом про мой третий вопрос ))).
Пока не сумел вернуть по окончанию foreach весь список. Как и раньше писал возвращает только последний обработанный элемент листа.
То есть вместо
(("1" "4" "18" "#5" "19" "72") ("2" "11" "20" "#5" "19" "220") ("3" "2" "9" "#5" "19" "18"))
на выходе
("3" "2" "9" "#5" "19" "18")
ХЕЛП плиз.

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

Код:

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

 (defun testit (/ nxl lst newlst)
 (setq lst '(("1" "4" "18" "#5" "19") ("2" "11" "20" "#5" "19") ("3" "2" "9" "#5" "19")))
 (setq lst
 (foreach n lst
  (setq nxl (list (itoa (* (read (nth 1 n)) (read (nth 2 n))))));How can I convert   into a string with lisp
  (append n nxl)
 )
 )
  (princ lst)
)

По пункту 3. Пока продолжил в децимальной системе. Потом переконвертирую, или вообще в децимальной оставлю.

[Дима_]

Сообщение от Red Nova Пока не сумел вернуть по окончанию foreach весь список

Для этого есть mapcar.

[Red Nova]

По поводу пункта 2 придумал такой вариант. mapcar таки не использовал.

Код:

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

 (defun testit (/ nxl lst newlst)
;(setq lst '(("1" "4" "18'-2 3/4\"" "#5" "19") ("2" "11" "20'-10 1/4\"" "#5" "19") ("3" "2" "9'-1 1/4\"" "#5" "19")))
 (setq lst '(("1" "4" "18" "#5" "19") ("2" "11" "20" "#5" "19") ("3" "2" "9" "#5" "19")))
 (foreach n lst
  (setq nxl (list (itoa (* (read (nth 1 n)) (read (nth 2 n))))));How can I convert   into a string with lisp
  
  (setq newlst (append (list (append n nxl)) newlst))
  )
  (setq lst (reverse newlst))
)

[Дима_]

А если попробывать с:

Код:

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

 (defun testit2()
(mapcar '(lambda (n) (reverse (cons (itoa (* (read (nth 1 n)) (read (nth 2 n)))) (reverse n))))
         '(("1" "4" "18" "#5" "19") ("2" "11" "20" "#5" "19") ("3" "2" "9" "#5" "19"))))

ops. К вечеру глаз замылился - этож лисп:

Код:

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

 (defun testit2()
(mapcar '(lambda (n) (reverse (cons (itoa (* (read (cadr n)) (read (caddr n)))) (reverse n))))
         '(("1" "4" "18" "#5" "19") ("2" "11" "20" "#5" "19") ("3" "2" "9" "#5" "19"))))

[kacugu]

или попробовать с append

Код:

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

 
(defun c:testit (/ lst newlst)
(setq lst '(("1" "4" "18" "#5" "19") ("2" "11" "20" "#5" "19") ("3" "2" "9" "#5" "19")))
(setq newlst
	(mapcar
		'(lambda (x)
			(append x
				(list(itoa(* (atoi(cadr x)) (atoi(caddr x)))))))lst))
(princ)
)

[Дима_]

Сообщение от kacugu или попробовать с append

про append 1-го элемента см. здесь начиная с #12.

[Red Nova]

Гдеж вы были пока я не нашел решение Шучу, самому всегда интересно ковыряться. Вот только если бы на счет itoa подсказали это бы сэкономило мне несколько часов.
Тогда раз уж вас тут так много объясните кто-нибудь почему у меня vlide постоянно на лямбдах выводит в новое окно сообщение

;;; Copied to window at 8:14 PM 9/24/16 (LAMBDA (X) (ZEROP (SETQ I (1- I)))) ;;; End of text

Я потом не могу просмотреть last value после лямбды. Приходиться при помощи ctr+f8 пропускать кусок а дальше в окне последнего значение

'(LAMBDA (X) (ZEROP (SETQ I (1- I))))

Это можно в настройках убрать?

----- добавлено через ~2 ч. -----
Идем дальше.
Теперь у меня задача провести сравнение всех элементов списка и если первые элементы одинаковы провести группирование (суммирование последних элементов списка).
То есть имеем список типа:

Код:

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

 (("1" "#5" "19" "225") ("1" "#5" "19" "463") ("1" "#5" "19" "1164.75") ("2" "#5" "19" "2653.75") ("2" "#5" "19" "585") ("3" "#5" "19" "2653.75") ("3" "#5" "19" "585") ("3" "#5" "19" "227.5"))

На выходе требуется получть:

Код:

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

 (("1" "#5" "19" "1852.75") ("2" "#5" "19" "3238,75") ("3" "#5" "19" "3466.25"))

Есть идеи?

P.S. По поводу прошлого кода, использовал код от Димы с #3010, но пришлось заменить itoa на rtos чтоб работала с дробными...

[VVA]

Сообщение от Red Nova Есть идеи?

Есть. Немного изменить под твой список

----- добавлено через ~2 ч. -----
Как вариант

Код:

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

 
(defun any2float (item)
  (cond
    ((eq (type item) 'STR)(atof item))
    ((eq (type item) 'INT) item)
    ((eq (type item) 'REAL) item)
    (t 0)
    )
  )
(defun MakeUniqueMembersOfListWithCount  ( lst / OutList head countelt)
 ;;; lst - список списков, где последний элемент списка - число или число в строковом представлении
;;Применение
;;(MakeUniqueMembersOfListWithCount '((1 1)(2 1)(3 1)(1 2)(2 1)(3 3)))
;; Вернет ((1 3) (2 2) (3 4))
  
  (while lst
    (setq head (car lst)
	  countelt 0
          lst (vl-remove-if '(lambda(pt)(if (equal (reverse(cdr(reverse pt)))(reverse(cdr(reverse head))) 1e-6)(setq countelt (+ countelt (any2float(last pt)))) nil)) lst)
          OutList (append OutList (list (reverse(cons countelt (cdr(reverse head))))))))
  OutList
  )

На твоем примере

Код:

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

 

(setq srclst '(("1" "#5" "19" "225") ("1" "#5" "19" "463") ("1" "#5" "19" "1164.75") ("2" "#5" "19" "2653.75") ("2" "#5" "19" "585") ("3" "#5" "19" "2653.75") ("3" "#5" "19" "585") ("3" "#5" "19" "227.5")))
(MakeUniqueMembersOfListWithCount srclst)

[Кулик Алексей aka kpblc]

Сообщение от Red Nova почему у меня vlide постоянно на лямбдах выводит в новое окно сообщение

Вместо '(lambda( .... )) используй (function (lamdba( ... )), тогда точки останова корректно срабатывают.

[Red Nova]

VVA, Спасибо . На тесте все работало, но при применении в команде дало сбой почему-то. Если интересно, во вложении код и файл на котором тестил (команда RN_SlabtableTotal)
Тут мне еще Lee Mac вариант подкинул. Так работает без ошибок.

Код:

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

     (defun mergelist ( l / a r x )
        (foreach x l
            (if (setq x (cons (list (car x) (cadr x) (caddr x)) (distof (last x)))
                      a (vl-some '(lambda ( y ) (if (vl-every '= (car x) (car y)) y)) r)
                )
                (setq r (subst (cons (car a) (+ (cdr a) (cdr x))) a r))
                (setq r (cons x r))
            )
        )
        (reverse (mapcar '(lambda ( x ) (reverse (cons (rtos (cdr x)) (reverse (car x))))) r))
    )

Кулик Алексей aka kpblc Спасибо, попробую.

[VVA]

Сообщение от Red Nova но при применении в команде дало сбой почему-то

Может быть потому, что в ф-ции последний элемент остается числом, а в твоем примере - строка
Добавил rtos

Код:

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

(defun MakeUniqueMembersOfListWithCount  ( lst / OutList head countelt)
 ;;; lst - список списков, где последний элемент списка - число или число в строковом представлении
;;Применение
;;(MakeUniqueMembersOfListWithCount '((1 1)(2 1)(3 1)(1 2)(2 1)(3 3)))
;; Вернет ((1 3) (2 2) (3 4))
  
  (while lst
    (setq head (car lst)
	  countelt 0
          lst (vl-remove-if '(lambda(pt)(if (equal (reverse(cdr(reverse pt)))(reverse(cdr(reverse head))) 1e-6)(setq countelt (+ countelt (any2float(last pt)))) nil)) lst)
          OutList (append OutList (list (reverse(cons (rtos countelt 4 6)(cdr(reverse head))))))))
  OutList
  )

----- добавлено через ~3 мин. -----
PS Проверил - работает. Правда к командам (command) и опциям пришлось добавить префиксы "_"
PPS Обрати внимание на цифру 4 в rtos

[Red Nova]

VVA, Спасибо. О футах и дюймах при применении rtos я уже нашел.

Теперь пытаюсь добавить в последнюю строку списка суммарное значение всех длин.
Сперва я очистил лист от всех ненужных элементов, дальше нужно суммировать.
Вроде как прочитал тут что для этого есть функция reduce. Но она у меня не определена . Она вообще в лиспе есть?

Код:

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

 (defun testit ()
(rtos (reduce #'+ (mapcar 'distof (mapcar 'car '(("225") ("560") ("463") ("755") ("1164.75") ("2653.75") ("585") ("153.75") ("2653.75") ("585") ( "227.5"))))))
  )

Command: (testit) ; error: no function definition: REDUCE

_________________________________
Добавил

Как я понял покопавшись - reduce это привилегия Emacs Lisp
Так что сделал так:

Код:

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

 (defun test8 (/ lst tot)
(setq tot 0)  
(foreach n (mapcar 'distof (mapcar 'car '(("225") ("560") ("463") ("755") ("1164.75") ("2653.75") ("585") ("153.75") ("2653.75") ("585") ( "227.5"))))
          (setq tot (+ n tot))
  )
  )

[VVA]

Сообщение от Red Nova дальше нужно суммировать

Код:

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

(setq lst '(("225") ("560") ("463") ("755") ("1164.75") ("2653.75") ("585") ("153.75") ("2653.75") ("585") ( "227.5")))
(setq sum (apply '+(mapcar 'atof (mapcar 'car lst))))

[Red Nova]

Спасибо, я apply без тебя не нашел. Пришлось извращаться )).

Кок можно проверить (вернуть T / nil) есть ли блок с определенным именем в файле (точнее проверить вставлен ли блок в файл)?