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

_____________________________________________________________________________________________________________

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

Konstnt16 · 24.01.2025, 09:51

Добрый день, у меня проблема с неправильной отрисовкой штриховки, после внимательного изучения проблему установил что проблема проявляется у тех штриховок у которых граница полилиния и Флаг замкнутости установлен в 0.
Посмотрите правильно ли я код из поста [4877"]https://forum.dwg.ru/showpost.php?p=2086777&postcount=4877[/url] переделал под свой случай

Код:

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

 (defun c:test (/ ss i a b new)
  ;; Выбор рамкой всех штриховок, у которых граница внешняя полилиния DXF код 92 - 7
  (setq ss (ssget '((0 . "HATCH") (92 . 7))))
  (repeat (setq i (sslength ss))
    ;; Установка Флага замкнутости в 1
    (setq a (ssname ss (setq i (1- i))))
    (setq b (entget a))
    (setq new (subst '(73 . 1) (assoc 73 b) b))
    (entmod new)
  ) ;_ end repeat
  (princ)
) ;_ end defun

P.S. Проверил, работает. Спасибо name02 за исходный код.

===AAA=== · 24.01.2025, 14:16

Стандартный виндосовский "Блокнот" автоматически правильно отображает
кодировку русских символов - что UTF-8, что ANSI.

Дело в том, что в самом начале файла UTF-текста находятся спецсимволы,
которые не отображаются на экране, но которые дают понять программе
(в нашем случае - "Блокноту"), как нужно показывать очертания символов.

Из-за этого и получается путаница.

Вроде в "Блокноте" всё хорошо, а в Автокаде - ерунда.

Нужно именно преобразовывать кодировку, но стандартный "Блокнот" для этого не годится.
Нужен или Notepad++ или другой текстовый редактор, который умеет это дело.

Moi Imena · 30.01.2025, 08:51

Вопрос может глупый, почему нельзя вызвать команду BURST из экспресс тулс, с помощью лисп ?
(defun c:burstselected ()
(setq ss (ssget))
(if ss
(command "_BURST" ss ""))
(princ)
)

Кулик Алексей aka kpblc · 30.01.2025, 09:23

А если поискать... К примеру, https://forum.dwg.ru/showpost.php?p=593640&postcount=11 + https://forum.dwg.ru/showpost.php?p=1811175&postcount=7 и тому подобные темы по поиску "burst lisp", к примеру

Ingpro · 07.02.2025, 10:55

По идее код должен сработать в фоновом режиме (назначить слои объектам), но что-то идет не так:
Команда: PLACEOBJLAY
._LAYER
Текущий слой: "Размеры"
Задайте параметр [?/Создать/Установить/Новый/ПЕРеименоватЬ/Вкл/Откл/Цвет/Тип/вЕс/пРозрачность/Материал/пеЧать/Заморозить/РАзморозить/Блок/рАзблок/Конфигурация/опИсание/соГласовать/ВНешняя ссылка]: _New
Имя нового слоя(ев): Circle-all Задайте параметр [?/Создать/Установить/Новый/ПЕРеименоватЬ/Вкл/Откл/Цвет/Тип/вЕс/пРозрачность/Материал/пеЧать/Заморозить/РАзморозить/Блок/рАзблок/Конфигурация/опИсание/соГласовать/ВНешняя ссылка]: _Color
Новый цвет [изПалитры/Альбом] : 230
Неправильное ключевое слово.
; ошибка: Функция прервана.

Код:

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

 ;; создать слой и поместить на него объекты
(defun c:PlaceObjLay (/ ssCircles ssLines ssPlines ssText ssMtext)

  (defun CreateOrUpdateLayer (layerName layerColor)
    (if (not (tblsearch "LAYER" layerName))
 
      (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "")
         (command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) "")
    )
  )

  (CreateOrUpdateLayer "Circle-all" 230)
 
  (setq ssCircles (ssget "_X" '((0 . "CIRCLE"))))
  (if ssCircles
    (command "._CHANGE" ssCircles "" "_Properties" "_LA" "Circle-all" "")
  )
  
  (princ)
)

И появляется выбор свойств для слоя, хотя не должен... Как можно вылечить, плз...
Как-то странно получается: слой 0 становится цветом 230, а слой "Circle-all" создается, но черным цветом...

name02 · 07.02.2025, 12:53

Запусти в автокаде команду (command "._LAYER" "_New" "Circle-all" "_Color" 250) и посмотри, что тебе предлагает автокад для ввода по умолчанию

Ingpro · 07.02.2025, 13:36

Цитата:

Сообщение от name02

Запусти в автокаде команду (command "._LAYER" "_New" "Circle-all" "_Color" 250) и посмотри, что тебе предлагает автокад для ввода по умолчанию

Предлагает
Список имен слоев для присвоения цвета 250 <Line_obr>:
Нужно повторить имя слоя или как? А если слоя нет?

name02 · 07.02.2025, 13:38

Ingpro · 07.02.2025, 13:44

но у меня в коде такой строки нет...
(command "._LAYER" "_New" "Circle-all" "_Color" 250)

name02 · 07.02.2025, 13:51

Да, нет. Зато у тебя есть (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "") и после указания цвета, автокад спрашивает, какому слою его назначить - и по умолчанию предлагает имя активного слоя.
Ты же на это не обращаешь внимание и "жмешь" ввод, а надо дать имя layerName!

Ingpro · 07.02.2025, 14:01

Цитата:

Сообщение от name02

Да, нет. Зато у тебя есть (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "") и после указания цвета, автокад спрашивает, какому слою его назначить - и по умолчанию предлагает имя активного слоя.

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

Код:

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

  ;; создать слой и поместить на него объекты
(defun c:PlaceObjLay (/ ssCircles ssLines ssPlines ssText ssMtext)

  (defun CreateOrUpdateLayer (layerName layerColor)
    (if (not (tblsearch "LAYER" layerName))
 
      (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "")
         (command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) "")
    )
  )

  (CreateOrUpdateLayer "Circle-all" 230)
 (CreateOrUpdateLayer "Line-all" 5)

  (setq ssCircles (ssget "_X" '((0 . "CIRCLE"))))
  (if ssCircles
    (command "._CHANGE" ssCircles "" "_Properties" "_LA" "Circle-all" "")
  )
 
 (setq ssLines (ssget "_X" '((0 . "LINE"))))
  (if ssLines
    (command "._CHANGE" ssLines "" "_Properties" "_LA" "Line-all" "")
  )

  (princ)
)

name02 · 07.02.2025, 14:44

Сделай так что-ли (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) layerName "")

Кулик Алексей aka kpblc · 07.02.2025, 14:52

Я б сделал, наверное, отдельную функцию, в которую передавать список точечных пар "Тип объекта" - "Имя слоя". По-быстрому накидал, особо не тестировал:

Код:

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

 (vl-load-com)

(defun c:place-obj-to-layers (/ _kpblc-conv-vla-to-list fun_save-layers-status fun_restore-layers-status fun_change-objects fun_create-layer adoc ent_layer_list
                              layer_status
                             )

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
    *    Конвертация vla в список
    *    Параметры вызова:
      value  ; преобразовываемое значение
    |;
    (cond ((listp value)
           (mapcar (function _kpblc-conv-vla-to-list) value)
          )
          ((= (type value) 'variant)
           (_kpblc-conv-vla-to-list (vlax-variant-value value))
          )
          ((= (type value) 'safearray)
           (if (>= (vlax-safearray-get-u-bound value 1) 0)
             (_kpblc-conv-vla-to-list (vlax-safearray->list value))
           ) ;_ end of if
          )
          ((and (= (type value) 'vla-object)
                (vlax-property-available-p value 'count)
           ) ;_ end of and
           (vlax-for sub value (setq res (cons sub res)))
          ) ;_ end of cond
          (t value)
    ) ;_ end of cond
  ) ;_ end of defun

  (defun fun_save-layers-status (doc / res)
                                ;|
    *    Функция сохранения статуса слоев с одновременной их разблокировкой и разморозкой
    *    Параметры вызова:
      doc   ; документ, для которого надо выполнять обработку
    |;
    (mapcar
      (function
        (lambda (layer)
          (cons layer
                (mapcar
                  (function
                    (lambda (prop / temp)
                      (setq temp (vlax-get-property layer prop))
                      (vl-catch-all-apply
                        (function
                          (lambda ()
                            (vlax-put-property layer prop :vlax-false)
                          ) ;_ end of lambda
                        ) ;_ end of function
                      ) ;_ end of vl-catch-all-apply
                    ) ;_ end of lambda
                  ) ;_ end of function
                  '("freeze" "lock")
                ) ;_ end of mapcar
          ) ;_ end of cons
        ) ;_ end of lambda
      ) ;_ end of function
      (_kpblc-conv-vla-to-list (vla-get-layers doc))
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun fun_restore-layers-status (doc status)
                                   ;|
    *    Функция восстановления статуса слоев
    *    Параметры вызова:
      doc    ; обрабатываемый документ
      status ; ранее сохраненный список состояний слоев.
    *    ПРИМЕЧАНИЕ. Может сгенерировать ошибку, если в процессе слой из списка был удален / переименован
    |;
    (foreach item status
      (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
  ) ;_ end of defun

  (defun fun_change-objects (doc param-list / item objtype)
                            ;|
    *    Функция смены слоя для примитивов
    *    Параметры вызова:
      doc        ; документ, в котором выполняется обработка
      param-list ; список параметров вида
        '((<Тип объекта как для SSGET> . <Имя устанавливаемого слоя>)
          (<Тип объекта как для SSGET> . <Имя устанавливаемого слоя>)
          ..
          )            
    |;
    (setq param-list
           (mapcar
             (function
               (lambda (x)
                 (cons (strcase (car x)) (cdr x))
               ) ;_ end of lambda
             ) ;_ end of function
             param-list
           ) ;_ end of mapcar
    ) ;_ end of setq
    (vlax-for block_def (vla-get-blocks doc)
      (vlax-for ent block_def
        (setq objtype (substr (strcase (vla-get-objectname ent)) 5))
        (if (and (setq item (assoc objtype param-list))
                 (setq item (cdr item))
            ) ;_ end of and
          (vla-put-layer ent item)
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of vlax-for
  ) ;_ end of defun

  (defun fun_create-layer (doc name layer-list / res)
                          ;|
    *    Функция создания слоя с настройками
    *    Параметры вызова:
      doc        ; указатель на документ, с которым выполняется работа
      name       ; имя создаваемого слоя
      layer-list ; список настроек слоя вида
      '(("description" . <Описание слоя>)
        ("lineweight" . <Вес линии>)
        ("linetype" . <Тип линии>) ; Тип линии должен быть уже загружен в документ
        )
    |;
    (setq res (vla-add (vla-get-layers doc) name))
    (foreach prop layer-list
      (vl-catch-all-apply
        (function
          (lambda ()
            (vlax-put-property res (car prop) (cdr prop))
          ) ;_ end of lambda
        ) ;_ end of function
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of foreach
    res
  ) ;_ end of defun

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)

  (setq ent_layer_list
                       (list (cons "line"
                                   (fun_create-layer
                                     adoc
                                     "Layer-for-lines"
                                     (list (cons "color" 1)
                                           (cons "lineweight" aclnwt025)
                                     ) ;_ end of list
                                   ) ;_ end of fun_create-layer
                             ) ;_ end of cons
                             (cons "circle"
                                   (fun_create-layer
                                     adoc
                                     "Layer-for-circles"
                                     (list (cons "color" 3)
                                           (cons "lineweight" aclnwt053)
                                     ) ;_ end of list
                                   ) ;_ end of fun_create-layer
                             ) ;_ end of cons
                       ) ;_ end of list
        ent_layer_list (mapcar
                         (function
                           (lambda (x)
                             (cons (car x) (vla-get-name (cdr x)))
                           ) ;_ end of lambda
                         ) ;_ end of function
                         ent_layer_list
                       ) ;_ end of mapcar
  ) ;_ end of setq

  (setq layer_status (fun_save-layers-status adoc))
  (fun_change-objects adoc ent_layer_list)
  (fun_restore-layers-status adoc layer_status)

  (vla-endundomark adoc)
  (princ)

) ;_ end of defun

----- добавлено через ~3 мин. -----
Выглядит стремно, согласен - но основной код команды занимает всего ничего ) И в принципе (надеюсь) понятно, что за чем идет, в какой последовательности, и кому и как передается

Ingpro · 07.02.2025, 15:11

Цитата:

Сообщение от Кулик Алексей aka kpblc

Я б сделал, наверное, отдельную функцию, в которую передавать список точечных пар "Тип объекта" - "Имя слоя". По-быстрому накидал, особо не тестировал:

Алексей, Ваш код сработал, спасибо!

Цитата:

Сообщение от name02

Сделай так что-ли (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) layerName "")

Это тоже вроде сработало, ещё потестирую, спасибо, name02!
Заменяю 2 строки и -ура!- работает!

Код:

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

   ;; создать слои и поместить на них объекты
(defun c:PlaceObjLay-name02 (/ ssCircles ssLines ssPlines ssText ssMtext)

  (defun CreateOrUpdateLayer (layerName layerColor)
    (if (not (tblsearch "LAYER" layerName))
 
      ; (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "")
      ; (command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) "")
(command "._LAYER" "_New" layerName "_Color" (itoa layerColor) layerName "")
(command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) layerName "")
    )
  )

  (CreateOrUpdateLayer "Circle-all" 230)
 (CreateOrUpdateLayer "Line-all" 5)

  (setq ssCircles (ssget "_X" '((0 . "CIRCLE"))))
  (if ssCircles
    (command "._CHANGE" ssCircles "" "_Properties" "_LA" "Circle-all" "")
  )
 
 (setq ssLines (ssget "_X" '((0 . "LINE"))))
  (if ssLines
    (command "._CHANGE" ssLines "" "_Properties" "_LA" "Line-all" "")
  )

  (princ)
)

Кулик Алексей aka kpblc · 07.02.2025, 15:48

ЕМНИП, для команды _.-layer есть еще и опция _make. Вроде бы и создает, и активирует слой сразу (проверить не могу, машину с кадом уже выключил).

Ingpro · 13.02.2025, 21:29

Я пытаюсь сделать обратное коду из поста #4865 (преобразовать тексты в отдельные мтексты)
Код расчленяет мтексты, но в ком. строке пишет: Неизвестная команда "MTXT2TXT"

Код:

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

 [(defun c:mtxt2txt (/ ss i old_sett doc *error* )
  (vl-load-com)

  (defun *error* (msg)
    (princ)
  ) ;_ end defun

  (setq ss       (ssget '((0 . "MTEXT")))
        old_sett (getvar 'CMDECHO)
        doc      (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end setq

  (vla-StartUndoMark doc)

  (setvar 'CMDECHO 0)

  (if ss
    (repeat (setq i (sslength ss))
      (vl-cmdf "_.EXPLODE" (ssname ss (setq i (1- i))) "")
    ) ;_ end repeat
  ) ;_ end if
(vl-cmdf "_justifytext" "_P" "" "_mc" "") ; ??
  (setvar 'CMDECHO old_sett)

  (vla-EndUndoMark doc)

  (princ)
) ;_ end defun

Ещё хочу выровнять тексты на "_mc":
(vl-cmdf "_justifytext" "_P" "" "_mc" "")
но выравнивается только один из выбранных...

koMon · 13.02.2025, 22:37

Цитата:

Сообщение от Ingpro

пытаюсь сделать обратное коду из поста #4865

Код:

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

 
(defun c:mtxt2txt (/ ss i old_sett doc *error* )
  (vl-load-com)

  (defun *error* (msg)
    (princ)
  ) ;_ end defun

  (setq ss       (ssget '((0 . "MTEXT")))
        old_sett (getvar 'CMDECHO)
        doc      (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end setq

  (vla-StartUndoMark doc)
  
  (setvar 'CMDECHO 0)
  
  (if ss
    (repeat (setq i (sslength ss))
      (vl-cmdf "_.EXPLODE" (ssname ss (setq i (1- i))))
      (vl-cmdf "_justifytext" "_P" "" "_mc")
    ) ;_ end repeat
  ) ;_ end if
 ; ??
  
  (setvar 'CMDECHO old_sett)
  
  (vla-EndUndoMark doc)
  (princ)
) ;_ end defun

Ingpro · 13.02.2025, 23:07

koMon, спасибо, скобочки...

Gretech89 · 16.02.2025, 19:19

Подскажите, пожалуйста, как грамотно реализовать?
Имеется список VLA-объектов (линии), имеется второй список VLA-объектов, который содержит в себе помимо прочих еще и объекты из списка №1. Как исключить из второго списка все объекты, содержащиеся в 1ом?

Кулик Алексей aka kpblc · 16.02.2025, 20:40

(vl-remove-if '(lambda(x) (member x first-list)) second-list) :?:

20.07.2008, 20:12	1 \|
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу) Red Nova ՃԱՐՏԱՐԱԳԵՏ, տ.գ.թ. Торонто Регистрация: 23.10.2007 Сообщений: 1,990 Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (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.
Просмотров: 2047452

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