[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

_____________________________________________________________________________________________________________

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

[Disney]

Сообщение от gomer зы п.3 почти противоречит п1

Вот и я про тоже, но это не пункты, а разные допустимые значения для разных edit_box, которые вы предлагаете проверять одной библиотечной функцией.

[ShaggyDoc]

Поясняю, как использовать библиотечную функцию ru-dcl-check-tile-param для контроля ввода во множестве программ.
Библиотечная - это функция, которая уже находится в памяти, наподобие штатных. Т.е. она доступна всегда, в любой программе.

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

Ввод описан в соответствующих action_tile:

Код:

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

 ...
 (action_tile "ed_hole_length" "(_edit_length)(_set_tiles)")
 (action_tile "ed_hole_width" "(_edit_width)(_set_tiles)")
 (action_tile "ed_level" "(_edit_level)(_set_tiles)")
...

Здесь (_set_tiles) - вызов локальной функции заполнения полей диалогового окна через set_tile. Вызывается после действия в каждом action_tile. Не привожу, чтобы не отвлекать на второстепенное.

Контроль ввода спрятан в локальные функции _edit_*:

Код:

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

  (defun _edit_length ()
  (setq *hole_length
        (ru-dcl-check-tile-param
         "ed_hole_length"
         "Длина"
         50
         6000.0
         *hole_length
         0
         "button_do"
        )
  )
 )

 (defun _edit_width ()
  (setq *hole_width
        (ru-dcl-check-tile-param
         "ed_hole_width"
         "Ширина"
         0
         6000.0
         *hole_width
         0
         "button_do"
        )
  )
 )

 (defun _edit_level ()
  (setq *level_floor
        (ru-dcl-check-tile-param
         "ed_level"
         "Отметка"
         -100000
         100000
         *level_floor
         0
         "button_do"
        )
  )
 )

Зачем это спрятано в локальные функции, а не записано просто в action_tile? Да для удобства и надежности. Конечно, можно написать и:

Код:

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

 (action_tile
    "ed_hole_length"
    "(setq *hole_length (ru-dcl-check-tile-param \"ed_hole_length\" \"Длина\" 50 6000.0 *hole_length 0 \"button_do\"))(_set-tiles)"
)

результат будет аналогичный. Но формировать строку внутри строки неудобно - обратите снимание на слэши перед кавычками. Здесь легко ошибиться, поэтому лучше спрятать в функции. Да и код основной программы получается более ясный и лаконичный.

[Disney]

Сообщение от ShaggyDoc Но формировать строку внутри строки неудобно

а так

Код:

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

 (action_tile
  "ed_hole_length"
  (vl-prin1-to-string
    (quote
      (progn
	(setq *hole_length
	       (ru-dcl-check-tile-param
		 "ed_hole_length"
		 "Длина"
		 50
		 6000.0
		 *hole_length
		 0
		 "button_do"
		)
	)
	(_set-tiles)
      )
    )
  )
)

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

[Do$]

Можно полностью отказался от action_tile и пользоваться функцией отклика диалога, которая указывается третим аргументом функции new_dialog. А в ней уже обрабатывать события, используя переменные действия диалога. В таком варианте вопросов по формированию строки вообще не возникает.

[alex8888]

Do$

Можно полностью отказался от action_tile

,
примерчик можно?
Offtop: Достаточно актуально для меня по крайней мере.

[Disney]

Сообщение от Do$ пользоваться функцией отклика диалога, которая указывается третим аргументом функции new_dialog. В таком варианте вопросов по формированию строки вообще не возникает.

А не чего, что этот третий аргумент является строкой?

[ShaggyDoc]

а так

Всяко можно. И сзаду и спереду. Но обрати внимание, ты последовательно вызываешь три ненужных "технологически" функции vl-prin1-to-string, quote и progn и только ради того, чтобы сделать код более запутанным.

Ну, и попробуй, какой будет получаться результат, учитывая последовательное применение функций. А ведь в action_tile надо всего лишь передать имя в виде строки. Или выражение, которое надо выполнить. На других языках сделать это чрезвычайно сложно.

[Do$]

Сообщение от alex8888 примерчик можно?

http://forum.dwg.ru/showthread.php?p=465226 начиная с #14.

Сообщение от Disney А не чего, что этот третий аргумент является строкой?

Напрягает маленько, но терплю

[gomer]

Сообщение от ShaggyDoc обрати внимание, ты последовательно вызываешь три ненужных "технологически" функции vl-prin1-to-string, quote и progn и только ради того, чтобы сделать код более запутанным.

Это "ООП"! ну, не создавать же местные лямбды и дефуны

[gizmo_zx]

Помогите доработать "dictedit".
Чтоб удалить все связи словаря "Datalink" за раз по нажатию "Delete" (их уже сотни).

[ALFMario]

НЕ могу понять почему код не работает с аннотативными размерами

Код:

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

   (defun C:DLA ( / ss i pt1 pt2 lst e1 ed mpt ang90 pt14 Isrus *error*)
  (defun *error* (msg)(princ msg)
 (vla-endundomark(vla-get-activedocument (vlax-get-acad-object)))) ;_ end of defun
  (vl-load-com)
  (vla-startundomark(vla-get-activedocument (vlax-get-acad-object)))
 (setq Isrus (= (getvar "DWGCODEPAGE") "ANSI_1251"))
  (setq e1 nil mpt 1) 
   (while mpt
     (cond ((= mpt 1)
            (setq e1 (car(entsel (if Isrus  "Выберите эталонный размер <указать точку>:"
				            "Select source dimension <pick point>:"
				   ))))
            (if e1
              (if (and (=(cdr(assoc 0 (setq ed (entget e1)))) "DIMENSION")
                       (member '(100 . "AcDbAlignedDimension")ed)
                       )
                (progn
                (setq mpt nil)
                (setq pt1 (cdr(assoc 10 ed)))
                )
		(if Isrus
		  (princ "\nНужно выбрать линейный размер")
		  (princ "\nNeed linear or aligned dimension")
		  )
                )
              (setq mpt 2)
              )
            )
           ((= mpt 2)
            (if(setq pt1 (getpoint (if Isrus
				     "\nУкажите точку выравнивания <выбрать размер>:"
				     "\nPick align point <select dimension>:"
				     )))
              (setq pt1 (trans pt1 1 0) mpt nil)
              (setq mpt 1)
              )
            )
           (t nil)
           )
     )
  (princ (if Isrus "\nВыберите размеры для варавнивания" "\nSelect the dimensions for alignment"))
  (if (setq ss (ssget "_:L" '((0 . "DIMENSION"))))
  (progn
  (setq i '-1)
  (repeat (sslength ss)
    (setq e1  (ssname ss (setq i (1+ i))))
    (if (member '(100 . "AcDbAlignedDimension")(setq ed(entget e1)))
      (progn
        (setq pt2 (polar pt1 (+ (setq ang90 (angle (cdr(assoc 10 ed))(cdr(assoc 14 ed))))(* 0.5 pi)) 1e3))
        (if (and
              (setq mpt (inters pt1 pt2
                                (cdr(assoc 10 ed))
                                (polar (cdr(assoc 10 ed)) ang90 1e3)
                                nil
                                )
                    )
              (setq ed (subst (cons 10 mpt)(assoc 10 ed) ed)) 
               )
          (progn
            (entmake ed)
            (entupd e1)
            )
                                
      )
      )
    )
    )
  )
  )
  (setq ss nil)
(vla-endundomark(vla-get-activedocument (vlax-get-acad-object)))    
  (princ)
  )

[gomer]

наверное из-за смайлика в названии

[ALFMario]

пробовал рисовать не смайлик, всё равно не аннотацие размера не работает

[VVA]

ALFMario, приложи файл с примером где не работает

[gomer]

Повторюсь здесь... ну очень уж интересная задачка... Вот условие...

На железнодорожных путях стоит товарный состав состоящий из цистерн и товарных вагонов. Определить сколько цистерн в составе и первую максимальную по количеству цистерн цепочку, ее начало и длину.
Состав может выглядеть так: '( 0 0 1 0 1 1 1 0 0 0 1 1 0 0 1 1 1 ... )
'( 0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1 ... ) общий случай, когда в нем не только цистерны и вагоны... где 1 - цистерны, 0 - вагоны 2 ... - еще чего нибудь прицепили
Нужно решение именно на лиспе ...

[Disney]

Сообщение от gomer ну очень уж интересная задачка...

Вполне простая задачка, другой вопрос как её максимально изящно решить в пару действий...
вот мой вариант:

Код:

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

 (defun Search_for_tanks (train / pos count result cistern)
;;;  (Search_for_tanks '( 0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1))
  (setq
     pos 1
      count 0)
(while train
  (setq flag (eq (car train)1)
	train (cdr train))
  (cond
    ((and (not train)cistern flag)
     (setq result (cons (list pos (1+ count)) result)))     
    ((and cistern flag)
     (setq count (1+ count)))
    (flag
     (setq count 1
	   cistern t))
    (cistern
     (setq result (cons (list pos count) result)
	   pos (+ pos count 1)
	   cistern nil))
    (t (setq pos (1+ pos)
	     count 0))))
(setq max_chain (car(vl-sort (reverse result)(function(lambda (x y)(> (cadr x)(cadr y)))))))
(princ (strcat"\nВсего цистерн " (itoa (apply '+ (mapcar 'cadr result)))", первая максимальная цепочка начинается с " (itoa (car max_chain))"-ой позиции, и состоит из "(itoa (cadr max_chain))" цистерн"))
  )

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

http://forum.dwg.ru/showpost.php?p=739916&postcount=8

[gomer]

Сообщение от Кулик Алексей aka kpblc http://forum.dwg.ru/showpost.php?p=739916&postcount=8

Я специально выбрал именно эту тему... так как интересовало решение именно на лиспе... воть
Хотелось бы увидеть решение от Димы_ ... ... ...
Disney, пасиб... и hwd тоже...
Мое решение...
1. Сгруппировать вагоны и цистерны по спискам:
'((0 0) (1) (0) ... )
2. найти максимальный по длине, а заодно и его длину
3. отрезать его вместе с хвостом
4. собрать остальное и вычислить длину получившегося списка...
Вопрос собственно в том, как объединить по п.1

[Disney]

Сообщение от gomer Сгруппировать вагоны и цистерны по спискам: '((0 0) (1) (0) ... )

gomer, я тебе удивляюсь, там же совсем всё просто, или тебе рекурсии ни как покоя не дают?

Код:

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

 ;;;(group_values '(0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1))
(defun group_values (_list / first temp_list next res_list)
  (while _list
    (setq
      first	(car _list)
      temp_list	(list first)
    )
    (while (eq first (setq next (cadr _list)))
      (setq temp_list (cons next temp_list)
	    _list     (cdr _list)
      )
    )
    (setq res_list (cons temp_list res_list)
	  _list	   (cdr _list)
    )
  )
  (reverse res_list)
)

, я бы тоже посмотрел на рекурсивную функцию, причем заменить каждый while на отдельные fun_rec не проблема, а вот как задачу решить через одну fun_rec без использования циклов внутри неё, где-то на уме крутиться, а в код ни как не ложиться.

[TararykovDG]

У меня вот такой вариант. Без рекурсии правда, но и без вложенного цикла.

Код:

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

 
(defun test(lst_in / lst_current lst_out)
  (setq lst_current (list (car lst_in)))
  (foreach item (cdr lst_in)
    (if (= item (last lst_current))
      (setq lst_current (cons item lst_current))
      (setq lst_out (append lst_out (list lst_current))
	    lst_current (list item)
	    )
      )
    )
  lst_out
  )

_$ (test '(0 0 1 0 1 1 1 0 0 0 1 2 1 1 0 0 1 1 1))
((0 0) (1) (0) (1 1 1) (0 0 0) (1) (2) (1 1) (0 0))