[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

_____________________________________________________________________________________________________________

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

[ShaggyDoc]

я немного о другом спрашивал... в примере создал объект и запомнил его в переменной. И потом построчно менял свойства объекта... полагаю можно обойтись без переменной

А я специально на другое внимание обратил - на надежность. Что касается свойств, то в объектной модели AutoCAD сделано именно так ("по-бейсиковски")- сначала надо объект создать, получить указатель на него, а пото менять какие-то свойства. Здесь нет смысла пытаться избавиться от переменной, да это и не получится для нескольких свойств.

vla-item возвращает либо нужный слой, либо ошибку и абзац...

Ошибка - это тоже ответ. А чтобы его использовать и не довести до "абзаца", надо применять ловушку ошибок с помощью vl-catch-all-apply, vl-catch-all-error-p. В моем примере ru-error-catch - это оболочка для ошибок, подобная try ... except ... end в других языках.

Т.е. делается попытка выполнить какое-то выражение после try, а если произойдет ошибка по любой причине, то выполнится выражение между except и end.

[Vladimir_Sergeevich]

Сообщение от ShaggyDoc подобная try ... except ... end в других языках.

других языков не знаю, кроме азов паскаля из школьного курса...
про ловушку ошибок, в принципе, понял, что сначала объект создается тоже... мне было интересно можно ли этот указатель на объект передать сразу нескольким функциям. суть то (vla-put-property [содал объект] 'свойство [значение] ) только "'свойство [значение]" сразу списком передать, а не через переменную

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

Vladimir_Sergeevich, как один из вариантов "передачи массы аргументов": http://autolisp.ru/2009/10/21/lisp-overloading/

[ShaggyDoc]

мне было интересно можно ли этот указатель на объект передать сразу нескольким функциям. суть то (vla-put-property [содал объект] 'свойство [значение] ) только "'свойство [значение]" сразу списком передать, а не через переменную

В AutoCAD "ActiveX" объекты и работа с ними простроены не "по-лисповски", а в соответствии с теорией объектно-ориентированного программирования. Т.е. объект надо сначала создать (и запомнить указатель на него в переменной), а только потом назначать ему свойства и применять методы. Можно было бы и сразу сделать создание объекта и назначение свойств в "одном действии", но это бы противоречило теоретическим постулатам. Да и вся объектная модель делалась под VBA.

Функции, наподобие vla-addline - это тоже дополнительные оболочки, пришпандоренные внутри AutoCAD. Можно было бы вызывать (vla-add 'Line ...), но это совсем не по-лисповски. Но LISP хорош тем, что внутри его функций можно спрятать, что угодно.

В приведенной мной функции (ru-line-add start_pnt end_pnt lineweight ltype) спрятано построение отрезка объектным методом. И никто (без исходников) не знает, как именно это сделано, используются ли локальные переменные. А можно было бы и через command и через entmake внутри функции отрезок создавать. Передавать свойства можно и списком (лисповским), но в случае ограниченного количества свойств в этом нет смысла - себе дороже будет этот список разбирать. А вот для полилинии координаты надо передавать именно списком, т.к. их количество может быть произвольным, наподобие (ru-pline-add points is_closed width lineweight ltype).

[Дима_]

Сообщение от ShaggyDoc Можно было бы и сразу сделать создание объекта и назначение свойств в "одном действии", но это бы противоречило теоретическим постулатам.

Это каким постулатам? ИХМО VisualLisp реализован так только из-за лени программистов его создавших. Все постулаты ООП прекрасно реализуются в функциональных языках (если быть точнее, то функциональную парадигму можно лекго урезать - ввести ограничения - до ООП).

[kha]

Дима_, спасибо за замечания

Сделал проверку на функцию msg-yes-no в начале программы, запоминание и восстановление переменной

Сейчас увидел, что программа не взрывает объекты внутри блоков и массивов, буду развивать дальше.

з.ы. Не партесь - все бы так как Вы программировали...

Приятно читать. Это только благодаря форуму и книгам Полещука.
Сначала подстраивал программы с форума под свои нужды, а где-то месяц назад сам начал писать.

Код:

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

 (defun C:kha_spds_explode ( / ss i obj_name var)
(if (bg:msg-yes-no "Внимание" "Все объекты SPDS GraphiCS будут взорваны !!!\nПродолжить?")
  (progn
  (setq i 0)
  (if (setq ss (ssget "_x"))
    (repeat (sslength ss)
      (setq obj_name (cdr (assoc 0 (entget (ssname ss i)))))
      (if (or (= obj_name "mcsPseudoLine") (= obj_name "mcsPseudoPolyline") (wcmatch obj_name "SPDS*"))
	(setq i (1+ i))
	(setq ss (ssdel (ssname ss i) ss))
	) ; end if
      ) ; end repeat
    ) ; end if
  (if (not (= (sslength ss) 0))
    (progn
      (setq var (getvar "qaflags"))
      (setvar "qaflags" 1)
      (command "_.explode" ss "")
      (setvar "qaflags" var)
      ) ; end progn
    (print "Отсутствуют объекты СПДС GraphiCS")
    ) ; end if
   ) ; end progn
  ) ; end if
  (princ)
  ) ; end defun

(defun bg:msg-yes-no ( title message / WScript ret)
(setq WScript (vlax-get-or-create-object "WScript.Shell"))
(setq ret (vlax-invoke-method WScript "Popup" message "0" title (+ 4 48)))
(vlax-release-object WScript)
(= ret 6)  
)

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

Как вариант, без проверок (поскольку СПДС GraphiCS нету):

Код:

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

 (defun c:kha_spds_explode (/ adoc fun_conv-vla-to-list layerstatus)

  (defun fun_conv-vla-to-list (value / res)
                              ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((= (type value) 'variant)
       (fun_conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (fun_conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (member (type value) (list 'ename 'str 'vla-object))
            (= (type value) 'vla-object)
            (vlax-property-available-p value 'count)
            ) ;_ end of and
       (vlax-for sub value
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       res
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (if (bg:msg-yes-no "Внимание" "Все объекты SPDS GraphiCS будут взорваны !!!\nПродолжить?")
    (progn
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (setq layerstatus
             (mapcar
               (function
                 (lambda (x)
                   (list x
                         (mapcar
                           (function
                             (lambda (prop / tmp)
                               (setq tmp (vlax-get-property x (car prop)))
                               (vl-catch-all-apply
                                 (function
                                   (lambda ()
                                     (vlax-put-property x (car prop) (cdr prop))
                                     ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                               (cons (car prop) tmp)
                               ) ;_ end of lambda
                             ) ;_ end of function
                           (list (cons "freeze" :vlax-false)
                                 (cons "lock" :vlax-false)
                                 ) ;_ end of list
                           ) ;_ end of mapcar
                         ) ;_ end of list
                   ) ;_ end of lambda
                 ) ;_ end of function
               (vl-remove-if
                 (function
                   (lambda (x)
                     (wcmatch (vla-get-name x) "*|*")
                     ) ;_ end of lambda
                   ) ;_ end of function
                 (fun_conv-vla-to-list (vla-get-layers adoc))
                 ) ;_ end of vl-remove-if
               ) ;_ end of mapcar
            ) ;_ end of setq
      (vlax-for blk_def (vla-get-blocks adoc)
        (if (equal (vla-get-isxref blk_def) :vlax-false)
          (vlax-for ent blk_def
            (if (and (wcmatch (strcase (vla-get-objectname ent)) "MCS*,SPDS*")
                     (vlax-method-applicable-p ent 'explode)
                     ) ;_ end of and
              (progn
                (vla-explode ent)
                (if (and ent
                         (not (vlax-erased-p ent))
                         ) ;_ end of and
                  (vla-erase ent)
                  ) ;_ end of if
                ) ;_ end of progn
              ) ;_ end of if
            ) ;_ end of vlax-for
          ) ;_ end of if
        ) ;_ end of vlax-for
      (foreach item layerstatus
        (foreach prop (cdr item)
          (vl-catch-all-apply
            (function
              (lambda ()
                (vlax-put-property (car item) (car prop) (cdr prop))
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of foreach
        ) ;_ end of foreach
      (vla-endundomark adoc)
      ) ;_ end of progn
    (princ "\nДействие отменено")
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

(defun bg:msg-yes-no (title message / wscript ret)
  (setq wscript (vlax-get-or-create-object "WScript.Shell"))
  (setq ret (vlax-invoke-method wscript "Popup" message "0" title (+ 4 48)))
  (vlax-release-object wscript)
  (= ret 6)
  ) ;_ end of defun

Код написан "насухую", так что не обессудь ))

[ShaggyDoc]

ИХМО VisualLisp реализован так только из-за лени программистов его создавших

Когда сам AutoCAD писали и COM-сервер в него встраивали о VisualLisp вообще и не думали. Я так думаю. Шли стандартным путем - объект, свойства, методы. Это позволяет на любых языках программы писать. Ну а потом уже к Лисп стали приспосабливать к созданной объектной модели.

Хотя далеко не всегда надо именно объекты создавать - можно и обычными функциями обойтись. Ну и конечно, если бы не лень - из VisualLisp можно было бы "конфетку сделать". А они даже поленились свой редактор сделать и купили VitalLisp для основы. А могли бы многое сделать, например DCL на XAML заменить.

[kha]

Кулик Алексей aka kpblc , спасибо!

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

[Дима_]

Сообщение от ShaggyDoc Ну а потом уже к Лисп стали приспосабливать к созданной объектной модели.

Я не про то, что объектная модель автокада лежит не в идеологии функционального программирования (например vla-addCircle - возрващает ссылку на новый круг, а если разрабатывать с точки зрения функционального подхода, то она бы должна была возратить ссылку на новую, readonly, копию блока к которому она уже применена - modelSpace например - с кругом внутри - по типу cons в лиспе - что давло бы возможность использовать совместно с ней всю гибкость лиспа - но, в то же время, вывернуло мозги набекрень всей "классической" школе). Лисп можно гораздо лучше "пристроить" и к императивной объектной модели (той что в автокад) - см. например CLOS.

[gomer]

не забывайте про entmake, который может создать слой без всякий рекурсий

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

Ага, может. Только настройки такого созданного слоя могут быть немного неожиданными
Я немного расковыривал эти вещи: http://autolisp.ru/2014/03/05/base-s...rs-anf-styles/

[gomer]

Кулик Алексей aka kpblc, подскажи чем отличается мой код

Код:

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

     (vlax-for blk_def (vla-get-blocks
                         (vla-get-activedocument (vlax-get-acad-object))
                      )
      (if (eq :vlax-false (vla-get-isxref blk_def))
        (vlax-for subent blk_def
          (if (= "AcDb3dSolid" (vla-get-objectname subent))
            (vl-catch-all-apply
              'entdel
              (list
                  (cdr (assoc 350
                              (entget (vlax-vla-object->ename subent))))
              )
            )
          )
        )
      )
    )

сделанный из твоего?

Код:

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

     (progn
      (vlax-for blk_def (vla-get-blocks adoc)
        (if (equal (vla-get-isxref blk_def) :vlax-false)
          (vlax-for subent blk_def
            (if (= (vla-get-objectname subent) "AcDb3dSolid")
              (setq ent_lst (cons (vlax-vla-object->ename subent) ent_lst))
              ) ;_ end of if
            ) ;_ end of vlax-for
          ) ;_ end of if
        ) ;_ end of vlax-for
      (foreach ent ent_lst
        (if (and (cdr (assoc 350 (entget ent)))
                 (not (vl-catch-all-error-p
                        (vl-catch-all-apply
                          (function
                            (lambda () (entget (cdr (assoc 350 (entget ent)))))
                            ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                        ) ;_ end of vl-catch-all-error-p
                      ) ;_ end of not
                 (entget (cdr (assoc 350 (entget ent))))
                 ) ;_ end of and
          (entdel (cdr (assoc 350 (entget ent))))
          ) ;_ end of if
        ) ;_ end of foreach
      (setq ent_lst nil)
      ) ;_ end of progn

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

Твой код значительно короче

[Дима_]

У Крыса просто почерк размашистый...

[Vladimir_Sergeevich]

И снова я с глупыми вопросами
хочу рисовать кучу размеров автоматом по двум точкам... Для этого сделал функцию отрисовки этого самого размера.

Код:

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

 (defun create-dim-rotated (pv pn pk adim/ )
(entmakex (list
    (cons 0 "DIMENSION") ;*
    (cons 100 "AcDbEntity") ;*
    (cons 100 "AcDbDimension") ;*
    (cons 10 pv)   
    (cons 70 32) ;*
    (cons 51 adim)
    (cons 3 "2-100")
    (cons 100 "AcDbAlignedDimension") ;*
    (cons 13 pn)
    (cons 14 pk)
    (cons 50 adim)
    (cons 100 "AcDbRotatedDimension") ;*
   )
) ;_ end of entmakex
);end create-dim-rotated

Проблема: работает через раз и не понимаю почему.
примерная хронология:
1. написал для первых четырех - все как надо отрисовало
2. добавил пятый размер - не работает
3. удалил его к лешему (точнее сначала закомментил) - все равно не хочет
В том виде как в п.1 тоже с бубна только пошло...
Вызов функции (create-dim-rotated p-vline p-ntr p-ktr a-dim), где p-vline, p-ntr, p-ktr - точки которые расчитываются для каждого, a-dim - угол поворота размера (в моем случае 20‰)

з.ы. приложил файло - красным покрасил размерчики отрисованные программой

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

замени adim/ на adim /

[Vladimir_Sergeevich]

Сообщение от Кулик Алексей aka kpblc замени adim/ на adim /

Ни в жизнь бы не догатался там косяк искать. Спасбо

[gomer]

Сообщение от Vladimir_Sergeevich Ни в жизнь бы не догатался

Так надо читать сообщения об ошибках...

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

Я на подобные "грабли" наступал достаточно часто (особенно со старыми клавиатурами), так что опыт есть