[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

_____________________________________________________________________________________________________________

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

[Ingpro]

Команда несколько раз срабатывает, как надо, потом начинает сбоить, в чём может быть причина?

Код:

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

 (defun c:StepPl (/ step-height step-width num-steps start-point points current-point next-point pt)
  (setq step-height 150) 
  (setq step-width 300)  
  (setq num-steps 10)    
  (setq start-point (getpoint "\nУкажите начальную точку: ")) 

  (setq points (list start-point))
  (setq current-point start-point)

  (repeat num-steps
    (setq next-point (list (car current-point) (+ (cadr current-point) step-height)))
    (setq points (append points (list next-point)))
    (setq current-point next-point)

    (setq next-point (list (+ (car current-point) step-width) (cadr current-point)))
    (setq points (append points (list next-point))) 
    (setq current-point next-point)
  )

  (setq points (append points (list (list (+ (car start-point) (* step-width num-steps)) (cadr start-point))))) 

  (command "_.PLINE") 
  (foreach pt points
   ; (command pt)  ; ошибка
(command "_non" pt) ; исправление
  )
  (command "") 
(princ)
)

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

Что значит "сбоить"? Что пишется в консоли? Какие значения переменных при отладке? Про разницу между command, command-s, vl-cmdf в курсе?
P.S. ИМХО проще всего создавать полилинию чисто программно, без использования команд.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc то значит "сбоить"? Что пишется в консоли?

Начинает чертить не ступени, а какую-то ф---ю.
Ничего криминального не пишет...
Укажите начальную точку: _.PLINE
Начальная точка:
Текущая ширина полилинии равна 0.00
Следующая точка или [Дуга/Полуширина/длИна/Отменить/Ширина]:
Следующая точка или [Дуга/Замкнуть/Полуширина/длИна/Отменить/Ширина]:
Следующая точка или [Дуга/Замкнуть/Полуширина/длИна/Отменить/Ширина]:

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

http://forum.dwg.ru/showpost.php?p=271151&postcount=167

[koMon]

(command pt) -> (command "_non" pt)

[Ingpro]

Сообщение от koMon (command pt) -> (command "_non" pt)

Спасибо, это сработало, код в #4961 исправлен.

[Gretech89]

Подскажите, пожалуйста. К примеру: имеется вхождение блока "A". Внутри него блок "B". Я правильно понимаю, что блок "B" не является вхождением на чертеже, т.к. он внутри блока "A"?
В общем задача получить список вложенных блоков причем с определенным именем (имена у вложенных блоков в другие блоки начинаются с одних и тех же символов - "MACRO*"). Делаю я это так:

Код:

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

 	(setq block_in ((lambda (/ res)
		(vlax-for block_def (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
			(if
			  (wcmatch (strcase (vla-get-name block_def)) "MACRO*")
			  (setq res (cons block_def res))
			)
		)
			(reverse res)
	               ))
	)

Загвоздка в том, как получить список вхождений блоков, чтобы далее получить их габаритные координаты (GetBoundingBox). И вообще возможно ли такое? Искомые блоки находятся в блоках и разбивать их нельзя..

[1958]

Вопрос по ssget с условием.
Имеются две переменные: lst - список точек и lay - название слоя.
Кодом

Код:

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

 (setq ss (ssget "_F" (mapcar '(lambda (x) (trans x 0 1)) lst)))

выбираются все примитивы, пересекаемые линией с вершинами из списка lst.
Мне нужно выбрать примитивы не принадлежащие слою lay.
Попробовал так:

Код:

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

 (setq ss (ssget "_F"
                          (mapcar '(lambda (x) (trans x 0 1)) lst)
                          (cons -4 "<NOT")
                          (list (cons 8 lay))
                          (cons -4 "NOT>")
                   )
          )

Результат: Error: слишком много аргументов
В чем ошибка? Или ssget с методом "_F" фильтры со сложными условиями не поддерживается?

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

М.б., так?

Код:

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

 (setq ss (ssget "_F" 
                (mapcar '(lambda (x) (trans x 0 1)) lst)
                (list (cons -4 "<NOT") 
                      (cons 8 lay)
                      (cons -4 "NOT>")
                )
         )
)

[===AAA===]

Кстати.

К выбору "Линией" нужно относиться с осторожностью.

Если среди выбираемых объектов есть тексты, то эта
"линия" может оказаться как раз "между слов" или даже
"между букв" и в результате объект окажется не выбранным.

[1958]

Сообщение от Кулик Алексей aka kpblc М.б., так?

Рахмат, понимаш, катта!

----- добавлено через ~1 мин. -----

Сообщение от ===AAA=== Если среди выбираемых объектов есть тексты, то эта "линия" может оказаться как раз "между слов" или даже "между букв" и в результате объект окажется не выбранным.

Это относится и к пунктирным линиям. Но, что делать!?

[===AAA===]

Это относится и к пунктирным линиям. Но, что делать!?

(ssget "_c" ...)

понадёжнее будет.

Разве, что нужен какой-то "очень хитрый" контур выбора...
Но у меня в реальности такой задачи пока не возникало.

[1958]

Сообщение от ===AAA=== (ssget "_c" ...)

Я сейчас как раз этот вариант рассматриваю.
Как можно изменить список координат типа lst = ((х1 у1) (х2 у2)...(х8 у9)), добавив к каждому элементу по (2 2)?
(mapcar '+ lst '(2 2)) - результата не дает.
Строить линию по списку lst, делать офсет в обе стороны и получать новый список для замкнутого контура - как-то муторно мне кажется.

[koMon]

Сообщение от ===AAA=== Если среди выбираемых объектов есть тексты, то эта "линия" может оказаться как раз "между слов" или даже "между букв" и в результате объект окажется не выбранным.

на этот случай есть переменная textgapselection, которая

Controls whether you can select text or mtext objects within the gaps or spaces between the characters. Value Description 0 Text and mtext objects can be selected only on a character (legacy behavior) 1 Text and Mtext objects can be selected within the gaps or spaces between characters within a line of text

то есть установленная в 1 позволит выбирать *тексты по пробелам и промежуткам между букв.

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

Без проверок:

Код:

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

 (mapcar 
  (function 
    (lambda (point) 
      (mapcar 
        (function +)
        '(2. 2.)
        point
      )
    )
  )
  lst
)

[koMon]

Сообщение от 1958 Это относится и к пунктирным линиям. Но, что делать!?

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

----- добавлено через ~4 мин. -----

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

не сработает сорян) сработает

Код:

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

Command: (mapcar '(lambda (point) (mapcar '+ '(2 2) point)) '((1 1) (2 2 ) (3 3) (4 4)))
((3 3) (4 4) (5 5) (6 6))

[1958]

Сообщение от Кулик Алексей aka kpblc Без проверок: Код:

Спасибо!

[===AAA===]

на этот случай есть переменная textgapselection ...

Как говорится, "да, но..."

а) Она есть не во всех версиях АвтоКада (кажется, появилась с версии 2021)
б) В наноКаде (по крайней мере, в 23.1) её тоже нет
в) В программе, где есть (ssget "_f" ... ) нужно будет озаботиться её проверкой и/или установкой.

Так что "секрамка" - наше всё. :-)

[Ingpro]

Код работает, но "не видит" операцию деления, если ввести "/", то операция выполняется.
В коде [*/+/-//], в ком. строке [*/+/-], как можно исправить, плз?

Код:

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

 ;;; Функция выполнения арифметических операций ("*" "+" "-" "/") с объектами TEXT или MTEXT
;;; -------------------------------------
(defun getNumericValue (ent / edata val str1 str3)
  (setq edata (entget ent))
  (cond
    ((equal (cdr (assoc 0 edata)) "TEXT")
     (setq val (cdr (assoc 1 edata))))  
    ((equal (cdr (assoc 0 edata)) "MTEXT")

     (setq str1 (cdr (assoc 1 edata)))
     (setq str3 (cdr (assoc 3 edata)))  
     (setq val (strcat str1 str3))       
    )
    (T
     (setq val "0") 
    )
  )
  (atof val)
)

;;; ------------------------------------------------------
(defun c:CalculTxt ( / lastOp prompt op ent1 ent2 v1 v2 result inspt validOps)
  (setq validOps '("*" "+" "-" "/")) 

  (setq lastOp (getenv "CALC_TXT_LAST_OP"))

  (setq prompt (strcat "\nВыберите операцию [*/+/-//] <" (if lastOp lastOp "") ">: "))

  (setq op (getstring "\nВыберите операцию [*/+/-//]: "))

  (if (= op "") (setq op lastOp))

  (if (not (member op validOps))
    (progn
      (alert "Недопустимая операция. Используется операция \"+\".")
      (setq op "+")
    )
  )

  (setenv "CALC_TXT_LAST_OP" op)

  (setq ent1 (car (entsel "\nВыберите первый текст или MTEXT: ")))
  (if (null ent1) (exit)) 

  (setq ent2 (car (entsel "\nВыберите второй текст или MTEXT: ")))
  (if (null ent2) (exit)) 

  (setq v1 (getNumericValue ent1))
  (setq v2 (getNumericValue ent2))

  (cond
    ((= op "*") (setq result (* v1 v2)))
    ((= op "+") (setq result (+ v1 v2)))
    ((= op "-") (setq result (- v1 v2)))
    ((= op "/") 
      (if (zerop v2)
        (setq result 0.0) 
        (setq result (/ v1 v2))
      )
    )
    (T (setq result 0.0)) 
  )

  (setq inspt (getpoint "\nУкажите точку вставки результата: "))
  (if (null inspt) (exit))

  (command "_.TEXT" inspt "250" "0" (rtos result 2 2) "")

  (princ)
)

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

ИМХО не лечится. Попробуй нечто типа

Код:

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

 (if (= (type (setq op
                    (vl-catch-all-apply
                      (function
                        (lambda ()
                          (initget "+ - * \\ _ + - * /" 6)
                          (cond
                            ((getkword "\nEnter operation[+/-/*/\\] <+> : "))
                          ) ;_ end of cond
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
             ) ;_ end of setq
       ) ;_ end of type
       'str
    ) ;_ end of =
  (princ (strcat "\n " op " selected"))
) ;_ end of if