[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

_____________________________________________________________________________________________________________

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

[1958]

Кто знает, в какой системной переменной хранится описание "ГИС координат" ?

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

Это что-то из Civil, скорее всего. И вряд ли на это есть системная переменная.

[1958]

Сообщение от Кулик Алексей aka kpblc Это что-то из Civil

Да, это задано в Civil. Но в голом автокаде тоже отображается. Так что где-то это прописано. Где?

[1958]

Команда: (getvar "CGEOCS")
"UTM84-42N"
Только чтение, а жаль.
Можно поиграться.
https://help.autodesk.com/view/ACD/2...6-DA4670D0F3FD

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

Сообщение от 1958 Но в голом автокаде тоже отображается.

В чистом ACAD - нет, насколько я знаю. Ты сначала в ACAD выстави demandload в 2, перегрузи - и смотри, отобразится или нет.

[1958]

Сообщение от Кулик Алексей aka kpblc в ACAD выстави demandload в 2, перегрузи - и смотри, отобразится или нет.

Отображается.

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

А, сорян. С этой ботвой толком не сталкивался

[Ingpro]

Код изменяет регистр всех!!! Текстов на чертеже (без выбора) на верхний.
Как правильно добавить выбор текстов (по одному и рамкой), и чтобы объекты (не тексты), попавшие в рамку выбора игнорировались
Я пытаюсь:

Код:

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

 (setq (ssget (quote ((0 . "TEXT")))) "")

выбор работает, но регистр не изменяется...

Код:

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

 (defun c:ch-cs ( / OLDLIST ALLENTS NXT ELIST OLDSLOPE SLOPE NEWTEXT N)
(SETVAR "CMDECHO" 0)

(defun *Error* (msg)
  (if (/= msg "Function cancelled")
    (princ (strcat "\nError: " msg))
  )
(terpri)
                         
  (setq *error* olderr)        
  (princ)
)

(if cont (exit))
(setq oldlist (list (CONS 0 "TEXT")))
(setq allents (ssget "_X"  oldlist))
(setq n 0)
(setq nxt (ssname allents n))
(while nxt
(Setq elist (entget nxt))
(setq oldslope (assoc 1 elist))
(setq slope (cdr oldslope))
          
          (setq newtext (cons 1 (strcase slope)))
          (setq elist (subst newtext oldslope elist)) 
          (entmod elist)
(setq n (+ 1 n))
(setq nxt (ssname allents n))
);endwhile
(princ)
);end
(princ)

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

Не страшно глобально обработчик ошибок переопределять? И системную переменную обратно не возвращать?

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

Код:

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

 (defun c:ch-cs (/ OLDLIST ALLENTS NXT ELIST OLDSLOPE SLOPE NEWTEXT N *error*) 
  (SETVAR "CMDECHO" 0)

  (defun *Error* (msg) 
    (if (/= msg "Function cancelled") 
      (princ (strcat "\nError: " msg))
    )
    (terpri)

    (setq *error* olderr)
    (princ)
  )

  (setq allents (ssget "_:L" '((0 . "TEXT")))
        n       0
        nxt     (ssname allents n)
  )
  (while nxt 
    (Setq elist (entget nxt))
    (setq oldslope (assoc 1 elist))
    (setq slope (cdr oldslope))

    (setq newtext (cons 1 (strcase slope)))
    (setq elist (subst newtext oldslope elist))
    (entmod elist)
    (setq n (+ 1 n))
    (setq nxt (ssname allents n))
  )
  (princ)
)
(princ)

[skkkk]

Сообщение от Кулик Алексей aka kpblc Не страшно глобально обработчик ошибок переопределять?

А чем это чревато?

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

Ну хотя бы тем, что в штатном обработчике ошибок может быть ооочень много всего намешано (особенно это касалось вертикалок).

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Не страшно глобально обработчик ошибок переопределять? И системную переменную обратно не возвращать?

Спасибо, Алексей. Так выбирает и изменяет регистр.
А если снести обработчик ошибок и добавить (SETVAR "CMDECHO" 1)?

Код:

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

  (defun c:ch-cs (/ OLDLIST ALLENTS NXT ELIST OLDSLOPE SLOPE NEWTEXT N) 
  (SETVAR "CMDECHO" 0)

   (setq allents (ssget "_:L" '((0 . "TEXT")))
        n       0
        nxt     (ssname allents n)
  )
  (while nxt 
    (Setq elist (entget nxt))
    (setq oldslope (assoc 1 elist))
    (setq slope (cdr oldslope))

    (setq newtext (cons 1 (strcase slope)))
    (setq elist (subst newtext oldslope elist))
    (entmod elist)
    (setq n (+ 1 n))
    (setq nxt (ssname allents n))
  )
  (princ)
(SETVAR "CMDECHO" 1)
)
(princ)

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

А что ты будешь делать, если человек специально ставил cmdecho у себя в 0? Ну вот нравится ему такое, а ты тут со своим кодом - и выставляешь в 1. Хотя об этом тебя никто не просил.
Вывод: считывать значение системной переменной, устанавливать свое, и по окончании восстанавливать. В том числе и в случае ошибки.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc А что ты будешь делать, если человек специально ставил cmdecho у себя в 0? Ну вот нравится ему такое, а ты тут со своим кодом - и выставляешь в

Тогда так?:

Код:

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

 ; изменяет регистр выбранных! Текстов на чертеже на верхний
(defun c:Txt-case-choice (/ OLDLIST ALLENTS NXT ELIST OLDSLOPE SLOPE NEWTEXT N *error*) 
 (setq oldCMDECHO (getvar 'CMDECHO))
(setvar 'CMDECHO 0)

  (defun *Error* (msg) 
    (if (/= msg "Function cancelled") 
      (princ (strcat "\nError: " msg))
    )
    (terpri)

    (setq *error* olderr)
    (princ)
  )

  (setq allents (ssget "_:L" '((0 . "TEXT")))
        n       0
        nxt     (ssname allents n)
  )
  (while nxt 
    (Setq elist (entget nxt))
    (setq oldslope (assoc 1 elist))
    (setq slope (cdr oldslope))

    (setq newtext (cons 1 (strcase slope)))
    (setq elist (subst newtext oldslope elist))
    (entmod elist)
    (setq n (+ 1 n))
    (setq nxt (ssname allents n))
  )
  (princ)
(setvar "CMDECHO" oldCMDECHO)
)
(princ)

[skkkk]

Сообщение от Ingpro Тогда так?:

А *error* куда пропала? В нём нужно прописать возврат переменной в случае выхода, к примеру, по Escape. Просто Алексей имел в виду, что её нужно объявить локальной, то есть прописать в первой строчке кода после слэша. Она будет тогда действовать только внутри функции команды c:ch-cs2, а не глобально.

[Ingpro]

Сообщение от skkkk А *error* куда пропала? В нём нужно прописать возврат переменной в случае выхода, к примеру, по Escape. Просто Алексей имел в виду, что её нужно объявить локальной, то есть прописать в первой строчке кода после слэша. Она будет тогда действовать только внутри функции команды c:ch-cs2, а не глобально.

А как это конкретно в коде прописать?

Код:

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

   (defun *Error* (msg)
  (if (/= msg "Function cancelled")
  (princ (strcat "\nError: " msg))
  )
  (terpri)
  (setq *error* olderr)
  (princ)
  )

Т. е. достаточно добавить *error*, и больше ничего не менять в коде?

Код:

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

 (defun c:ch-cs (/ OLDLIST ALLENTS NXT ELIST OLDSLOPE SLOPE NEWTEXT N *error*)

[===AAA===]

А вот, кстати, интересный вопрос... А есть ли где-нибудь достоверное
описание того, что делает "штатная" *error*, кроме того, что
выводит на экран сообщение об ошибке ?

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

Понятно, мой вариант кода никто не смотрел...
Опять же, пара вариантов как бы я их писал. Один через ename, второй через ActiveX. Без проверок

Код:

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

 (vl-load-com)
(defun c:ch-cs1 (/ adoc selset) 
  (if 
    (= 
      (type 
        (setq selset (vl-catch-all-apply 
                       (function 
                         (lambda () 
                           (ssget "_:L" '((0 . "TEXT")))
                         )
                       )
                     )
        )
      )
      'pickset
    )
    (progn 
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (foreach elist 
        (mapcar (function entget) 
                ((lambda (/ tab item) 
                   (repeat 
                     (setq tab  nil
                           item (sslength selset)
                     )
                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                   )
                 ) 
                )
        )
        (entmod 
          (subst 
            (cons 1 (strcase (cdr (assoc 1 elist))))
            (assoc 1 elist)
            elist
          )
        )
      )
      (vla-endundomark adoc)
    )
  )
  (princ)
)

(defun c:ch-cs2 (/ adoc selset) 
  (if 
    (= 
      (type 
        (setq selset (vl-catch-all-apply 
                       (function 
                         (lambda () 
                           (ssget "_:L" '((0 . "TEXT")))
                         )
                       )
                     )
        )
      )
      'pickset
    )
    (progn 
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (foreach ent 
        (mapcar (function vlax-ename->vla-object) 
                ((lambda (/ tab item) 
                   (repeat 
                     (setq tab  nil
                           item (sslength selset)
                     )
                     (setq tab (cons (ssname selset (setq item (1- item))) tab))
                   )
                 ) 
                )
        )
        (vla-put-textstring ent (strcase (vla-get-textstring ent)))
      )
      (vla-endundomark adoc)
    )
  )
  (princ)
)

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Опять же, пара вариантов как бы я их писал. Один через ename, второй через ActiveX. Без проверок

Оба работают!

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

Сообщение от ===AAA=== А вот, кстати, интересный вопрос... А есть ли где-нибудь достоверное описание того, что делает "штатная" *error*, кроме того, что выводит на экран сообщение об ошибке ?

Насколько я знаю, нет. Но после игрищ с этим зверем в вертикалках типа АА я зарекся вообще в его сторону смотреть. Уже проще через vl-catch-* работать, если припрет.