[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

_____________________________________________________________________________________________________________

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

[Frigate]

Уважаемые софорумчане :-)

Прошу помощи, может кто предложит нормальное решение моей проблемки.

Итак,

имею файл .txt с разделителями Tab.

Открываю его в Excel.

И вместо номера позиции "4-1" получаю запись в ячейке "04.янв".

Как с этим бороться?

Пока рациональных мыслей нет )))

На всякий случай код функции, открывающей файл в Excel (взято у VVA и немного упрощено):

Код:

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

  
(defun adv-file-open-in-EXEL (path      /
         excelapp      sheet
         sheet_name_or_number
         workbook
        )
    (setq sheet_name_or_number 1)  ; 1 - первый лист файла Эксель 
  (setq ExcelApp (vlax-get-or-create-object "Excel.Application"))
  (vla-put-visible ExcelApp :vlax-true)
  (setq
    Workbook (vl-catch-all-apply
        'vla-open
        (list (vlax-get-property ExcelApp "WorkBooks") path)
      ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq
  (setq sheet (vl-catch-all-apply
  'vlax-get-property
  (list (vlax-get-property Workbook "Sheets")
        "Item"
        sheet_name_or_number
  ) ;_ end of list
       ) ;_ end of vl-catch-all-apply
  ) ;_ end of setq
  (vlax-invoke-method sheet "Activate")
  (setq sheet nil
 WorkBook nil
 ExcelApp nil
  ) ;_ end of setq
 
  (gc)
  (gc)
  (PRINC "\nФайл настроек открыт в Exel.")
) ;_ end of defun
 

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

Перед такими значениями принудительно попробуй поставить знак апострофа '

[Дима_]

Для открытия текстового файла с особыми параметрами юзай Workbooks.OpenText

[Frigate]

Кулик Алексей aka kpblc,

так можно и любой ставить, например звездочку )))

я тоже к такому склонялся, хотя это вносит некую нестыковку и необходимость доработки таблицы.

Ладно, чую что нет иного выхода.

Дима_,
С применением методов VBA нет пока времени разбираться, может позднее.

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

Frigate, символ апострофа принудительно переводит значение в строковое представление - по крайней мере при программном заполнении ячеек.

[Дима_]

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

[Frigate]

Дима_,

я же писал, что это функция от VVA (вроде так).

Прошу помочь с написанием кода, если это не сильно затруднит.

Прилагаю файл txt с пробелами, который нужно открывать в Excel.


======добавлено===========

Смотрю на филдинфо ))) Немноо как китайская грамота. ПРимерчик бы ))) Для упрощения - можно все столбцы из файла-примера открывать как текстовые.


=============добавлено=============

помучался немного и решил открывать текстовый файл не из автокада а из экселя, так проще - макрос это не lisp )))

Хотя жаль, конечно.

[Дима_]

Сообщение от Frigate Смотрю на филдинфо ))) Немноо как китайская грамота. ПРимерчик бы )))

Код:

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

 (defun excel-open-text (excel path field)
  (vlax-invoke-method
    (vlax-get-property excel 'Workbooks)
    'OpenText path nil nil nil nil nil nil nil nil nil nil nil
    (if field
         (vlax-safearray-fill
            (vlax-make-safearray vlax-vbvariant
                                 (cons 1 (length field)))
         (mapcar
             '(lambda (x)
                (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbinteger '(0 . 1))
                   x))
              field)))
    nil nil nil nil nil))

excel - vla указатель на excel, path - полное имя к файлу, field список списков в формате номер столбца (начиная с 1 и тип данных его данных - вот). С фиелдом, по крайней мере у меня на машине - не все гладко, на номер столбца он почему-то глубоко плюет - а расставляет типы данных тупо попорядку (пробовал "жестко" устанавливать DataType<-XlTextParsingType.xlDelimited - ему по боку) - почему не знаю (может в какаой другой variant завернуть надо - возиться лень)???
Пример вызова:
(excel-open-text (vlax-get-object "excel.application") "d:/test.txt" '((1 2) (2 2) (3 2) (4 2)))

[Никита Ремизов]

Код:

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

(defun C:MASSIVM ()
(setvar "cmdecho" 0)
(setvar "osnapcoord" 1)
(prompt "\nВыберите объекты: ")
(setq old_error *error*)
(setq *error* ERR_)
(setq
     LL        (ssget)
     W         (entget (ssname LL 0))
     TN        (cdr (assoc 10 W))
     S         (getreal "\n Шаг копирования: ")
);setq

(setq sp (getpoint "\nВведите первую точку отрезка распространения: "))
(setq ep (getpoint "\nВведите вторую точку отрезка распространения: "))
(setq pangle (angle sp ep))
(setq plength (distance sp ep))



(setq
          
     Q         (fix (/ plength S))
     TK        (polar TN pangle S)
     N         2)
(command "_.undo" "_be")
(repeat Q
(command "_.copy" LL "" TN TK)
(setq
      S1       (* S N)
      TK       (polar TN pangle S1)
      N        (+ 1 N))
);repeat
(command "_.undo" "_end") 
(setq *error* old_error)
);setq
(defun ERR_ (msg)
(command "_.undo" "_end")
(setq *error* old_error)
(princ)
)efun ERR

При работе данного лиспа, при вводе второй точки отрезка распространения не работает полярное отслеживание. Как сделать, чтобы работало?

[gomer]

Сообщение от Никита Ремизов При работе данного лиспа, при вводе второй точки отрезка распространения не работает полярное отслеживание. Как сделать, чтобы работало?

Почитай про функцию getpoint и ее аргументы в справке, а вообще это плохой, плохой лисп.. К тому же, следует помнить, что для вкл/выкл режима объектной привязки есть переменная autosnap

[Никита Ремизов]

Сообщение от gomer Почитай про функцию getpoint и ее аргументы в справке, а вообще это плохой, плохой лисп..

В какой справке?
Лисп не моего авторства, может он и какой-то там очень плохой, но работает безотказно

[skkkk]

Сообщение от Никита Ремизов При работе данного лиспа, при вводе второй точки отрезка распространения не работает полярное отслеживание. Как сделать, чтобы работало?

А вдруг, посмотреть негде?
Надо заменить строку

Код:

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

(setq ep (getpoint "\nВведите вторую точку отрезка распространения: "))

на строку

Код:

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

(setq ep (getpoint sp "\nВведите вторую точку отрезка распространения: "))

[gomer]

Код:

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

 (if (zerop (logand 16 (setq as (getvar 'autosnap))))
 (setvar 'autosnap (+ 16 as))
)

[gomer]

У кого-нибудь есть инфа по (_vl-times)? Что-то привирает она, как раз в 4 раза (по количеству ядер процессора, что ли?)

Код:

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

 
(defun dividers	(n / i lst)
  (setq
    i	1
    lst	'()
  )
  (while (<= i (/ n 2))
    (setq i (1+ i))
    (if	(zerop (rem n i))
      (setq lst (cons i lst))
    )
  )
  lst
)

(defun solve (a b / lst _timer _result len)
  (setq
    lst	   '()
    _timer (car (_vl-times))
  )
  (while (<= a b)
    (if	(>= (setq len (length (dividers a))) (cdar lst))
      (setq lst (cons (cons a len) lst))
    )
    (setq a (1+ a))
  )
  (setq	_result
	 (mapcar 'car
		 (vl-remove-if-not
		   (function (lambda (x) (= (cdr x) (cdar lst))))
		   lst
		 )
	 )
  )
  (princ "\nTime: ")
  (princ (* 0.001 (- (car (_vl-times)) _timer) 2 2))
  (terpri)
  _result
)

Самое интересное, что, если использовать (getvar 'date), то результат такой же... в общем я в прострации уже...

[Flash51]

Как в cond объединить несколько условий?

[MrBrown]

Разрешите вопрос новичка.
Кое-что понял из "Полещука". Теоретически, а на практике - прошу помочь.
Вот функция извлечения начала и конца отрезка:

Код:

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

 (defun c:test  ()
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel)))))
)

Анализирую с конца, с внутренних скобок:
(entget (car (entsel)) - получен первый элемент (имя выбранного примитива) из базы.
(lambda (x) (= (car x) 10)) - первому элементу аргумента Х функции lambda присвоены координаты начала отрезка
vl-remove-if-not исключает lambda (x), значит, остается вся остальная инфа из базы, а не только координата конца отрезка (?).
Вопрос: как тут работает mapcar, последовательно составляя список координат?
Реально, запутался в этой простой строке, как та сороконожка, которая задумалась, с какой ноги начинать движение.
Спасибо.

[Sleekka]

мапкар последовательно применяет cdr к каждому элементу списка, т.е. отрезает dxf - пометку "10".

[dirge]

MrBrown, там получается список списков из координат ((10 0 1 0) (10 1 1 0)) и т.д. mapcar 'cdr из каждого списка вынимает всё кроме первого елемента, получается ((0 1 0) (1 1 0))

[MrBrown]

Но ведь код "10" - это код начала отрезка. А "11" - конца. Или я ошибаюсь? Вот я нарисовал отрезок с координатами (0.0 0.0) (200.0 200.0)
ком.строка на запрос

Код:

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

 (defun c:test  ()
(lambda (x) (= (car x) 10)) (entget (car (entsel)))
)

выдала

Код:

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

 Выберите объект: ((-1 . <Имя объекта: 7ea09518>) (0 . "LWPOLYLINE") (330 . <Имя 
объекта: 7ea0fcf8>) (5 . "21B") (100 . "AcDbEntity") (67 . 0) (410 . "Model") 
(8 . "0") (100 . "AcDbPolyline") (90 . 2) (70 . 0) (43 . 0.0) (38 . 0.0) (39 . 
0.0) (10 0.0 0.0) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 200.0 200.0) 
(40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (210 0.0 0.0 1.0))

то есть и начало и конец отрезка имеют код "10". Или я невнимательно читал "Маркса"? ("Полещука")

[gomer]

А ты часом окружности дугами не рисуешь,бро?

[MrBrown]

gomer, в ответе твоём уловил намёк. Пошёл штудировать "Полещука".
Спасибо.
_______________
Намека не понял:
У Полещука на стр. 116, где "Функция Entget": "10" - координаты начальной точки, "11" - координаты конечной точки.
Для проверки нарисовал полилинию с несколькими вершинами. Ком.строка выдала все вершины под кодом "10". Что ж, беру за основу практику.

[Do$]

Зачем там лямбда в запросе?
Отрезок - это LINE. У него под кодом 10 _ начальная точка в мировой СК, под кодом 11 - конечная точка в мировой СК.
У Вас LWPOLYLINE - это простая "плоская" полилиния. У нее под кодами 10 координаты всех вершин, их может быть очень много, поэтому неразумно им давать коды 10, 11, 12... Причем координаты ДВУХМЕРНЫЕ в системе координат ОБЪЕКТА.
Штудировать в этом плане лучше DXF Reference.

[MrBrown]

Do$, ну, если честно, я выдрал эту строчку с лямбдой из какого-то макроса на форуме и, начитавшись "Маркса", решил с ней разобраться. И, как видно, влип. Спасибо за ссылку. И, да, сам же нарисовал полилинию, а хочу коды отрезка. Невнимательность, однако.
_________________
С отрезком все получилось - и "10", и "11".

А такой вопрос: есть ли способ производить загрузку макроса побыстрее? Или каждый раз, изменив его, надо идти по пути "Сервис-приложения-загрузить...".

[Do$]

Если Вы программируете во встроенном редакторе VLIDE, то там по сочетаниям клавиш или кнопками можно выполнить быстро загрузку.
http://autolisp.ru/2009/09/10/vlide-misc-01/
http://autolisp.ru/2009/09/12/vlide-misc-02/

[skkkk]

Сообщение от MrBrown А такой вопрос: есть ли способ производить загрузку макроса побыстрее? Или каждый раз, изменив его, надо идти по пути "Сервис-приложения-загрузить...

А если в блокноте, то сохраненный файл lsp можно мышкой перетащить в окно Автокада, либо вывести на панель новую кнопку и на нее повесить макрос

Код:

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

^C^C(load "test.lsp");test

Каждый раз при нажатии на кнопку лисп будет подгружаться.
Кстати, это только у меня VLIDE не понимает кириллицу?

[Alan]

Сообщение от skkkk Каждый раз при нажатии на кнопку лисп будет подгружаться.

Ну почему не в редакторе VLIDE нажимать кнопку????

Кстати, это только у меня VLIDE не понимает кириллицу?

Пишите сразу в редакторе.
P.S. Ну писали же в этой теме... о редакторе VLIDE.
Запускайте оттуда же!
Отладка там же пошагово через точки останова и т.д. и т.п.
Зачем усложнять себе жизнь?

[skkkk]

Ну не легла у меня душа к VLIDE. Возможно от невежества... Я настроил Notepad++ и уже привык.
Добавил автозавершение и подсветку, в том числе vla-функций... Сворачивание блоков текста также очень удобно, множественная замена текста. Подсветка всех повторений выделенной части текста, например, переменной. Автоматическое создание резервных копий. Всем этим активно пользуюсь, но никого не агитирую, только мое скромное мнение. Хотя, признаюсь, иногда руки тянутся, влекомые авторитетом уважаемых программистов, разобраться с VLIDE, но пока так и не дошли
Но знаю точно, не один я такой, и это несколько успокаивает. Тем более, что я всего лишь любитель.
А писать сразу во VLIDE как, если я часто беру коды с форума и допиливаю под себя?

[Do$]

Кириллицу понимает. Есть проблема с копипастом (та же, что и с командной строкой), решается сменой текущего языка на русский перед копированием-вставкой.

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

Все она понимает. Просто при копировании "откуда-то" в этом "откуда-то" должна быть включена русская раскладка...

[skkkk]

Сообщение от Do$ решается сменой текущего языка на русский перед копированием-вставкой

Сообщение от Кулик Алексей aka kpblc Все она понимает. Просто при копировании "откуда-то" в этом "откуда-то" должна быть включена русская раскладка...

Действительно. Или еще можно сохранить файл, а затем открыть его во VLIDE (меню Файл->Открыть файл...). Тогда с кириллицей все в порядке. И как оказалось, в 2011-м Акаде во VLIDE уже есть подсветка vla-функций. Похоже, может оказаться удобным писать код в Notepad++, а отладку производить в редакторе VLIDE. Попробуем...

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

Сообщение от skkkk во VLIDE уже есть подсветка vla-функций

Она и в 2004 была... Достаточно было выполнить (vl-load-com)

[Do$]

Даже больше: есть подсветка функций, написанных на ObjectARX/NET и подгруженных в AutoCAD.

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

Естественно! А если tbl импортнешь корректно, так еще и левые методы и свойства станут подсвечиваться

[Do$]

Мммм... Это, например, методы работы с excel-word?

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

И это тоже. Основная проблема - определить, какую tlb надо импортировать, и ее путь. Но в принципе это решается, насколько я помню.
ИМХО - это аналог раннего связывания со всеми его плюсами и минусами. Лично я предпочитаю работать с поздним связыванием, поскольку позднее немного универсальнее, но при этом и затратнее (по времени, по скорости...).

[dirge]

Здравствуйте, подскажите пожалуйста у функции ssget можно как-то запротектить выбор объектов которые уже в наборе в другом наборе? Суть такая я в цикле перебираю координаты и в набор попадают объекты, можно как-то сделать чтобы одинаковые объекты потом не копировались в новый набор.
Сам код:

Код:

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

   (setq i 0)
  (while (< i (length positions))
    (setq objects
	   (vl-remove-if
	     'listp
	     (mapcar 'cadr (ssnamex (ssget "_CP" (nth i positions))))
	   )
    )
    (setq pos (cons objects pos))
    (setq i (1+ i))
  )

[Do$]

Функции SSMEMB - проверка наличия примитива в наборе и SSDEL - удаление примитива из набора.

[chicot]

Неожиданно столкнулся с проблемой создания набора из динамических блоков.
Симптомы:
После вставки динамического блока в пространство модели, пробую извлечь его имя с помощью

Код:

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

  (setq UMR_bJIOKA (cdr(assoc 2 (entget (car (entsel))))))

. На выходе все в ажуре (т.е. в случае с примером из прилагаемого файла, получаем "flower"). Теперь видоизменим блок с помощью динамической операции "отразить" (flip).Опять запускаем запрос на имя

Код:

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

 (setq UMR_bJIOKA (cdr(assoc 2 (entget (car (entsel))))))

... и получаем удар в пах , а именно "*U6" !!! Причем характкрно, что если открыть свойства этого блока в КАДе, то там английским по белому в поле "имя" значится как раз "flower", а никакое не "*U6".
На даный момент выяснил, что *U это признак временного блока. Но , увы, сие никак не сдвинуло ситуацию с мертвой точки. Просьба ко всем завсегдатаям "списочного" пантеона объяснить простолюдину где грабли, на которые я наступаю. Файл с примером экспериментального блока прилагаю:
http://files.mail.ru/AB7D56C47B8941609F904FBF2205B25C

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

Сам же находил тему: http://forum.dwg.ru/showthread.php?t=85454
Там есть соответствующие коды

[chicot]

Да, огромное спасибо! Уже разобрался. Приношу свои искренние "Я больше не буду" Но справедливости ради, попробуйте забить в поиск "Создание набора из динамических блоков" (а меня именно ssget с фильтром по имени интерисовал), ну или просто "Динамические блоки". Это беда всех форумов - поиск не инструмет, а большая рулетка. Да да да - нужно уметь формулировать запрос! Но скажите, Бога ради, что еще нужно было ввести в поле поиска, что бы попасть на http://forum.dwg.ru/showthread.php?t=85454 ? Я там побывал только после того как меня Земляк носом ткнул во время общения в Скайпе.

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

Например : http://www.google.ru/cse?cx=partner-...%BA&gsc.page=1
http://www.google.ru/cse?cx=partner-...sget%20dynamic

[dirge]

О какой проблеме в скрипте на лиспе может идти речь если скрипт подряд отрабатывает 5-10 раз, а потом ломается? Обработка происходит в одном и том же файле, на одних и тех же объектах.

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

dirge, это кому адресовано и по поводу чего?

[dirge]

Сообщение от Кулик Алексей aka kpblc dirge, это кому адресовано и по поводу чего?

Это был вопрос. У меня проблема следующего характера при выборе объектов, в набор их попадает иногда меньшее количество. Происходит это рандомно, хотя координаты полигона для поиска статичны.
Есть следующий код и файл (во вложении):

Код:

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

 
(defun c:testing ( / I NUM OBJECTS POS POSITIONS )
       
  (setq positions (list '((3.51635e+006 2.07346e+006) (3.51739e+006 2.07202e+006) (3.51747e+006 2.07209e+006) (3.51643e+006 2.07352e+006))
	                '((3.51747e+006 2.07209e+006) (3.51914e+006 2.07023e+006) (3.51907e+006 2.07016e+006) (3.51739e+006 2.07202e+006))
	                '((3.51914e+006 2.07023e+006) (3.51962e+006 2.06969e+006) (3.51955e+006 2.06962e+006) (3.51907e+006 2.07016e+006))
	          )
  )
  
  (setq i 0)
  (while (< i (length positions))
    (if (setq num (ssget "_CP" (nth i positions)))
    	(progn
	    (setq objects
		   (vl-remove-if
		     'listp
		     (mapcar 'cadr (ssnamex num))
		   )
	    )
	    (setq pos (cons objects pos))
	)
    )
    (setq i (1+ i))
  )

  (mapcar 'length pos)
)

Результаты выдаёт следующие:
(33 91 25)
(33 91 25)
(33 91 25)
(33 91 59)
(33 25)
(14 91 59)

По ощущения кажется, что ssget зависит от времени выбора. Бред, но может кто подскажет как с этим побороться.

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

Вся область выбора должна находиться на экране.

[dirge]

Сообщение от Кулик Алексей aka kpblc Вся область выбора должна находиться на экране.

Я думал флаг "CP" не так должен работать. Алексей спасибо, прояснили ситуацию.

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

CP = CrossPolygon. Вообще говоря, любой выбор, кроме "_X", "_A" и пользовательского, требует полного отображения выбираемой области.

[ashas-]

Здравствуйте Уважаемые форумчане. Вопрос не по коду, а теоретический, который не дает мне покоя уже продолжительный период времени.
При написании кода лучше использовать переменные или стараться обходится без них? И почему?
Бывает приходится использовать несколько функций в одном выражении по несколько раз в одном коде, когда можно сделать один раз и присвоить значение переменной. Но тогда переменных может стать слишком много... И если я правильно понимаю, они сидят в памяти, тем самым замедляя работу кода. Но с другой стороны не приходится снова выполнять выражение, так как оно уже храниться в переменной, что опять же должно ускорить работу кода. В общем я в растерянности и надеюсь на помощь ГУРУ этого замечательного форума...

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

ashas-, если честно, то тут может рассудить только эксперимент. Лично мне, например, проще работать с переменными. Дима_, например, пишет полностью лисповый код и на "лишние" переменные у него реакция сильно отрицательная
Можешь написать два (три, четыре, пять...) варианта кода и прогнать их по аналогии с http://autolisp.ru/2009/09/20/execution-speed-check/

[ShaggyDoc]

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

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

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

Код:

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

 (setq L (func params1))
(setq B (func params2))
(setq S (* L B))

Надо просто (2):

Код:

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

 (* (func params1) (func params1))

возможно даже не присваивая результат какой-то переменной.

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

Но вызывать функции надо тоже с умом. Чаще всего "без ума" последовательно вызывают функцию setq, присваивая значения разным переменным (см. пример 1). Если предположить, что без переменных ну никак не обойтись, то надо было писать (3):

Код:

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

 (setq L (func params1) 
                           B   (func params2)
                   )

т.е. выполняя функцию setq один раз.

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

Переменные работу не замедляют, они занимают память. А вот вызовы функций могут замедлить работу, т.к. при каждом вызове интерпретатор должен проверить наличие такой функции и правильность её применения. Код (3) будет работать быстрее кода (1)

[Дима_]

Тут сначала надо определиться что такое переменная - переменная по замыслу своему это индексированная ячейка памяти которая МЕНЯЕТ свое значение в ходе выполнения программы. А сейчас я скажу то, что наверное не все воспримут - но перед тем как это опровергать, попробуйте осмыслить. В автолиспе переменных в вышеуказанном смысле НЕТ. Да да их просто нет и соответственно Вы не можете их использовать, даже если Вам кажется что Вы так делаете. В автолиспе можно переопределять именна, причем абсолютно не важно используеться аналогичное имя уже или нет. Поясню код (setq a 5 a 10 a 20) создает три значения 10 20 и 30, но т.к. все они индексируются через имя "a", то по окончании функции доступно для программы остается только последнее. Все недоступные значения будут уничтожены при очередном ручном, либо автоматическом, вызове "сборщика мусора". Но т.к. классическая школа программирования объясняет нам все через "ячейки", в автолиспе реализован механизм который внешне очень похож на императивную парадигму. Все согласны?? Я при этом полностью согласен далее называть их переменными, чтоб никого не путать.
Вопрос ведь в использовании этого механизма, а не в устройстве автолиспа, но к сожалению т.к. мы сейчас говорим о конкретном языке, то для понимания "правильности" использования переменных, без его устройства нам не обойтись (ведь глупо говорить в общем о необходимости переменных т.к. - в си без них, ну просто никак, а в хаскеле их просто нет как таковых). Итак у нас есть механизм использования переменных, вопрос - стоит ли им пользоваться. Мой ответ (а я пока, вроде как, неформально считаюсь здесь ведущим "идеологом" в этой области) - да без них невозможно обойтись в автолиспе. Есть варианты когда хоть убейся нужны глобальные переменные, есть функции автолиспа которые заточенны под их использование. Есть ActiveX который содержит в себе изменяемые объекты (вот их свойства, кстати, мы с полной правотой можем называть как "настоящие" переменные - то есть мы можем изменять свойства конкретных объектов). Это необходимость сделанна по нескольким причинам - во первых для "простого инженера" будет несколько сложней написать "вспомогалку" на 3 строчки (с императивной парадигмой он наверное знаком с большей вероятностью); во вторых полноценно реализовывать в интерпритаторе монады и замыкания (механизмы в языках функционального программирования позволяющие полностью не использовать изменяемые значения) это не простое занятие; в третьих использование COM все равно выходит за рамки функциональной парадигмы (т.к. объекты содержат изменямые значения, а реализовывать их через монадические представление это такой-же бред как и использование 1001 переменной в лиспе) и соответственно вся чистота (это термин описывающий тип функций, а не мое отношение к ним) всей "лестницы" функций использующий COM накрывается медным тазом. Весь вопрос в удобстве, либо не удобстве их использования.
Я убежден, что 95% примеров использования здесь переменных вызванны недостаточной степенью владения функционалом автолиспа. Большинство начинающих считают что lambda это такое приложение к mapcar'у, но вопрос опять-таки не про них - считаем что мы разбераем случай не для вышеупомянутого "простого инжинера" (не чуть не хочу задеть профессию - имеется в виду человек который, что-то дописывает себе к автокаду постольку поскольку) - ему тратить время на "изыски" некогда, да и наверное не зачем,а для того перед кем стоит реальная практическая Offtop: ShaggyDoc задача по написанию программы на автолиспе. Используемые внутри программы имена мы можем определять и использовать по разному. Можем глобально setq'овать, можем локализировать используемые внутри функции и сразу со старта их "инициализировать" через setq, можем использовать lambda функционал. Ну про глобальные тут все понятно и вроде все согласны - внутренние имена подлежат обязательной локализации. Вопрос 2 - как лучше сделать - локализовать имена и присвоить им значения, либо использовать лямбды - по мне разницы особой нет - в данном случае вопрос действительно предпочтений. При локализации имен есть плюс в случае если нужно дать имена вычисляемым друг из друга значениям (в автолиспе нет функционала рекурсирвного определения типа letrec), что можно сделать без проблем с помощью setq (когда определяеться первая "пара" она сразу доступна второй), но при лямбдах, вне зависимости от размера используемой основной функции, нам не нужно "городить" имена типа my-first-value т.к. - как всегда можно автоматически провести расстановку отступов и сразу будет видно где кто - никогда не перепутаешь и можно в ручную задать нужную область ее видимости. Совсем другое дело это использованием переменных с именно изменяемым значением в течении работы программы (не 1 раз как в случае "инициализации" локально объявленных - а как-бы циклично).
Offtop: Сократ мне друг, но истинна дороже
Вот здесь хочеться начать с новой строчки. Насчет указанных ShaggyDoc'ом практических целей и пр. Есть в автолиспе несколько "императивно-ориентированных" функций в которых не использование переменных похоже на бред сумашедшего например:

Код:

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

 (defun coll->list(obj / ret)
  (vlax-for x obj (setq ret (cons x ret)))
  (reverse ret))

В чистом виде императивная функция которая постоянно циклично изменяет определение ret, в основе которой лежит как раз-таки "императивно-ориентированный" vlax-for. Писать подобное через "функциональный функционал" в автолиспе - бред. Аналог кода будет в 15 раз длиннее и гораздо сложнее алгоритмически. Но, я уверен, что ShaggyDoc имеет в виду не только этот случай и вот здесь я с ним имею радикально противоположную точку зрения. Принимая "простоту" использования переменных мы сталкиваемся с целым букетом гораздо более сложных проблем в корне которых лежит, то, что мы не знаем (в момент анализа программы), что у нас находиться под конктретным именем. Как только Вы начнинаете "крутить" переменными весь функциональный подход летит в мусорное ведро. У вас теряеться и структура и читабельность прграмм - здравствуй VLIDE и соотношение времени написание:отладка 1:10, досвидания рекурсия (если использовать "наружные" переменные рекурсивно - это гарантированный "провал") вся суть использования лиспа теряеться - пишите тогда на VB - для чего тогда все эти скобки? - ради пары фишек типо mapcar'a? Что программы становяться не читаемыми - покажите мне такую, правильно написаннаю - я за 5 секунд отформатирую ее и логика сразу "всплывет", а вот как раз при использовании переменных наступает полная "каша" в которой без пошаговой отладки никто ничего не поймет. Программы, написанные в лисп ключе -это по сути своей метод представления алгоритма - если Вы посмотрите на интегральную формулу - Вы тоже скажите что это чушь - т.к. многие ее не понимают, но почему-то для описания математики используют именно их, а не описывают все простыми понятными словами - т.к. многие вещи ими просто умрешь выводить. А "чехорда" из переменных не несет в себе никакой логики - ее невозможно понять не выполнив ее пошагово (в уме - что на практике просто нереально, либо отладчиком). Хочу особо подчеркнуть, что только при отказе от таких переменных лисп программа имеет декларативный вид - с ними это чистой воды императивка просто написанная лисп синтаксисом.
Скорость выполнения, в большинстве случаев, упадет при использовании функционального подхода (при прочих равных), но программы станут не читаемыми, и не редактируемые. Лично мне глубоко плевать на эти 3% времени - они не будут заметны ни при каком случае, а вот при попытке разложить хоть каплю сложный алгоритм "на переменные" - сразу идет тенденция к его упрощению (т.к. сложные вещи описать ими ой как непросто) и в результате мы видим выполнение быстрых переменных логарифмически неэффективно - и как вывод - эти 3% - надуманная чушь.
Есть в автолиспе еще отсутствие хвостовой рекурсии - это грустный факт. Из за которго мне несколько раз приходилось переводить готовую программу в "переменное" исполнение. Но я всегда обязательно оставлял "оригинал" - т.к. если потрбуется расширить функционал - гораздо проще добавить его в нем, чем пытаться копашиться в переменных (такая вот ручная оптимизация).

[ashas-]

Кулик Алексей aka kpblc, ShaggyDoc, Дима_, благодарю за подробные разъяснения.
Не все понял из того что написал Дима_, но в целом суть уловил. И буквально недавно я стал уходить от переменных (раньше без них совсем не мог), поэтому и возник такой вопрос . Действительно я обратил внимание, что без переменных код читается легче, как писал Дима_ хоть и получается длиннее. И стараюсь как можно меньше работать с автокадом (командами и объектами, тягая из них информацию), понял что лучше сохранить информацию в лиспе, чем несколько раз ее вытаскивать из объекта. В общем еще раз спасибо, это было познавательно.

[Ilez]

Здравствуйте уважаемые участники. Такой вопрос. Возможно ли изучать AutoLisp и пользоваться им, не имея никаких знаний английского языка?
Почему спрашиваю. Один знакомый поступив на специальность программирования, начал изучать английский, так как он входил в программу обучения и ему в деканате сказали, что при обучении на этой специальности он должен по-любому изучать английский. Но это целая специальность, где изучаются много языков и на глубоком уровне. А для AutoLispа требуется ли хоть базовое знание? Знания английского практически нулевые. Заранее спасибо за ответ.

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

Документация для AutoLISP доступна только на английском языке. Ну или искать книги Полещука Н.Н.

[gomer]

английский разговорный + технический в обязательном порядке, без этого далеко не пойдешь

[alex8888]

Вот как раз английский разговорный и не обязательно. Достаточно только сотни слов, обычных в программировании типа save, open, edit ...

Или? Ну ежели только для самоуспокоения.

[gomer]

Сообщение от alex8888 Вот как раз английский разговорный и не обязательно

это называется вариться в собственном соку...

[Vladimir_Sergeevich]

Есть задачка. Найти пересечение двух линий и по полученой координате выбрать ближайший к этой точке примитив. Точку я нашел, а как привязаться к объекту? _select !pt не катит, потому как ловит только тогда, когда картинка достаточно далеко.
Зачем мне это нужно: есть номограмма, по значениям двух параметров надо выбрать изолинию на пересечении (но точка может оказаться не на изолинии, а рядом...)
Поиском ничего вразумиельно не нашел.

[gomer]

http://forum.dwg.ru/showpost.php?p=1044227&postcount=11

[Vladimir_Sergeevich]

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

З.ы. но за идею спасибо. В итоге ssget _с, постепенно увеличиваю размер рамки, пока хоть кто туда не попадет. (Пишу с телефона, поэтому приложить не могу).

З.з.ы 2 Ilez. Английский нужно знать как минимум в части, касающейся автокада. Почти все свойства объектов и сам объекты, да и методы написаны простым английским языком... зная язык легче запомнить что есть что и соответственно применить, где надо.

[VVA]

Сообщение от Vladimir_Sergeevich Есть задачка. Найти пересечение двух линий и по полученой координате выбрать ближайший к этой точке примитив.

Сообщение от Vladimir_Sergeevich Зачем мне это нужно: есть номограмма, по значениям двух параметров надо выбрать изолинию на пересечении (но точка может оказаться не на изолинии, а рядом...)

Могу предложить такой алгоритм
1. Сформировать набор изолиний (скорее всего это полилинии, возможно на определенном слое)
2. С помощью vlax-curve-getClosestPointTo найти ближайшую к указанной точку на изолинии.
3. С помощью distance найти минимальное расстояние и ,соотвественно, саму ближайшую изолинию

[Vladimir_Sergeevich]

VVA, таким макаром проверять каждую из изолиний надо что ли и у каждой считать расстояние и выбирать минимальный?
в моем случае выбор через (ssget "_c" p1 p2) с увеличением рамки с шагом 0.1 достаточно.

[Flash51]

Может ли редактор блоков работать в фоновом режиме? Программно создаю блок, задаю атрибут и закрываю редактор блоков. Нужно чтобы все операции были невидимыми и экран не мигал.

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

Создавай блок программно и на этом все.

[Flash51]

Под "программно" я имел ввиду следующее. Описал в лиспе все действия, которые выполняет пользователь при создании блока, а при запуске, акад сам отрисовывает модель, создает блок и присваивает атрибут. Как в этой ситуации быть, т.к. видимо до создания блоков на самом деле программно я еще не дошел.

[skkkk]

Сообщение от Кулик Алексей aka kpblc Создавай блок программно и на этом все.

Программно, если говорить о лиспе, блок можно создать тремя способами (насколько я знаю):
1. Командные методы (функции command и vl-cmdf)
2. Метод описания точечных пар (entmake)
3. Обращение к объектной модели (vla-методы)

Сообщение от Flash51 Под "программно" я имел ввиду следующее. Описал в лиспе все действия, которые выполняет пользователь при создании блока, а при запуске, акад сам отрисовывает модель, создает блок и присваивает атрибут. Как в этой ситуации быть, т.к. видимо до создания блоков на самом деле программно я еще не дошел.

Очевидно, имеется в виду первый пункт.
Командными методами можно сделать примерно так:

Код:

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

 (defun C:CreateBlock ( / ss)
	; тут нужно бы добавить обработку ошибок и отключение привязок
	(if (not (tblsearch "block" "Наш_блок")) ; выполняем проверку: если блока "Наш_блок" в чертеже нет, то
  		(progn
    			(setq ss (ssadd)) ; создаем пустой набор
    			(command "_PLINE" "0.00,0.75" "0.00,-0.75" "") ; создаем, например, полилинию
    			(ssadd (entlast) ss) ; добавляем полилинию в этот набор
    			(command "_CIRCLE" "0.0,0.0" "0.26") ; создаем, например, круг
    			(ssadd (entlast) ss) ; добавляем его в набор
    			(command "_-ATTDEF" ; создаем атрибут
				 "" ; тут, если нужно, можем назначить свойства (скрытый, аннотативный, многострочный, см. опции командной строки)
				 "Наш_атрибут" ; имя атрибута
				 ""  ; подсказка
 				 "1" ; значение по умолчанию
				 "0.0,0.0" ; точка вставки
				 "2.5" ; высота текста
				 "" ; поворот
			    ) ; end of command "_-ATTDEF"
			    (ssadd (entlast) ss) ; добавляем его в набор
    			(command "_CHANGE" ss "" "_P" "_COLOR" "_BYBLOCK" "_LTYPE"  "_BYBLOCK" "_LWEIGHT" "_BYBLOCK" "_LAYER" "0" "") ; назначаем объектам из набора свойства "По блоку" и слой "0"
    			(command "_-BLOCK" "Наш_блок" "0,0" ss "") ; наконец, создаем блок
  		) ; end of progn
 	) ; end of if
     ; тут добавить включение привязок 
    (command "_-INSERT" "Наш_блок") ; ну и вставляем блок с запросом параметров у пользователя
) ; end of defun

[Flash51]

Я примерно так и делаю. Через command. Но меня немного беспокоит мигание экрана при открытии и закрытии редактора блока в этом процессе. skkkk, не могли бы Вы немного прояснить, как то же самое сделать через

Сообщение от skkkk 2. Метод описания точечных пар (entmake)

[chicot]

Приветствую! Прошу посильной помощи Клуба.
У Полещука:
(ssget '(125.4 58.1)
создает набор из всех примитивов, проходящих через точку (125,4 58,1)

Из официальной справочной документации:
Command: (ssget '(2 2))
Create a selection set of the object passing through (2,2)

Из личных "хождений по целине":
Строю ряд отрезков, абсолютно точно, проходящих через начало UCS (оная есть World). Запускаю код

Код:

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

(sslength (ssget '(0 0 ) '(( 0 . "line"))))

получаю 1(мать бы его так).
Так что же нужно учитывать при написании кода, чтобы был набор из примитивов, а не просто один object ? И если, все же, можно только один, то по какому критерию он выбирается из общего множества?

[gomer]

обсуждалось, в поиск

[chicot]

Поверьте, не имею такой привычки - постить с бухты барахты:
http://www.google.ru/cse?cx=partner-...%83&gsc.page=1
http://www.google.ru/cse?cx=partner-...get&gsc.page=2
Если не сложно уточните свое утверждение ссылкой.

[gomer]

http://forum.dwg.ru/showpost.php?p=1...postcount=2054

[chicot]

Спасибо огромное! Однако, хотелось бы понять отчего же такой облом происходит. Это не первое и, увы, не единственное мое наблюдение странностей применения "условий выбора" при создании наборов. Пытался докопаться, посты читая, но так и не нашел ответов - просто поменял алгоритм, усыпляя чувство нарастающей тревоги, своей недалекостью в ОбработчикеСписков... Ну а сегодня понял, что нужно ставить диагноз не допуская перетекания в хронику.
И кстати, даже увеличив величину допуска до 1, в любезно предоставленном коде, все рано в набор цепляет всего 3 отрезка из 8-ми.
Пардон - вот только что прочел всю ветку (сразу не вкурил как перейти туда). Так вот - точка с координатами '(0 0 0). как мне видится, здесь абсолютно не причем. На этот косяк, а точнее свою неверную трактовку Полещука, я нарвался, решая не рафинированную (как в моем первом примере "для чистоты эксперимента") задачу, и исход был таким же!
Мое внимание привлек вот этот пост:

Сообщение от skkkk Олег (jr.), а как в твоем варианте выбрать ТОЛЬКО полилинии, проходящие через точку pt? Do$, не пойму, причем тут погрешность и числа с плавающей запятой? В варианте Полещука выбирается тот примитив, который является самым новым в порядке прорисовки, т.е. самый "верхний". Если его убрать за объекты, выбирается другой примитив, проходящий через эту точку.

Что и соответствует всем результатам моих проб и ошибок. В голове вертится один алгоритм, но уж больно он проктологический. Подумаю на досуге. Найду не постыдное решение - отпишусь.
Спасибо огромное Клуб!!! Всем успехов.

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

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

[skkkk]

Сообщение от Flash51 Я примерно так и делаю. Через command. Но меня немного беспокоит мигание экрана при открытии и закрытии редактора блока в этом процессе.

Flash51, при использовании команды _-BLOCK (обратить внимание на тире) ни диалоговые окна, ни редактор блоков не открываются. Это работа в режиме опций командной строки. Поэтому никаких миганий экрана быть не должно. Либо я что-то не так понял.

Сообщение от Flash51 не могли бы Вы немного прояснить, как то же самое сделать через метод описания точечных пар (entmake)

Так в двух словах и не объяснишь. Это надо смотреть DXF-Reference и функцию entmake - не все там так просто. Проще разобраться с кодом из поста #2061. Либо пояснее поставить задачу. Что нужно? Чтоб при нажатии на кнопку на панели на курсоре висел нужный блок с запросом точки вставки? Или что-то еще?

Сообщение от chicot Так что же нужно учитывать при написании кода, чтобы был набор из примитивов, а не просто один object ?

chicot, я сделал вот так:

Код:

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

(ssget "_C" (polar pt (/ pi 4) 0.01) (polar pt (/ (* 5 pi) 4) 0.01) '(( 0 . "LINE")))

где pt - нужная точка. Данный вариант создаст набор из всех примитивов LINE, попадающих в квадрат (рамку) с центром в данной точке и с диагональю 0.02 (единицы чертежа). Для моих целей подходит стопроцентно, работает безошибочно. Спасибо CB за наводку. Хотя Александр Ривилис считает подобные методы извращением. К слову, точность можно и увеличить, если есть страх, что в этот квадратик попадут ненужные линии.
И, как абсолютно справедливо заметил Алексей в предыдущем посте, область должна быть на экране. Поэтому я всегда предварительно программно зумирую вид в эту точку.

[chicot]

Сообщение от skkkk Хотя Александр Ривилис считает подобные методы извращением.

Признаться, меня тоже всегда коробят компромиссы основанные на подмене понятий ( в нашем случае точки на область). Тем не менее хочу еще раз выразить огромнейшую признательность всем завсегдатаям этого Клуба Братьев по Разуму
Ну и выставляю на ваш суд свой опус:

Код:

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

 setq nabor (ssadd))			;из пустой консервной банки создаем камеру-обскура
(vl-cmdf "undo" "mark" "")		;отмечаем точку входав "Матрицу" :-)
(while (ssget '(0 0 0))
  (setq nabor (ssadd (ssname (ssget '(0 0 0)) 0) nabor))
  (vl-cmdf "erase" (ssname (ssget '(0 0 0)) 0) "")
)					;в нужной нам стопке фотографируем верхний лист и уничтожаем его  циклично до полной аннигиляции стопки)
(vl-cmdf "undo" "back" "")		;делаем обратный звонок в реальность :-)
(setq i 0)
(while (ssname nabor i)
  (if (not
	(equal (assoc 0 (entget (ssname nabor i))) (cons 0 "LINE"))
      )
    (progn (setq nabor (ssdel (ssname nabor i) nabor))
	   (setq i 0)
    )
    (setq i (1+ i))
  )
)
					;фильтруем нашу "пиратку" на предмет ненужных вхождений

[VVA]

Сообщение от skkkk Это надо смотреть DXF-Reference и функцию entmake - не все там так просто.

Здесь подробно и с примерами entmake и block/insert
примеры entmake'ов Entmake Functions
Чтобы создать вхождение блока (INSERT) нужно воспользоваться функцией insert из последней ссылки

[baaba]

У меня проблема: моя функция выводит результат вычисления в экспоненциальном виде:
6.66e+007
А я ожидал: 185.0

Вот так выглядит функция:

Код:

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

 
(defun c:dii ()
	(* (getdist) (getvar "dimscale"))
)

Мне она нужна что бы делать измерения на чертежах, сделанных не в масштабе.

Если запускать из командной строки, нет проблем:

Код:

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

 (* (getdist) (getvar "dimscale"))

Но это не так удобно.

PS У меня ещё вопрос: может ли человек читать такое представление числа?

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

Код:

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

 (rtos (* (getdist) (getvar "dimscale")) 2 1)

[Do$]

Сообщение от baaba У меня проблема: моя функция выводит результат вычисления в экспоненциальном виде: 6.66e+007 А я ожидал: 185.0

6.66e+007 = 66600000.0
Ожидания сильно не оправдались. Может быть, поделить надо на dimscale?

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

Или на dimlfac... Кто ж его знает?

[baaba]

Сообщение от Кулик Алексей aka kpblc (rtos (* (getdist) (getvar "dimscale")) 2 1)

Алексей, спасибо! Это работает - я получаю результат в кавычках. Но моя ошибка была как оказалось в другом: я перепутал умножение на деление, от этого получалось большое число, и автокад автоматически представлял его в экспоненциальном представлении.
Спасибо за ответ!

[mankurt]

Всем привет!
Добрые гуру лиспа, а просветите пожалуйста чайника, какими средствами достичь ускорения работы лиспа в автокаде?

Поясню - есть лисп, который:
1. в топографических планах ищет замкнутые горизонтали;
2. просчитывает точки вставки бергштрихов (полилинии, указывающие направление уклона рельефа);
3. создает из триангуляционной модели рельефа (в виде 3dFace) список с координатами и высотами вершин каждого треугольника.
4. ищет по текущим координатам точки вставки треугольник, которому эта точка принадлежит, и сравнивает высоты (находит уклон рельефа);
5. вставляет в точку вставки блок, разворачивает его и взрывает

Треугольников в чертеже может быть десятки тысяч, соответственно список тоже ооочень длинный. Количество анализируемых точек вставки - сотни.
Из команд автокада используется обращение к layer и insert, порядка 20 переменных.

Смущает скорость выполнения. Autocad Civil 2013, порядка 9000 треугольников 3D Face, 330 точек вставки - формирование списка - порядка 10 секунд, вставка блоков - около 10 минут.
Если треугольников уже десятки тысяч, то время возрастает до часа-полутора. При этом та же программа начисто подвешивает Land 2006 и из ступора он уже не выходит.

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

[ShaggyDoc]

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

Для этого надо смотреть код - как именно "просчитывает", "ищет", формирует и обрабатывает списки на алгоритмическом уровне.

И однозначно тормоз здесь

Из команд автокада используется обращение к layer и insert

Функции command и vl-cmdf работают во много раз медленнее, чем объектные методы. При каждом вызове анализируются все опции и только потом управление передается внутренним механизмам AutoCAD.

[mmax]

Сообщение от mankurt какими средствами достичь ускорения работы лиспа в автокаде?

давным давно я тестировал автолисп на скорость.
Сделал программку рисующую кривую Коха.. Кривая Коха это такая хитрая фигурка похожая на очень кривой штакетник которая может содержать от 4 до бесконечности линий.

Уж и не помню точно, программа отрисовывала больше миллиона линий, а может даже больше десятка миллионов. Фрактал растет в какой-то быстро возрастающей не линейной прогрессии названия которой я уже и не помню. В общем за несколько циклов количество линий во фрактале вырастает от 4 до миллиардов. Возможно даже моя программа отрисовывала и миллиард линий. Суть не в этом.

Рисовалась она тремя способами.

1 При помощи command. Я успел попить чайку, а фрактал продолжал расти когда я его уже выпил и сходил покурить. Что-то около получаса заняло.
2. При помощи entmake дело пошло быстрее, но не намного.
3. При помощи объектной модели (vla-функций) я лицезрел конечный результат не вылезая из за компьютера, не пил чай и не курил. А потом задал такое количество циклов роста фрактала (вроде даже попросил нарисовать бесконечный фрактал), что через 5 минут получил сообщение о недостатке памяти. В командную строку вылезло какое-то сообщение об ошибке номер 000005 c буквой "С" то-ли спереди то-ли сзади.

Вывод: хочешь скорости? Выбирай объектную модель.

[Дима_]

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

[mmax]

В вопросе скорости можно вообще не париться. Я вот тут прикинул. Если на формате а1 нарисовать около 1500 линий толщиной 0.5мм, то мы получим черный прямоугольник. Кто нибудь может похвастаться чертежом с более 2000 примитивов?
Автолисп с легкостью обработает десятки тысяч данных самым неоптимизированным в мире кодом. Кто нибудь может похвастаться чертежом с сотнями тысяч примитивов? На современной технике автолисп и сотнями тысяч не подавится. У кого мильён линий в чертеже?....

[Дима_]

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

[ShaggyDoc]

В вопросе скорости можно вообще не париться

Во многих случаях да. Особенно во всяких интерактивных "рисованиях" - типа нарисовать балку. Но рано или поздно возникают задачи с очень большими вычислениями - когда счет времени на сутки идет. Вот здесь решающую роль играют алгоритмы и методы рисования. Кстати, и об утечках памяти надо заботиться, иначе постепенно начинает подключаться дисковая память. Да заодно не забывать и про ловушки ошибок.

[mankurt]

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

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

Сообщение от mmax хочешь скорости? Выбирай объектную модель.

Необязательно: http://autolisp.ru/2009/09/22/programming-style/ + http://autolisp.ru/2009/09/20/execution-speed-check/

[Fedorino]

Добрый день! Подскажите пожалуйста чайнику!
Вопрос касается расширенных данных.
Почему этот код работает

Код:

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

 (setq layer0 (entget (tblobjname "LAYER" "Слой1")))
                  (setq x_date (list (list -3 (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 "слой1")) (list "AcCmTransparency" (cons 1071 0)))))
	    (setq layer0 (append layer0 x_date))
	    (entmod layer0)

а вот этот не работает

Код:

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

 (setq layer0 (entget (tblobjname "LAYER" "Слой1") '("*")))
                  (setq x_date (list (list -3 (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 "слой1")) (list "AcCmTransparency" (cons 1071 0)))))
	    (setq layer0 (append layer0 x_date))
	    (entmod layer0)

почему в последнем случае идет объединение dxf кода -3, а в первом замена?
Заранее спасибо!

[mankurt]

Почему может не работать подобная конструкция? По замыслу в переменной Obj должны записаться 3d face в слое Триангуляция, выбранные в области, ограниченной окном (координаты считаются).
Error пишет: ActiveX Server returned the error: unknown name: Select; error:
An error has occurred inside the *error* functionAutoCAD variable setting
rejected: "osmode" nil

Код:

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

 
(defun C:kak ( / )
   (begin_activex)
   (setq TrLayer "ИИ_ТРИАНГУЛЯЦИЯ_025")
   (setq coord_point (getpoint "Выберите точку"))
     (setq coord_point1 (polar coord_point (/ (* 3 pi) 4) 30)
	   coord_point2 (polar coord_point (/ (* 7 pi) 4) 30)	   
	   );

     (setq coord_point1
	    (vlax-make-variant
	       (vlax-safearray-fill ; заполнение созданного безопасного массива
                    (vlax-make-safearray vlax-vbString '(0 . 2)  ; создание безопасного массива с 3-мя элементами
		    )
		     coord_point1
	       )
	    )
     );setq

      (setq coord_point2
	    (vlax-make-variant
	       (vlax-safearray-fill ; заполнение созданного безопасного массива
                    (vlax-make-safearray vlax-vbString '(0 . 2)  ; создание безопасного массива с 3-мя элементами
		    )
		     coord_point2
	       )
	    )
     );setq
     
     (setq Obj (vla-select model_space acSelectionSetWindow coord_point1 coord_point2
                (vlax-safearray-fill
		    (vlax-make-safearray vlax-vbInteger '(0 . 1)
                     ) '(0 8)
		 )
                (vlax-safearray-fill
		    (vlax-make-safearray vlax-vbVariant '(0 . 1)
                     ) '("3DFACE" "ИИ_ТРИАНГУЛЯЦИЯ_025")
		 )
       
              )
      )
  
);defun


;****************************************************************
; подготовка к работе с ActiveX
;****************************************************************
(defun begin_activex ( / )
  (vl-load-com)
  (setq acad_application (vlax-get-acad-object))
  (setq active_document (vla-get-ActiveDocument acad_application))
  (setq model_space (vla-get-ModelSpace active_document))
); defun begin_activex

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

А что, в coord_point1 на момент вызова (setq coord_point1 (vlax-make-safearray ... хранятся строки? Это раз.
Второе. То же самое - с coord_point2
Дальше даже не стал смотреть. Советую пройтись по шагам (часть пояснений есть здесь: http://autolisp.ru/2009/09/12/vlide-misc-02/ ) и посмотреть, на каком месте спотык.

[mankurt]

Сообщение от Кулик Алексей aka kpblc А что, в coord_point1 на момент вызова (setq coord_point1 (vlax-make-safearray ... хранятся строки? Это раз. Второе. То же самое - с coord_point2 Дальше даже не стал смотреть. Советую пройтись по шагам (часть пояснений есть здесь: http://autolisp.ru/2009/09/12/vlide-misc-02/ ) и посмотреть, на каком месте спотык.

Ок, вставил для coord_point1 и coord_point2 тип vlax-vbDouble, в результате формируются два варианта с типом safe-array, содержащие координаты точек.
Теперь прога стопорится на (выделено жирным):

Код:

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

(setq Obj (vla-select model_space acSelectionSetWindow coord_point1 coord_point2
                (vlax-safearray-fill
		    (vlax-make-safearray vlax-vbInteger '(0 . 1)
                     ) '(0 8)
		 )
                (vlax-safearray-fill
		    (vlax-make-safearray vlax-vbVariant '(0 . 1)
                     ) '("3DFACE" "ИИ_ТРИАНГУЛЯЦИЯ_025")
		 )
       
              )
      )[/lisp]

Запутался, если честно, с этим типами.. Из описания vla-select способом acSelectionSetWindow:
- коды фильтров - безопасный массив целых чисел в виде варианта - с этим понятно, задаем тип vbInteger
- значения фильтров - безопасный массив типа вариант в виде варианта. - то есть надо присваивать тип vlax-vbvariant, так?
Но '("3DFACE" "ИИ_ТРИАНГУЛЯЦИЯ_025") в виде варианта не воспринимается. То есть надо еще сделать из этого списка вариант? На каком этапе это надо делать, внутри самой vlax-make-safearray?

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

http://www.afralisp.net/visual-lisp/...ction-sets.php
поиск - великая штука!

[gomer]

Сообщение от mankurt Почему может не работать подобная конструкция?

Перемудрил вот и не работает, помимо замечаний kpblcа неправильно организована функция *error*, в которой системной переменной osmode присваивается значение не инициализированной переменной.

[Shoorup]

Решил попробовать себя в Lisp и накатать программку которая давно назревала в наших проектных массах. По большей части изобретение велосипеда, но я для учебных целей. Итак мне нужно рисовать рамки с половиной бокового штампа в пространстве модели и автоматом создавать видовой экран в пространстве листа для него. Все это вешаю на несколько кнопок: +1 лист, +5 листов, -1 лист - 5 листов. Листы всегда формата А3. Вновь создаваемые листы всегда на строго отведенном месте в пространстве модели начиная от координаты 0.0 вниз по 5 листов в ряд. Создавать листы из блоков думаю не стоит... потому как всегда найдутся те кто захочет удалить кнопкой Del, расчленить блок и т.д. А для чертежа нужен независимый счетчик листов (возможно с их описанием) для того чтобы добавить/удалить лист. И тут я подумал про простую группировку объектов (group). Удалить получится только все объекты входящие в группу, а разгруппировать уверен не сможет никто кто у нас работает, в силу того, что даже не знает о такой фишке как группировка.
Хотелось бы комментариев специалистов на уровне постановки задачи, чтоб не биться в стену за зря

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

Ctrl+H (насколько я помню) - и удаление объекта из группы выполняется легко и непринужденно.

[Shoorup]

Алексей, я же написал что уверен, что у нас не додумаются Народ у нас настолько"неграмотен" в AutoCAD, что я уже просто молчу. Уверен что из 60 человек про группировку слышало максимум 3 человека. Более 10 лет весь отдел работает только в пространстве модели и эта программка будет первым шагом к переходу к пространству листа.

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

Блажен кто верует - ему тепло...

[Shoorup]

Тогда какие варианты для защиты от удаления из чертежа (блока или набора примитивов, группы)? Как я понимаю нужно вести счетчик количества листов в чертеже, и примитивы надо както обозначить что это лист и по отдельности их удалять не надо. Можно еще анонимные блоки попробовать... но не хочется перемудрить...

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

Делай MINSERT-блок (вопросы защиты чертежей на форуме были).

[Shoorup]

тут под "защитой" понимается не удалить половину листа например. Т.е. чтобы при добавлении например листа программой точно было посчитано что в чертеже 6 листов а не 5,5 А за PICKSTYLE спасибо - учтем. Я уже проверил "блок" из группы на рядовом пользователе - по частям у него удалить не получилось.

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

Я говорю - делаешь MINSERT-блок. Можно даже анонимный. Вставляешь его, меняешь атрибуты. Потом при вставке следующего получаешь все вхождения соответствующих MINSERT-блоков, считываешь оттуда данные.

[Shoorup]

уже тренируюсь создавать группу... но наверно блоки вставлять было бы попроще Но мы же не ищем легких путей.
Пока план такой:
0. делаем кнопку по нажатию на которой выполняется программа по вставке листа в пространство модели
1. Рисую рамку vl-cmdf
2. Заношу нарисованные объекты в группу, присваиваю группе имя, описание.
это уже реализовал
3. при следующем нажатии (как и при первом) проверяем сколько групп с именем (шаблон) уже вставлено.
4. По описанию прибавляем к координатам поправки и вставляем следующие листы
5. создаем видовой экран в пространстве листа и по поправкам координат даем ему размеры + настраиваем лист - это для меня самое сложное наверно будет...

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

Если хочется совсем заморочиться, то вот еще вариант:

1. Создается анонимный блок, содержащий всю рамку. В описание блока (например, в словарь) засовываются данные, позволяющие определить - что это за блок и что он требует дополнительной обработки
2. Блок вставляется как MINSERT с количеством строк и столбцов равным 1
3. Проверяются все вхождения MINSERT-блоков (точнее, анонимных блоков), в описании которых есть данные, определенные в п.1.
4. С блоков считываются данные о номерах листов и общем количестве листов.
5. Вызывается диалог, позволяющий заполнить атрибуты этого самого блока

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

[Shoorup]

Все понял кроме атрибутов. А зачем они? Какбы штамп я не планирую в рамку. А дополнительную информацию в атрибутах хранить мне кажется незачем.
В любом случае доделаю - выложу исходник посмеятся
Программа действительно специфичная... врядли кому пригодится, но я точно уверен, что в наш отдел она очень нужна. У нас 90% чертежей это формат А3. Другие форматы выполняются в специальственных программах где создание видового экрана этого листа не требуется. А те что делаем чертежи могут содержать от 1 до 150 листов А3 в одном чертеже. Создавать руками для каждого листа даже копируя видовой экран это долго. А тут и потренеруюсь и польза будет


Объясните мне пожалуйста вот такую штуку. Почему если поменять первую строку со второй получим разные результаты?

Код:

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

 (vl-cmdf "_.rectang" "Ширина" "1" "" '(20 5) '(415 292))
(vl-cmdf "_.rectang" "Ширина" "0" "" '(0 0)  '(420 297))

[Дима_]

Сообщение от Shoorup Объясните мне пожалуйста вот такую штуку. Почему если поменять первую строку со второй получим разные результаты?

Ищи по слову привязки...

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

http://autolisp.ru/2013/12/19/comman...utre-troubles/

[Shoorup]

Дима_, Кулик Алексей aka kpblc, спасибо! Граблями по лбу получил

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

Касаемо слова "Ширина" в команде: http://autolisp.ru/2010/03/04/localization/

[Shoorup]

Кулик Алексей aka kpblc, я начал тему перечитывать потиху. Правило №1,2 VVA уже учу Но я и так про них знал, просто пользуюсь только локализованым AutoCADом да и программка не планируется за пределы.
Лучше поясните мне плиз как работает osnapcoord на примере. Справку почитал и по форуму тоже полистал. Эту переменную тоже сохраняют зачемто, но я не пойму даже как она работает и на что может повлиять при выполнении lisp.

[Nike]

Уважаемые товарищи программисты! Помогите подправить программку, пожалуйста! Самому ума не хватило

Программка меняет ширину выбранного атрибута на заданное значение у выбираемого блока или во всех одноименных блоках.
А можно ли сделать так, чтобы изменялись атрибуты в выбираемой группе блоков?

Код:

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

 (defun c:widedit (/ aDoc x attent uwd option tag blk bn)
;;;	pBe 11JN2013	;;;
 (vl-load-com)
 (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object))) 
 (if (and (setq x (car (nentsel "\nSelect attribute: ")))
 	  (eq "ATTRIB" (cdr (assoc 0 (entget x))))
	  (setq attent (vlax-ename->vla-object x))
          (princ (strcat "\nCurrent Width is <" (rtos (vla-get-scalefactor attent) 2)"> "))
    	  (setq uwd (getreal "\nEnter new width:  "))) 
  (progn	          
	(initget "Y N")
	(setq option (cond
	               ((getkword "\nApply width to all Attribute of the same block? [Yes/no] <N>: "))
                       ( "N" ))) 
	(if (eq option "N")
          	(vla-put-scalefactor attent uwd)
                (progn
                  (setq tag (vla-get-tagstring attent))
                  (setq Blk (vla-ObjectIdToObject aDoc
					(vla-get-OwnerId  attent))
                        Bn  (vla-get-effectivename blk))
                  (vlax-for itm (vla-item (vla-get-blocks aDoc) bn)
                    	(if (and (eq (vla-get-objectname itm) "AcDbAttributeDefinition")
                    		 (eq (vla-get-tagstring itm) tag))
                          		(vla-put-scalefactor itm uwd)))
		(vlax-for layout (vla-get-layouts aDoc)
		    (vlax-for i (vla-get-block layout)
		      (if (and
		            (eq (vla-get-objectname i) "AcDbBlockReference")
		            (eq (Vla-get-hasAttributes i) :Vlax-true)
		            (eq (vla-get-effectivename i) bn)
		          )
		        (foreach itm  (vlax-invoke i 'GetAttributes)
		                  (if (eq (vla-get-tagstring itm) tag)
		                      (vla-put-scalefactor itm uwd))
		          	)
		          )
		      	)
		      )
                  )
          )
    )
   (vl-some
         '(lambda (j) (if (null (eval (car j))) (princ (cadr j))
              )) 
         '((x "\n<<None Selected>>")
           (attent "\n<<Selected object not an Attribute>>")
           (uwd "\n<<No Width value>>"))
         )
   )
  (princ)

)

[mankurt]

Подскажите, существует ли способ удалить из selection set, содержащего vla- объекты, какой-либо элемент "начисто", чтобы он позднее не нашелся при обращении к этому selection set?
Я пробовал удалять методом vla-delete, но во модели остается упоминание об объекте. Далее в процессе циклического перебора программа натыкается на удаленный элемент и возвращает ошибку.
Проверить на vlax-erased-p не удается, так как указатель на удаленный элемент selection set нельзя получить.

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

Ничего не понял. Объект физически удаляется или его надо просто "выкинуть" из результата, возвращаемого ssget?

[mankurt]

Сообщение от Кулик Алексей aka kpblc Ничего не понял. Объект физически удаляется или его надо просто "выкинуть" из результата, возвращаемого ssget?

Элементы selection set (бергштрихи-полилинии) проверяются, содержатся ли они внутри замкнутых контуров строений, если содержатся, то удаляются из чертежа физически.
Надо сделать так, чтобы при последующей проверке для других контуров, удаленный бергштрих "не отсвечивал", т.к. в selection set он все равно присутствует.

Selection set формируется методом
(vla-Select berg_ss acSelectionSetAll nil nil filter_code filter_value)

[Дима_]

Сообщение от mankurt Далее в процессе циклического перебора программа натыкается на удаленный элемент и возвращает ошибку.

Скорее это ошибка в алгоритме - объект физически удалили, а ссылку на него оставили - вот и ругается. Из под автолиспа, я предпочитаю не работать напрямую с selectionset а перегнать в список (и если надо - потом обратно), хоть в принципе функция для удаления элемента из коллекции есть - ssdel.
p/s/ проверяйте последовательность команд - скорее всего Вы "попались" на ловушки переменных значений.

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

Кажется, так:

Код:

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

  (vlax-for item berg_ss
    (if (_is-ent-inside bound item)
      (vla-erase item)
      ) ;_ end of if
    )

[Алена92]

Здравствуйте!

Начала (учить '(lisp)), уже не терпиться написать программы, которые сократят количество кликов в разы на моей работе: возник вопрос.

Восстанавливаю 3D из 2D чертежей.
У меня есть штриховка, есть кнопка с коммандой восстановить контур штриховки _.HATCHGENERATEBOUNDARY
Иногда контур приходится редактировать.
Из полученного контура я кнопочкой создаю область (клик по кнопке создать область, затем выбираю контур)
После этого иногда бывает нужно преобразовывать область в поверхность, чтобы можно было обрезать лишнее.
Потом вытягиваю, вращаю и пр.

Собственно вопрос - как передавать полученный из штриховки контур функции автокада по созданию области? А затем область передавать функции по преобразованию в поверхность?

использую (vl-cmdf ...)

Спасибо за помощь!

[Дима_]

Сообщение от Алена92 использую (vl-cmdf ...)

это зря он в понимании простой, но работать с ним сложно (геморно). По основному воросу - попробуй (entlast)

[Алена92]

О, класс, то что нужно! буду пробовать и по результату напишу что получилось. Мерси ! :*

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

Только не помешает предусмотреть ситуацию, когда контур не создался.

[Алена92]

Сообщение от Кулик Алексей aka kpblc Только не помешает предусмотреть ситуацию, когда контур не создался.

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

[gomer]

Сообщение от Алена92 Начала (учить '(lisp))

Сообщение от Алена92 Восстанавливаю 3D из 2D чертежей.

Сообщение от Алена92 как передавать полученный из штриховки контур функции автокада по созданию области?

Меня одного напрягает такая постановка вопроса?

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

Меня "напрягает" только создание 3D из 2D... А в остальном - мы все учились понемногу...

[mankurt]

Снова вынужден обратиться к вам, гуру Lisp, cо своей неразрешимой проблемой ).
У небезызвестного многим Lee Mac есть функция определения координат центроида замкнутой полилинии (код смотрите ниже).
При встраивании этой функции в свою программу столкнулся с тем, что не все контуры обрабатываются правильно - то есть не всегда точка центроида ставится внутри контура.
Приложил файл .dwg c примером конфликтной ситуации. Все контура полилинии одинаковые и замкнутые.

Случай 1: Координаты X - семизначные, Y - шестизначные. Контур полилинии слева отрабатывается неправильно, справа - правильно.

Случай 2: Те же контура, но находятся в окрестностях начала координат. Оба контура обрабатываются правильно.

Намекните, как могут координаты контуров влиять на результат функции LM:PolyCentroid и приводить к неправильному вычислению координат центроида?
Координаты же не сикстиллионы с сикстиллиардами.. Может дело в какой-то системной переменной?

UPD. C причиной не разобрался, попробовал использовать библиотечную dwgru-geom-lwpolyline-centroid - работает безошибочно

Код:

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

 ;; Polygon Centroid  -  Lee Mac
;; Returns the WCS Centroid of an LWPolyline Polygon Entity

(defun LM:PolyCentroid ( e / l )
    (foreach x (setq e (entget e))
        (if (= 10 (car x)) (setq l (cons (cdr x) l)))
    )
    (
        (lambda ( a )
            (if (not (equal 0.0 a 1e-8))
                (trans
                    (mapcar '/
                        (apply 'mapcar
                            (cons '+
                                (mapcar
                                    (function
                                        (lambda ( a b )
                                            (
                                                (lambda ( m )
                                                    (mapcar
                                                        (function
                                                            (lambda ( c d ) (* (+ c d) m))
                                                        )
                                                        a b
                                                    )
                                                )
                                                (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                                            )
                                        )
                                    )
                                    l (cons (last l) l)
                                )
                            )
                        )
                        (list a a)
                    )
                    (cdr (assoc 210 e)) 0
                )
            )
        )
        (* 3.0
            (apply '+
                (mapcar
                    (function
                        (lambda ( a b )
                            (- (* (car a) (cadr b)) (* (car b) (cadr a)))
                        )
                    )
                    l (cons (last l) l)
                )
            )
        )
    )
)

(defun c:test ( / ss )
    (if
        (setq ss
            (ssget "_+.:E:S:L"
               '(
                    (0 . "LWPOLYLINE")
                    (-4 . "&=")
                    (70 . 1)
                    (-4 . "<NOT")
                    (-4 . "<>")
                    (42 . 0.0)
                    (-4 . "NOT>")
                )
            )
        )
        (entmake (list '(0 . "POINT") (cons 10 (LM:PolyCentroid (ssname ss 0)))))
    )
    (princ)
)

[mankurt]

Есть ли, навскидку, какая-то альтернатива команде trim среди ActiveX методов? Или все только trim в своих программах используют?
"Extrim" из Express написана c обращением к куче команд. Если на нее подавать кучу полилиний из SS, то очень долго получается. Хотя там много проверочных условий...

[gomer]

нет такого вроде

[mkung]

Добрый день.
Понадобилось написать небольшую программку (чего очень давно не делал).
В зависимости от наличия переменной или уже определенных путей, устанавливает или добавляет нужное значение переменной TRUSTEDPARTS.
Вот ее текст:

Код:

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

 (vl-load-com)
(setq trup (getvar "TRUSTEDPATHS"))
(if (/= trup nil)
      (if (or (= trup ";") (= trup "")) ((setvar "TRUSTEDPATHS" "T:\\AutoCAD\\admin_tools\\lispload") 
	                                              (princ "\nПуть к доверенным файлам установлен") 
	                                             )
			                             (if (wcmatch trup "T*AutoCAD*admin_tools*lispload") (princ "\nНужный путь к доверенным файлам уже установлен") 
					 					                                                          ((setvar "TRUSTEDPATHS" (strcat trup "; T:\\AutoCAD\\admin_tools\\lispload"))
											                                                   (princ "\nПуть к доверенным файлам добавлен") 
											                                                  )
				                     )
      )
      (princ "\nТакой переменной не существует")
)

Все работает как надо, но одна беда - по завершении после сообщения вылазит "ошибка; неизвестная команда "T:\\AUTOCAD..."
Я так понимаю, что это установленное значение влетает в командную строку и пытается выполниться.
Как этого избежать? Заранее благодарен.
Михаил

[Frigate]

Код:

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

  ((setvar "TRUSTEDPATHS" (strcat trup "; T:\\AutoCAD\\admin_tools\\lispload")) 

у тебя тут скобки закомменчены, проверь еще раз

[mkung]

Сообщение от Frigate Код: [Выделить все] ((setvar "TRUSTEDPATHS" (strcat trup "; T:\\AutoCAD\\admin_tools\\lispload")) у тебя тут скобки закомменчены, проверь еще раз

Да вроде нормально все со скобками...

[w7ra]

to mkung ,
Да нет одной не хватает 3- начинают, а 2 закрывают. Не зер гуд, посмотри в строке (посчитай, количество открытых и закрытых скобок повнимательней).Должно быть (_(_(_____)_)_), а у Вас (_(_(_____)_)_?. Вроде так учили на парах по программированию.

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

А почему перед setvar стоит 2 скобки? Почему после ";" в строковой переменной установлен пробел?

[gomer]

Код:

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

 (setq appath "T:\\AutoCAD\\admin_tools\\lispload"
      trup   (getvar "TRUSTEDPATHS")
)
(cond
  ((null trup)
   (princ "\nТакой переменной не существует")
  )
  ((wcmatch trup (strcat  "*" appath "*"))
   (princ "\nНужный путь к доверенным файлам уже установлен")

  )
  ((member trup '("" ";"))
   (setvar "TRUSTEDPATHS" appath)
   (princ "\nПуть к доверенным файлам установлен")
  )

  (T
   (setvar "TRUSTEDPATHS" (strcat trup (chr 59) appath))
   (princ "\nПуть к доверенным файлам добавлен")
  )
)

[kha]

Прошу покритиковать одну из моих первых программ:

Код:

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

 (defun C:kha_spds_explode ( / ss answer i obj_name)

  (setq ss (ssget "_x"))
(setq answer (bg:msg-yes-no "Внимание"
	     "Все объекты SPDS GraphiCS будут взорваны !!!\nПродолжить?"))
(setq i 0)
(if ss (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))
   )
)
)
(if (and ss answer)
  (progn
   	(setvar "qaflags" 1)
   	(command "_.explode" ss "")
        (setvar "qaflags" 2)
	)
  )
)

(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)  
)

Программа взрывает объекты СПДС GraphiCS и псевдолинии и псевдополилинии SPDS.

Вопросы:

1. Не слишком ли много переменных? Можно ли сделать меньше?
Как вариант: (setq obj_name (cdr (assoc 0 (entget (ssname ss i))))) заменить на функцию и вызывать функцию, а не обращаться к переменной. Ещё вариант ухода от переменной (только что пришла мысль) - блок кода со взрывом объектов забросить в первую конструкцию (if ...) и в условии спрашивать не переменную answer, а сделать прям там вызов диалога (итого - получилось минус две переменные)

2. В этой программе я использовал функцию вызова диалога из пакета программ bgtools. Как обычно описываются сторонние функции? Требуется ли сообщать автору (если есть возможность его найти) об использовании его функции в своей программе? Какие правила (писаные/неписаные) есть по этому поводу?

[Vladimir_Sergeevich]

Два вопроса о vla-
1. условие (if (not (vla-item (vla-get-layers adoc) "_vsp"))... понял, что нельзя, как красиво обойти?
2.объясните как оптимизировать создание объекта с помощью vla

Код:

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

 (setq lay-vsp (vla-add (vla-get-layers adoc) "_vsp"))
(vla-put-plottable lay-vsp :vlax-false)
(vla-put-color lay-vsp 140)
(vla-put-lineweight lay-vsp 30)

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

[ShaggyDoc]

2.объясните как оптимизировать создание объекта с помощью vla

Надо не столько "оптимизировать", сколько сделать надежным. Например, в "частном случае" vla-add может сработать с ошибкой, и последующие vla-put также будут создавать ошибки. Но со слоем это частный случай. Гораздо чаще надо создавать объекты-примитивы. Для них надо сделать надежные библиотечные функции, в аргументах которых можно передавать чаще всего используемые данные - слой, цвет, тип линии, вес.

Например, создание отрезка:

Код:

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

 
(defun ru-line-add (start_pnt end_pnt lineweight ltype / obj)

  (ru-error-catch
    (function (lambda ()
                (setq obj (vla-addline
                            (ru-obj-active-space)
                            (vlax-3d-point start_pnt)
                            (vlax-3d-point end_pnt)
                          ) 
                ) 
                (cond
                  ((vlax-write-enabled-p obj)
                   (ru-lw-set-for-obj obj lineweight)
                   (if Ltype
                     (ru-ltype-apply obj Ltype)
                   ) 
                   (vla-update obj)
                   obj
                  )
                )
              )
    ) 
    (function (lambda (x)
                (princ (strcat "\nОШИБКА RU-LINE-ADD " x))
                nil
              ) 
    ) 
  )                 
)    

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

Код:

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

   (ru-line-add (list 0.0 0.0) (list 10000.0 10000.0) 50 nil)
  (ru-line-add (list 0.0 0.0) (list 1000.0 10000.0) 50 "DASHDOT2")

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

[gomer]

Сообщение от Vladimir_Sergeevich как красиво обойти?

В большинстве случаев можно схалтурить и просто спросить у чертежа есть ли в нем нужный слой

[Дима_]

Сообщение от kha Прошу покритиковать одну из моих первых программ:

Ну если из первых - то программа просто шикарная, но есть несколько логических казусов:
- возврат функции msg-yes-no надо проверять сразу по выполнению и если он "нет", то нет никакого смысла выполнять фильтрацию набора - он все равно не понадобится - как следствие нет нужды в выделении имени answer - ненужная работа.
- "qaflags" надо не устанавливать в фиксированное значение, а "запоминать" перед изменением и восстанавливать после работы (как впрчем и любые другие используемые на изменение системные переменные).

Сообщение от kha 1. Не слишком ли много переменных? Можно ли сделать меньше?

Это на ваш вкус - можно избавиться от всех.
з.ы. Не партесь - все бы так как Вы программировали...

[Vladimir_Sergeevich]

Сообщение от ShaggyDoc Надо не столько "оптимизировать", сколько сделать надежным. Например, в "частном случае" vla-add может сработать с ошибкой, и последующие vla-put также будут создавать ошибки. Но со слоем это частный случай. Гораздо чаще надо создавать объекты-примитивы. Для них надо сделать надежные библиотечные функции, в аргументах которых можно передавать чаще всего используемые данные - слой, цвет, тип линии, вес.

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

Сообщение от gomer В большинстве случаев можно схалтурить и просто спросить у чертежа есть ли в нем нужный слой

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

[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]

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

[gomer]

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

Код:

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

 (defun c:test ()

  (setq vprt (car (entsel)))
  (setq ang (getreal "\nAngle: "))
  
  (setq cen (cdr (assoc 10 (entget vprt))))
  (setq old (getvar 'VPROTATEASSOC))
  
  (setvar 'VPROTATEASSOC 1)
  (vl-cmdf "_.rotate" vprt "" cen ang)
  
  (setvar 'VPROTATEASSOC 0)
  (vl-cmdf "_.rotate" vprt "" cen (- ang) )
  
  (setvar 'VPROTATEASSOC old)
)

[kakt00z]

vla-put-rot*
или vla-put-a*
думаю может помоч (мне помогало)
Offtop: gomer, сообщение напоминают тот случай когда папы играются с вертолетиками своих дтей

[Дима_]

Он работает - выздоравливай.

[gomer]

Сообщение от Дима_ Он работает

ТОгда ж почему он не поворачивает обратно вьюпорт?

[Vov.Ka]

Сообщение от gomer подскажите как повернуть вид в вьюпорте

Код:

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

 vla-put-TwistAngle

[gomer]

Сообщение от Vov.Ka vla-put-TwistAngle

Это я пробовал, не то. TwistAngle закрручивает вид в пространстве, а нужно повернуть плоскость xy относительно оси z

[Vov.Ka]

Сообщение от gomer а нужно повернуть плоскость xy относительно оси z

[IMG]http://i.*******info/i9/90ae47b091820f3bc1bf760e92d9c530/1398111430/4235/373356/Clipboard_1_240.jpg[/IMG][IMG]http://i.*******info/a3/2014-04-21-20-17/i9-6273494/240x136-r/i.gif[/IMG]

[gomer]

Vov.Ka, все равно не подходит, вид улетает, а нужно, чтоб вид сохранялся, причем при любом угле, не только 90 градусов

[mkung]

Добрый день.
Есть программка, отрисовывающая выноску по параметрам дуги.
Но пользователь попросил, чтобы выноска была в пространстве листа.
Выноска, как она получается - во вложенном файле.
Проблема в том, что она аннототивная и при использовании команды СМЕНАПРОСТР с масштабом полный алес-капут.
Может кто подскажет как корректно перенести выноску на лист программно?
Заранее благодарен.

[Vov.Ka]

Сообщение от gomer все равно не подходит, вид улетает

другого выхода у нас нет
будем извращаться

Код:

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

 (defun vk_ZoomTo (Center)
  (vla-ZoomCenter
    (vlax-get-acad-object)
    (vlax-3d-point Center)
    (getvar "VIEWSIZE")
  )
)
(defun vk_CenterViewport (Viewport Center / ADoc)
  (setq	ADoc	 (vla-get-ActiveDocument (vlax-get-acad-object))
	Viewport (if (= (type Viewport) 'ENAME)
		   (vlax-ename->vla-object Viewport)
		   Viewport
		 )
  )
  (vla-put-MSpace ADoc :vlax-true)
  (vla-put-ActivePViewport ADoc Viewport)
  (vk_ZoomTo Center)
  (vla-put-MSpace ADoc :vlax-false)
)
(defun vk_Mx*Vec (m v)
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
(defun vk_RotatePoint2d	(P Ang / s c)
  (setq	s (sin Ang)
	c (cos Ang)
  )
  (vk_Mx*Vec (list (list c (- s)) (list s c)) P)
)
(defun vk_GetAssVal (Key InList) (cdr (assoc Key InList)))
(defun vk_RotateViewPort (Viewport Ang / TwAng Center)
  (setq	TwAng  (vk_GetAssVal 51 (entget Viewport))
	Center (vk_RotatePoint2d (vk_GetAssVal 12 (entget Viewport)) (- TwAng))
  )
  (vla-put-TwistAngle (vlax-ename->vla-object Viewport) (+ TwAng Ang))
  (vk_CenterViewport Viewport Center)
)

[Дима_]

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

[gomer]

Сообщение от Дима_ интересно в чем там заковырка

Тут два варианта, либо баг, либо фишка. Если Это фишка, то тогда чего я не знаю? Причем не склоняется обратно даже с помощью vla-rotate.

[kakt00z]

возник вопрос в продолжение темы танцев с viewport
сталкивался ли кто-нибудь с такой ситуацией
создаю программно layout (задаю ему только название)
вставляю в layout видовой экран, включаю его, устанавливаю ему target (вычисленный в координатах модели из параметров блока)
и он волшебным образом смещает вид от указанной точки на величину своего dxf 12 кода
в описании этого кода "View center point (in DCS)", что за DCS пока что не нашел
заметил что он не меняется на разных файлах, НО меняется - при смене принтера по умолчанию и переоткрытии файла
entmod'ом этот код в '(0 0 0) не меняется
где его можно обнулить

PS вопрос снят, был неправильный подход к решению задачи

[Vladimir_Sergeevich]

Созрел вопрос, а можно ли средствами автолиспа добавить в настройки автокада путь к вспомогательным файлам? например "M:\дороги\_font for autocad"

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

Можно. Вариантов масса:
1. Анализировать (getenv "ACAD") и при необходимости добавлять свой путь (пути)
2. Анализировать (vla-get-supportpath (vla-get-files (vla-get-preferences (vlax-get-acad-object)))) и добавлять свой путь (пути)
3. Залезать в реестр (ИМХО наименее удобный способ).

[Vladimir_Sergeevich]

Думаю №2 самое удобное будет, руки дойдут - займусь. просто, глядя на объектную модель в справке, направления так и не понял без подсказки.

[seregabs]

Уважаемые форумчане! Интересует такой вопрос, сперва принципиально (возможно/нет), после (или в процессе) вставки динамического блока командой из лиспа, выбрать конкретный заранее известный параметр из таблицы выбора этого блока?

[Дима_]

1. Можно.
2. К vla-объекту блока - getdynamicplockproperties->выбор нужного свойства (например по имени ) - vla-put-value порядкового номера.

[kakt00z]

у объекта IAcadDynamicBlockReferenceProperty есть свойство AllowedValues

[seregabs]

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

Код:

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

(vla-load-com)
(setq es (entlast))
(setq ve (vlax-ename->vla-object es))
(setq DynPrs (vlax-Invoke ve 'GetDynamicBlockProperties))
(foreach Prop DynPrs
  (if (= (vla-get-PropertyName Prop) "PosQuan")
    (vlax-put Prop 'Value "11 pos")
  )
)
)

Не разобрался как обратиться сразу к нужному свойству по имени, сделал перебором всех, сработало. Имя всегда одно и то же ("PosQuan"), устанавливаемое значение всегда известно заранее ( для примера "11 pos"). Как бы это упростить?...

[Дима_]

Сообщение от seregabs Не разобрался как обратиться сразу к нужному свойству по имени, сделал перебором всех, сработало.

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

Сообщение от seregabs Как бы это упростить?

Да по сути никак - только что лишние переменные создаете (вполне можно применять функции друг к другу) - вот копия с Вашего поста:

Код:

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

(vla-load-com)
(foreach Prop (vlax-Invoke (vlax-ename->vla-object (entlast)) 'GetDynamicBlockProperties)
  (if (= (vla-get-PropertyName Prop) "PosQuan")
    (vlax-put Prop 'Value "11 pos")))

[Wolkodaw]

Пытаюсь освоить программирование, не могу понять как загружать в автокад диалоговые окна с расширением dcl, чтобы появилось окно. как загрузить? (файл примера скачал на сайте)

[VVA]

http://lee-mac.com/dialogposition.html
там и пример диалога, и его загрузки

[crux]

Доброго времени суток. Подскажите, пожалуйста:
Есть шаблоны с таблицами, данные в таблицы загружаю через связь с данными из экселя.
В случае, когда текст в ячейке экселя длиннее ячейки када, ячейка меняет высоту, шаблон с настроенными листами плывет и приходится ручками все править, что не очень удобно.
Собственно вопрос: есть ли возможность с помощью лиспа определять ширину строки в таблице и переносить часть текста, не уместившуюся в заданную ширину, ячейкой ниже, возвращая ячейке исходную высоту? Соответственно смещая и весь ниже следующий текст.
В лиспе новичок, но если подскажите где копать, буду очень признателен.

[Дима_]

Сообщение от crux В лиспе новичок, но если подскажите где копать, буду очень признателен

В объектной модели автокада - конкретно в классе AcadTable.

[WhiteShark]

Не кидайте помидорами! Лучше подскажите почему не работает такой код

Код:

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

 (defun foo (f x)
  (f x))
(foo 'car '(1 2 3))

Почему error: bad function: CAR ?

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

Код:

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

 (defun foo (f x)
 (apply f (list x))
 ) ;_ end of defun
(foo 'car '(1 2 3))

[WhiteShark]

Алексей, спасибо, конечно! Но я пример с car привел просто так. То есть функция передаваемая в качестве параметра в foo должна быть любой и агрумент любой. Тут всё таки вопрос глубже. В теории видимо дело. Правильно ли я понимаю, что при связывании формальных параметров (f x) превращается в (car '(1 2 3))? Должно же быть так? Почему тогда car не находится системой и выдаётся ошибка error: bad function ?

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

Потому что в твоем случае функцию надо применить (т.е. apply) к списку аргументов. Мне так каэцца
P.S. А в чем более общая задача-то состоит?

[WhiteShark]

Общая задача состоит в том, чтобы работал функционал ) То есть функция (foo), одним из параметров которой является функция, передаваемая как параметр. К примеру (foo '+ '(1 2 3)) уже в твоем варианте работать не будет. Я хочу понять, почему правильная синтаксически с точки зрения языка конструкция выдаёт ошибку. Особенность ли это реализации именно AutoLISP'a. Вот тут http://homelisp.ru/help/classic_funct.html#FUNCTION приведен точно такой же пример и он почему то работает. Подозреваю, что _Дима знает ответ )

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

См. в "Библиотеке" функцию dwgru-error-catch и примеры ее использования.

[gomer]

Сообщение от WhiteShark конечно!

По хорошему тут следовало бы разобраться что такое квота, функция и символ. Правильно не работает, потому что символ - не функция
Работает так

Код:

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

 (defun foo (f x)
  (f x)
)
(foo car '(1 2 3))

[Дима_]

Сообщение от WhiteShark Подозреваю, что _Дима знает ответ

Друзья я приболел - и не заглядывал в интернеты, gomer ответил все верно. Первопричина разночтений лежит глубже. Есть два принципиальных отличия в различных диалектах лиспа - это наличие или отсутствие (ну или отсутствия по умолчанию) т.н. замыканий - проще говоря какие значения имен будут использоваться во время выполнения функции - которые заданы на момент ее выполнения, либо которые заданы на момент определения функции (естественно только "внутренних" имен, а не аргументов). У каждого из них свои плюсы и минусы - я однозначный сторонник замыканий, (которые к моему сожалению не поддерживает автолисп), но это только мое мнение. Для того, чтоб частично устранить проблему отсутствия замыканий, там где без них "тяжко" используют "стандартный" прием - передают функцию как символ - которую принимающая функция выполнит посредством (apply ...), но если ей будет необходимо - она сможет ее "замкнуть" посредством парсинга и "подмены" имен на необходимые значения. Этот прием практически не используеться в автолиспе (по крайней мере в сегменте dwg.ru - я не встречал, ну я от безисходности пару раз делал - если не понимать для чего они (замыкания) нужны, то и алгоритм планируешь без них - парадокс Блаба - а испорченным различными знаниями головам - это информация мешает "творить нормально" - извращаются). Отсюда и разница в синтаксисе например CommonLisp и Scheme (mapcar 'fn lst) против (map fn lst).

[WhiteShark]

Ну вот ) Мои подозрения в кастирорванности нашего любимого AutoLISPa оправдались (
Спасибо нашему больному Диме_ за ответ! (Чтоб мы все так даже в бреду владели! )

[Wolkodaw]

Прошу подсказать опытных форумчан как с помощью active x можно изменять свойства динамических блоков (в частности нужно менять длину блока).

[kakt00z]

Код:

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

 (defun getbdyn (bl prop /)
  (car
    (vl-remove-if-not '(lambda (x) (= prop (vla-get-PropertyName x)))
      (vlax-safearray->list (vlax-variant-value(vla-GetDynamicBlockProperties bl)))
      )
    )
  );defun
(vla-put-value (getbdyn bl_name prop_name) prop_value)

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

Wolkodaw, пять минут:
http://forum.dwg.ru/showthread.php?t=20823

[mkung]

Код:

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

 (vl-cmdf "_.PSPACE")

Подскажите, пожалуйста - как сделать то же самое через vla-put-... (для видового экрана)

[Vladimir_Sergeevich]

Помогите дураку пожалуйста!
надо сжатие арибутов поменять у блоков. написал так:

Код:

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

 (setq BlkRef (vlax-ename->vla-object (car (entsel "Выбери блок:"))))
(foreach item (vlax-safearray->list  (vlax-variant-value (vla-GetAttributes BlkRef))) (vla-put-ScaleFactor item 0.75))

а этот шедевр меняет только во вхождении блока. Как то же самое сделать в описании блока?

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

mkung, а чем не нравится (setvar "ctab")?
Vladimir_Sergeevich, так ты сначала получи указатель на описание блока...

Код:

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

 (defun tt (/ blkref blkdef)
  (if (and (setq blkref (car (entsel "Выбери блок:")))
           (setq
             blkdef (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
                              (if (vlax-property-available-p (setq blkref (vlax-ename->vla-object blkref)) 'effectivename)
                                (vla-get-effectivename blkref)
                                (vla-get-name blkref)
                                ) ;_ end of if
                              ) ;_ end of vla-item
             ) ;_ end of setq
           ) ;_ end of and
    (vlax-for ent blkdef
      (if (and (wcmatch (strcase (vla-get-objectname ent) "*ATTR*"))
               (vlax-property-available-p ent 'scalefactor)
               ) ;_ end of and
        (vla-put-scalefactor ent 0.75)
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of if
  ) ;_ end of defun

[mkung]

Сообщение от Кулик Алексей aka kpblc mkung, а чем не нравится (setvar "ctab")?

Ну, мне кажется это немного не то...
Вот получил я наконец-то активный вьюпорт на листе:

Код:

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

 (vla-get-ActivePViewport (vla-get-ActiveDocument (vlax-get-acad-object)))

Теперь пытаюсь понять - как переключать на нем пространства...
ActiveSpace к нему не применяется видимо.
Хочется сделать как-то поаккуратнее, поскольку командный вариант:

Код:

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

 (vl-cmdf "_.PSPACE")
(setq nvyn (getpoint "\nУкажите начало выноски:"))

Приводит вот к такой ошибке:
Команда: Выберите дугу:_PSPACE
Команда:
Укажите начало выноски:
Повторный вход в LISP невозможен.
Неверная точка.
Укажите начало выноски:

[Vladimir_Sergeevich]

получил !BLKDEF
#<VLA-OBJECT IAcadBlock 21b35494>
далее (vla-GetAttributes BlkDef)
; ошибка: ActiveX Server возвратил ошибку: неизвестное имя: GetAttributes
...
что то не понял, как добраться до описания отрибута внутри описания блока?
одна из мыслей: описание блока - это коллекция примитивов, поэтому надо vlax-for item?
...
где то в строках 12-18 пишет ; ошибка: слишком мало аргументов
не могу понять где. хотя понял (wcmatch (strcase (vla-get-objectname ent) "*ATTR*"))
такогй функции не знал - закоментил - заработало

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

Ну правильно, писал без проверок (не успевал). Вот более верный вариант:

Код:

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

 (defun tt (/ blkref blkdef)
 (if (and (setq blkref (car (entsel "Выбери блок:")))
          (setq
            blkdef (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
                             (if (vlax-property-available-p (setq blkref (vlax-ename->vla-object blkref)) 'effectivename)
                               (vla-get-effectivename blkref)
                               (vla-get-name blkref)
                               ) ;_ end of if
                             ) ;_ end of vla-item
            ) ;_ end of setq
          ) ;_ end of and
   (vlax-for ent blkdef
     (if (and (wcmatch (strcase (vla-get-objectname ent)) "*ATTR*")
              (vlax-property-available-p ent 'scalefactor)
              ) ;_ end of and
       (vla-put-scalefactor ent 0.75)
       ) ;_ end of if
     ) ;_ end of vlax-for
   ) ;_ end of if
 ) ;_ end of defun

[Vladimir_Sergeevich]

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

[mkung]

Добрый день.

Пытаюсь посчитать количество вьюпортов на активном листе. Написал:

Код:

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

 (setq name_lay (vla-get-name (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object))))) 
(setq xx (strcat "\"" name_lay "\""))
(setq nabor_vp (ssget "_x" '((0 . "VIEWPORT") (67 . 1) (cons 410 xx))))
(princ (sslength nabor_vp))

Получаю в ответ: ; ошибка: неверный список SSGET
Пробовал разные варианты: со скобками и без, подставлять переменную, предварительно созданную CONS - ничего не помогает.
Если подставить тупо (410 . "Первый лист") - то все нормально.
В чем тут дело?

И второй вопрос.
У меня на одном листе 2 экрана, на втором еще 3.
Если моя программка отрабатывает, то длину набора выбора пишет для первого листа 3, а для всего чертежа 8.
Чего туда еще добавляется?
Ну и, может быть, как получить именно количество вьюпортов?

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

(ssget "_x" (list '(0 . "VIEWPORT") '(67 . 1) (cons 410 xx)))

[mkung]

Сообщение от Кулик Алексей aka kpblc (ssget "_x" (list '(0 . "VIEWPORT") '(67 . 1) (cons 410 xx)))

Спасибо. Тупо, но апостроф в исходнике не заметил... Очки пора носить.

А чего еще в набор кроме самих вьюпортов попадает не подскажешь?
А то для меня пока потрошить наборы непросто...

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

При таких условиях, как в коде, только VIEWPORT и попадут.

[mkung]

Сообщение от Кулик Алексей aka kpblc При таких условиях, как в коде, только VIEWPORT и попадут.

Повторюсь.
У меня на одном листе 2 экрана, на втором еще 3.
Если моя программка отрабатывает, то длину набора выбора пишет для первого листа 3, для второго 4, а для всего чертежа (без имени листа) 8.
Получаю из набора по условию в коде (через sslength)

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

Если хочешь получить все ВЭ - убери группу 410. См.DXF Reference

[mkung]

Сообщение от Кулик Алексей aka kpblc Если хочешь получить все ВЭ - убери группу 410. См.DXF Reference

Алексей, под (без имени листа) я и имел в виду без условия по коду 410.
Но при подсчете по программе для одного листа получаемое значение на 1 больше реального количества ВЭ, а для всего чертежа - на 3.
На листе без ВЭ показывает 1.

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

Насколько я помню, один "виртуальный" ВЭ создается при активации пространства. Но не уверен - надо в справке копаться, а у меня сейчас нет времени

[Wolkodaw]

Сообщение от Кулик Алексей aka kpblc Wolkodaw, пять минут: http://forum.dwg.ru/showthread.php?t=20823

Спасибо! Несколько дней копаюсь с этими кодами (код kakt00z в предыдущем посте не понял как работает), а по ссылке код

(setq object_block (vlax-ename->vla-object (car (entsel))))
(setq object_block (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties object_block))))
(setq temp (vlax-variant-value (vla-get-value (nth 0 object_block))))

разобрал полностью, и по моей логике если последнюю строчку изменить на:

(vla-put-value (nth 0 object_block) 2000)

динамический блок должен стать не 1000 как исходный, а 2000 мм. Но он не становится таким. Выдает ошибку ; ошибка: Ошибка Automation. Неверный ввод.

Что я неправильно понимаю в изменении свойства?

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

Скорее всего, первый параметр не может принимать значение 2000. И посмотри http://www.caduser.ru/forum/index.ph...D=44&TID=36703 (сейчас перекину те коды на autolisp.ru - поскольку на caduser.ru уже черт-те сколько не появляюсь).
---
Перекинул: http://autolisp.ru/2014/06/27/dynblocks-parameters/

[Wolkodaw]

Сообщение от Кулик Алексей aka kpblc Скорее всего, первый параметр не может принимать значение 2000. И посмотри http://www.caduser.ru/forum/index.ph...D=44&TID=36703 (сейчас перекину те коды на autolisp.ru - поскольку на caduser.ru уже черт-те сколько не появляюсь). --- Перекинул: http://autolisp.ru/2014/06/27/dynblocks-parameters/

а пример использования можно? Как запустить в командой строке, какие аргументы в каком виде ввести...

[mkung]

Добрый день.
При печати из модели по умолчанию Автокад устанавливает масштаб печати "Вписать".
Есть пользователи, которые печатают "не глядя" (благо просмотр удобоваримый).
Можно ли программно установить скажем 1:100? Чтобы отметка "Вписать" была уже осознанным действием.
Заранее благодарен.

[kha]

Добрый день!

Подскажите, пожалуйста, как получить путь к папке из которой был запущен лисп?

Допустим, есть лисп D:\LISP\Lisp.lsp

Мне нужно, чтобы после запуска лиспа он смог определить своё местоположение. На выходе нужно "D:\LISP"

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

Сообщение от kha Подскажите, пожалуйста, как получить путь к папке из которой был запущен лисп?

Средствами lisp'a - нереально. Александр Ривилис когда-то писал приложение GetLispInfo, но оно было для бог знает какого ACAD'a, и потом не развивалось (уточню: приложение писалось по моей просьбе; но потом надобность в нем отпала. Я и не стал Александра попусту терроризировать).

[skkkk]

Код:

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

(setq path (findfile "Lisp.lsp"))

и далее с помощью функций обработки строк приводить к нужному виду. Не то?

[Дима_]

Крайне сложно - в теории лисп вобще не факт что откуда-то загружен (он может быть сгененирован другим лиспом). Самим лиспом никак (если только сделать специальный лисп который будет следить за системой). Поищи - уже обсуждалось.
з.ы. - ух уже понаписали...

[skkkk]

Сообщение от Кулик Алексей aka kpblc Средствами lisp'a - нереально.

Сообщение от Дима_ Крайне сложно - в теории лисп вобще не факт что откуда-то загружен

Ну если имя файла доподлинно и заранее неизвестно, тогда я прогнал.

[kha]

Спасибо за ответы.

Сообщение от skkkk Код: [Выделить все] (setq path (findfile "Lisp.lsp")) и далее с помощью функций обработки строк приводить к нужному виду. Не то?

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

Хотел сделать миниустановщик, как в VetCAD. Чтобы установить VetCAD, нужно загрузить файл "SetupVetCAD_XXXX.arx".
Он тут же запускается и прописывает нужные пути доступа. Но насколько я понял, это уже средствами arx нужно делать.

Хорошо, средствами LISP не получится. В какую тогда сторону смотреть? net или arx?

[Дима_]

Сообщение от kha В какую тогда сторону смотреть? net или arx?

Не принципиально, можно еще COM, а еще можно установщиком вначале записать в самом лиспе (в реестре) путь к нему-же. Я обычно ставлю установщиком в %appdata%...

[kha]

Дима_, пока что прописываю пути явно. В начале накидал переменных с путями.

Кулик Алексей aka kpblc, нашёл твою тему по этому поводу: http://www.caduser.ru/forum/index.ph...#message127730

по прочтению темы придумал, как можно быстро побороться с возможным переименованием имени сервера. Прописываю имя сервера в переменную в начале лиспа, нужные пути получаю strcat'ом

[kha]

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

После загрузки приложения AutoCAD прописывает путь в реестр:

[HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\RXXX\ACAD-AXXX:XXX\Profiles\[имя профиля]\Dialogs\Appload]

параметр MainDialog

Появился ещё один вопрос - как сделать так, чтобы лисп запустился автоматически после его загрузки через диалог _appload?

[skkkk]

Сообщение от kha как сделать так, чтобы лисп запустился автоматически после его загрузки через диалог _appload?

В самом теле лиспа после закрывающей скобки defun прописать на исполнение определенную в этом лиспе команду или функцию.
Например:

Код:

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

(defun C:TEST ()
	...........
	...........

)
(C:TEST)

[kha]

skkkk, первым делом попробовал, но что-то пошло не так.

Сейчас получилось, благодарю

UPD: понял. Я писал (test), а надо было (c:test)

круто! теперь можно делать макросы для кнопок чуток попроще.

вместо ^C^C(load "test") test
можно писать ^C^C(load "test")

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

Сообщение от kha как сделать так, чтобы лисп запустился автоматически после его загрузки через диалог _appload?

Добавить самовызов функции.

[skkkk]

Сообщение от Кулик Алексей aka kpblc Добавить самовызов функции.

Алексей, а это как? Не так ли, как я толковал в #2221? Offtop: Подозреваю, что ты не заметил еще одну страницу темы

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

Сообщение от skkkk Не так ли, как я толковал в #2221?

Да, так

Сообщение от skkkk Подозреваю, что ты не заметил, что есть еще одна страница темы

Учитывая, что отвечал я с телефона, думаю - мне простительно

----- добавлено через 21 сек. -----
Только что сел за комп...

[gomer]

Фигней страдаете, господа писатели. Есть нормальный способ загрузки, придуманный автодеском давным давно. Сейчас это выглядит как связка CUIX и MNL. Это самый простой вариант, в котором есть и меню и панели инструментов с иконками. Причем команды подгружаются из строго определенного места. Более того, в cuix можно прописать нужные лиспы и они будут подгружаться автоматически. Хотя ИМХО это уже лишнее. Из mnl все что нужно и так прекрасно подгружается

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

gomer, http://adn-cis.org/posledovatelnost-...v-autocad.html и http://adn-cis.org/autocad-autoload-security.html видел? И потом, вопрос был совсем не про это

[gomer]

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

Видал, вот из-за таких деятелей и наворотили непотребностей. а ведь все так красиво начиналось... а кончилось фондом помощи детям зимбабве... а кто теперь эти реакторы пользует? Еще раз повторюсь, чтоб не возникало вопросов типа а откуда ж у меня лисп загрузился, нужно разобрать авгиевы конюшни в системе и грузить все из одного места, обычно это

Код:

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

 (strcat (getenv "PROGRAMFILES") "\\" "MySuperPuperApp2014")

[skkkk]

Сообщение от kha вместо ^C^C(load "test") test можно писать ^C^C(load "test")

С этой стороны не все ли равно, где прописать слово test: в макросе на кнопку или в теле файла *.lsp?
И зачем же каждый раз подгружать лисп? Я вижу, правда два оправданных варианта:
1. Тестирование и отладка кода происходит не во встроенном VLIDE, а в блокноте. Тогда нажатие на кнопку будет каждый раз подгружать измененный код и запускать его на исполнение.
2. Запуск функции необходим при старте Автокада. Дабы не лезть в acad.lsp или acaddoc20XX.lsp, добавляем файл в автозагрузку - и он грузится при старте и тут же исполняется (например, создаются слои, стили размеров, вставляются форматки и т.д.)
В случае с кнопкой для рядового пользователя подгружать лисп стоит лишь в том случае, если он еще не загружен. Конечно, загрузка происходит очень быстро и незаметно, но это как-то плохо, не по Фен-Шую что ли...

[kha]

skkkk, чтобы было по Фен-Шую можно поставить проверку на загрузку лиспа: ^C^C(if (= c:test nil) (Load (findfile "test.lsp")) (c:test)).

Хотя да, смысл теряется. Макрос проще выглядит без автозапуска лиспа:

^C^C(if (= c:test nil) (Load (findfile "test.lsp"))) test

Как только появляется молоток, сразу же всё вокруг кажется гвоздями

Сообщение от skkkk 2. Запуск функции необходим при старте Автокада. Дабы не лезть в acad.lsp или acaddoc20XX.lsp, добавляем файл в автозагрузку - и он грузится при старте и тут же исполняется (например, создаются слои, стили размеров, вставляются форматки и т.д.)

За это спасибо, всё голову ломал, как бы от редактирования acaddoc20XX.lsp уйти.

[Vladimir_Sergeevich]

Прошу критики и помидоров, дабы понять, в том ли направлении мыслю в целом.

Код:

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

 (defun c:pk ( / pt pt1 pt2 pk oldcmd adoc *mspace*)
(vl-load-com)
       (defun *error* (msg)
	(if oldcmd (setvar "CMDECHO" oldcmd))
        (princ msg)
	(princ)
	);end error
(setq oldcmd (getvar "CMDECHO")) (setvar "CMDECHO" 0)
(setq adoc (vla-get-activedocument (vlax-get-acad-object))
      *mspace* (vla-get-ModelSpace adoc))
(if (null curve-os)
(setq curve-os (car (entsel "\nУкажите ось: ")))
);if
(initget "Другая ось")
(setq pt (getpoint "\nУкажите точку: [Другая ось]"))
(cond 
((= pt "Другая")
(setq curve-os (car (entsel "\nУкажите другую ось: ")))
(setq pt (getpoint "\nУкажите точку: "))
)
(t nil);t
);cond
(setq pk (vlax-curve-getDistAtPoint curve-os (vlax-curve-getClosestPointTo curve-os pt))
      pt1 (getpoint "\nУкажите положение текста: ")
      pt2 (getpoint pt1 "\nУкажите поворот текста: ")
)
    (vla-put-Rotation
	(vla-addText *mspace* 
	(strcat "+" (rtos (rem pk 100) 2 1)) 
	(vlax-3d-point pt1) 
	(getvar "textsize"))
    (angle pt1 pt2)
    )
(princ (strcat "\nПоложение точки отностительно оси: " (rtos pk 2 2)))

(setvar "CMDECHO" oldcmd)
(princ) 
);end defun

собственно должна выдавать привязки точек относительно оси с возможностью смены оси

[gomer]

Сообщение от Vladimir_Sergeevich Прошу критики и помидоров

1. Зачем CMDECHO ??? Где OSMODE?
2. Что будет если ось удалена после выполнения программы?
3. Что будет если активна не модель?
4. (t nil) ?

[Vladimir_Sergeevich]

1. почему не надо отключать эхо? привзку отключать тут не надо
2. как то не приходило в голову, что у кого то рука поднимется на такое кощунство
3. все привязки делаются только в модели ибо там же и ось и вся ситуация
4. слизано с полещука - что бы функция возвращала nil в случае когда условие не выполняется. перечитал, подумал, наверно соглашусь, лишее...

з.ы. проверил 2:
Укажите точку: [Другая ось]неверное значение аргумента: AcDbCurve 2130622808
можно спокойно задать другую ось и продолжать ваять

[gomer]

Сообщение от Vladimir_Sergeevich почему не надо отключать эхо? привзку отключать тут не надо

потому что зачем, командные методы не используются, а пользователь должен видеть, что он ввел в комстроку. В вашем случае надо не отключать, а включать...

[Vladimir_Sergeevich]

Идею понял, но... кроме entsel в самом начале и getpoint 3 раза пользователь ничего не вводит, ему на координаты что ли смотреть?
кстати, ради интереса закомментил - разницы никакой не обнаружил, значит можно совсем убрать

[gomer]

вот три раза и нужно указать правильную привязку, почему бы и не посмотреть? разница есть, жаль вы ее не видите

[Vladimir_Sergeevich]

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

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

Я несколько раз пытался понять, чего надо получить... Оказалось выше моего понимания. Может, такой код будет более устойчивым (код из #2231 у меня работал "как бог на душу положит"):

Код:

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

 (vl-load-com)

(defun c:pk1 (/ adoc curve_axe pt ins_pt rot_pt)

  (defun fun_get-objid (obj id)
    (if (> (vl-string-search "x64" (getvar "platform")) 0)
      (vla-objectidtoobject32 obj id)
      (vla-objectidtoobject obj id)
      ) ;_ end of if
    ) ;_ end of defun

  (if (and (= (type (setq curve_axe (vl-catch-all-apply
                                      (function
                                        (lambda ()
                                          (vlax-ename->vla-object (car (entsel "\nУкажите ось <Отмена> : ")))
                                          ) ;_ end of lambda
                                        ) ;_ end of function
                                      ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'vla-object
              ) ;_ end of =
           (member (type (setq pt (vl-catch-all-apply
                                    (function
                                      (lambda (/ res)
                                        (initget 135) ; "Другая Other _ Д O")
                                        (setq res (getpoint "\nУкажите точку <Другая ось> : "))
                                        (if
                                          (= (type res) 'str)
                                           (setq res (car (entsel "\nДругая ось <Отмена> : ")))
                                           ) ;_ end of if
                                        res
                                        ) ;_ end of lambda
                                      ) ;_ end of function
                                    ) ;_ end of vl-catch-all-apply
                               ) ;_ end of setq
                         ) ;_ end of type
                   (list 'list 'ename)
                   ) ;_ end of member
           ) ;_ end of and
    (progn
      (if (= (type pt) 'ename)
        (progn
          (setq curve_axe (vlax-ename->vla-object pt)
                pt        (vl-catch-all-apply
                            (function
                              (lambda ()
                                (getpoint "\nУкажите точку <Отмена> : ")
                                ) ;_ end of lambda
                              ) ;_ end of function
                            ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
          ) ;_ end of progn
        ) ;_ end of if
      (if (and (= (type pt) 'list)
               (= (type (setq ins_pt (vl-catch-all-apply
                                       (function
                                         (lambda ()
                                           (getpoint "\nТочка вставки текста <Отмена> : ")
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                       ) ;_ end of vl-catch-all-apply
                              ) ;_ end of setq
                        ) ;_ end of type
                  'list
                  ) ;_ end of =
               (= (type (setq rot_pt (vl-catch-all-apply
                                       (function
                                         (lambda ()
                                           (cond
                                             ((getangle ins_pt "\nУгол поворота текста <0.0> : "))
                                             (t 0.0)
                                             ) ;_ end of cond
                                           ) ;_ end of lambda
                                         ) ;_ end of function
                                       ) ;_ end of vl-catch-all-apply
                              ) ;_ end of setq
                        ) ;_ end of type
                  'real
                  ) ;_ end of =
               ) ;_ end of and
        (progn
          (vla-put-rotation (vla-addtext
                              (fun_get-objid (vla-get-activedocument (vlax-get-acad-object))
                                             (vla-get-ownerid curve_axe)
                                             ) ;_ end of fun_get-objid
                              (strcat "+"
                                      (rtos (rem (setq pt (vlax-curve-getdistatpoint
                                                            curve_axe
                                                            (vlax-curve-getclosestpointto curve_axe pt)
                                                            ) ;_ end of vlax-curve-getDistAtPoint
                                                       ) ;_ end of setq
                                                 ) ;_ end of rem
                                            ) ;_ end of rtos
                                      ) ;_ end of strcat
                              (vlax-3d-point ins_pt)
                              (getvar "textsize")
                              ) ;_ end of vla-addtext
                            rot_pt
                            ) ;_ end of vla-put-Rotation
          (princ (strcat "\nПоложение точки относительно оси = " (rtos pt 2 2)))
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[Vladimir_Sergeevich]

мать моя женщина... Алексей, я десятка 2 привязок посадил - ничего не увидел странного... а твой шедевр я еще месяц раскуривать буду
поясни, что ты имел ввиду под "бог на душу", представить не могу, желательно с пояснениями что и зачем добавлено.

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

Vladimir_Sergeevich, у меня твой код через раз на ровном месте (то при попытке выбора первой оси, то при попытке ввода точки) выдавал ошибку. Кстати, я у себя тож одну ошибку нашел (уже исправил). А логика-то работы проста как 3 копейки:
1. Получаем первую ось. Если пользователь нажал Esc или правую кнопку (то есть ни шиша не выбрал), то просто уходим с выполнения
2. Дальше аналогично запрашивается вторая точка. Если пользователь нажал правую кнопку, то вместо точки запрашивается "вторая ось".
3. Дальше, если в п.2 выл выбран объект (а не точка), повторно запрашиваем точку. Заодно гарантированно преобразовываем объекты в ActiveX (можно было и в другом месте это сделать, но я оставил как есть - писалось-то все "на коленке")
4. По полной аналогии с п.1 запрашиваем точку вставки и угол поворота текста.
5. Вставляем текст в пространство, в котором находится "ось".

Если пользователь нажмет Esc в любом запросе, или укажет непонятно чего - код выполняться не будет.

P.S. По-хорошему надо бы контролировать тип примитивов "осей", но мне уже лениво

[seregabs]

Просмотрел много тем про работу с атрибутами блоков. С тем, как в лиспе присваивать им новые значения, примерно понял. Но не могу этого проверить для своих нужд. А именно:

Есть мелкий работающий лисп, вставляющий несколько блоков. Для первого блока точка вставки указывается кликом, для остальных точка вставки пляшет уже от нее приращением координат.

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

Загвоздка вышла с тем, как обратиться к атрибуту именно того блока, на который был сделан клик. Вот в начале я получаю эту точку:

Код:

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

(setq krd (getpoint "\n Введите точку вставки:"))

и получаю в переменной krd координаты точки, лежащей на блоке рамки. На следующих этапах эта переменная меняется приращениями, поэтому я ее дублирую:

Код:

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

(setq krdramka krd)

Сразу вопрос - так можно координаты присвоить новой переменной?
И далее мне нужно обратиться к атрибуту блока с известным названием и известной точкой, лежащей на нем.
Можно ли определить нужный блок вот так:

Код:

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

(setq ramka (vlax-ename->vla-object 
  (ssget '(krdramka) '((0 . "INSERT") (2 . "название_блока")))
     ))

[Дима_]

Сообщение от seregabs Загвоздка вышла с тем, как обратиться к атрибуту именно того блока, на который был сделан клик.

результат функции (entsel ...) содержит как точку указания, так и ename выбранного блока.

[seregabs]

Но я указываю именно точку (getpoint), не выбираю блок. Если я правильно понимаю, я не могу тут использовать entsel ? Но точка лежит на объекте в составе блока всегда.

[Дима_]

Сообщение от seregabs Если я правильно понимаю, я не могу тут использовать entsel

Почему? - мне пока тяжело понять что Вы придумали.

[skkkk]

Сообщение от seregabs (setq krdramka krd) Сразу вопрос - так можно координаты присвоить новой переменной?

Можно.

Сообщение от seregabs Можно ли определить нужный блок вот так: Код: [Выделить все] (setq ramka (vlax-ename->vla-object (ssget '(krdramka) '((0 . "INSERT") (2 . "название_блока"))) ))

Так мы получим не блок, а набор, и то, если исправим ошибки:

Код:

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

(setq ss (ssget krdramka '((0 . "INSERT") (2 . "название_блока")))

и то, только если точка krdramka будет непременно лежать на каком-либо из объектов блока, а не рядом, на пустом месте. Да там еще подводные камни могут возникнуть. Далее из набора нужно извлечь блок. Если мы уверены, что в наборе один блок, то извлекаем его так:

Код:

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

(setq ramka (ssname ss 0))

где 0 - порядковый номер примитива в наборе, начиная с нуля.
в итоге вся конструкция примет вид:

Код:

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

 (setq ramka 
		(vlax-ename->vla-object 
			(ssname 
				(ssget krdramka '((0 . "INSERT") (2 . "название_блока")))
				0
			)
		)
)

[seregabs]

Лучше приложу начало лиспа незаконченного

Код:

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

(defun c:ins_ved ()
(setq krd (getpoint "\n Введите точку вставки:")) ; <- тут пользователь кликает на точку, лежащую на блоке "название"
(setq krdramka krd)                              ; <- работает ли так передача координат точки? 
(command "_insert" "Ведомость" krd 1 1 0 "16,9" "0,3" "0,3" "17,2") ; в указанную точку вставляется блок "Ведомость"

(vl-load-com)         
                                                                      
  (foreach Prop (vlax-Invoke (vlax-ename->vla-object (entlast)) 'GetDynamicBlockProperties) ; этими строками выбираю
    (if (= (vla-get-PropertyName Prop) "PosQuan") 				            ; нужную настройку свойства
      (vlax-put Prop 'Value "2 позиции")))					            ; дин. блока "Ведомость"
	  
(setq krd (LIST ( - ( CAR krd ) 1750) (- (CADR krd) 330) 0))                            ; вставляются еще n (тут два)
(command "_insert" "Str_Channel" krd 1 1 0 "12" "1,6" "16,7" "16,7" "С245" "27772-88")  ; других блоков с атрибутами
(setq krd (LIST ( CAR krd )  ( - ( CADR krd ) 100) 0))							    
(command "_insert" "Str_Plate" krd 1 1 0 "6" "110x45" "1" "0,2" "0,2" "С245" "27772-88")  

(setq ramka (vlax-ename->vla-object			     ; теперь мне нужно прописать блоку "название" определенное
  (ssget '(krdramka) '((0 . "INSERT") (2 . "название")))))   ; значение атрибута с тегом "KKS".
						             ; думал, что после этих строк можно будет работать с объектом
						             ; ramka - он же блок "название". и менять ему атрибут.
                                                             ; но, похоже, что через координаты точки не получается у меня блок определить
 )

skkkk успел ответить, пока я правил текст, поэтому на данный момент вопрос исчерпался. Спасибо! Буду доделывать теперь идею

[ShaggyDoc]

Код:

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

 (setq krd (getpoint "\n Введите точку вставки:")) ; <- тут пользователь кликает на точку, лежащую на блоке "название"

Сразу источник ошибок:
1. Пользователь может кликнуть совсем не на точке, "лежащей на блоке", а промахнуться
2. Кликнет не на блоке "название", а на другом.
3. Пользователь может нажать Enter.
4. Пользователь может нажать ESC.

В любом случае все остальные действия будут бессмысленны. Правильно будет действовать только сам программист, да и то пока не забыл. А пользователь имеет право делать всё не так, и программист это должен учитывать. И писать код со всеми необходимыми проверками до "исполнения по существу".

Код:

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

 (command "_insert" "Ведомость" krd 1 1 0 "16,9" "0,3" "0,3" "17,2")

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

Далее смотреть код нет смысла.

[Sirius2w]

Коллеги, кто поможет написать простенький ЛИСП?
Я начал прорабатывать блок-схему процесса но запутался и сам разобраться не могу.

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

Критерии обработки:
1) Блок должен содержать атрибут "марка" (причем у динамического блока имя одно и то же, а значение атрибута "марка" разное)
2) Блок не должен содержать атрибут "номер" со значением "б/п" (эти блоки нужно пропускать всегда)
3) Блокам с одинаковым значением атрибута "марка" должны быть присвоены одинаковые значения атрибута "номер"
4) Блоки, с пустым значением атрибута "номер" должны получить новое значение, при этом:
4.1 Изначально нумерация может быть хаотической, поэтому при первом запуске ЛИСП должен очистить все значения атрибутов "номер" не содержащих "б/п" на пустые значения.
4.2 После очистки ЛИСП присваивает в порядке возрастания всем блокам новые значения атрибутов "НОМЕР" в числовом формате 1.2.3.4.5.6.... и т.д.
с условием соблюдения предыдущих пунктов 1-2-3
5) При повторном запуске ЛИСП проверят какой список значений получился во всех значениях атрибутов "номер":
5.1. Если список содержит пропуски типа 1.2.3_._.5.6. и нет новых блоков с пустым значением атрибута "номер" - переписать поочередно максимальные значение на
пустующие.
5.2. Если имеются блоки с пустым значением атрибута "НОМЕР" (были добавлены новые блоки) - им присвоить очередные значения.

Пример файла во вложении.

Учитывая, что в лиспе пока вообще ни бум-бум... прошу объяснить с самого начала пошагово с реальными примерами.

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

Sirius2w, есть спец.раздел. Называется "Поиск исполнителей". У этой темы и у этого раздела задачи иные.

[Sirius2w]

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

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

Sirius2w, ты же просишь не помочь тебе в разработке (объяснить скользкие моменты), а написать за тебя. Почему-то меня обуревают сомнения, что кто-то согласится...

[gomer]

Я бы взялся, но

Сообщение от Кулик Алексей aka kpblc Почему-то меня обуревают сомнения

, что справлюсь, задачка не плевая, с наскоку не сделаешь. Как минимум достойна отдельной темы.

[Sirius2w]

Сообщение от Кулик Алексей aka kpblc Sirius2w, ты же просишь не помочь тебе в разработке (объяснить скользкие моменты), а написать за тебя. Почему-то меня обуревают сомнения, что кто-то согласится...

Я исправил пост. Если честно - очень хочу научиться, но вообще нет времени ...
Прогресс конечно есть - не совсем ноль, начал к примеру с этого:

(defun c:ATConsecutive_numbering ()
а как дальше - вообще не понятно.

[gomer]

Sirius2w, у тебя в "коде" не хватает завершающей скобки

Код:

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

 (defun c:ATConsecutiveNumbering ( / )
  ;; твой код...
)

[Sirius2w]

Все, что нашел с помощью поиска не совсем подходит - нумерация блоков не учитывает, что блоки с одинаковым значением атрибута "марка" должны иметь одинаковый номер..((

[kurstep]

Код:

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

 (defun C:pp ( / ss e p1 p2 p3 p4 i n)                 
    ((setq ss (ssget '((0 . "3DFACE"))))
        (setq i 0 n (sslength ss))
        (while (< i n)
          (setq e (entget (ssname ss i)))
          (setq p1 (cdr (assoc 10 e)) p2 (cdr (assoc 11 e)) p3 (cdr (assoc 12 e)) p4 (cdr (assoc 13 e))    )
         
(entmakex (list '(0 . "POINT") p1))
	  (entmakex (list '(0 . "POINT") p2))
	  (entmakex (list '(0 . "POINT") p3))
	  (entmakex (list '(0 . "POINT") p4))        
           
          (setq i (1+ i))
        ) 
      )
  )

П

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

подскажите пожалуйста в чем ошибка почему комп выдает lselsetp nil даже не дав выбрать объекты (Программа должна строить вершины в точках грани)

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

Лишняя открывающая скобка перед первым setq

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

Код:

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

 (vl-load-com)

(defun test (/ selset i adoc)
  (if (and (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
           (= (type (setq selset (vl-catch-all-apply
                                   (function
                                     (lambda () (ssget '((0 . "3DFACE"))))
                                     ) ;_ end of function
                                   ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
              'pickset
              ) ;_ end of =
           ) ;_ end of and
    (foreach ent ((lambda (/ tab item)
                    (repeat (setq tab  nil
                                  item (sslength selset)
                                  ) ;_ end setq
                      (setq tab (cons (ssname selset (setq item (1- item))) tab))
                      ) ;_ end of repeat
                    ) ;_ end of lambda
                  )
      (vla-startundomark adoc)
      (mapcar
        (function
          (lambda (x)
            (entmakex (list (cons 0 "POINT") (cons 10 x)))
            ) ;_ end of lambda
          ) ;_ end of function
        (mapcar (function (lambda (x) (cdr (assoc x (entget ent))))) '(10 11 12 13))
        ) ;_ end of mapcar
      (vla-endundomark adoc)
      ) ;_ end of foreach
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[tehkonst]

Подскажите как из одного набора (selection set) получить другой набор, отфильтровав его

Например есть набор objSet

Код:

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

 ( setq objSet ( ssget '((0 . "*LINE,CIRCLE,ARC")) ) )

Из него можно получить новый набор, состоящий только из линий

Код:

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

 ( setq linesSet (ssget "_P" '((0 . "LINE"))) )

А дальше нужно получить еще один набор из objSet , состоящий только из полилиний. Как это можно сделать, если он уже не последний?

[skkkk]

При помощи ssget уже никак. Только удалять из набора не полилинии либо создавать новый набор из полилиний, перебирая все объекты набора objSet.

[WhiteShark]

А сразу ( setq objSet ( ssget '((0 . "LWPOLYLINE")) ) ) не катит?

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

Основной вопрос - а потом что планируется делать с этими "поднаборами"? Может, будет проще сразу получать списки указателей на объекты и делать все чего хочется уже со списками?

[tehkonst]

Сообщение от Кулик Алексей aka kpblc Основной вопрос - а потом что планируется делать с этими "поднаборами"? Может, будет проще сразу получать списки указателей на объекты и делать все чего хочется уже со списками?

Я разбираюсь пока. Задача, например, такая: выделить все вместе, а потом создать 3 переменные:
1. Список отрезков на слое "lay1"
2. Список отрезков на слое "lay2"
3. Список полилиний (тоже с каким-нибудь свойством)

Потом с этими списками работать: анализ, дополнительные построения.
Объекты желательны сразу в виде Active-x (vla-object), потому что, я смотрю, там методов хватит на все задачи и читать их проще.

Фильтры от ssget мне показались самыми доступными для того, чтобы выбрать по свойствам.
Но без них пока я вижу только один способ: получить один общий набор, пройтись по нему, преобразовав каждый примитив во vla-object, потом условия задавать на наличие нужных свойств.

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

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

[tehkonst]

Сообщение от skkkk При помощи ssget уже никак.

Все-таки это можно сделать. Я не совсем понимаю, для чего служит команда sssetfirst, но она выделяет набор по имени и с ним можно потом работать.

Код:

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

  ( setq objSet ( ssget '((0 . "*LINE,CIRCLE,ARC")) ) )
 ( sssetfirst nil objSet)
 ( setq linesSet (ssget "_I" '((0 . "LINE"))) )
 ( setq polylinesSet (ssget "_I" '((0 . "*POLYLINE"))) )

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

Нарисуй по окружности, отрезку и дуге в каждом листе и в модели. Перейди в лист, войди внутрь ВЭ и выполни такой код:

Код:

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

  ( setq objSet ( ssget "_X" '((0 . "*LINE,CIRCLE,ARC")) ) )
( sssetfirst nil objSet)
( setq linesSet (ssget "_I" '((0 . "LINE")))
 polylinesSet (ssget "_I" '((0 . "*POLYLINE"))) ) 

А потом через sslength проверь количество объектов в каждом наборе.

[tehkonst]

Проверил. Считает все объекты на всех листах и в модели. Независимо от того: внутри ВЭ, в модели или в листе. Это плохо?

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

Offtop: Как бы нет, но... В общем, можешь считать это моей придурью: я предпочитаю не работать такими методами.

[tehkonst]

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

Раскрыть подробнее можешь? Мне интересно.

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

В порядке оффтопа
Offtop: Обычно с подобными "наборами" потом что-то надо делать: удалять, перемещать, менять свойства и т.п. ИМХО намного проще пройтись по такому "набору" чисто программными методами и сделать все "втихаря". Была бы видна конечная задача - можно было бы голову поломать. А так - это гадание на кофейной гуще.

[VVA]

Сообщение от tehkonst А дальше нужно получить еще один набор из objSet , состоящий только из полилиний. Как это можно сделать, если он уже не последний?

Сообщение от tehkonst Но без них пока я вижу только один способ: получить один общий набор, пройтись по нему, преобразовав каждый примитив во vla-object, потом условия задавать на наличие нужных свойств.

Как-то так

Код:

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

(setq objSet ( ssget '((0 . "*LINE,CIRCLE,ARC")))
      lineset (ssadd)
      circleset (ssadd)
      arcset (ssadd)
      plineset (ssadd)
      i -1
      )
(while (and objSet (setq e (ssname objSet (setq i (1+ i)))))
  (cond ((eq(cdr(assoc 0 (entget e))) "LINE")(ssadd e lineset))
        ((eq(cdr(assoc 0 (entget e))) "CIRCLE")(ssadd e circleset))
        ((eq(cdr(assoc 0 (entget e))) "ARC")(ssadd e arcset))
        (t nil)
        )
  )

Про полилинии - тебе домашнее задание. Только учти, что полилинии бывают нескольких видов - LWPOLYLINE и POLYLINE

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

Сообщение от tehkonst Потом с этими списками работать: анализ, дополнительные построения.

Если нужны списки, то немного по другому

Код:

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

(setq objSet ( ssget '((0 . "*LINE,CIRCLE,ARC")))
      linelist nil
      circlist nil
      arclist nil
      i -1
      )
(while (and objSet (setq e (ssname objSet (setq i (1+ i)))))
  (cond ((eq(cdr(assoc 0 (entget e))) "LINE")(cons (vlax-ename->vla-object e) linelist))
        ((eq(cdr(assoc 0 (entget e))) "CIRCLE")(cons (vlax-ename->vla-object e) circlelist))
        ((eq(cdr(assoc 0 (entget e))) "ARC")(cons (vlax-ename->vla-object e) arclist))
        (t nil)
        )
  )

[tehkonst]

Спасибо

Сообщение от VVA Только учти, что полилинии бывают нескольких видов - LWPOLYLINE и POLYLINE

Это я уже опытным путем выяснил

У меня еще вопрос:

На этой странице в конце пример. Но он выдает ошибку "Automation Error. Problem in loading VBA" С чем это связано?

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

Например, с тем, что у тебя "не тот" VBA. Обрати внимание: справка для AutoCAD 2015, и VBA-коды гарантированно будут работать только в 2015. С остальными версиями - как повезет.

[tehkonst]

Сообщение от VVA Если нужны списки, то немного по другому

А если нужно, чтобы 1 список состоял из линий на слое "LAY1" и цветом красным, а другой - из линий на слое "LAY2"?
Просто мне кажется, что через ssget и фильтры запись намного короче (и читать проще). Я уже выше отписал как это можно сделать, и после этого перевести каждый selectionset в список объектов.

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

Сообщение от Кулик Алексей aka kpblc Например, с тем, что у тебя "не тот" VBA. Обрати внимание: справка для AutoCAD 2015, и VBA-коды гарантированно будут работать только в 2015. С остальными версиями - как повезет.

Я у Полещюка сначала про эту функцию (vla-Eval) вычитал. Т.е. под 2005 автокад работает, под 2015 работает. А под 2011 нет нужного VBA ?

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

Вот чего не знаю, того не знаю: VBA не использую примерно с 2007 года.

[tehkonst]

Это как бы не вба. Это лисп, который вызывает вба.

Код:

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

 (vl-load-com)
(defun c:Example_Eval()
    ;; This example shows how to can use Eval to run a VBA code fragment
    ;; without having to create a Module or procedure.
    (setq acadObj (vlax-get-acad-object))
    
    ;; Create VBA code fragment
    (setq VBACode "MsgBox \"Simple code fragment\"")
    
    ;; Use Eval method to evaluate the small VBA script
    (vla-Eval acadObj VBACode)
)

Мне эта функция тоже не очень то и нужна. Интересно просто стало, что это за "зверь".

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

Я хоть убей не понимаю необходимости использования vla-eval вместо обычного eval.

[Сергей812]

Добрый день. В программах на lisp регулярно встречается конструкция "loc:" - но не могу найти никак, для чего она. Подскажите, пожалуйста, где можно про нее почитать?

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

Скорее всего, это имя (или часть имени) переменной.

[Сергей812]

Т.е, например, в определение функции

Код:

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

 (defun loc:catch (func / ret)
...
)

loc: - это лишь часть имени? Просто часто встречаю достаточно в примерах кода, подумал, что это какой-то модификатор доступа. Поискал по книжкам Полещука и Зуева, в электронном виде по форумам - ничего определенного не нашел.

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

Имя переменной / функции в лиспе не может содержать, насколько я помню, символы ";", "(", ")" и " ". Остальные, кажется, вполне допустимы. Ну и зарезервированные имена лучше не переопределять )))

[Сергей812]

kpblc, Спасибо) значит, видимо просто пометка - что локальная функция, переменная.

[skkkk]

Сергей812, тоже задавался в свое время этим вопросом. Пришел к однозначному выводу: двоеточие в имени функции или переменной есть не что иное, как система обозначений, принятая неким автором или сообществом авторов кодов для обеспечения (в том числе и себя же в последующем) понимания логики кода. Многие вместо двоеточия используют тире. Еще один пример: знаменитый Lee Mac предваряет свои функции префиксом LM:. Больше ничего это не значит. Исключение, по-видимому, составляет C:, вроде что-то еще было, но не припомню.
Вот, кстати, вспомнил про двоеточия в методах функции ssget. Насколько я разобрался, комбинировать можно ТОЛЬКО методы с двоеточием. И так и не смог разобраться, что означают и каким образом применять затронутые описанием у Полещука, как недокументированнные, методы, наследуемые от соответствующих функций ObjectARX ("M", ".", "#", ":O", ":$" и т.д.). Кто знает, о чем речь?

[ShaggyDoc]

Пришел к однозначному выводу: двоеточие в имени функции или переменной есть не что иное, как система обозначений, принятая неким автором или сообществом авторов кодов для обеспечения (в том числе и себя же в последующем) понимания логики кода. Многие вместо двоеточия используют тире.

Именно так. Вводят свои префиксы для удобства понимания кода. Кто-то любит двоеточие. У меня у всех функций префикс "ru-", у низкоуровневых "_ru-". А в именах переменных разлелитель слогов всегда "_", что легко позволяет отличить переменную от функции. Глобальные переменные заключаю в ** и пишу в верхнем регистре.

И классический пример в AutoLisp Tutorial где все функции с префиксом GP: и пояснение

These names are prefixed with gp: to indicate they are specific to the garden path application. This is not a requirement, but it is a good naming convention to use to distinguish application-specific functions from general utility functions you frequently use.

[tehkonst]

Сообщение от ShaggyDoc что легко позволяет отличить переменную от функции

Я все функции, с глагола начинаю. Если что-то получить - get: getPoint, getArea. Если что-то нарисовать - draw: drawTangent, drawWall и т.д.

[skkkk]

Offtop: tehkonst, при таком подходе при выполнении функции

Сообщение от tehkonst getPoint

можно удивиться

[tehkonst]

Offtop: Не вижу ничего странного. В любом ооп так принято методы называть.

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

tehkonst, намек: ты про зарезервированные слова наверняка слышал...

[ShaggyDoc]

Я все функции, с глагола начинаю

Хоть как можно начинать, лишь бы была система. У меня около 3000 функций разного назначения (компилируемых в один файл библиотеки), да еще несколько сотен "функций-программ". Без системы в именовании (а также без раскладки по папкам) в них не разобраться. Помимо системы имен, еще каждая функция в отдельном файле, да в своем каталоге.
И конечно нельзя "штатные" имена применять.

В любом ооп так принято методы называть

Так то в ООП. Там внутри разных классов могут быть одинаковые имена, и это как раз хорошая практика. Но это не в Автокадовском Лисп.
Вот у меня для ввода точки куча функций:

Код:

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

 ru-get-point-reguired
ru-get-point-or-lw-or-exit
ru-get-point-or-lw-or-continue-or-exit
ru-get-point-or-exit-or-kword-base
ru-get-point-or-exit-base
ru-get-point-with-offset
ru-get-point-reguired-with-offset
ru-get-point-or-exit-with-offset
ru-get-point-or-exit-or-kword-base-with-offset
ru-get-point-or-exit-base-with-offset
ru-get-point-in-angle-with-offset
ru-get-point-or-exit
ru-get-point-on-ent
ru-get-point-and-ang-on-ent
ru-get-corner-reguired.lsp

Условно это всё разные "методы" ввода точки. Но это не ООП. А вот система имен позволяет очень облегчить собственную работу.

[gomer]

раз уж снова пошел такой срач

LESSON 5 VARIABLES: Variables are used as the principle means to store values. Files may also be used to store values, but variables are what store values for short term use. AutoLisp variables may be any of (4) four "types"; integer, real, point, and string. Variables in AutoLISP are automatically "typed" depending on the value they contain, so no "typeing" of variables is required. The function "setq" will be used to create a variable. A variable will contain a nil value until some value is bound to it. If you reference a variable before you have assigned a value to it, you will receive nil as the result of the reference. (setq a 3) ;Integer variable (setq a 3.00) ;Real variable (setq a (list 1.50 2.375 1.00) ;Point variable (setq a "This is a string.") ;String variable VARIABLE NAMING: When we discussed comments in lesson 3, we neglected to touch on the easiest method of commenting of all; variable names. If you use proper variable names, much of your code can be self-documenting. You need only add comments to code which is not clear simply by reading it. Variables can be named anything you want providing the first character is alphabetic, and you don't use the reserved characters from lesson 2. Many AutoLISP programmers try to keep variable names to (6) six characters or less. This is due to the way variables are stored in AutoLISP. If a variables name is less than 6 characters AutoLISP only requires (2) two nodes to store the value. If you make the variable name longer than (6) six characters, AutoLISP stores the value in one node and stores a pointer to the name in the other node. The name itself is stored in memory taken from the heap for string storage. Heap space is limited and that is why some programmers try to keep variable names short. Two things have happened that makes this rule not so carved in stone as it used to be. The advent of virtual memory and learning how to program cleanly have done much to solve the problem of running out of memory. I can't do much about the amount of memory in your computer or the amount of memory AutoCAD needs, but I can show you how not to run out of memory by programming in a clean manner. Anyway, back to naming variables. Naming a variable is not like naming the family pet, you can't choose a name cause it's cute or it's what the variable looks like. You need to choose names based on what it is the variable holds. You must look at the variable and its name as being the same thing. If you can't tell what the variable is, maybe you don't need the variable anyway. If a variable holds the point for a line, state that in the variable name. First tell which line, and then tell which point. Variables can be named well or they can be named badly, it's all up to you. Good: CenterLineStart CtrLnStrt CtrLnEnd Bad: C1 ;Start of centerline C2 ;End of centerline The bad variable names have been made sightly more palletable by the use of comments to say what they are, but the good variable names are much more descriptive and require no comments. Anyone who has programmed for awhile knows comments rarely come easy and sometimes not at all. It is better to give your variables names which do not need explained, so a missing comment later will not lead to confusion about what the variable is holding. Also note that end-line comments no matter how well done, clutter up code and make it harder to read. If you can avoid using end-line comments, you will be much better off. Sometimes you have many variables that seem to hold the same type values. They may seem the same but there is always something different about them that the name can tell you. Good: TapDrillCenterLineStart TapDrCtrLnStrt TapDrCtrLnEnd TapCenterLineStart TapCtrLnStrt TapCtrLnEnd Bad: TDCS TDCE TDS TDE I have seen programmers go as far as giving many pages of comments to explain what each of thier variables was supposed to hold. Having a decoder ring is no substitute for proper variable naming. If you give full variable names you will have alot less commenting and alot easier time when hunting problems. Index variables ... Indexes through a loop are one of the areas where it is sometimes difficult to come up with a name. Many programmers have a name they give to all indexes, such as Index, Idx, Ndx, or some such thing that they are comfortable looking at. They know when they read their code what these things are, but others may not. If you are going to use short names for indexes be sure to tell what it is that you are indexing through. Good: PointNdx ListNdx FileNdx Bad: x Idx Ndx An index variable is like any other variable and needs a proper name to be truly understood. Status variables ... Status variables should be given names better than "flag". Everyone seems to use flag for status variables. The first thing we have to do to give truly meaningful names to variables, is get away from thinking about our problems from the viewpoint of the computer. A flag tells if something is right or wrong, it should be given a name that reflects the item we are checking. Good: FileDone PrintDone SortDone Status variables are not used extensively in AutoLISP programming, but if you use them, give them real names. Naming guidelines ... Variables should be named in a manner that also identifies their scope and / or type. GLOBAL variables should be identifiable as such by reading their name. Some people use prefix or suffix notations to accomplish this. An example would be to add a g or g_to the beginning of the variable name: gScrewList This identifies the variable as a list that is available to all the functions in your program. I am not a fan of putting the "_" character in variable names as a separator. I prefer the naming convention where you capitalize the first letter of each word or abbreviation in the variable name. CONSTANTS are normally capitalized as a way of identifying them. They stand out from the rest of your code so you know they are a constant. INPUT variables, which are parameters to a function, should not be modified inside the function. It is recommended that you identify input variables so if you see one getting modified you can do something else. It will be a lot easier to read your code and tell which variables are parameters if you identify them in the name. An "i" or "ip" may be prefixed to the name to identify them.

[Curiosity]

Доброго времени суток!
Можно ли сформировать один набор, выбором нескольких рамок (ssget "_W" (pt1 pt2) (pt3 pt4)...)?

[skkkk]

Сообщение от Curiosity Можно ли сформировать один набор, выбором нескольких рамок (ssget "_W" (pt1 pt2) (pt3 pt4)...)?

Нельзя. Можно создать несколько наборов, а потом объединить их. LISP : Как объединить два набора в один?

[Curiosity]

Сообщение от skkkk Нельзя. Можно создать несколько наборов, а потом объединить их. LISP : Как объединить два набора в один?

Спасибо за ссылку
А как можно сделать так чтобы
(command "_rectang" pause pause)
повторялось до тех пор пока пользователь не нажмет enter или space?

[skkkk]

Вариант 1 (лисп):

Код:

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

(defun C:MULTIRECTANG ()
	(while t
		(command "_RECTANG" pause pause)
	)
)

Ввариант 2 (макрос со звездочкой на кнопку):

Код:

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

*^C^C_RECTANG

[Curiosity]

Это не совсем то что мне нужно
Мне надо прервать _rectang без прекращения работы лиспа, чтобы лисп дальше выполнялся
(defun c:.... ()
........
(while (not ("Проверка нажатия enter или space"))
(command "_rectang" pause pause)
)
........
)

[kurstep]

Подскажите пожалуйста как открыть файл экселя через автолисп

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

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

[skkkk]

Сообщение от Curiosity А как можно сделать так чтобы (command "_rectang" pause pause) повторялось до тех пор пока пользователь не нажмет enter или space?

Сообщение от skkkk Вариант 1 (лисп):

Сообщение от Curiosity Это не совсем то что мне нужно Мне надо прервать _rectang без прекращения работы лиспа, чтобы лисп дальше выполнялся (defun c:.... () ........ (while (not ("Проверка нажатия enter или space")) (command "_rectang" pause pause) ) ........ )

Извиняюсь, виноват - не проверил условие выхода по Enter. Значит, перед отрисовкой прямоугольника придется запрашивать точки. Если совсем по-простому, то будет примерно так:

Код:

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

 (defun C:TEST ( / pt1 pt2)
    (vl-cmdf "_PLINE" pause pause "")
	(setq pt1 T pt2 T)
	(while (and pt1 pt2)
		(setq pt1 (getpoint "\nПервый угол: "))
		(if pt1 (setq pt2 (getcorner pt1 "\nВторой угол: ")))
		(vl-cmdf "_RECTANG" "_none" pt1 "_none" pt2)
	)
    (vl-cmdf "_CIRCLE" pause pause)
)

[gomer]

Сообщение от skkkk Если совсем по-простому

это не по простому. это по куринному...

[skkkk]

Offtop: Отвергаешь - предлагай. А так - всё это болтовня и флуд. Причем с ошибками. С пятью!

[kurstep]

Сообщение от Кулик Алексей aka kpblc Открываешь экземпляр MS EXcel, в нем получаешь указатель на коллекцию рабочих книг - и потом уже собственно открытие файла.

Спасибо за ответ...Но мне так не понять, я представлял увидеть уже чтото похожее на код)

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

kurstep, так ты свой вариант покажи Кроме того, вариантов работы с Excel из-под лиспа немеряно: http://www.google.ru/cse?cx=partner-...cel&gsc.page=1

----- добавлено через 39 сек. -----
Туда же (первая ссылка по результатам поиска): http://forum.dwg.ru/showthread.php?t=8147

[gomer]

Сообщение от skkkk С пятью!

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

[skkkk]

Вот и рассказал бы, как правильно, чем обзываться
Почему я не могу для запуска цикла сначала их "заБУлить", а потом "заТОчить"? Чем чревата такая смена типа?
Первый алгоритм, который пришел мне в голову. Может, я пропустил тот урок?
Расскажи, пожалуйста, как правильно?

[gomer]

Сообщение от skkkk Расскажи, пожалуйста, как правильно?

правильно тут никак
а если по простому, то как минимум так, причем это еще без ловли блох

Код:

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

[lisp](defun c:test (/ *error* pt1 pt2)
;;; тут могла быть ваша реклама
;;; (fefun  *error* ( msg) ...
  (if
    (and (setq pt1 (getpoint "\nНачальная точка <Отмена>: "))
	 (progn	(initget 1)
		(setq pt2 (getpoint pt1 "\nКонечная точка: "))
	 )
    )
     (vl-cmdf "_.PLINE" "_none" pt1 "_none" pt2 "")
  )

  (while
    (and (setq pt1 (getpoint "\nПервый угол <Завершить>: "))
	 (progn	(initget 1)
		(setq pt2 (getcorner pt1 "\nВторой угол: "))
	 )
    )
     (vl-cmdf "_.RECTANG" "_none" pt1 "_none" pt2)
  )
  (if
    (setq pt1 (getpoint "\nЦентр <Отмена>: "))
     (vl-cmdf "_.CIRCLE" pt1 pause)
  )
)/LISP]

[Nike]

gomer, вот молодец, так бы сразу и .. И не надо было людям грубить, б.. р..!

[gomer]

Nike,

[Curiosity]

Извиняюсь за глупые вопросы
Почему в vlide при отладке кода с функцией lambda, выскакивает окно "источник"? при этом отладка кода останавливается

[wahir]

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

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

Сообщение от Curiosity Почему в vlide при отладке кода с функцией lambda, выскакивает окно "источник"? при этом отладка кода останавливается

Настройки VLIDE в студию. Ну и код не помешал бы.

Сообщение от wahir в какой книге удобно сведены в таблицы dxf-коды примитивов с описаниями возможных значений?

Любая книга по лиспу за авторством Полещука. Я бы брал "постарше"

Сообщение от wahir создание размеров. может и не через entmake это удобно делать, подскажите как принято.

ИМХО принято так, как удобно программисту. Можно через entmake, можно через vla, можно через командные методы - вариантов масса.

[Curiosity]

Сообщение от Кулик Алексей aka kpblc Настройки VLIDE в студию. Ну и код не помешал бы.

Вот скриншоты, в настройках все по умолчанию я ничего не менял

Вот кусок кода
(foreach item (_dwgru-conv-pickset-to-list ss1)
(setq xx (vl-list* (vl-sort (mapcar 'cadr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget item))) '<) xx))
(setq yy (vl-list* (vl-sort (mapcar 'caddr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget item))) '<) yy))
)

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

Попробуй заменить ' на function. Например, так:

Код:

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

 (foreach item (_dwgru-conv-pickset-to-list ss1)
  (setq xx (vl-list* (vl-sort (mapcar
                                (function cadr)
                                (vl-remove-if-not
                                  (function
                                    (lambda (x)
                                      (= (car x) 10)
                                      ) ;_ end of lambda
                                    (entget item)
                                    ) ;_ end of function
                                  ) ;_ end of vl-remove-if-not
                                ) ;_ end of mapcar
                              '<
                              ) ;_ end of vl-sort
                     xx
                     ) ;_ end of vl-list*
        yy (vl-list*
             (vl-sort (mapcar
                        (function caddr)
                        (vl-remove-if-not
                          (function
                            (lambda (x)
                              (= (car x) 10)
                              ) ;_ end of lambda
                            ) ;_ end of function
                          (entget item)
                          ) ;_ end of vl-remove-if-not
                        ) ;_ end of mapcar
                      '<
                      ) ;_ end of vl-sort
             yy
             ) ;_ end of vl-list*
        ) ;_ end of setq
  ) ;_ end of foreach

Поставь соответствующие точки останова (теперь они работать будут) и смотри, что и как у тебя получается
P.S. Меня интересовало состояние меню "Debug", ну да ладно.

[Curiosity]

Сообщение от Кулик Алексей aka kpblc Попробуй заменить ' на function. Например, так: Код: [Выделить все] (foreach item (_dwgru-conv-pickset-to-list ss1) (setq xx (vl-list* (vl-sort (mapcar (function cadr) (vl-remove-if-not (function (lambda (x) (= (car x) 10) ) ;_ end of lambda (entget item) ) ;_ end of function ) ;_ end of vl-remove-if-not ) ;_ end of mapcar '< ) ;_ end of vl-sort xx ) ;_ end of vl-list* yy (vl-list* (vl-sort (mapcar (function caddr) (vl-remove-if-not (function (lambda (x) (= (car x) 10) ) ;_ end of lambda ) ;_ end of function (entget item) ) ;_ end of vl-remove-if-not ) ;_ end of mapcar '< ) ;_ end of vl-sort yy ) ;_ end of vl-list* ) ;_ end of setq ) ;_ end of foreach Поставь соответствующие точки останова (теперь они работать будут) и смотри, что и как у тебя получается P.S. Меня интересовало состояние меню "Debug", ну да ладно.

При такой конструкции vlide выдает ошибку

; ошибка: неверный синтаксис функции: ((LAMBDA (X) (= (CAR X) 10)) (ENTGET ITEM))

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

Вот веришь - я тупо заменил ' на function и отформатировал код. Не больше.

Код:

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

 (defun _dwgru-conv-pickset-to-list (value / tab item)
  (repeat (setq tab  nil
                item (sslength value)
                ) ;_ end setq
    (setq tab (cons (ssname value (setq item (1- item))) tab))
    ) ;_ end repeat
  ) ;_ end defun

(defun tt (/ xx yy ss1)

  (setq ss1 (ssget))

  (foreach item (_dwgru-conv-pickset-to-list ss1)
    (setq xx (vl-list*
               (vl-sort
                 (mapcar
                   (function cadr)
                   (vl-remove-if-not
                     (function
                       (lambda (x)
                         (= (car x) 10)
                         ) ;_ end of lambda
                       ) ;_ end of function
                     (entget item)
                     ) ;_ end of vl-remove-if-not
                   ) ;_ end of mapcar
                 '<
                 ) ;_ end of vl-sort
               xx
               ) ;_ end of vl-list*
          ) ;_ end of setq
    (setq yy (vl-list*
               (vl-sort
                 (mapcar
                   (function caddr)
                   (vl-remove-if-not
                     (function
                       (lambda (x)
                         (= (car x) 10)
                         ) ;_ end of lambda
                       ) ;_ end of function
                     (entget item)
                     ) ;_ end of vl-remove-if-not
                   ) ;_ end of mapcar
                 '<
                 ) ;_ end of vl-sort
               yy
               ) ;_ end of vl-list*
          ) ;_ end of setq
    ) ;_ end of foreach
  ) ;_ end of defun

[Сергей812]

Здравствуйте. Подскажите, пожалуйста, назначение функции vla-item? Нашел только примеры использования, а описание - нет(

[SetQ]

Сообщение от Сергей812 Здравствуйте. Подскажите, пожалуйста, назначение функции vla-item? Нашел только примеры использования, а описание - нет(

Gets the member object at a given index in a collection, group, or selection set.

Получает объект заданного номера из коллекции, группы или набора объектов.

http://help.autodesk.com/view/ACD/20...6-D3C3C349475B

[Дима_]

Только не номера, а индекса - это важное отличие, итератор может быть индексирован через любые типы данных.

[Сергей812]

SetQ , Дима_ Спасибо. Примерно я догадывался по Item, что это доступ к коллекции. Но терзали смутные сомнения - нет ли какого-то приведения типов или еще подобного.

[Vladimir_Sergeevich]

Сообщение от wahir какой книге удобно сведены в таблицы dxf-коды примитивов с описаниями возможных значений?

по моему, в родной справке все хорошо описано (по крайней мере в той, что идет с акад 2010)

Сообщение от wahir конкретно сейчас меня интересует создание размеров.

Код:

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

 
(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

pv pn pk - точки начало конца и положения размерной линии, adim - угол наклона в радианах

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

Это справедливо только при создании выровненного (Aligned) размера...

[Vladimir_Sergeevich]

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

з.ы. вспомнил про один вопрос, не так давно возникал...
Ситуация такая: надо примитиву задать толщину (370 группа). когда она "по слою" entget её вообще не выдает, соответственно subst её найти не может и entmod получает исходный список...
В таком случае надо дописывать проверку наличия данной группы и добавлять её другим способом? (я, что бы долго не думать, пошел через vla-put...)

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

Как материал для размышления (код сперт с "САПР на базе"):

Код:

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

 (defun _kpblc-ent-modify-autoregen (ent bit value ext_regen / ent_list old_dxf new_dxf layer_dxf70)
                                   ;|
*    Функция модификации указанного бита примитива
*    Параметры вызова:
*  entity  - примитив, полученный через (entsel), (entlast) etc
*  bit  - dxf-код, значение которого надо установить
*  value  - новое значение
*  regen  - выполнять или нет регенерацию примитива сразу. t/ nil
*    Примеры вызова:
(_kpblc-ent-modify-autoregen (entlast) 8 "0" t)  ; перенести последний примитив на слой 0
(_kpblc-ent-modify-autoregen (entsel) 62 10 nil)  ; установить выбранному примитиву цвет 10
*    Возвращаемое значение:
*  примитив с модифицированным dxf-списком. Примитив перерисовывается в
* зависимости от значения ключа ext_regen
|;
  (setq ent (_kpblc-conv-ent-to-ename ent))
  (if (not
        (and
          (or
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
            (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
            ) ;_ end of or 
          (= bit 100)
          ) ;_ end of and 
        ) ;_ end of not 
    (progn
      (setq ent_list (entget ent)
            new_dxf  (cons bit
                           (if (and (= bit 62) (= (type value) 'str))
                             (if (= (strcase value) "BYLAYER")
                               256
                               0
                               ) ;_ end of if 
                             value
                             ) ;_ end of if 
                           ) ;_ end of cons 
            ) ;_ end of setq 
      (if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
        (progn
          (entmod (if old_dxf
                    (subst new_dxf old_dxf ent_list)
                    (append ent_list (list new_dxf))
                    ) ;_ end of if 
                  ) ;_ end of entmod
          (if ent_regen
            (entupd ent)
            (redraw ent)
            ) ;_ end of if
          ) ;_ end of progn 
        ) ;_ end of if 
      ) ;_ end of progn 
    ) ;_ end of if 
  ent
  ) ;_ end of defun

Библиотечная функция

Код:

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

 (defun _kpblc-conv-ent-to-ename (ent_value / _lst)
                                ;|
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
*  ent_value  значение, которое надо преобразовать в примитив. Может
*      быть именем примитива, vla-указателем или просто
*      списком.
*      Если не принадлежит ни одному из указанных типов,
*      возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-ename (entlast))
(_kpblc-conv-ent-to-ename (vlax-ename->vla-object (entlast)))
|;
  (cond
    ((= (type ent_value) 'vla-object)
     (vlax-vla-object->ename ent_value)
     )
    ((= (type ent_value) 'ename) ent_value)
    ((and (= (type ent_value) 'str) (handent ent_value) (entget (handent ent_value)))
     (handent ent_value)
     )
    ((and (= (type ent_value) 'str) (handent ent_value) (tblobjname "style" ent_value))
     (tblobjname "style" ent_value)
     )
    ((and (= (type ent_value) 'str) (handent ent_value) (tblobjname "dimstyle" ent_value))
     (tblobjname "dimstyle" ent_value)
     )
    ((and (= (type ent_value) 'str) (handent ent_value) (tblobjname "block" ent_value))
     (tblobjname "block" ent_value)
     )
    ((and (= (type ent_value) 'list) (cdr (assoc -1 ent_value))) (cdr (assoc -1 ent_value)))
    (t nil)
    ) ;_ end of cond
  ) ;_ end of defun

[wahir]

с созданием размеров через entmake вроде разобрался, не смог понять только одно - как выбрать аннотативный масштаб для размера? в dxf-reference не могу нужных кодов найти, вроде перенес максимум значений из заранее созданного размера, но всё равно не выходит.

Код:

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

 (entmake (list
	   '(0 . "DIMENSION")
	   '(100 . "AcDbEntity")
	   '(67 . 0)
	   '(410 . "Model")
	   '(8 . "$Размеры")
	   '(100 . "AcDbDimension")
	   '(280 . 0)
	   (cons 10 (polar '(0.0 0.0 0.0) 1 (- (/ ds 2))))
	   '(70 . 35)
	   '(71 . 5)
	   '(72 . 1)
	   '(210 0.0 0.0 1.0)
	   '(3 . "Annotative$3")
	   '(100 . "AcDbDiametricDimension")
	   (cons 15 (polar '(0.0 0.0 0.0) 1 (/ ds 2)))
	 );end list
);end entmake

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

Голову ломать немного лениво: http://autolisp.ru/2011/03/17/howto-...tyle-or-block/

[wahir]

Сообщение от Кулик Алексей aka kpblc Голову ломать немного лениво: http://autolisp.ru/2011/03/17/howto-...tyle-or-block/

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

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

Создаешь стиль и потом устанавливаешь ему аннотативность, или размер - и потом уже аннотативность для объекта. Какая в принципе разница?

[Сергей812]

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

Код:

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

 (defun sys-InsertDescriptionBlock ( aNameBlock aNameSourceFile / )
	; Если в текущем чертеже нет описания данного блока
  	( if (= (tblsearch "BLOCK" aNameBlock) nil)
		( progn
			; Если существует указанный файл с описаниями блоков
	  		( if (/= (findfile aNameSourceFile) nil)
				; Вставляем все определения блоков из указанного файла
		  		( vl-cmdf "_-INSERT" aNameSourceFile )
				( vl-cmdf )
			)
		)
	)
)

почему, несмотря на наличие имитации отмены ввода ( vl-cmdf ) продолжает запрашивать точку вставки ?

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

Offtop: Сто лет уже так не поступал...
Может, дело в отсутствующем progn ?

[skkkk]

Offtop:

Сообщение от Кулик Алексей aka kpblc Offtop: Сто лет уже так не поступал...

Не понял, о чем это ты?

[Сергей812]

Сообщение от Кулик Алексей aka kpblc Offtop: Сто лет уже так не поступал... Может, дело в отсутствующем progn ?

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

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

Сообщение от skkkk Offtop: Не понял, о чем это ты?

Я копирую описания блоков через ObjectDBX - как-то мне такой подход больше понравился.

[kakt00z]

а мне больше так нравится :
(setq tmpblk (vla-InsertBlock #modspace (vlax-3d-point '(0 0 0)) $filepath 0.001 0.001 0.001 0))
с последующим удалением

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

В таком случае "тащится" многовато мусора.

[kakt00z]

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

[Frigate]

Приветствую!

ПРошу подсказать пути решения.
Если последним объектом в чертеже является блок с атрибутами, к примеру, "AN_1", и его запоминаем по ENTLAST, добавляем новые объекты в чертеж, а потом "вдруг" обнаруживаем появление дополнительных объектов - атрибутов последнего блока ("AN_1"). Как с этим бороться?
Пока придумал такое - вставлять любой текстовый объект, после выполнения программы его удалять.

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

А этот блок вставляется руками или программно? Если программно, то получить указатель именно на него вообще не вопрос.

[baaba]

Здравствуйте!
Есть такая конструкция:

Код:

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

 (defun c:ut ()
  (command "_.ucs" "_n" "_ob")
)

Это нужно что бы поворачивать вид по объекту, постоянно пользуюсь.
Но есть одно неудобство - чертёж каждый раз масштабируется (аналогично _zoom extend). В старых версиях Автокада этого масштабирования кажется не было и было намного удобнее.
Проблема упоминается здесь:
http://forum.dwg.ru/showthread.php?t=36250
http://forums.autodesk.com/t5/pointi...i/td-p/4399367

Я пробовал сообразить что то такое

Код:

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

 (defun c:ut ()
	(command "_.ucs" "_n" "_ob" )
	(command "")
	(command "zoom" "p")
)

Но, к сожалению, должным образом не работает. Кажется я смутно понимаю как обращаться с command

Или вообще стоит избавится от command и написать как то по-другому, но мне важнее результат и что бы это было на автолиспе.

PS если удастся сделать то сразу надо наверное будет добавить подобную конструкцию:

Код:

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

 (if (= 1 (getvar "ucsfollow")) (command "zoom" "p"))

Обход масштабирования при ucsfollow = 0.

[skkkk]

Сообщение от Frigate Если последним объектом в чертеже является блок с атрибутами, к примеру, "AN_1", и его запоминаем по ENTLAST, добавляем новые объекты в чертеж, а потом "вдруг" обнаруживаем появление дополнительных объектов - атрибутов последнего блока ("AN_1"). Как с этим бороться?

Я не очень понял, что надо и с чем бороться. Если именно запомнить этот блок в переменной:

Код:

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

(setq block (entlast))

- то не должно иметь значения, есть ли в нем атрибуты или нет, - переменная block будет указывает на этот блок: в пределах функции, если она объявлена в локальных, или в пределах сеанса, если переменная глобальная. Или я не так понял...

Сообщение от baaba Но есть одно неудобство - чертёж каждый раз масштабируется (аналогично _zoom extend)

У меня не зумируется. Автокад 2011х64 RUS SP2. Так что проверить не могу. Но есть подозрение, что не хватает подчеркиваний перед именами команд и их опций. Может, так сработает:

Код:

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

(command "_.ucs" "_n" "_ob" pause "_.zoom" "_p")

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

ucsfollow, кажется, надо поменять. Могу ошибаться

[baaba]

Сообщение от Кулик Алексей aka kpblc ucsfollow, кажется, надо поменять. Могу ошибаться

Да, в моём понимании это должно помочь. Но пока всё равно не выходит. Вот как сейчас всё выглядит:

Код:

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

 (defun c:ut ()
	(setvar "ucsfollow" 0)
	(command "_.ucs" "_n" "_ob" )
	(command "")
	(setvar "ucsfollow" 1)
)

Вот что получается в комстроке (_CMDECHO 1):

Код:

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

Command: ut _.ucs
Current ucs name:  *NO NAME*
Specify origin of UCS or [Face/NAmed/OBject/Previous/View/World/X/Y/Z/ZAxis] 
<World>: _n
Specify origin of new UCS or [ZAxis/3point/OBject/Face/View/X/Y/Z] <0,0,0>: _ob
Select object to align UCS:
Command: 1

[Curiosity]

Здравствуйте!
Недавно нашел здесь на форуме lisp VVA по сортировке текстовых примитивов

Код:

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

(defun f_sel_txt_x (sset dxf / )
	(if (not (equal sset nil))
		(mapcar 
			(function 
				(lambda (x)
					(cdr (assoc dxf (entget x)))
				) ;_ end of lambda
			) ;_ end of function
			(vl-sort
				(vl-remove-if
					(function listp)
					(mapcar (function cadr)
						(ssnamex sset)
					) ;_ end of mapcar
				) ;_ end of vl-remove-if
				'(lambda (a b)
					(or
						(< (cadr (assoc '11 (entget a)))
							(cadr (assoc '11 (entget b)))
						) ;_ on X
						(and  ;_ On Y if eq X
							(equal 
								(cadr (assoc '11 (entget a)))
								(cadr (assoc '11 (entget b)))
								0.1
							) ;_ end of equal
							(> (caddr (assoc '11 (entget a)))
								(caddr (assoc '11 (entget b)))
							) ;_ end of <
						) ;_ end of and
					) ;_ end of or
				) ;_ end of lambda
			) ;_ end of vl-sort
		) ;_ end of mapcar
	) ;_ end of if
) ;_ end of defun

И написал lisp который делает набор по списку координат

Код:

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

(defun f_multi_set (lst / ss ss1 ss2 )
	(setq i 0)
	(repeat (f_round (/ (float (length lst)) 2.0) 1)
		(setq ss1 (ssget "_W" (car (nth i lst)) (cadr (nth i lst))))
		(if 
			(equal (nth (1+ i) lst) nil)
			(setq ss2 (ssadd))
			(setq ss2 (ssget "_W" (car (nth (1+ i) lst)) (cadr (nth (1+ i) lst))))
		)
		(if (equal ss nil)
			(setq ss (ssadd))
		)
		(setq i (+ i 2))
		(vl-cmdf "_select" ss ss1 ss2 "")
		(setq ss (ssget "_p"))	
	)
)
(defun f_round (val prec / )
	(* 
		(fix 
			(+ 
				(/ val (float prec))
				0.5
			)
		)
	 prec
	)
)

Так вот когда пытаюсь отсортировать текстовые примитивы выбранные f_multi_set, функция f_sel_txt_x сортирует их неправильно.
(f_sel_txt_x (f_multi_set (список точек)) -1)
Подскажите пожалуйста что не так?

[baaba]

Сообщение от skkkk У меня не зумируется. Автокад 2011х64 RUS SP2. Так что проверить не могу. Но есть подозрение, что не хватает подчеркиваний перед именами команд и их опций. Может, так сработает: Код: [Выделить все] (command "_.ucs" "_n" "_ob" pause "_.zoom" "_p")

Только что проверил на Автокад 2012. Зуммируется. Наверное я не очень внятно объяснил в чём моя проблема.
Вот это видео правда сделано на 2010 Автокаде, но 2012 ведёт себя так же:
http://tinyurl.com/m5enjsb

При выполнении _.plan _c , т. е. план в текущей системе координат, чертёж зуммируется полностью. При этом в чертежах, особенно генпланы, бывают отдельные примитивы случайно или по необходимости отнесённые далеко от основного чертежа. Тогда затем приходится долго зуммировать до нужного фрагмента. Если это делать часто - неочень удобно.
"_.zoom" "_p" - выручает. Но при этом сбивается поворот относительно системы координат, а это аннулирует все удобства UCSFOLLOW = 1. Это как раньше были кульманы у которых вращался угольник. Мне нужно что бы при этом вращалась и моя голова.
Это обеспечивается установкой UCSFOLLOW = 1. То есть у меня например ось под углом 60 градусов. Я выбираю ПСК по объекту: ucs > new > object. При этом происходит смена ПСК и сразу же и поворот вида ортогонально новой ПСК, что иногда очень нужно. Но при этом же происходит и масштабирование, что не удобно и чего в старых версиях кажется не было. Если UCSFOLLOW = 0 то такой проблемы нет, но и "голова не вращается".

Хотел написать скрипт. Но основная проблема в том что (command "_.zoom" "_p") сбивает поворот вида.

[skkkk]

Сообщение от baaba Вот это видео правда сделано на 2010 Автокаде, но 2012 ведёт себя так же

Это точно 2010? Судя по видео, там есть автозавершение функций в комстроке, а оно появилось, вроде в 2012-м, по крайней мере у меня в 2011-м этого нет. Вряд ли в 2010-м было... Или я не знаю, как его включить?
Заявляю со всей ответственностью: в 2011-м по факту выполнения _USC _OBJ масштабирования не происходит. Сказать что-то больше я просто не могу, т.к. не имею под рукой Автокада 2012

[baaba]

Сообщение от skkkk Это точно 2010?

Да, точно он, 2010. Автокомплит в нём есть, чему я несказанно рад. Странно что в Автодеск его не додумались его включить раньше. Этой вещью давно пользуется всё прогрессивное человечество -) В любом случае спасибо за наблюдение. Будет под рукой 2011 - проверю.

[skkkk]

Сообщение от baaba 2010. Автокомплит в нём есть

А почему у меня в 2011-м нет? Как его включить?

[baaba]

Сообщение от skkkk А почему у меня в 2011-м нет? Как его включить?

Я его ни как не включал. Пользуюсь клавишей TAB и у меня работает. Вспомнил: у нас стоял 2011. На нём это то же работало, клавишей TAB.
Но у меня не выводится список комманд. Я просто перебираю табом, но меня это категорически устраивает (я и так примерно помню нужные комманды, работаю уже давно без меню).

[Сергей812]

Добрый день. Предистория: есть файл шаблона autocad с настроенными листами с форматами. На каждом листе есть блок основной надписи с именем "Основная_надпись_ЕСКД", расположенный на слое "Формат_ЕСКД". Требуется: вставить сверху (можно было в атрибутах - но это переделывать много сотен файлов) в определенное место на блоке текст вида "Авторский лист ХХХ".

Загвоздка: в зависимости от формата координаты местоположения блока основной надписи, естественно, разные. Написал следующий код:

Код:

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

 (defun c:TestSSGet ( / lSetBlk n b1 lP lPx lPy)
	(setq lSetBlk nil)
  	(setq lSetBlk (ssget "_X" (list '(0 . "INSERT") '(8 . "Формат_ЕСКД") )))
	(setq n (sslength lSetBlk))
		(while (> n 0)
			(setq b1 (ssname lSetBlk(- n 1)))
			(if (= (vla-get-effectivename (vlax-ename->vla-object b1)) "Основная_надпись_ЕСКД" )
				(progn
					(setq lP (cdr(assoc 10 (entget b1))))
					(setq lPx (car lP))
			  		(setq lPy (car (cdr lP)))
				  	(princ (strcat "\nX=" ( rtos lPx) "  Y=" ( rtos lPy) "\n"))
					(setq n -9)
			  	)
			)
	    (setq n (- n 1)) 
	)

)

Но все время получаю одни и те же координаты вне зависимости от размера листа. Причем на пустом листе ( без настроенного формата и отсутствующего блока основной надписи) выдает те же координаты. Куда нужно "копать": неправильный код, неправильная DXF группа, некорректная работа с наборами или что то еще?

p.s. ( vl-load-com ) вызывается ранее, поэтому нет в функции.

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

(setq n -9) - это к чему?

[Сергей812]

Сообщение от Кулик Алексей aka kpblc (setq n -9) - это к чему?

Просто выход из цикла - как нашли блок основной надписи и "сдернули" координаты с него, дальше перебирать набор смысла нет. Далее простейший код вида:

Код:

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

 	(if (= n -10)
	    (progn
	  	(setq lSOsMode (getvar "OSMODE"))
	      	(setvar "OSMODE" 0)
		(entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 1) '(8 . "Формат_ЕСКД") '(100 . "AcDbMText")
			(cons 10 (list (- lPx 22.5) (+ lPy 47.8) 0.0)) '(40 . 2.0) '(71 . 1) '(72 . 5)
			(cons 1 (strcat "Авторский лист " (itoa lNum))) '(7 . "штамп") '(210 0.0 0.0 1.0) '(11 1.0 0.0 0.0)
			'(50 . 0.0) '(73 . 1) '(44 . 1.0))		   
		)
	      	(setvar "OSMODE" lSOsMode)
	    )
	) 

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

Файлик приложи. Навскидку я не понимаю, почему не работает.
P.S. osmode в принципе можно не снимать. А при entmake не помешает учитывать пространство (лист/модель), в котором объект надо создавать.

[Сергей812]

Сам тестовый чертеж и lsp

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

Два варианта кода. Первый пишет на всех листах один и тот же текст, второй - автоматически счетчик добавляет.

(defun c:Вставить_номер_авторского_листа (/ lincnamefile lnum lfile lsetblk n b1 lp lpx lpy lsosmode)

(vl-load-com)
(setq
lincnamefile (strcat (vl-filename-directory (vla-get-fullname (vla-get-activedocument (vlax-get-acad-object))))
"\\"
"Increment.txt"
) ;_ end of strcat
) ;_ end of setq
(if (= (findfile lincnamefile) nil)
(progn
(setq lnum 1
lfile (open lincnamefile "W")
) ;_ end of setq
(write-line (itoa lnum) lfile)
(close lfile)
) ;_ end of progn
(progn
(setq lfile (open lincnamefile "R")
lnum (+ (atoi (read-line lfile)) 1)
) ;_ end of setq
(close lfile)
(setq lfile (open lincnamefile "W"))
(write-line (itoa lnum) lfile)
(close lfile)
) ;_ end of progn
) ;_ end of if
(if (setq lsetblk (ssget "_X" (list '(0 . "INSERT") '(8 . "Формат_ЕСКД"))))
(foreach ent
(vl-remove-if-not
(function
(lambda (x)
(= (strcase
(vlax-get-property (vlax-ename->vla-object x)
(if (vlax-property-available-p (vlax-ename->vla-object x) 'effectivename)
"effectivename"
"name"
) ;_ end of if
) ;_ end of vlax-get-property
) ;_ end of strcase
"ОСНОВНАЯ_НАДПИСЬ_ЕСКД"
) ;_ end of =
) ;_ end of lambda
) ;_ end of function
((lambda (/ item tab)
(repeat (setq tab nil
item (sslength lsetblk)
) ;_ end setq
(setq tab (cons (ssname lsetblk (setq item (1- item))) tab))
) ;_ end of repeat
) ;_ end of lambda
)
) ;_ end of vl-remove-if-not
(setq lp (cdr (assoc 10 (entget ent))))
(princ (strcat "\nx="
(rtos (car lp) 2 14)
"; y="
(rtos (cadr lp))
"; space="
) ;_ end of strcat
) ;_ end of princ
(if (not (entmakex (append (list '(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
) ;_ end of list
(mapcar
(function
(lambda (x)
(assoc x (entget ent))
) ;_ end of lambda
) ;_ end of function
'(67 8 410)
) ;_ end of mapcar
(list (cons 10 (list (- (car lp) 22.5) (+ (cadr lp) 47.8)))
'(40 . 2.)
'(71 . 1)
'(72 . 5)
(cons 1 (strcat "Авторский лист " (itoa lnum)))
'(41 . 185.)
'(7 . "штамп")
'(11 1.0 0.0 0.0)
'(50 . 0.0)
'(73 . 1)
'(44 . 1.)
'(210 0. 0. 1.)
) ;_ end of list
) ;_ end of append
) ;_ end of entmakex
) ;_ end of not
(princ (strcat "\nCan't write " (itoa lnum) " value"))
) ;_ end of if
) ;_ end of foreach
) ;_ end of if
) ;_ end of defun

(defun c:testssget (/ lsetblk n b1 lp lpx lpy)
(vl-load-com)
(setq lsetblk nil)
(setq lsetblk (ssget "_X" (list '(0 . "INSERT") '(8 . "Формат_ЕСКД"))))
(setq n (sslength lsetblk))
(while (> n 0)
(setq b1 (ssname lsetblk (- n 1)))
(if (= (vla-get-effectivename (vlax-ename->vla-object b1)) "Основная_надпись_ЕСКД")
(progn
(setq lp (cdr (assoc 10 (entget b1))))
(setq lpx (car lp))
(setq lpy (car (cdr lp)))
(princ (strcat "\nX=" (rtos lpx) " Y=" (rtos lpy) "\n"))
(setq n -9)
) ;_ end of progn
) ;_ end of if
(setq n (- n 1))
) ;_ end of while
) ;_ end of defun

Код:

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

 (defun c:Вставить_номер_авторского_листа (/ lincnamefile lnum lfile lsetblk n b1 lp lpx lpy lsosmode)

  (vl-load-com)
  (setq
    lincnamefile (strcat (vl-filename-directory (vla-get-fullname (vla-get-activedocument (vlax-get-acad-object))))
                         "\\"
                         "Increment.txt"
                         ) ;_ end of strcat
    ) ;_ end of setq
  (if (= (findfile lincnamefile) nil)
    (progn
      (setq lnum  1
            lfile (open lincnamefile "W")
            ) ;_ end of setq
      (write-line (itoa lnum) lfile)
      (close lfile)
      ) ;_ end of progn
    (progn
      (setq lfile (open lincnamefile "R")
            lnum  (+ (atoi (read-line lfile)) 1)
            ) ;_ end of setq
      (close lfile)
      (setq lfile (open lincnamefile "W"))
      (write-line (itoa lnum) lfile)
      (close lfile)
      ) ;_ end of progn
    ) ;_ end of if
  (if (setq lsetblk (ssget "_X" (list '(0 . "INSERT") '(8 . "Формат_ЕСКД"))))
    (progn
      (foreach ent
               (vl-remove-if-not
                 (function
                   (lambda (x)
                     (= (strcase
                          (vlax-get-property (vlax-ename->vla-object x)
                                             (if (vlax-property-available-p (vlax-ename->vla-object x) 'effectivename)
                                               "effectivename"
                                               "name"
                                               ) ;_ end of if
                                             ) ;_ end of vlax-get-property
                          ) ;_ end of strcase
                        "ОСНОВНАЯ_НАДПИСЬ_ЕСКД"
                        ) ;_ end of =
                     ) ;_ end of lambda
                   ) ;_ end of function
                 ((lambda (/ item tab)
                    (repeat (setq tab  nil
                                  item (sslength lsetblk)
                                  ) ;_ end setq
                      (setq tab (cons (ssname lsetblk (setq item (1- item))) tab))
                      ) ;_ end of repeat
                    ) ;_ end of lambda
                  )
                 ) ;_ end of vl-remove-if-not
        (setq lp   (cdr (assoc 10 (entget ent)))
              lnum (1+ lnum)
              ) ;_ end of setq
        (princ (strcat "\nx="
                       (rtos (car lp) 2 14)
                       "; y="
                       (rtos (cadr lp))
                       "; space="
                       ) ;_ end of strcat
               ) ;_ end of princ
        (if (not (entmakex (append (list '(0 . "MTEXT")
                                         '(100 . "AcDbEntity")
                                         '(100 . "AcDbMText")
                                         ) ;_ end of list
                                   (mapcar
                                     (function
                                       (lambda (x)
                                         (assoc x (entget ent))
                                         ) ;_ end of lambda
                                       ) ;_ end of function
                                     '(67 8 410)
                                     ) ;_ end of mapcar
                                   (list (cons 10 (list (- (car lp) 22.5) (+ (cadr lp) 47.8)))
                                         '(40 . 2.)
                                         '(71 . 1)
                                         '(72 . 5)
                                         (cons 1 (strcat "Авторский лист " (itoa lnum)))
                                         '(41 . 185.)
                                         '(7 . "штамп")
                                         '(11 1.0 0.0 0.0)
                                         '(50 . 0.0)
                                         '(73 . 1)
                                         '(44 . 1.)
                                         '(210 0. 0. 1.)
                                         ) ;_ end of list
                                   ) ;_ end of append
                           ) ;_ end of entmakex
                 ) ;_ end of not
          (princ (strcat "\nCan't write " (itoa lnum) " value"))
          ) ;_ end of if
        ) ;_ end of foreach
      (setq lfile (open lincnamefile "W"))
      (write-line (itoa lnum) lfile)
      (close lfile)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

(defun c:testssget (/ lsetblk n b1 lp lpx lpy)
  (vl-load-com)
  (setq lsetblk nil)
  (setq lsetblk (ssget "_X" (list '(0 . "INSERT") '(8 . "Формат_ЕСКД"))))
  (setq n (sslength lsetblk))
  (while (> n 0)
    (setq b1 (ssname lsetblk (- n 1)))
    (if (= (vla-get-effectivename (vlax-ename->vla-object b1)) "Основная_надпись_ЕСКД")
      (progn
        (setq lp (cdr (assoc 10 (entget b1))))
        (setq lpx (car lp))
        (setq lpy (car (cdr lp)))
        (princ (strcat "\nX=" (rtos lpx) "  Y=" (rtos lpy) "\n"))
        (setq n -9)
        ) ;_ end of progn
      ) ;_ end of if
    (setq n (- n 1))
    ) ;_ end of while
  ) ;_ end of defun

Я не добавлял метки начала/конца отмены, это уж сам

[Сергей812]

Кулик Алексей aka kpblc, спасибо, буду разбираться. Второй вариант. Так как смысл этой программки - в одной папке лежит куча файлов *.dwg, объединенных через подшивку. И когда приходит информация со стройки о очередном изменений - делается копия проекта и выпускаются новые авторские листы, каждый из которых должен иметь свой уникальный номер в пределах проекта. И таких папок еще по корпусам немало. И народ просто путается в запарке, в какой папке какой следующий номер можно взять.
И поскольку каждый вызов команды - это один лист, то метки отмены не вижу смысла ставить - ведь текстовой файл не "откатиться" сам назад. А вот что лисп не проверяет и не удаляет эту надпись на листе, если существует-это мой косяк)

[Сергей812]

Разобрался вроде - оказалось, ssget "_X" работает не с активной вкладкой, а со всем чертежом. И возвращает набор из всех блоков основной надписи во всех листах. Соответственно, всегда получал координаты только первого блока вне зависимости от активной вкладки. Как вариант - можно было делать проверку не только на имя блока, но и выдергивать из 410 группы название листа и сравнивать с ( getvar "CTAB").

Появился один вопрос: если переменная для хранения набора локальная - то при выходе из функции ей автоматически будет присвоено значение nil? Чтобы закрыть открытый набор...

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

Сообщение от Сергей812 но и выдергивать из 410 группы название листа и сравнивать с ( getvar "CTAB")

Если надо обрабатывать только текущее пространство, попробуй ключ _A для ssget. Да и справку почитать не помешает

Сообщение от Сергей812 если переменная для хранения набора локальная - то при выходе из функции ей автоматически будет присвоено значение nil

Да.

[Сергей812]

Ключ "_A" не дал эффекта выбора текущего пространства.. справку читаю - там вообще убрали этот ключ. В книге "AutoLisp и VisualLisp в среде AutoCAD" разница между ключами описывается как: "_A" эквилентно "_X" с пустым фильтром.

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

Насколько я помню, ключ "_А" давал автоматическую фильтрацию по текущему пространству...

[Сергей812]

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

[Дима_]

Сообщение от Сергей812 если переменная для хранения набора локальная - то при выходе из функции ей автоматически будет присвоено значение nil

При очередном вызове сборщика мусора (прямом или автоматическим).

[VVA]

Сообщение от Сергей812 Разобрался вроде - оказалось, ssget "_X" работает не с активной вкладкой, а со всем чертежом. И возвращает набор из всех блоков основной надписи во всех листах. Соответственно, всегда получал координаты только первого блока вне зависимости от активной вкладки. Как вариант - можно было делать проверку не только на имя блока, но и выдергивать из 410 группы название листа и сравнивать с ( getvar "CTAB").

Сообщение от Кулик Алексей aka kpblc Если надо обрабатывать только текущее пространство, попробуй ключ _A для ssget.

Ничего не мешает указать текущее пространство в фильтре выбора ssget. Или я чего-то не понял?

Код:

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

(setq ssblk (ssget "_X" (list(cons 0 "INSERT")(cons 410 (getvar "CTAB")))))

и все в текущем пространстве

Код:

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

(setq currlay (ssget "_X" (list(cons 410 (getvar "CTAB")))))

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

VVA, кажется, в каких-то версиях AutoCAD ключ "_А" обрабатывал именно текущее пространство. Похоже, я ошибался

[Сергей812]

Сообщение от VVA Ничего не мешает указать текущее пространство в фильтре выбора ssget. Или я чего-то не понял? Код: [Выделить все] (setq ssblk (ssget "_X" (list(cons 0 "INSERT")(cons 410 (getvar "CTAB"))))) и все в текущем пространстве

У меня была подобная мысль. Сварганил лиспик для проверки вида:

Код:

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

(defun c:TestSSGet3 ( / lSetBlk1 lSetBlk2)
  (setq lSetBlk1 (ssget "_X" (list (cons 0 "INSERT") (cons 410 (getvar "CTab")))))
  (setq lSetBlk2 (ssget "_X" (list(cons 0 "INSERT"))))
  (princ (strcat "\nWith DFX 410 = " (itoa (sslength lSetBlk1)) "  Without DFX 410" (itoa (sslength lSetBlk2)) ))
  (princ)
)

работает вроде)

[Fedorino]

Здравствуйте!
Как же тяжело и долго даётся мне visual lisp, с autolisp было немного попонятней.
Будьте добры подскажите, как сделать предпоследнее выражение, оно пропущено в коде
Заранее спасибо,

Код:

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

 (vl-load-com)

(vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark

; запоминаем текущий слой
(setq altlayer (getvar "clayer"))
; создаем уникальный слой для помещения в него создаваемых примитивов
(entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "_LVR_") (70 . 0) (62 . 41) (6 . "Continuous")))
; делаем активным слой _LVR_
(vla-get-ActiveLayer actdoc)
(vla-put-ActiveLayer actdoc (vla-Item (vla-get-Layers actdoc) "_LVR_"))
; чертим отрезок
(setq obj (vla-get-ModelSpace actdoc))
(vla-AddLine obj (vlax-3D-point -0.5 0.0 0.0) (vlax-3D-point -1.0 0.0 0.0))
; делаем активным первый слой
(setvar "clayer" altlayer)
; создаем блок
(setq block (vla-Add (vla-get-Blocks actdoc) (vlax-3D-point 100.0 100.0 0.0) "_Nude"))
; помещаем все примитивы в слое _LVR_ в набор
(setq actsel (vla-get-ActiveSelectionSet actdoc) tmp nil)
(vla-Clear actsel) ; очистка набора
(vla-Select actsel acSelectionSetAll nil nil 
	(vlax-safearray-fill (vlax-make-safearray vlax-vbInteger '(0 . 1)) '(0 8))
	(vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 1)) '("Line" "_LVR_"))) ; добавление объектов в набор
; затем нужно всем отрезкам в наборе по очереди присвоить слой 0, как это сделать ? его знает
	
; помещаем все примитивы набора в блок
(setq temp (vla-CopyObjects actdoc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0 (1- (vla-get-Count actsel)))) (vlax-for x actsel (setq tmp (cons x tmp))))) block 'idpairs))

(vla-endundomark adoc)

[Сергей812]

ну насколько понимаю, надо типа

Код:

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

(vlax-for lItem actsel (vla-put-Layer lItem "0"))

[Fedorino]

Сергей812, огромное спасибо
Вы сэкономили мне несколько часов поисков .
Вот изобретаю свой велосипед лиспик для программного создания блоков.
Понимаю что есть уже готовые лиспы, но разбираться в них не позволяет мой уровень знаний.
На основе него планирую создание полноценного блока.
Этот блок (так то он стандартный "_Dot", но хочу его создавать программно) в свою очередь будет учавствовать в программном создании стиля мультивыноски (код подсмотрел у А. Кулика).

[Сергей812]

А чего искать? Если надо перебрать все элементы в наборе - то нужен цикл, для activeX это обычно vlax-for. А работа с свойствами примитива - vla-put-%Имя свойства% (установка) или vla-get-%Имя свойства% (получение).

----- добавлено через ~16 мин. -----
И чего то меня терзают смутные сомнения - а нельзя ли добавлять сразу в набор при программном рисовании примитивов? Тогда не надо вспомогательного слоя создавать, делать потом выборку.. Сохранил текущий слой, переключился в нулевой...

[Fedorino]

Сергей812, да можно и сразу добавлять, в обычном лиспе я бы так и сделал, но в методах ActiveX вообще не силен.
Полещука почитываю, но тяжко даётся.
Поэтому и хотя бы как-нибудь нужно было поместить в набор, благо в этом же учебнике примеры на глаза с vla-Select с выбором по слою попались.

Вот в учебнике есть это, но не расписано, что и для чего, какие массивы и по какому принципу создаются, инфа скудная увы,
(vla-Select actsel acSelectionSetAll nil nil
(vlax-safearray-fill (vlax-make-safearray vlax-vbInteger '(0 . 1)) '(0 8))
(vlax-safearray-fill (vlax-make-safearray vlax-vbVariant '(0 . 1)) '("Line" "_LVR_")))
Буду потихоньку разбираться, считаю все-таки у vlisp плюсов больше по сравнению с lisp.

[Vladimir_Sergeevich]

В продолжение темы о блоках. я делал _ArchTick через dxf.

Код:

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

 (if (not (tblobjname "block" "_ArchTick"))  ;создание блока стрелки если его нет в чертеже
(progn
;create block begin
(entmakex (list
	(cons 0 "BLOCK") 
	(cons 100 "AcDbEntity") 
	(cons 100 "AcDbBlockBegin") 
	(cons 2 "_ArchTick");name block
	(list 10 0.0 0.0 0.0);base coord 
	(cons 70 0)
	);end list
	);end entmake

	;create pline
	(entmakex (list
	(cons 0 "LWPOLYLINE") 
	(cons 100 "AcDbEntity") 
	(cons 100 "AcDbPolyline")
	(cons 6 "ByBlock");linetype
	(cons 8 "0");layer
	(cons 62 0)
	(cons 90 2)
	(cons 70 0) 
	(cons 43 0.15) 
	(list 10 -0.5 -0.5) 
	(cons 40 0.15) 
	(cons 41 0.15) 
	(cons 42 0.0)
	(cons 91 0) 
	(list 10 0.5 0.5) 
	(cons 40 0.15) 
	(cons 41 0.15) 
	(cons 42 0.0)
	(cons 91 0) 
	;(list 210 0.0 0.0 1.0)
	);end list
	);end entmake
	
	;endblk
	(entmakex (list
	(cons 0 "ENDBLK") 
	(cons 100 "AcDbEntity") 
	(cons 100 "AcDbBlockEnd")
	);end list
);end entmake
);end progn
);end if

Собственно создается описание блока, без предварительной отрисовки элементов.
А сейчас возник вопрос: насколько будет жизнеспособно создание полилинии методами activx (и, скажем, не только их), сохранив границы описания блока в dxf? или я уже слишком размечтался...

[Curiosity]

Здравствуйте!
Помогите разобраться с рекурсией
Помогите написать рекурсивную функцию для такого уравнения.

[ciril]

ну как сказано, так и написано

Код:

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

 
((eval (setq ksicir (function (lambda () (/ (+ N (* Rb A (/ (sin (* 2 pi ((eval ksicir)))) (* 2 pi)))) (+ (* Rb A) (* Rs Astot))))))))

[Curiosity]

А как условие остановки написать? Я этого не могу понять
И какое значение при первом проходе вместо ksicir поставляется? И как осуществляется поиск решения?
Мне кажется нужно написать условие типа ksicir(i-1) не должно отличаться от ksicir(i) больше чем на 0.001

[ciril]

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

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

Curiosity, почитай разбор рекурсии: http://elpanov.com/index.php?id=10

[voron83]

Здравствуйте люди добрые.
Вот и я пришел к мысли что нужно изучать лисп, т.к. пользуюсь автокадом давно вот и решил разобраться и начать писать программки для себя. Пока я лиспе полный "0"
Поставил перед собой задачу, наверное для ГУРУ это простая задача, написать лисп который вычитает,или складывает из одного числа, записанного как текст, другое число, также текст. Результат действия третье число. тоже текст.
Алгоритм действия пользователя:
1 Тыкаю мышкой на первое число
2 выбираю действие (+ или -)
3 Тыкаю мышкой на второе число
4 Тыкаю мышкой куда нужно поставить результат

Так вот первая проблема это как переменной задать выбранное число? Не допру какая функция отвечает за "тык мыши"?

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

Тебе не "тык мышой" надо, а получение примитива. entsel в помощь.

[voron83]

Сообщение от Кулик Алексей aka kpblc Тебе не "тык мышой" надо, а получение примитива. entsel в помощь.

Буду изучать. Спасибо.

[jackUAROBEY]

Добрый день.
Помогите. Как сделать так чтоб при досрочном выходе из программки системные переменные возвращали свое первоначальное значение.

Код:

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

 (progn
  (princ " \nНаберите в командной строке:")
  (princ "\nтру - начинает строить отрезок")
  (princ "\nмир - мировая система координат")
  );progn
(defun C:тру ( /  dim ugol)
  (setq snn (getvar "CELWEIGHT"))  
  (setq snp (getvar "CELTYPE"))
  (setq snpl (getvar "plinewid"))
  (setvar "CELTYPE" "CONTINUOUS")
  (setvar "CELWEIGHT" 30)
  (setvar "plinewid" 0)
  (initget 128)
  (Setq qwew (getreal "Перепад"))
  (initget 128)
  ;(Setq dim (getreal "Диаметр"))
  (Setq ugol (* (atan (/ qwew 200.0)) 57.29747))
  (Command "_.UCS" "z" ugol "")
  (command "ORTHOMODE" 1)
  (COMMAND "_.Line" pause pause "")
  (Command "_.UCS" "" )   
  (command "_.TRIM" "" pause "" )
  (command "_.Copy" "Последний" "" "@" )
  (setvar "CELWEIGHT" snn)
  (setvar "CELTYPE" snp)
  (setvar "plinewid" snpl)
  )
(defun C:мир ( / )
  (Command "_.UCS" "" )
  )

[Дима_]

Вариант 1: назначить функции функции от 1-го аргумента (это будет описание ошибки в виде строки) имя *error* - где произвести необходимые манипуляции по восстановлению.

Код:

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

 ((lambda (*error*) (/ 5 0)) (lambda (err) (alert err)))

Вариант 2: см. (vl-catch-all-apply ...)

[skkkk]

voron83, написать хочется непременно, даже если есть уже готовые решения? Просто писать-то лучше то, чего еще нет. А так - поиск по форуму по словам "сумма текстов" и там в коде можно поменять плюс на минус. Таких решений уже полно.

[voron83]

Сообщение от skkkk voron83, написать хочется непременно, даже если есть уже готовые решения? Просто писать-то лучше то, чего еще нет. А так - поиск по форуму по словам "сумма текстов" и там в коде можно поменять плюс на минус. Таких решений уже полно.

Написать хочется ради изучения лиспа. Мне не важно что есть готовое решение, хотя в них я иногда подсматриваю . Хочется творить самому. Создавать то что нужно мне. Ну и разбираться в уже готовых изменяя их для себя.
Про решение моей задачи есть тема http://forum.dwg.ru/showthread.php?t...EA%F1%F2%EE%E2. Взяв за основу буду разбираться и доводить ее для своих целей.

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

http://autolisp.ru/2009/09/13/error-catch/

[trushev]

В 2015 версии появилась новая функция COMMAND-S.
Ее надо использовать вместо VL-CMDF и COMMAND,
если функция вызывается с заранее заданными аргументами
и не подразумевается никаких действий пользователя во время ее вызова.
Синтаксис функции command-s:
(command-s [cmdname [arguments ...]]).
Синтаксис функции command:
(command [cmdname [arguments ...]] ... [cmdname [arguments ...]]).
При адаптации древних Lisp'ов при тупой замене command на command-s выполняется только первая
команда остальные команды игнорируются с продолжением работы без прерывания и сообщения об ошибке.
Более детально лезть в код лень. Что посоветуете?

P.S. В 2015 с command в работе лиспа нареканий не обнаружил.

[skkkk]

Сообщение от trushev Что посоветуете?

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

Сообщение от trushev P.S. В 2015 с command в работе лиспа нареканий не обнаружил.

В смысле? Вроде как command в 2015-м не работает. Сам проверить не могу - нет 15-го, это я по сообщениям форума сужу.
Были также предложения просто заменить во всех лиспах command на vl-cmdf, но поведение их порой отличается, и на результатах работы программы сказаться может в худшую сторону. Довольно редко, но я с этим сталкивался.

[trushev]

Спасибо skkkk

[Wolkodaw]

Помогите, пожалуйста, с сортировкой списка:
Есть набор динамических блоков в автокад. Блоки преобразованы во VLA-объекты. Необходимо отсортировать список из VLA - объектов (названий блоков), но по их длине.
Никак не могу понять как привязать коэффициент перебора номера блока k:

(vl-sort-i ars_list_blocks '< (vlax-variant-value (vla-get-value (car (vl-remove-if-not '(lambda (x) (= "ars_distance" (vla-get-propertyname x))) (vlax-safearray->list (vlax-variant-value (vla-GetDynamicBlockProperties (nth k ars_list_blocks))))))))))

где ars_list_blocks-список, созданный функцией list, возвращает значение, типа (#<VLA-OBJECT IAcadBlockReference 19733bf4> #<VLA-OBJECT IAcadBlockReference 19744bf5> #<VLA-OBJECT IAcadBlockReference 19538gh4>)

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

на выбор:

Код:

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

 (vl-sort
  ars_list_blocks
  (function
    (lambda (a b)
      (apply (function <)
             (mapcar
               (function vla-get-effectivename)
               (list a b)
               ) ;_ end of mapcar
             ) ;_ end of apply
      ) ;_ end of lambda
    ) ;_ end of function
  ) ;_ end of vl-sort

(vl-sort
  ars_list_blocks
  (function
    (lambda (a b)
      (< (strlen (vla-get-effectivename a)) (strlen (vla-get-effectivename b)))
      ) ;_ end of lambda
    ) ;_ end of function
  ) ;_ end of vl-sort

[Wolkodaw]

Спасибо, но оно я как понимаю сортирует по эффективному имени блока, а не по длине ("ars_distance")...

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

Минуту. Ты просил:

Сообщение от Wolkodaw Необходимо отсортировать список из VLA - объектов (названий блоков), но по их длине

Я так понял, что нужно было именно имя блока. А если нет - то получай соответствующее значение определенного свойства дин.блока и сортируй по нему. Принцип не меняется ни на йоту.

[Wolkodaw]

Хорошо, попробую, спасибо

Пол-дня бьюсь, никак не выходит((( голову скоро сломаю...
Как заменить vla-get-effectivename на код по извлечению длины?
Задача состоит в том, чтобы отсортировать список ИМЕН (VLA-адресов) блоков, но по их длине (свойство "ars_distance"). Получается что-то вроде двойной сортировки.

[trushev]

Я не программист, английского не знаю. В середине 90-х пересел от
кульмана к компьютеру. Каюсь, первое время расстояние на мониторе
мерял линейкой. Познакомился с lisp'ом, dcl в объеме книги Ю. А. Кречко
В. В. Полищук "Автокад 13: новые возможности" Москва "Диалог-МИФИ" 1996.
Связки DCL-LSP по параметрическому вычерчиванию прослужили без проблем
от R12 по AutoCAD 2014. Беглая проверка на ACADVER = "20.0s (LMS Tech)"
показала их работоспособность.
По совету skkkk изучил тему "Mapcar, foreach и AutoCAD 2015". Очень
понравилось решение VVA (#8) и идея пакетной обработки roaa (#13).
В результате родилось следующее:

Замена command на функцию adapt

С учетом синтаксиса функции command:
(command [cmdname [arguments ...]] ... [cmdname [arguments ...]])

На вход adapt подается список:

Код:

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

         (list (list [arguments ...])
                ...
              (list [arguments ...])
        )

Координаты в аргументах должны быть преобразованы к виду "XXX.xxx,YYY.yyy"

Код:

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

 (defun adapt (sp)
       (if command-s     ;Предложено VVA
           (foreach k sp
                    (eval (cons 'command-s (car sp)))
                    (setq sp (cdr sp))
           );foreach k sp
              ;ИНАЧЕ
           (eval (cons 'command (append sp)))
       );if command-s
);defun adapt (sp)

При наличии в аргументах координат в виде (list x y) требуются дополнительные
затраты на преобразование кода (strcat (rtos x 2 n) "," (rtos y 2 n)).
Можно ли обойтись без этих затрат?


Но продолжает грызть вопрос: нужна ли адаптация если нет вложений command
в mapcar или foreach?

----- добавлено через ~15 мин. -----
Прошу прощения.
На вход adapt подается список:

Код:

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

         (list (list [cmdname [arguments ...]])
                ...
              (list [cmdname [arguments ...]])
        )

[mkung]

Подскажите, пожалуйста, как набор, сформированный функцией (ssget) сохранить в отдельный файл.
Что-то туплю...

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

В какой "отдельный файл"? В текстовый?

[mkung]

Сообщение от Кулик Алексей aka kpblc В какой "отдельный файл"? В текстовый?

DWG, конечно

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

Сообщение от mkung DWG, конечно

Это было неочевидно.
Есть команда _.wblock, есть вариант выполнять через ObjectDBX копирование объектов (vla-CopyObjects). Что больше нравится?

[mkung]

Сообщение от Кулик Алексей aka kpblc Это было неочевидно. Есть команда _.wblock, есть вариант выполнять через ObjectDBX копирование объектов (vla-CopyObjects). Что больше нравится?

Я бы сделал через vla-wblock, но не пойму как мне набор из SSGET превратить в "vla-SelectionSet"...

[Dima_90]

Прошу помощи в формировании размеров видового экрана.
Не получается присвоить к (Vports) значение ((2 (0.42 0.0) (1.0 1.0)) (3 (0.0 0.0) (0.42 1.0)))
Подскажите как надо написать программный код.

[skkkk]

Сообщение от mkung не пойму как мне набор из SSGET превратить в "vla-SelectionSet"...

А почему бы сразу не создавать этот набор методами ActiveX? Но если уж так хочется "превращений" (может, там у ssget фильтр какой-нибудь незаурядный по плану) , то, наверное, как-то так:

Код:

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

 (setq ss (ssget))
(sssetfirst nil ss)
(setq vla-ss (vla-get-PickfirstSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))

Сообщение от Dima_90 Прошу помощи в формировании размеров видового экрана.

Совершенно не понимаю, что означает эта строка

Сообщение от Dima_90 ((2 (0.42 0.0) (1.0 1.0)) (3 (0.0 0.0) (0.42 1.0)))

Либо туговато соображаю с утра, либо одно из двух. Что за цифры 2 и 3? Что за координаты? Координаты вершин четырехугольника неправильной формы? Видовой экран должен быть непрямоугольным? Трапецевидным? Тогда в него нужно "превращать" полилинию, если я ничего не путаю. Можно приложить файл dwg с изображением желаемого эффекта?
Offtop: Одни Гарри Поттеры, блин

[Dima_90]

skkkk
Я имел в виду следующее.
В автокаде можно разделять экран на несколько видовых экранов (два вертикально, 3 вертикально, горизонтально) в модели. Но чтобы мне удобно поделить модель на 2 видовых экрана мне приходиться создавать их большое количество а потом пользуясь инструментом "объединить видовые экраны" создавать 2 видовых экрана со смещенным центром. Рассматривая учебник по написанию программного кода я обнаружил функцию (Vports) которая может показать значения координат видовых окон. А вот самому задать эти значения у меня не получается

[ShaggyDoc]

В автокаде можно разделять экран на несколько видовых экранов (два вертикально, 3 вертикально, горизонтально) в модели. Но чтобы мне удобно поделить модель на 2 видовых экрана мне приходиться создавать их большое количество а потом пользуясь инструментом "объединить видовые экраны" создавать 2 видовых экрана со смещенным центром.

Видовые экраны в пространстве модели - анахронизм. Когда-то (когда не было Layout) они были очень нужны - чтобы быстро переходить между видами на разные участки модели. При этом количество и расположение таких ВЭ было ограничено.

Но в этом уже давно нет нужды. Если множество Layout с любыми плавающими ВЭ. И нет никакой необходимости "создавать большое количество", а потом "объединять".

Подумайте об организации своей работы, а не об обработке списков.

[Dima_90]

ShaggyDoc
Не совсем понял Вашу мысль. Я согласен с тем, что подготовить чертежи к выпуску, работая с листами намного проще и удобней в большинстве случаев (особенно если добавлять в ЛИСТ несколько видовых экранов). Но в моих проектах (электрика) существует множество дискомфорта с подобной организацией работы.

Может быть я не совсем понятно написал что же я хочу сделать, поэтому распишу подробно мой случай.
У меня стоит на рабочем месте 2 монитора разной диагонали и разрешения. Я при работе растягиваю окно Автокада на 2 монитора и делю пространство модели на пополам по вертикале. В моем случае получается что рабочая область находиться на одном мониторе, а вспомогательная область на другом.
НО т.к разрешение мониторов разное, то получается что автокад при делении на пополам (по пикселям) модель, не по полам делит изображения на два монитора (граница деления проходит на мониторе с большим разрешением).
Чтобы решить данную проблему я делю пространство модели на очень большое количество по вертикали, потом эти видовые экраны модели объединяю таким образом, что полоса деления модели по "полам" проходит между двумя физическими мониторами. Затем я сохраняю этот новый видовой экран модели и могу в данном файле в пару кликов его подгружать. Но в другой файл я не нашел как его импортировать. Из-за этого приходиться в каждом новом файле его создавать заново утомительным способом.
И вот недавно я нашел функцию Vports, которая если взять в скобочки, то даст размеры видовых экранов модели. Вот теперь я хочу создать несколько строчек программного кода который у функции (Vports) поменяет данные на те, которые я укажу. Потом это можно будет завязать на кнопку и делить экран под мои мониторы за один клик.

Моя проблема состоит в том, что у меня не получается в функцию Vports записать список моей информации.

[mkung]

Спасибо - работает.

Сообщение от skkkk А почему бы сразу не создавать этот набор методами ActiveX?

Да я бы с радостью. И нашел уже vla-select, но что-то пока с safearray не въезжаю...
Задача вобщем-то примитивная - создать наборы объектов по существующим слоям и записать в отдельные файлы DWG.

[Сергей812]

Сообщение от Dima_90 Затем я сохраняю этот новый видовой экран модели и могу в данном файле в пару кликов его подгружать. Но в другой файл я не нашел как его импортировать. Из-за этого приходиться в каждом новом файле его создавать заново утомительным способом.

А разве нельзя запись в макрос (рекордер операций) последовательность действий и вызывать в новом файле?

[Dima_90]

Сергей812
Записать макрос когда можно и мышкой и клавиатурой и лентой пользоваться не получается, т.к при повторении в новом файле макрос сбивается. Возможно получиться если вручную все прописывать, но это хлопотно и не универсально (на других ПК с другими мониторами его надо будет переписывать). А вот если как то получаться в эту функцию (Vports) мои значение задать то это будет намного проще. Может надо через ключи какие то, или переменные посреднические прописать. Подробнее о данной функции, чем в учебнике, страницы которого я выкладывал, информации нигде не нашел.

[skkkk]

Сообщение от Dima_90 можно разделять экран на несколько видовых экранов (два вертикально, 3 вертикально, горизонтально) в модели.

Точно, плохо соображал с утра. Даже не вспомнил о такой возможности.

ShaggyDoc, анахронизм анахронизмом, а до сих пор поддерживаются они еще Автодеском. Тут прочитал, что в 2015-й версии добавили к этим экранам возможность перемещать границы мышью. Об организации работы, конечно, думать надо, и очень основательно, но ведь можно найти и случаи, когда такая модель работы будет очень кстати.

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

Код:

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

(entget (tblobjname "VPORT" "*ACTIVE"))

и убрав read-only точечные пары, а также придумав новое имя, попробовал создать табличную запись такой же конфигурации в новом чертеже:

Код:

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

(entmakex '((0 . "VPORT") 
			(100 . "AcDbSymbolTableRecord") 
			(100 . "AcDbViewportTableRecord") 
			(2 . "USER-CONFIG") ; имя конфигурации 
			(70 . 0) 
			(10 0.5 0.0 0.0) 
			(11 1.0 0.5 0.0) 
			(12 2633.82 1499.32 0.0) 
			(13 0.0 0.0 0.0) 
			(14 10.0 10.0 0.0) 
			(15 10.0 10.0 0.0) 
			(16 0.0 0.0 1.0) 
			(17 0.0 0.0 0.0) 
			(40 . 2499.32) 
			(41 . 1.58323) 
			(42 . 50.0) 
			(43 . 0.0) 
			(44 . 0.0) 
			(50 . 0.0) 
			(51 . 0.0) 
			(71 . 0) 
			(72 . 1000) 
			(73 . 1)
			(74 . 3) 
			(75 . 0) 
			(76 . 1) 
			(77 . 0) 
			(78 . 0) 
			(281 . 0) 
			(65 . 1) 
			(110 0.0 0.0 0.0) 
			(111 1.0 0.0 0.0) 
			(112 0.0 1.0 0.0) 
			(79 . 0) 
			(146 . 0.0) 
			(60 . 3) 
			(61 . 5) 
			(292 . 1) 
			(282 . 1) 
			(141 . 0.0) 
			(142 . 0.0) 
			(63 . 250) 
			(421 . 3355443)
		   )
)

Теоретически, должно было бы сработать, но когда в команде _-VPORT пытаюсь восстановить данную конфигурацию ("USER-CONFIG"), то активным становится только правый нижний экран из четырех, причем остальные даже недоступны для активации и показывают лишь черный фон и больше ничего.
И вот что это? Глюк моего Автокада 2011 или еще какие-то точечные пары лишние в списке?

Сообщение от mkung что-то пока с safearray не въезжаю...

Терпение и труд все перетрут. Информации полно. Насколько помню, у Полещука прям объекты слоя и выбираются в примерах к методу Select.

[Dima_90]

skkkk
Я не силен в программировании, но читать немного умею программные коды. Помню в одном из случаев по каким то причинам так же не присваивались значения к функции, и в этом случае вводили переменную, прописывали что там могут быть целые числа, потом присваивали к переменной список точечных пар через оператор List, а уже потом получалось значения этой переменной применить к функции. Может в этом случае так же надо. Сам я пробовал подобное написать, но что то ничего не вышло.

[Forsy]

День добрый граждане, большая просьба помочь с написанием макроса.Изо дня в день выполняю одни и те же действия,захотелось упростить себе работу.Итак на входе имеем файл,в котором имеется контур объекта,выполненный замкнутый полилинией,на вершинах которой расположены блоки,все блоки имеют одно имя,по сути одинаковые.Нужно сделать следующее: полилинию сделать красным цветом(что не сложно) а на вершинах проставить черные точки,ну или окружности заполненные черным цветом.Что делаю я-захожу в редактор блоков одного из блоков, заштриховываю черным цветом,сохраняю-в итоге все блоки черного цвета.
Макрос пока получается такого вида ^C^C-блокред bl_119
_hpname;SOLID;_bhatch
Но дальше пока ничего неполучается(.

[ciril]

В вершинах полилинии расставляет штриховки солидом черного цвета на текущем слое непрерывным типом линии с весом 0.0
Выделяешь нужную полилинию, вызываешь макрос.
В '(40 . 1.3) вместо 1.3 поставь нужный тебе радиус.

Код:

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

 
(mapcar (function
          (lambda (e00)
            (and (eq 10 (car e00))
                 (entmake (append '((0 . "HATCH")
                                    (100 . "AcDbEntity")
                                    (62 . 250)
                                    (6 . "Continuous")
                                    (370 . 0)
                                    (100 . "AcDbHatch")
                                    (10 0.0 0.0 0.0)
                                    (210 0.0 0.0 1.0)
                                    (2 . "SOLID")
                                    (70 . 1)
                                    (71 . 0)
                                    (91 . 1)
                                    (92 . 1)
                                    (93 . 1)
                                    (72 . 2))
                                  (list (append e00 '(0.0)) '(40 . 1.3) '(50 . 0.0) (cons 51 (* 2 pi)))
                                  '((73 . 1)
                                    (97 . 0)
                                    (75 . 0)
                                    (76 . 1)
                                    (98 . 1)
                                    (10 0.0 0.0 0.0)
                                    (450 . 0)
                                    (451 . 0)
                                    (460 . 0.0)
                                    (461 . 0.0)
                                    (452 . 0)
                                    (462 . 1.0)
                                    (453 . 2)
                                    (463 . 0.0)
                                    (421 . 255)
                                    (463 . 1.0)
                                    (470 . "LINEAR")))))))
        ((eval (function (lambda (e00)
                           (if e00
                             (entmod (append (entget (ssname e00 0)) '((62 . 1)))))))) (cadr (ssgetfirst))))

[Forsy]

Сообщение от ciril В вершинах полилинии расставляет штриховки солидом черного цвета на текущем слое непрерывным типом линии с весом 0.0 Выделяешь нужную полилинию, вызываешь макрос. В '(40 . 1.3) вместо 1.3 поставь нужный тебе радиус. Код: [Выделить все] (mapcar (function (lambda (e00) (and (eq 10 (car e00)) (entmake (append '((0 . "HATCH") (100 . "AcDbEntity") (62 . 250) (6 . "Continuous") (370 . 0) (100 . "AcDbHatch") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (2 . "SOLID") (70 . 1) (71 . 0) (91 . 1) (92 . 1) (93 . 1) (72 . 2)) (list (append e00 '(0.0)) '(40 . 1.3) '(50 . 0.0) (cons 51 (* 2 pi))) '((73 . 1) (97 . 0) (75 . 0) (76 . 1) (98 . 1) (10 0.0 0.0 0.0) (450 . 0) (451 . 0) (460 . 0.0) (461 . 0.0) (452 . 0) (462 . 1.0) (453 . 2) (463 . 0.0) (421 . 255) (463 . 1.0) (470 . "LINEAR"))))))) ((eval (function (lambda (e00) (if e00 (entmod (append (entget (ssname e00 0)) '((62 . 1)))))))) (cadr (ssgetfirst))))

Огромное спасибо за отклик,но автокад выдает следующее "ошибка: синтаксическая ошибка"P.S. акад 2009

[ciril]

Попробуй так:

Код:

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

 
(mapcar (function
            (lambda (e00)
                (and (eq 10 (car e00)) (entmake (append '((0 . "CIRCLE") (40 . 1.3)) (list (append e00 '(0.0))))))))
        ((eval (function (lambda (e00)
                             (if e00
                                 (entmod (append (entget (ssname e00 0)) '((62 . 1))))))))
            (cadr (ssgetfirst))))

Чертит окружности, если и с этим вариантом будет ошибка, то дело не в версии.

[Eugene.ne.Eugene]

добрый день! понадобилось мне из region сделать pline. А так как этих регионо у меня много (порядка 4000) - обычные способы, типа взорвать, или boundary создать - не вариант. Порывшись в интернете на зарубежном форуме нашел lisp для этого дела, вот только беда - он не поддерживает мультивыбора, т.е. опять же, надо все регионы выбирать по очереди. Помогите, пож, его переделать, если это вообще возможно

Код:

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

size=2>;;;===========================================

(defun c:reg2poly ( / ename old_cmdecho)
  
(if (setq ename (car (entsel)))
    (if (= (cdr (assoc 0 
(entget ename))) "REGION")
      
(progn
        (setq old_cmdecho (getvar 
'cmdecho))
        (setvar 'cmdecho 
0)
        (command "_.undo" 
"_begin")
        (command "_.explode" 
ename)
        (command "_.pedit" "_m" 
(ssget "_p") "" "_y" "_j" 0.0 "")
        
(command "_.undo" "_end")
        (setvar 
'cmdecho old_cmdecho)
      
)
      (prompt "\nThe selected object is not a 
region.")
    )
    (prompt 
"\nNothing selected.")
  )
  (princ)
)



size=2>;;;===========================================

[Сергей812]

Найти пример перебора выделенных элементов (набора) на лиспе и скрестите)

Код:

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

 (defun c:reg2poly ( / ename old_cmdecho)

превратиться в

Код:

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

 (defun reg2poly ( ename /  old_cmdecho)

и убрать строчку

Код:

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

 (if (setq ename (car (entsel)))

и получаете функцию для обработки переданного в аргументе ename примитива, если он регион ( и сам лисп рабочий). Далее вызываете эту функции в команде, перебирающей выбранные примитивы.

[Eugene.ne.Eugene]

Сообщение от Сергей812 превратиться в

в исходном коде, который я нашел было без "с:" но без него код не сработал. я добавил "с:" и хоть как то заработало
Если сделать как вы говорите снова перестает работать, пишет что не знает такой команды как reg2poly

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

Ясно, разница между командами и функциями неочевидна, хотя VVA ее отлично описал: http://dwg.ru/pub/9

[Сергей812]

Offtop: Я лишь написал, как превратить команду в функцию с минимальными переделками, чтобы ее использовать в дальнейшем.

[mkung]

Подскажите, пожалуйста, как программно к файлу конфигурации печати ( например DWG To PDF.pc3) подключить файл описания принтера (например DWG To PDF New.pmp)?
Заранее благодарен.

[trushev]

В функциях Кулик Алексея aka kpblc из темы "Проверка файла и dimpost" с autolisp.ru

(defun _lispru-error-sysvar-save-by-list (lst / res)
* Сохранение состояния системных переменных
(defun _lispru-error-sysvar-restore-by-list (lst)
* Восстановление состояния системных переменных.

не понял как они работают при сбойном завершении программы. Есть ли решение проблемы восстановления переменных в этом случае?

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

Для этого надо писать обработчик ошибок (функцию *error*) или использовать vl-catch- функции (на autolisp.ru я показывал варианты и одного, и другого).

[trushev]

Спасибо! Тему "Код без ошибок – возможно ли?" нашел. Буду разбираться.

[mkung]

Несколько вопросов:
1. (повтор) как программно к конфигурации печати ( например DWG To PDF.pc3) подключить файл описания принтера (например DWG To PDF New.pmp)?
2. Как из программы вызвать "проводник" - окно сохранения(открытия) файла?
3. Нужно сохранить файл перед обработкой. Как это сделать быстрее? Если использовать SaveAs - активной становится копия и при большом файле геморройно открывать старый-закрывать новый. Если через SSGET "_X" и потом WBLOCK - то можно ли быть уверенным, что чертеж будет идентичным?
Заранее благодарен.

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

Сообщение от mkung (повтор) как программно к конфигурации печати ( например DWG To PDF.pc3) подключить файл описания принтера (например DWG To PDF New.pmp)?

Топик-ап, добрый день

Сообщение от mkung Как из программы вызвать "проводник" - окно сохранения(открытия) файла?

startapp

Сообщение от mkung Нужно сохранить файл перед обработкой. Как это сделать быстрее?

1. (command "_.save")
2. (vla-save ...
3. Похожую задачу делал на http://adn-cis.org/forum/index.php?t...sg7171#msg7171 , но результат оказался никому не нужным. Код оставил просто "на память".

Сообщение от mkung Если через SSGET "_X" и потом WBLOCK - то можно ли быть уверенным, что чертеж будет идентичным?

Теоретически - да. Практически - еще вопрос.

[mkung]

Сообщение от Кулик Алексей aka kpblc Цитата: Сообщение от mkung Нужно сохранить файл перед обработкой. Как это сделать быстрее? 1. (command "_.save") 2. (vla-save ... 3. Похожую задачу делал на http://adn-cis.org/forum/index.php?t...sg7171#msg7171 , но результат оказался никому не нужным. Код оставил просто "на память".

Сорри... КОПИЮ ФАЙЛА

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

Сходи по ссылке, почитай обсуждение.

[sdv79]

Не понимаю первую скобку , что это значит, как можно по другому записать?

Код:

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

 
((lambda (/ res)(vlax-for sub VLA_ITEM(setq res (cons sub res))) (reverse res)))

[Дима_]

Это "локализация по месту" имени res - чтоб не засорять пространство имен - vlax-for устроен, так сказать, не в концепции лиспа - это чисто итеративная функция, а в функциональном стиле подобную "встроить" поленились - по факту функция берет vla коллекцию "VLA_ITEM" и возращает список ее item'ов - я тоже приодически использую подобнцй костыль - только "VLA_ITEM" у меня вынесен как аргумент.

[sdv79]

Не понятно. Если убрать первую и последнюю скобку работать не будет. ПОЧЕМУ?
Что там происходит, какой элемент находится? Чем эту пустоту можно описать (заменить)?

[Сергей812]

а если убрать

Код:

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

(/ res)

заработает?

[Дима_]

Сообщение от sdv79 Если убрать первую и последнюю скобку работать не будет. ПОЧЕМУ?

а у любого лиспа любую скобку(и) убери он уже по другому заработает, а в "пустоте" запускается только-что созданная функция.

[sdv79]

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

[Сергей812]

Чего читать то? В посте #2423 Дмитрий сказал, для чего такая конструкция:

Сообщение от Дима_ Это "локализация по месту" имени res - чтоб не засорять пространство имен

Может так будет понятнее

Код:

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

 (
 (lambda
    (/ res)
       (vlax-for sub VLA_ITEM
           (setq res (cons sub res) )
                                      )
       (reverse res)
 )
) 

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

Или так:
(apply (function (lambda
(/ res)
(vlax-for sub VLA_ITEM
(setq res (cons sub res) )
)
(reverse res)
) '())
ЗЫ пишу с планшета, так что код не проверял и не тестировал. Могут быть косяки

[sdv79]

Сергей812, я для себя именно в таком виде написал, поэтому не дают понимания крайние скобки (отсутствие функций).
Алексей, Ваш код не работает, но вносит ясность, это именно то о чем я спрашивал.

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

Сообщение от sdv79 Алексей, Ваш код не работает, но вносит ясность, это именно то о чем я спрашивал.

Правильно, я же скобки там не все поставил
P.S. Еще один вариант:

Код:

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

 (apply
  (function
    (lambda (sub / res)
      (vlax-for item sub (setq res (cons item res)))
      (reverse res)
      ) ;_ end of lambda
    ) ;_ end of function
  (list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))))
  )

Ну и еще один (просто работать не хочу - сил нет )

Код:

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

 (apply
  (function
    (lambda (/ res)
      (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
        (setq res (cons item res))
        ) ;_ end of vlax-for
      (reverse res)
      ) ;_ end of lambda
    ) ;_ end of function
  '()
  )

[sdv79]

Алексей, спасибо. Я разобрался. Стало "легче".
Получилась конструкция

Код:

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

 
(setq DOC (vla-get-activedocument ; вида #<VLA-OBJECT IAcadDocument 000000000d3417e8> 
	     (vlax-get-acad-object)
	    ) ;/ vla-get-activedocument
) ;/ setq
(setq VLA_ITEM	(vla-item ; вида #<VLA-OBJECT IAcadBlock 0000000037c34e08> 
	          (vla-get-blocks
	          DOC
	          ) ;/ vla-get-blocks
	         (vla-get-effectivename VLA-OBJECT)
	        ) ;/ vla-item
) ;/ setq
(setq *VLA_ITEM (apply ; Получить список всех примитивов, входящих в блок вида (#<VLA-OBJECT IAcadAttribute 0000000035b20e48> #<VLA-OBJECT IAcadAttribute 0000000035b20f28>...
                 (function
                  (lambda (sub / res)
                   (vlax-for item sub
                   (setq res (cons item res)))
                   (reverse res)
                  ) ;/ lambda
                 ) ;/ function
                 (list VLA_ITEM)
 ) ;/ setq

[trushev]

В прошлом веке познакомился с lisp'ом в объеме книги Ю. А. Кречко В. В. Полищук "Автокад 13: новые возможности" Москва "Диалог-МИФИ" 1996. В книге четко прописано ограничение: "... хотим добавить новый примитив, то должны использовать команды отрисовки или редактирования Автокада. Это ограничение связано с желанием защитить ГБД от неграмотного программиста: ...". Благодаря воспитательному эффекту форума обнаружил две новые для себя функции: entmake и entmakex. Безусловно такой подход на порядок, два увеличивает скорость работы lisp'а, существенно облегчает проблему отслеживания значений системных переменных. Но страх испортить ГБД остался.
На сколько защищена работа этих функций от действий "обезьяны с гранатой"?

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

А кто выступает в роли "обезьяны"? Если программист, но ничего не поможет. Если пользователь - то это более безопасно.
P.S. Кстати, прорекламируюсь-ка, пожалуй В свое время расписывал кое-что у себя на сайте: http://autolisp.ru/2009/09/22/programming-style/ ; http://autolisp.ru/2009/09/20/execution-speed-check/ ; http://autolisp.ru/2009/09/13/error-catch/ - ну так, для общей информации ))

[trushev]

Алексей, спасибо за оперативный ответ. От ошибки не соответствия dxf кода типу данных не застрахован и квалифицированный программист.
(entmakex
'((0 . "LINE")
(10 0. 0. 0.)
(11 100. 10. 0.)
(8 . "СлойОтрезка")
(62 . 1)
(6 . "Continuous")
(370 . 25)
(210 0. 0. 1.)
)
Например после кода 8 вставлены координаты кода 11. Что будет в этом или подобном случае?

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

В данном случае - скорее всего, ничего. Будет создан отрезок на слое "СлойОтрезка" (если слой не существует на момент вызова кода, слой будет создан с настройками по умолчанию). Для других примитивов (в частности, LWPOLYLINE) порядок следования кодов может оказаться критичным.

[trushev]

Сообщение от Кулик Алексей aka kpblc Для других примитивов (в частности, LWPOLYLINE) порядок следования кодов может оказаться критичным.

А насколько это критично для базы данных?

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

При работе в лиспе - вообще не критично, я думаю. Примитив (если его возможно создать) моментально создается в БД чертежа. Если допустима операция по модификации - то и изменения вносятся.
P.S. Есть разница между установкой свойств через entmod и через ActiveX, но в данный момент они некритичны, мне так каэцца ))

[trushev]

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

Ну это мне уже не по зубам. Еще раз спасибо за ответы.

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

О, пока сообразил и не забыл: ты отдаешь себе отчет, что примитив отрезка у тебя будет создан только в текущем документе и только в текущем пространстве? То есть если ты находишься в модели, то он будет создан в модели. если активно пространство листа - то в листе. А если ты оказываешься в режиме редактирования блока - то только внутри описания блока? При этом результат может оказаться немного неожиданным, если ты вдруг вошел в контекстное редактирование блока.

[trushev]

Спасибо. Я не ставлю перед собой непосильных для меня задач задач, работаю в модели.

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

Просто в режим контекстного редактирования блока можно войти и "почти случайно" ))) Постарайся учесть такое развитие ситуации.
Учитывая, что ты работаешь только в пространстве модели, не забывай про принудительное указание групп 67 и 410.

[ShaggyDoc]

В прошлом веке познакомился с lisp'ом в объеме книги Ю. А. Кречко В. В. Полищук "Автокад 13: новые возможности" Москва "Диалог-МИФИ" 1996. В книге четко прописано ограничение: "... хотим добавить новый примитив, то должны использовать команды отрисовки или редактирования Автокада. Это ограничение связано с желанием защитить ГБД от неграмотного программиста: ...".

Это очень древняя книжка. Тогда только подступались к программированию в Автокаде. Еще даже не было уверенности, будут ли entmake поддерживаться, будут ли такими DXF-коды. Их вообще приходилось "разведывательными" методами добывать.

Но с тех пор очень многое изменилось.

[mkung]

Подскажите, как из программы открыть текстовое окно Автокада?
Можно ли "заказать" его высоту (количество строк)?

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

Сообщение от mkung как из программы открыть текстовое окно Автокада?

Код:

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

 (textscr)

Сообщение от mkung Можно ли "заказать" его высоту (количество строк)?

По-моему, нет.

[trushev]

Редактирование через базу данных выполняется в следующей последовательности:

(setq nm (car (entsel)) ;Извлечение имени примитива (или иным способом)
sp (entget nm) ;Список из базы данных
sa (assoc dxf_код sp) ;Извлечение интересующего члена списка (Код параметр)
sn (cons dxf_код ...) ;Формирование нового члена (Код Измененный_параметр)
sp (subst sn sa sp) ;Замена старого члена на новый
)
(entmod sp) ;Обновление базы данных

При использовании entmake(x) по логике следует тоже применить entmod. Просмотрев примеры я не обнаружил в них обновления базы данных. Правильно ли я понимаю, что функции entmake, entmakex выполняют действия функции entmod.

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

Сообщение от trushev Редактирование через базу данных выполняется в следующей последовательности

Засем рухаисся насяльникама? Ты сам-то понял чего сказал?

Сообщение от trushev При использовании entmake(x) по логике следует тоже применить entmod

По какой логике?

Сообщение от trushev Правильно ли я понимаю, что функции entmake, entmakex выполняют действия функции entmod

Нет. Не путай создание и модификацию уже созданного.

[trushev]

К концу дня голова совсем тупая. Утро вечера мудренее.

[SetQ]

Подскажите, какой путь решения на ваш взгляд лучше у такой задачи: есть mtext, в нём несколько строк, разделённых "\P", надо получить список строк, например "abc\Pdef\Pjhi" -> ("abc" def" "jhi"). Можно работать только с исходной строкой vl-string-search, можно преобразовать vl-string->list и дальше работать со списком кодов, или надо совсем не так?

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

Код:

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

 (defun _kpblc-conv-string-to-list (string separator / i)
                                  ;|
*    Функция разбора строки. Возвращает список либо точечную пару.
*    Параметры вызова:
*  string    разбираемая строка
*  separator  символ, используемый в качестве разделителя частей
*    Примеры вызова:
(_kpblc-conv-string-to-list "1;2;3;4;5;6" ";")  ;'(1 2 3 4 5 6)
(_kpblc-conv-string-to-list "1;2" ";")    ;'(1 2)
*    За основу взяты уроки Евгения Елпанова по рекурсиям
|;
  (cond
    ((= string "") nil)
    ((vl-string-search separator string)
     ((lambda (/ pos res)
        (while (setq pos (vl-string-search separator string))
          (setq res    (cons (substr string 1 pos) res)
                string (substr string (+ (strlen separator) 1 pos))
                ) ;_ end of setq
          ) ;_ end of while
        (reverse (cons string res))
        ) ;_ end of lambda
      )
     )
    ((wcmatch (strcase string) (strcat "*" (strcase separator) "*"))
     ((lambda (/ pos res _str prev)
        (setq pos  1
              prev 1
              _str (substr string pos)
              ) ;_ end of setq
        (while (<= pos (1+ (- (strlen string) (strlen separator))))
          (if ;; (wcmatch (strcase (substr string pos)) (strcase (strcat separator "*")))
              (wcmatch (strcase (substr string pos (strlen separator))) (strcase separator))
            (setq res    (cons (substr string 1 (1- pos)) res)
                  string (substr string (+ (strlen separator) pos))
                  pos    0
                  ) ;_ end of setq
            ) ;_ end of if
          (setq pos (1+ pos))
          ) ;_ end of while
        (if (< (strlen string) (strlen separator))
          (setq res (cons string res))
          ) ;_ end of if
        (if (or (not res) (= _str string))
          (setq res (list string))
          (reverse res)
          ) ;_ end of if
        ) ;_ end of lambda
      )
     )
    (t (list string))
    ) ;_ end of cond
  ) ;_ end of defun

[trushev]

Разыскал бумажный вариант Полещук Н.Н. Visual LISP и секреты адаптации AutoCAD. - СП.: БХВ-Петербург. Разобрался.
PS Правильно, модификация

----- добавлено через ~8 мин. -----
Что может entmake сверх того что выполняет entmakex?

[Wolkodaw]

Как заставить работать функцию в этом примере: (vl-remove-if '(= (+ 2 3)) (1 2 3 4 5)) ?

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

Wolkodaw, ты бы хоть примерно написал, чего хотишь получить...

Код:

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

 (vl-remove-if
  (function
    (lambda (x)
      (= x (+ 1 2))
      ) ;_ end of lambda
    ) ;_ end of function
  '(1 2 3 4 5)
  ) ;_ end of vl-remove-if

[trushev]

Выкладываю свой первый результат наставлений Учителя (посты 2434, 2436, 2438, 2440, 2442 и 2447). Алексей, если найдется время, взгляни, дай замечания и ответь на вопросы:
1. В каких случаях не допускается применение entmakex вместо entmake?
2. Ограничение на точечную пару с кодом -1 прописано в книге Н. Полещука. Распространяется ли это ораничение на точечные пары с кодами 330 и 5?
3. Не понимаю точечную пару с кодом 100. Когда следует ее включать с список?

Замена command на entmakex

Код:

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

(foreach k sph  ;список ((list x h y) ... (list x h y))
     ;  (command "_.text"
     ;           "_j" "_ml" (list (car k) (- (caddr k) (* 1.35 mb)))
     ;           (rtos (*  0.2 mb) 2 2) "90" (rtos (cadr k) 2 2)
     ;            ;
     ;            ;Отрисовка отрезка
     ;            ;
     ;           "_.line" (list (car k) (- (caddr k) (* 1.5 mb))) (list (car k) (- (caddr k) (* 2.0 mb))) ""
     ;  )
       (entmakex (list '(0 . "TEXT")                              ;тип примитива
                       '(100 . "AcDbEntity")                      ;
                       '(67 . 0)                                  ;тип пространства (0 - модель)
                       '(410 . "Model")                           ;имя вкладки
                       (cons 8 (getvar "clayer"))                 ;имя слоя
                       (cons 62 (atoi (getvar "cecolor")))        ;номер цвета
                       '(100 . "AcDbText")                        ;
                       (list 10 (car k) (- (caddr k) (* 1.35 mb)) 0.0);координаты точки вставки
                       (cons 40 (*  0.2 mb))                      ;высота текста
                       (cons 1 (rtos (cadr k) 2 2))               ;значение текста
                       '(50 . 1.5707963)                          ;угол поворота в радианах
                       '(41 . 1.0)                                ;степень сжатия
                       '(51 . 0.0)                                ;угол наклона
                       (cons 7 (getvar "textstyle"))              ;имя текстового стиля
                       '(71 . 0)                                  ;генерация
                       '(72 . 0)                                  ;горизонтальное выравнивание
                       (list 11 (car k) (- (caddr k) (* 1.35 mb)) 0.0);точка выравнивания текста
                       '(210 0.0 0.0 1.0)                         ;координаты направление выдавливания
                       '(100 . "AcDbText")                        ;
                       '(73 . 2)                                  ;вертикальное выравнивание
                 )
       )
                 ;
                 ;Отрисовка отрезка
                 ;
       (entmakex (list '(0 . "LINE")                        ;тип примитива
                       '(100 . "AcDbEntity")                ;
                       '(67 . 0)                            ;тип пространства (0 - модель)
                       '(410 . "Model")                     ;имя вкладки
                       (cons  8 (getvar "clayer"))          ;имя слоя
                       (cons 62 (atoi (getvar "cecolor")))  ;номер цвета
                       '(100 . "AcDbLine")                  ;
                       (list 10 (car k) (- (caddr k) (* 1.5 mb)) 0.0);координаты начальной точки
                       (list 11 (car k) (- (caddr k) (* 2.0 mb)) 0.0);координаты конечной точки
                       '(210 0.0 0.0 1.0)                   ;координаты направление выдавливания
                 )
       )
);foreach k sph

P.S. Фрагмент кода из http://forum.dwg.ru/showthread.php?t=119413

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

Посмотри DXF Reference: в 5 группе хранится Handle объекта (задается самим AutoCAD). 330 - т.н. "мягкий" указатель на созданный объект (тоже от AutoCAD'a). -1 : тоже связано с указателями, насколько я помню (пишу с планшета). Так что задавать эти параметры бесполезно.
Группа 100 необходима при создании сложных примитивов типа полилиний - это точно. Касаемо текстов - кажется, для однострочных его можно пропустить, а для многострочных он обязателен.
И разница между entmake и entmakex только в возвращаемом значении в случае успеха: один возвращает список (аналог entget), второй - указатель на созданный примитив. А так больше вроде бы ничего у них и не различается.

[RNB]

Товарисчи, подскажите решение в лиспе.
http://forum.dwg.ru/showpost.php?p=1...&postcount=733
Интересует циклическое повторение ввода данных вручную, до нажатия пользователем Enter или Esc

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

RNB, тебя научить надо? Тогда добро пожаловать (в качестве начального варианта): http://autolisp.ru/2009/09/13/error-catch/ + http://autolisp.ru/2012/03/16/user-request/

[Vladimir_Sergeevich]

Алексей, еще вопрос про DXF 100: есть ли где то инфа про то, где и сколько таких групп надо?
Например, тут их по две:

Код:

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

(cons 0 "LWPOLYLINE") 
(cons 100 "AcDbEntity") 
(cons 100 "AcDbPolyline")

(cons 0 "DIMSTYLE")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbDimStyleTableRecord")

А тут уже четыре:

Код:

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

    (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") ;*

для меня пока самый надежный источник был (entget (car (entsel))) и смотреть что там есть да сравнивать.

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

Vladimir_Sergeevich, скажу честно: я почти всегда создаю через ActiveX - это нередко удобнее (особенно при работе внутри описания блоков или в неактивном документе).
Правда, это не касается размерного стиля - если его создавать или модифицировать лиспом, то кроме как entmake / entmod, ничего не срабатывает (я на autolisp.ru на эту тему как-то высказывался).

[trushev]

Огромное спасибо за ответы!
И еще вопрос по коду 62

(cons 62 (atoi (getvar "cecolor"))) - неудачное решение, getvar может вернуть строку "BYLAYER" или "BYBLOCK". Кроме того, кажется где-то в 2002-2005 версии, встречал возврат не целым числом, а словом с именем цвета. Первое, что приходит в голову - cond с нудным перечислением случаев. Где посмотреть варианты решения?

[Vladimir_Sergeevich]

Сообщение от Кулик Алексей aka kpblc если его создавать или модифицировать лиспом, то кроме как entmake / entmod, ничего не срабатывает

вот я с размерами тоже долго бодался. Хоть ActiveX и удобней в использовании, а тут пришлось через DXF...
Самое интересное, что для групп 50 и 51 в ActiveX свойства есть только для одного (по крайней мере для 50 я в справке не откопал) и даже если поменять 51, картинка не менялась, хотя значение, вроде как, запоминалось.

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

trushev, насколько я помню, если не указывать 62 группу, то примитив создается с текущим цветом (cecolor).
Vladimir_Sergeevich, вариантов на самом деле несколько:
1. Менять свойство Normal для vla-представления примитива. Возможно, потом понадобится выполнить vla-update для примитива
2. Для замены DXF-групп я уже давно использую код http://autolisp.ru/wp-content/upload...-autoregen.lsp + http://autolisp.ru/2013/11/19/partia...-ent-to-ename/ Как правило, хватает.

[RNB]

Сообщение от Кулик Алексей aka kpblc RNB, тебя научить надо? Тогда добро пожаловать (в качестве начального варианта): http://autolisp.ru/2009/09/13/error-catch/ + http://autolisp.ru/2012/03/16/user-request/

Вот что сваял в итоге. Подразумевается, что слой #Вспомогательная у меня есть. Есть какие-то замечания?

Код:

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

 (defun c:xline2 ()
  (command "_clayer" "#Вспомогательная" "_xline")
  (while (> (getvar "CMDACTIVE") 0)
    (if	(= (type
	     (vl-catch-all-apply
	       (function
		 (lambda ()
		   (command pause)
		 ) ;_ end of lambda
	       ) ;_ end of function
	     ) ;_ end of vl-catch-all-apply
	   ) ;_ end of type
	   'list
	) ;_ end of =
      (princ)
      (princ)
    ) ;_ end of if
  ) ;_ end of command
  (command "_layerp")
  (princ)
) ;_ end of defun

И вопросы: что в данном коде даёт (function (lambda ())) ?

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

vl-catch-all-apply (если обратиться к справке) применяет функцию к списку аргументов:
(vl-catch-all-apply 'function list)
Т.е. (vl-catch-all-apply (function (lambda() .... ) - просто другая форма записи (ИМХО - отлаживать такой код проще).

Сообщение от RNB Есть какие-то замечания?

Я не знаю, что хочется получить. Но как вариант:

Код:

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

 (defun c:xl2 (/ pt1 pt2 ang)
  (while (and (= (type
                   (setq pt1 (vl-catch-all-apply (function (lambda () (getpoint "\nПервая точка прямой <Отмена> : ")))))
                   ) ;_ end of type
                 'list
                 ) ;_ end of =
              (= (type
                   (setq pt2 (vl-catch-all-apply (function (lambda () (getpoint pt1 "\nВторая точка прямой <Отмена> : ")))))
                   ) ;_ end of type
                 'list
                 ) ;_ end of =
              ) ;_ end of and
    (setq ang (angle pt1 pt2))
    (entmakex (list '(0 . "XLINE")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbXline")
                    '(8 . "#Вспомогательная")
                    (cons 10 pt1)
                    (cons 11 (list (cos ang) (sin ang)))
                    ) ;_ end of list
              ) ;_ end of entmakex
    ) ;_ end of while
  ) ;_ end of defun

[RNB]

Сообщение от Кулик Алексей aka kpblc Я не знаю, что хочется получить

Хотелось получить команду, работающую как дефолтная, но в нужном слое. С возвратом первоначального слоя в конце.
В посте #2464 немного другой принцип.

[mkung]

Как проверить в LISP - загружен ли файл ARX, LSP, FAS? Определена ли команда AutoCAD, заданная в файле ARX, LSP, FAS?
Заранее благодарен.

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

Сообщение от mkung загружен ли файл ARX

(arx) - и сверяй результаты

Сообщение от mkung загружен ли файл LSP, FAS

Средствами lisp - никак. Когда-то Александр Ривилис писал arx-приложение, показывающее загрузку lsp.

Сообщение от mkung Определена ли команда AutoCAD, заданная в файле ARX, LSP, FAS?

(atoma-family 1) - может быть, оно сработает как надо

[mkung]

Сообщение от Кулик Алексей aka kpblc (atoma-family 1) - может быть, оно сработает как надо

; ошибка: no function definition: ATOMA-FAMILY

Понял... atoms-family

Вроде и работает, но

(if (member "C:TEXTFIT" (atoms-family 1)) (princ "YES!!!") (princ "NO!!!")) - пишет "YES!!!"

(if (member "C:TXT2MTXT" (atoms-family 1)) (princ "YES!!!") (princ "NO!!!")) - пишет "NO!!!!" хотя функция определена (EXPRESSTOOLS)

[RNB]

Почему во время выполнения кода

Код:

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

 (command "_mleader" pause pause pause)

во время третьей паузы текст вводится в командную строку, а не "по месту", как это происходит при использовании команды "с кнопки"?

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

Советую почитать http://autolisp.ru/2015/01/21/mleader_create_order/ - при создании мультивыноски командными методами можно наступить на очень обидные грабли.

[RNB]

Сообщение от Кулик Алексей aka kpblc Советую почитать http://autolisp.ru/2015/01/21/mleader_create_order/ - при создании мультивыноски командными методами можно наступить на очень обидные грабли.

Это я уже читал. Значение в реестре нужное... Да и точки стрелки и полки ставятся нормально, а вот когда дело доходит до текста, то его ввод перекидывается в командную строку, где пробел или энтер делют ретурн

[RNB]

2 вопроса.
1.

Код:

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

 (defun c:test1 ()
  (command "_-layer"   "_make"	   "-main2"		   "_ltype"
	   "Continuous"		   ""	       "_color"	   "5"
	   ""	       "_lweight"  "0.35"      ""	   ""
	  )
    (setvar "clayer" "0")
  (command "_LAYMRG" "_name" "#main" "" "_Name" "-main2" "_Yes")
  (setvar "clayer" "0")
  (princ "APPLY!")
  (princ)
)

Почему объекты со слоя #main после объединения остаются вообще без слоя, вместо того, чтобы переместиться на слой -main2? При этом объекты находящиеся в блоках ведут себя правильно.
2. Подскажите как программно выделить все объекты на одном слое. Ну или как заморозить все слои кроме текущего.

----- добавлено через ~9 мин. -----
UPD
На вопрос 1 ответ нашел. Проблема в решетке в названии слоя.

[skkkk]

Сообщение от RNB программно выделить все объекты на одном слое

Выделить все объекты слоя указанного объекта:
1. Во всех пространствах:

Код:

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

(sssetfirst nil (ssget "_X" (list (assoc 8 (entget (car (entsel)))))))

2. В текущем пространстве:

Код:

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

(sssetfirst nil (ssget "_X" (list (assoc 8 (entget (car (entsel)))) (cons 410 (getvar "CTAB")))))

Выделить все объекты в текущем пространстве на слое по его имени (вместо "Имя слоя" вписать нужное имя):

Код:

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

(sssetfirst nil (ssget "_X" (list (cons 8 "Имя слоя") (cons 410 (getvar "CTAB")))))

Сообщение от RNB как заморозить все слои кроме текущего

Как-то так:

Код:

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

 (defun C:LAYSFREESE ( / layer-list Table)
(vl-load-com)
	(defun Table (s / d r)
		(while (setq d (tblnext s (null d)))
			(setq r (append r (list (cdr (assoc 2 d)))))
		)
	)
	(setq layer-list (table "LAYER")
		  layer-list (vl-remove (getvar "CLAYER") layer-list)
	)
	(mapcar 
		'(lambda (x)
			(vla-put-Freeze 
				(vla-Item 
					(vla-get-Layers 
						(vla-get-ActiveDocument (vlax-get-acad-object))
					)
					x
				)
				1
			)
		 )
		 layer-list
	)
	(princ)
)

Функция Table найдена когда-то тут на форуме, опубликовал, если не ошибаюсь, Олег (jr.).

[RNB]

Сообщение от skkkk Выделить ...

Спасибо! Буду сидеть разбираться

[gomer]

это ж надо было столько нагородить...

Код:

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

 (defun C:LAYSFREESE ( )
  ( (lambda (x)
     (setvar 'cmdecho 0)
     (command "_.-layer" "_f" "*" "")
     (setvar 'cmdecho x)
    )
    (getvar 'cmdecho)
  )
  (princ)
)

[RNB]

Сообщение от gomer это ж надо было столько нагородить...

Поясни, пожалуйста, принцип "игры" с "cmdecho" и "x"

[gomer]

Сообщение от RNB Поясни, пожалуйста, принцип "игры" с "cmdecho" и "x"

все просто: запомнили, выключили, включили. главная фишка в другом. автокад никогда не заморозит текущий слой, так что можно смело морозить все...
обнуление cmdecho просто скрывает предупреждение автокада, что он не может заморозить текущий слой, а заодно и все остальные действия command

[RNB]

Сообщение от gomer все просто: запомнили, выключили, включили

"(lambda (x))" сохраняет в "x" значения всех переменных? Или всё-таки еще нужна строчка

Код:

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

 (setq x (getvar 'cmdecho))

или я что-то не догоняю в принципе работы функций?

[gomer]

Сообщение от RNB Или всё-таки еще нужна строчка

нет не нужна, x уже равен (getvar 'cmdecho) на входе в лямбду

[trushev]

Что обозначает 91 группа примитива "LWPOLYLINE"?

[Alexll]

Здравствуйте уважаемые. Осваиваю autolisp.
Есть задача, периодически менять текст в документе.
Выделяю текст, нахожу имя примитива и сохраняю его в файл. Потом считываю строку из файла и пытаюсь изменить текст, но ничего не выходит. Как я понял проблема в типе переменной.
До сохранения в файл переменная была типа ENAME. После чтения STR.
Подскажите можно ли преобразовать тип переменной, что бы можно было модифицировать текст?
Если нет, то как еще можно решить данную задачу?

[gomer]

Сообщение от Alexll ничего не выходит

сохраняй в файл метку примитива, по ней сможешь восстановить свой текст
(cdr (assoc 5 (entget textent)))
(handent strhandle)

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

trushev, dxf reference утверждает, что это идентификатор вершины. Правда, почему у LWPOLYLINE он всегда равен 0 (проверял в ACAD2014) - пока непонятно.

[Сергей812]

Сообщение от trushev Что обозначает 91 группа примитива "LWPOLYLINE"?

http://forum.dwg.ru/showthread.php?t=53504

[RNB]

Я правильно понимаю, команда, созданная в лисп, не запустится из другого лиспа?

[gomer]

Сообщение от RNB Я правильно понимаю, команда, созданная в лисп, не запустится из другого лиспа?

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

[RNB]

Сообщение от gomer не правильно, из одного лиспа можно запускать команды из другого лиспа, предварительно загрузив оба лиспа

Автокад выдал мне "неизвестная команда"...

----- добавлено через ~4 мин. -----
А если в коде взять название команды в скобки () - (ххх) Команда LISP недоступна

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

RNB, прочитай публикацию "Как использовать лисп, опубликованный на форуме" - там все написано.

[RNB]

Сообщение от Кулик Алексей aka kpblc прочитай публикацию "Как использовать лисп, опубликованный на форуме" - там все написано.

Прочитал. Почерпнул кое-что. Спасибо.
Но! Как запустить команду, созданную в лиспе, из другого лиспа - так и не въехал. В общем, стою на асфальте я в лыжи обутый...

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

(defun <ИмяФункции> (Параметры) <...>) : вызывается как (<ИмяФунции> Параметры)
(defun c:<ИмяКоманды>() <...>) : вызывается как (c:<ИмяКоманды>)

[RNB]

Сообщение от Кулик Алексей aka kpblc вызывается как (c:<ИмяКоманды>)

Вот! Спасибо!
Я пытался вызвать как (command "<Имя команды>")

[Alexll]

Здравствуйте.
Хочу сделать такую функцию: пользователь указывает примитив, нажимает кнопку с функцией, функция должна узнать слой в котором находится примитив, и дать пользователю возможность выбрать объекты. Проблема в том что не работает такая вот конструкция:

Код:

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

 (setq qq (ssget "_I"))
(setq qq1 (ssget))

Если два раза использовать ssget без "_I", то все нормально. А вот если с "_I" то lisp не предоставляет возможности для выбора примитивов для второго ssget. Думаю что нужна какая то пауза или еще что то.
Если кто знает как это победить, помогите пожалуйста.

[Vladimir_Sergeevich]

Alexll, три раза прочитал - ничего не понял...
(ssget "_I") - соберет то что было выделено до начала выполнения кода.
Если надо собрать примитивы по слою как у выделенного объекта, то что то типа такого:

Код:

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

 (setq ent (car (entsel))) ;;только тут запрашивается образец в ходе выполнения команды
(sssetfirst nil (ssget "_C" (getpoint "\nСекущий прямоугольник") (getpoint "\nвторая точка") (list (assoc 8 (entget ent))))) ;;тут можно играться опциями и фильтрами

И вообще есть готовый selsim с богатым функционалом.

[Alexll]

Недавно начал осваивать LISP поэтому тут даже вопрос не в наличии готовых программ, а в обучении. А заодно и что то полезное для себя сделать.
(ssget "_I") действительно собирает то что было выделено. Но после этого не поступает второго запроса на выбор (вторая строка).
LISP как будто объединяет эти два запроса. Если перед выполнение программы ничего не выделено, то он запрашивает выделение. Если если было что то выделено, то второго запроса на выделение не следует. Но при том оба набора qq и qq1 существуют, но они одинаковые.

А вот допустим если написать код
setq qq (ssget))
setq qq1 (ssget))
то после первого запроса на выделение, происходит второй. И я получаю два разных набора.

[Vladimir_Sergeevich]

(ssget) без опций при активном выборе срабатывает как (ssget "_I") и сбрасывает выбор (судя по экспериментам). В итоге у тебя получается два одинаковых набора.
попробуй между строками прописать (sssetfirst nil nil)

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

Сообщение от Vladimir_Sergeevich (ssget) без опций при активном выборе срабатывает как (ssget "_I")

Насклько я помню, не всегда: регулируется значением системной переменной PICKFIRST

[Alexll]

Владимир Сергеевич, огромное спасибо. Заработало.

[Vladimir_Sergeevich]

Алексей, а как часто PICKFIRST ставят в "0"? В моем понимании, это чаще случается случайно по непонятным пользователям причинам и вызывает панику у них же.
Сам в нюансы работы ssget особо не вникал, использовал только с конкретными опциями и кучей фильтров.

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

Vladimir_Sergeevich, это как карта ляжет...

[Vladimir_Sergeevich]

Возник вопрос о граблях ActivX...
Читал умную книжку и вычитал, что "...нужно заботиться о выделении памяти..." (это было про создание безопасных массивов)...
По логике, потом ведь надо это пространство памяти освободить (вычистить) или автокад сам этим занимается?
И еще вопрос, на какой стадии надо начинать отслеживать/замерять объем памяти требуемой для программы, что бы все не рухнуло?

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

В принципе в ACAD была функция (gc) - но ее вызов лично у меня никакого результата не давал. ACAD, как правило, сам занимается чисткой памяти.
Другой вопрос, что при обращении к сторонним приложениям надо принудительно эти приложения либо закрывать, либо релизить (см. vlax-release-object) для освобождения памяти основного процесса.

Сообщение от Vladimir_Sergeevich И еще вопрос, на какой стадии надо начинать отслеживать/замерять объем памяти требуемой для программы, что бы все не рухнуло?

ИМХО на стадии разработки алгоритма

[gomer]

(gc) была актуальна автокада до R10, R11

[Vladimir_Sergeevich]

Сообщение от Кулик Алексей aka kpblc ИМХО на стадии разработки алгоритма

Тут я не совсем четко сформулировал... допустим на начальных стадиях изучения Lisp я работал сугубо командными методами и спустя пол года подошел к программному методу. тут я думаю вообще можно особо не заморачиваться такими вещами (надеюсь я прав?). Последние пару лет потихоньку начинаю использовать объектные методы и вот тут, наверно, уже надо как то заглядывать вперед. Пока что у меня в арсенале точно нет таких, где бы я создавал safearray и прочие преобраозования типов.

Сообщение от Кулик Алексей aka kpblc при обращении к сторонним приложениям надо принудительно эти приложения либо закрывать

это например, когда считываю .xlsx делаю (close "....")

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

При чтении *.xls* через Excel последовательность будет такова:
Создать указатель на объект MS Excel (может быть, его придется создавать)
Создать указатель на коллекцию Workbooks
Открыть документ
Создать указатель на WorkSheets
Создать указатель на WorkSheet
Прочитать данные
Освободить указатель на WorkSheet
То же, WorkSheets
То же, WorkBooks
То же, Excel

Ну, по крайней мере, примерно так: я с Excel напрямую уже давненько не работал, подробностей не помню

[Сергей812]

и не забывать разделять локальные и глобальные переменные в функциях

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

Ну это-то понятно. Вопрос в другом: можно получить указатель на внешний объект и засунуть его в локальную переменную функции. При выходе из функции указатель не обнулится, а просто потеряется - что не есть гуд.

[gomer]

Сообщение от Кулик Алексей aka kpblc Создать указатель на объект MS Excel (может быть, его придется создавать)

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

не твое, не трогай, хуже будет

[Сергей812]

не лисп, но в тему - Работа с COM-объектами

[Vladimir_Sergeevich]

Сообщение от Кулик Алексей aka kpblc При выходе из функции указатель не обнулится, а просто потеряется - что не есть гуд.

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

[gomer]

Сообщение от Vladimir_Sergeevich вопрос только когда это произойдет...

в любой момент

[ShaggyDoc]

(gc) была актуальна автокада до R10, R11

Да, тогда без неё было просто не обойтись. Но и сейчас никто не мешает вставить вызов (gc) в одну из стартовых функций для сборки мусора.

Вопрос в другом: можно получить указатель на внешний объект и засунуть его в локальную переменную функции. При выходе из функции указатель не обнулится, а просто потеряется - что не есть гуд.

А его надо еще и принудительно "обнилить". Тогда ненужная память окажется в "куче" и с ней будет уже менеджер памяти Windows разбираться. Будет известно, что этот кусок "ничейный".

в любой момент

Может никогда, а может и быстро. Зависит от программы. Мне приходилось делать конвертор DWG с разнообразной обработкой - "нормализация", переименование слоев и прочее. Обрабатывались тысячи файлов. При этом происходили некоторые утечки памяти, но при 2-3 часах работы это было незаметно. А потом переполнялась память Windows, подключался своп и работа резко тормозилась.

Конечно, сейчас памяти "немеряно" и с этим можно никогда не столкнуться. Но память сейчас на 90% занята всякими "рюшечками и бантиками" и для серьезных программ это надо учитывать.

А ещё лучше всегда "мыть руки с мылом", т.е. обходиться минимумом глобальных, "обнилять" ненужное, не надеяться на автоматическую сборку мусора.

[Vladimir_Sergeevich]

Сообщение от ShaggyDoc "нормализация", переименование слоев и прочее.

Такое тоже есть, только для активного документа делал, а именно dxf сгенерированного робуром. Здесь обходился вообще без глобальных переменных.
И все таки не понял одного момента: локальные переменные тоже надо обнулять, или при завершении функции они сами в мусор сваливаются?

[ShaggyDoc]

локальные переменные тоже надо обнулять, или при завершении функции они сами в мусор сваливаются?

Нет, лисповские локальные сами уничтожаются по завешении. Дополнительное "обниление" лучше делать для сторонних COM-объектов, т.к. Windows на всякий случай ("вдруг опять понадобится") оставляет их в памяти на некоторое время (обычно около 10 минут).

Но указатель на такой объект может быть в лисповской локальной переменной. Я обычно делаю так:

Код:

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

 (if (setq srv (vlax-get-or-create-object "ruDoubleListSrv.DoubleListDlg"))
    (progn
      (vlax-invoke-method srv "Create")
      (vlax-put-property srv 'Header dlg_caption)
      (vlax-put-property srv 'LeftCaption left_caption)
      (vlax-put-property srv 'RightCaption right_caption)
      (vlax-put-property srv 'ReadOnly (ru-conv-value-to-wordbool read_only))
 ...
       (vlax-invoke-method srv "Free") ;_ end of vlax-invoke-method
      (vlax-release-object srv)
      (setq srv nil)
    ) ;_ end of progn
    (ru-msg-alert "Не удалось запустить ruDoubleListSrv.DoubleListDlg")
  ) ;_ end of if

Здесь srv - локальная переменная функции. В данном случае, помимо (vlax-release-object srv) сделано (setq srv nil). Для обычных переменных это делать не надо.

[mkung]

Подскажите как программно (на Лиспе) вставить блок с установкой значений атрибутов подставив вычисленные значения точки вставки и угла поворота.
Заранее благодарен.

[Сергей812]

Сообщение от mkung Подскажите как программно (на Лиспе) вставить блок с установкой значений атрибутов подставив вычисленные значения точки вставки и угла поворота. Заранее благодарен.

Ну что-то типа этого

[mkung]

Сообщение от Сергей812 Ну что-то типа этого

Это имеете в виду?

(command "_insert" "Vyn" po 1 1 0 bl_name V)
"_insert" – стандартная команда Автокад вставки блока;
"Vyn" – имя вставляемого блока;
(Если папка, в которой находится блок не прописана вспомогательных путях Автокад,
в качестве имя нужно указать полный путь к файлу “D:\MyLisp\Vyn.dwg”)
рo – базовая точка вставки блока;
1 – масштабный коэффициент по оси X;
1 – масштабный коэффициент по оси Y;
0 – угол поворота блока в радианах;
bl_name – значение верхнего атрибута;
V – значение нижнего атрибута;

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

[Vladimir_Sergeevich]

может поможет _-insert?
хотя у меня окно вылетает только при вставке с палитры, а с инсерта в текстовом режиме. может какие то настройки системы влияют?

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

attreq в 0 - и используй командные методы
Или entmake / entmakex / ActiveX, ему фиолетово на эти переменные

[Сергей812]

Сообщение от mkung Это имеете в виду? Вот только вместо установки атрибутов при данном варианте вылазит окно редактирования атрибутов.

Ну, например, вот так

Код:

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

 (defun c:InsertMyBlock( / acad_object active_document model_space bl_Vs po atr1 atr2)
(vl-load-com)
; Получаем доступ к пространству модели
(setq acad_object (vlax-get-acad-object))                   
(setq active_document (vla-get-activedocument acad_object)) 
(setq model_space (vla-get-modelspace active_document)) 
;Вставляем блок с пустыми атрибутами
(setq po (getpoint "Точка вставки блока:"))
(setq bl_Vs (vla-insertblock model_space (vlax-3d-point po) "324532" 1.0 1.0 1.0 0))
; Получаем атрибуты вставленного блока
(setq atr1 (car(vlax-safearray->list(vlax-variant-value(vla-getattributes bl_Vs)))))     
(setq atr2 (car(cdr(vlax-safearray->list(vlax-variant-value(vla-getattributes bl_Vs))))))
;Изменяем значение атрибутов
(vlax-put-property atr1 'TextString "Value1")
(vlax-put-property atr2 'TextString "Value2")
)

где: "324532" - имя вставляемого блока с двумя атрибутами (к примеру)
"Value1" и "Value2" - значения атрибутов

[mkung]

Сообщение от Кулик Алексей aka kpblc attreq в 0 - и используй командные методы Или entmake / entmakex / ActiveX, ему фиолетово на эти переменные

Спасибо, но за окна отвечает ATTDIA (помогло).

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

Сообщение от Сергей812 Ну, например, вот так Код: [Выделить все] (defun c:InsertMyBlock( / acad_object active_document model_space bl_Vs po atr1 atr2) (vl-load-com) ; Получаем доступ к пространству модели (setq acad_object (vlax-get-acad-object)) (setq active_document (vla-get-activedocument acad_object)) (setq model_space (vla-get-modelspace active_document)) ;Вставляем блок с пустыми атрибутами (setq po (getpoint "Точка вставки блока:")) (setq bl_Vs (vla-insertblock model_space (vlax-3d-point po) "324532" 1.0 1.0 1.0 0)) ; Получаем атрибуты вставленного блока (setq atr1 (car(vlax-safearray->list(vlax-variant-value(vla-getattributes bl_Vs))))) (setq atr2 (car(cdr(vlax-safearray->list(vlax-variant-value(vla-getattributes bl_Vs)))))) ;Изменяем значение атрибутов (vlax-put-property atr1 'TextString "Value1") (vlax-put-property atr2 'TextString "Value2") ) где: "324532" - имя вставляемого блока с двумя атрибутами (к примеру) "Value1" и "Value2" - значения атрибутов

Спасибо. Уже сделал командными методами, но этот вариант мне о-о-чень интересен!

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

mkung, attdia - за окно, а attreq - за запрос значений атрибутов.

[Konstruktiv54]

Вопрос к спецам по лиспу, как думаете...интересно просто в плане реализации (возможно/невозможно):

есть параметрический объект СПДС Графикса...арматурный стержень...фактически - отрезок, обладающий доп свойствами. Хотелось бы его удлинять и обрезать, но понятно что стандартные команды Автокада этого не делают. Возможно ли решить проблему с помощью лиспа?
Растягивание же работает...

[Сергей812]

Сообщение от Konstruktiv54 параметрический объект СПДС Графикса

это прокси объект, скорее всего. Lisp с ними не работает

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

Если СПДС GraphiCS установлена и загружена, то этот объект перестает быть прокси. Некоторые его свойства можно будет менять (ну или по крайней мере пытаться). Правда, для этого понадобится читать массу документации

[Сергей812]

Сообщение от Кулик Алексей aka kpblc Если СПДС GraphiCS установлена и загружена, то этот объект перестает быть прокси

Всегда думал-что загрузка приложения-источника прокси (енеблара) помогает получить доступ к свойствам прокси-объектов, а не преобразует их в примитивы автокада..

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

Не преобразовывает, это точно. Но "закрытые" свойства становятся доступными )

[Vladimir_Sergeevich]

Подскажите пожалуйста, как проще добраться до точки центра и радиуса дугового сегмента полилинии lwpolyline: через dxf (есть там свойство 42 bulge и что он показывает я не очень понял) или activX (к чему я больше склоняюсь)?
Для activeX скорее всего надо копать в сторону vlax-curve-getSecondDeriv. только вот есть ли вторая производная у круга? что то я слабоват в математике стал...

[skkkk]

Сообщение от Vladimir_Sergeevich ...есть там свойство 42 bulge и что он показывает я не очень понял...

О том, что такое bulge, неплохо написано здесь, например.

Сообщение от Vladimir_Sergeevich ...как проще добраться до точки центра и радиуса дугового сегмента полилинии...

Лисп. Полилиния

[Alexll]

Научите как из AutoLisp работать с базой данных.
Сам не программист, в AutoLisp то же новичок. Хотел написать программку облегчающую жизнь, данные сбрасывал в текстовый файл. Но очень уж неудобно работать с текстовым файл.
Просмотрел команды AutoLispa и не увидел в нем специальных команд для работы с базами данных. Подскажите с какими базами проще работать SQL, Excel? И если можно то ссылки или примеры. Спасибо.

[Сергей812]

Вы польстили Excel - он не разу БД не был)

А в целом-какая задача, в каком виде вводятся данные и выводятся. Кстати, текстовой документ с регулярной структурой можно легко импортировать в тот же эксель. И вы хоть что-то написали, или все закончилось на уровне хотелок?)

[Alexll]

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

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

[Сергей812]

хм.. а поля чем не угодили?)

[Alexll]

Какие поля? наверно я просто об этом ничего не знаю...

[Сергей812]

В костроке autocad наберите _field.

----- добавлено через ~8 мин. -----
Если нужно оформление одинаковое оформление - то подшивка и настроенные листы, например. Если нужно сразу во многих местах чертежа иметь одинаковые значения - то дублирующиеся значения в виде полей, ссылающихся на то же пользовательское свойство чертежа. Не надо считать-что только лисп и программирование в целом является панацеей от всего.

[Alexll]

Да, штука хорошая. То же только недавно узнал. В нашей конторе никто ничем подобным не пользуется, поэтому спросить не у кого.
Но и "поля" я могу только использовать когда исходное значение в таблице. А вот когда значение написано отдельной текстовой строкой делать "ссылку" на эту строку у меня так и не получилось.
Может посоветуете литературу какую по автокаду? А то чувствую у меня много пробелов.

[Сергей812]

Этот форум почитайте для начала)

Offtop:

Сообщение от Alexll А вот когда значение написано отдельной текстовой строкой делать "ссылку" на эту строку у меня так и не получилось.

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

[RNB]

Такой вопрос возник. Знает ли кто, какой командой AutoCad выполняет редактирование текста мультивыноски?

----- добавлено через ~1 ч. -----
UPD. Разобрался. При выделенной мультивыноске _MLEADERCONTENTEDIT

----- добавлено через ~3 ч. -----
Спасайте, товарищи. Мозг сплавил. Как сделать так, чтобы после выполнения лиспа остались выделенные объекты?

[Сергей812]

Сообщение от RNB Как сделать так, чтобы после выполнения лиспа остались выделенные объекты?

Может так ?

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

Или через sssetfirst

[RNB]

Сообщение от Сергей812 Может так ?

Сообщение от Кулик Алексей aka kpblc Или через sssetfirst

Получилось и через _pselect и через sssetfirst
Собственно, добился от мультивыноски, чтобы она работала как надо с заменой слоя. Выкладываю варик с _pselect.
С удовольствием выслушаю замечания

Код:

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

 (defun c:MYmleader ()
  (setvar "cmdecho" 0)
  (vl-cmdf "_-layer" "_make" "mleader" "")
  (if (= (type
	   (vl-catch-all-apply
	     (function
	       (lambda ()
		 (command "_mleader" pause pause "")
	       ) ;_ end of lambda
	     ) ;_ end of function
	   ) ;_ end of vl-catch-all-apply
	 ) ;_ end of type
	 'list
      ) ;_ end of =
    (princ)
    (princ)
  ) ;_ end of if
  (vl-cmdf "_layerp")
  (vl-cmdf "_pselect" "_l" "" "_mleadercontentedit")
  (setvar "cmdecho" 1)
  (princ)
) ;_ end of defun

[Сергей812]

копаться вглубь лень, но строчка 3 - почему не проверяете, существует ли уже данный слой? Проверяется одной строчкой вида (tblsearch "LAYER" %Имя слоя%) - если вернула nil, то тогда создаем. Иначе - просто делаем слой активным через "CLAYER". Естественно, перед этим значение нужно сохранить (setq lOldLayer (getvar "CLAYER")) и в строке 18 восстановить из этой переменной.

[RNB]

Сообщение от Сергей812 копаться вглубь лень, но строчка 3 - почему не проверяете, существует ли уже данный слой? Проверяется одной строчкой вида (tblsearch "LAYER" %Имя слоя%) - если вернула nil, то тогда создаем. Иначе - просто делаем слой активным через "CLAYER". Естественно, перед этим значение нужно сохранить (setq lOldLayer (getvar "CLAYER")) и в строке 18 восстановить из этой переменной.

Дельное замечание, спасибо.
Но и в этом варианте, думаю, достаточно будет _layerp, без переменных

[Alexll]

Подскажите как из LISPа получить доступ к атрибутам блока. Создал блок, создал для него пару атрибутов, а стандартными способами(как у примитива) доступ к этим атрибутам получить не могу.

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

Поискать: http://www.google.ru/cse?cx=partner-...%B0&gsc.page=1

[Alexll]

Прежде чем написать вопрос, я поискал. Большая часть тем ссылается на пару существующих программ lispа. Но дело в том, что те программы создавались для других целей, и для того что бы узнать атрибуты в некоторых случаях надо подключать до пяти функций.
Поэтому и задал такой вопрос, в надежде что кто то скажет что типа "....эта команда выдает атрибуты блока по его имени".

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

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

[gomer]

Сообщение от Кулик Алексей aka kpblc Такой команды нет

как минимум properties

[Сергей812]

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

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

gomer, я отвечал на вопрос

Сообщение от Alexll типа "....эта команда выдает атрибуты блока по его имени".

[Alexll]

Итак, товарищи, почитал по форуму еще раз, теперь скажите прав я или нет.
получается что имя атрибута блока, всегда следует за блоком. И зная имя блока, с помощью команды entnext мы можем узнать имя атрибута. А уж из имени атрибута достать все его данные не сложно.
Вопрос в том, всегда ли соблюдается это условие, что за именем блока следует имя атрибута? и не бывает ли это каким то образом перемешано?
Если этот способ получения атрибутов блока надежный, то он меня устраивает.

[Сергей812]

подсказка - смотрите DXF коды для INSERT, в частности - код 66.

[Alexll]

Ну это я понял. Если там 1, то далее идут еще какие то примитивы. Или вы что то другое имеете ввиду?

[Сергей812]

Сообщение от Alexll Ну это я понял. Если там 1, то далее идут еще какие то примитивы.

Дальше идут не какие то примитивы - а атрибуты)

Variable attributes-follow flag (optional; default = 0); if the value of attributes-follow flag is 1, a series of attribute entities is expected to follow the insert, terminated by a seqend entity.

[Vladimir_Sergeevich]

Помогите идеей пожалуйста. Есть чертеж трубы, создаваемой спец прогой, на нам надо найти два одинаковых числа и одно из них заменить. в общем случае все работает, за одним исключением.
1.нахожу в таблице отметку в поле Н8 (0 TEXT)
2.нахожу оба текста с этим значением (ssget "_X" (list (cons 0 "TEXT") (cons 1 val_h8))) ;;тут val_h8 - текстовая строка
3.изменяю тот, что не в таблице (их однозначно два и проверяю по точке вставки. например программа выдает 125,24, а надо Н8=125,24)
Есть один момент, когда это не срабатывает: когда отметка 125,20. В таблице она пишется как есть с двумя знаками, а на разрезе, где надо добавить "Н8=" хвостовые ноли подавляются и соответственно "125,20" /= "125,2"
Как еще можно реализовать подобный поиск?
з.ы. (rtos x 2 2) так же выдает без подавления - проверил сразу... хоть впору сначала все числа обработать, что бы везде до 2х знаков было.

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

Используй нечто типа (strcat "H8=" <Текстовая строка>)
Здесь <Текстовая строка> - прямо тот текст, который получаешь откуда надо.

[Vladimir_Sergeevich]

да я не о том спрашиваю. (strcat "H8=" <Текстовая строка>) есть у меня, тут ситуация хитрая:
напрямую найти отметку на разрезе я не смогу априори, ибо она может иметь любые координаты и любое значение.
Но эта отметка дублируется в таблице. Из таблицы я нахожу значение этой отметки и, уже зная это значение, ищу два одинаковых текста.
Зная координату того текста, что в таблице, его отбрасываю из рассмотрения и редактирую второй - тот что на разрезе.
А ломается всё, только в частном случае, когда на разрезе у отметки обрезаны хвостовые ноли.
з.ы. добавил картинку :
1 - отметка в таблице (по шапке её можно найти)
2 - та же отметка на разрезе. её то и надо править
3 - что должно получится в результате

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

Преобразовывай в float, а потом в строку через rtos. Не то?

----- добавлено через ~14 мин. -----
Во, пока вспомнил: в "Готовых программах" были решения по преобразованию числа в строку с заданной точностью. Поищи.

[Vladimir_Sergeevich]

не то. (ssget "_X" (list (cons 0 "TEXT") (cons 1 val_h8))) ищет по строке из "1". Когда они одинаковы - находит оба и можно обработать.
если бы (rtos 125.50 2 2) выдавал "125,5" то прокатило бы, но он выдает "125,50"

Код:

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

Команда: (rtos (atof "152.20") 2 2)
"152.20"

изначально уже про это говорил - проверено в первую очередь было
А ставить (rtos 125.50 2 1) приведет к тому, что перестанет работать случай равенства изначального. ("1" - 125,34, "2" - 125,34 проходя через rtos получится условие 125,3 /= 125,34)
з.ы. вся загвоздка в нахождении отметки на разрезе, когда на разрезе и в таблице нет полного соответствия.

Сообщение от Кулик Алексей aka kpblc в "Готовых программах" были решения по преобразованию числа в строку с заданной точностью. Поищи.

чем плох тот же rtos atof?
порядок поиска не позволяет так сделать. неизвестно заранее какая точность округления должна быть

[RNB]

Сообщение от Vladimir_Sergeevich изначально уже про это говорил - проверено в первую очередь было А ставить (rtos 125.50 2 1) приведет к тому, что перестанет работать случай равенства изначального. ("1" - 125,34, "2" - 125,34 проходя через rtos получится условие 125,3 /= 125,34) з.ы. вся загвоздка в нахождении отметки на разрезе, когда на разрезе и в таблице нет полного соответствия.

Не особо силен в лиспе, поэтому словами, а не функциями. Думаю, как промежуточное решение подойдет
если (rtos 125.50 2 1) = (rtos (125.50+0.0499999) 2 1) = (rtos (125.50-0.0499999) 2 1), то (rtos 125.50 2 1)
иначе (rtos 125.50 2 2)

[Vladimir_Sergeevich]

RNB, да как же объяснить что бы все уже поняли?
в #2556 есть рисунок.
"1" - это то что я могу найти это может быть как 125,30 так 125,32
"2" - это то что надо найти и изменить. он, соответственно, принимает значения 125,3 или 125,32

Аллилуйа!

Код:

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

Команда: (vl-princ-to-string 125.50)
"125.5"

В общем, рабочий вариант получился таким:

Код:

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

 (setq ent_sad (ssname (ssget "_X" (list (cons 0 "TEXT") (cons 1 "8,"))) 0)
	pt_ent (cdr (assoc 10 (entget ent_sad)));; ename и точка подписи
	ent_sad (ssname  (ssget "_F" (list 
		(mapcar '- pt_ent '(8 10 0))  
		(mapcar '- pt_ent '(-8 10 0))
		)) 0)
	val_h8 (cdr (assoc 1 (entget ent_sad))) ;;значение высоты
	pt_ent (cdr (assoc 10 (entget ent_sad)));;точка высоты в таблице
	ent_sad (ssget "_X" (list (cons 0 "TEXT") (cons 1 (vl-princ-to-string (atof val_h8)))));;здесь набор, вероятно из двух элементов
	);;setq
(cond
	( (= (sslength ent_sad) 1)
		(setq ent_sad (ssname ent_sad 0))
	);;c1 only one obj
	((= (sslength ent_sad) 2)
		(if 	(= (cdr (assoc 10 (entget (ssname ent_sad 0)))) pt_ent)
			(setq ent_sad (ssname ent_sad 0))
			(setq ent_sad (ssname ent_sad 1))
		)
	)	
	(t (princ "\nОтметка Н8 не найдена"))
)
(sad_rename ent_sad (strcat "H8=" val_h8))

[RNB]

Сообщение от Vladimir_Sergeevich RNB, да как же объяснить что бы все уже поняли? в #2556 есть рисунок. "1" - это то что я могу найти это может быть как 125,30 так 125,32 "2" - это то что надо найти и изменить. он, соответственно, принимает значения 125,3 или 125,32

Так "если (rtos 125.50 2 1) = (rtos (125.50+0.0499999) 2 1) = (rtos (125.50-0.0499999) 2 1)" и проверяет на 0 во втором знаке после запятой. Если оно выполняется, то ищем (rtos 125.50 2 1), если нет, то ищем (rtos 125.50 2 2)

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

Ну блин, сказано что искать, сказано - где. И все равно...
http://forum.dwg.ru/showthread.php?t=15429
http://forum.dwg.ru/showthread.php?t=15661

[RNB]

Сообщение от Vladimir_Sergeevich Аллилуйа!

Ну вот! Я знал, что должно быть простое решение. Но пока так не умею, поэтому приходится всё делать обходными путями

[skkkk]

Сообщение от Vladimir_Sergeevich если бы (rtos 125.50 2 2) выдавал "125,5" то прокатило бы, но он выдает "125,50"

Может, я не совсем правильно и, главное, вовремя понял суть задачи, но на всякий случай добавлю: чтобы (rtos 125.50 2 2) выдал "125.5" нужно DIMZIN установить в 8.

[Vladimir_Sergeevich]

Сообщение от skkkk DIMZIN установить в 8.

ну у меня стоит <1> Интересная конечно переменная, раньше с такой не сталкивался
ну и, в конкретном случае, использование vl-princ-to-string выглядит лучше, чем изменение системной переменной (это же её еще надо запомнить и вернуть обратно)

Сообщение от Кулик Алексей aka kpblc Ну блин, сказано что искать, сказано - где. И все равно...

а эту функцию я оттуда и помню, правда давненько я ту ветку изучал, сразу и не припомнил

[skkkk]

Сообщение от Vladimir_Sergeevich ну у меня стоит <1> Интересная конечно переменная, раньше с такой не сталкивался

А кто ж ее тогда поменял? По умолчанию она равна 8. Видимо, какой-то лисп не вернул ее обратно. Она, кстати, упоминается у Полещука в описании функции rtos.

[Vladimir_Sergeevich]

Сообщение от skkkk По умолчанию она равна 8.

судя по всему она хранится в чертеже. у меня в шаблонах она равна 1. А в dxf, которые экспортируются из других прог она у меня 0 по умолчанию.

[kacugu]

День добрый.
Для подписи закладных на чертеже использую код Lee Mac, который когда-то нашёл на theswamp. Лисп берёт данные из блока и чертит мультивыноску с этими значениями. Сейчас решил "модифицировать" лисп, чтобы текст, прописываемый в мультивыноске зависел от одного из атрибутов (в коде это at5). Но условие почему-то не срабатывает. При любом значении at5 выполняется второе выражение условия.
Подскажите, что делаю не так.

Код:

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

 
    (defun c:tr2ml2 ( / at1 at2 at3 at4 at5 ent enx pnt0 lst mld pnt )
       (while
           (progn
               (setvar 'errno 0)
               (setq ent (car (entsel "\nВыберите блок <Выход>: ")))
               (cond
                   (   (= 7 (getvar 'errno))
                       (princ "\nМимо, попробуйте снова.")
                   )
                   (   (null ent)
                       nil
                   )
                   (   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                       (princ "\nОбъект не является блоком.")
                   )
                   (   (/= 1 (cdr (assoc 66 enx)))
                       (princ "\nБлок не содержит атрибутов.")
                   )
                   (   (not
                           (and
                               (setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                                     lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
                               )
                               (setq at1 (cdr (assoc "НОМЕР_ПОЗИЦИИ" lst)))
							   (setq at2 (cdr (assoc "ТОЛЩИНА" lst)))
							   (setq at3 (cdr (assoc "КОД" lst)))
							   (setq at4 (cdr (assoc "ДИАМЕТР" lst)))
							   (setq at5 (cdr (assoc "МАРКА" lst))) 
                           )
                       )
				   (princ "\nБлок не содержит атрибут \"НОМЕР_ПОЗИЦИИ\".")
                   )
                   (   (setq pnt0 (getpoint  "\nВыберите начало мультивыноски >> \n")
                             pnt (getpoint (trans pnt0 ent 1) "\nВыберите конец мультивыноски <Выход>: ")
                       )
                       (setq mld
                           (vlax-invoke
                               (vlax-get-property (LM:acdoc)
                                   (if (= 1 (getvar 'cvport))
                                       'paperspace
                                       'modelspace
                                   )
                               )
                               'addmleader
                               (append (trans pnt0 ent 0) (trans pnt 1 0))
                               0
                           )
                       )
						(if 
							(= at5 0 )
								(vla-put-textstring mld
									(strcat 
											   "%<\\AcObjProp Object(%<\\_ObjId "
											   (LM:ObjectID at1)
											   ">%).TextString>%"
											   "\\P" 
											   "%%c"
											   "%<\\AcObjProp Object(%<\\_ObjId "
											   (LM:ObjectID at4)
											   ">%).TextString>%"
											   "х"
											   "%<\\AcObjProp Object(%<\\_ObjId "
											   (LM:ObjectID at2)
											   ">%).TextString>%"
											   "\\P"
											   "("
											   "%<\\AcObjProp Object(%<\\_ObjId "
											   (LM:ObjectID at3)
											   ">%).TextString>%"
											   ")"
									)
								)	
								(vla-put-textstring mld
									(strcat 
											   "%<\\AcObjProp Object(%<\\_ObjId "
											   (LM:ObjectID at1)
											   ">%).TextString>%"
											   "\\P" 
											   "%<\\AcObjProp Object(%<\\_ObjId "
											   (LM:ObjectID at5)
											   ">%).TextString>%"
											   "\\P"
											   "("
											   "%<\\AcObjProp Object(%<\\_ObjId "
											   (LM:ObjectID at3)
											   ">%).TextString>%"
											   ")"
									)						
								)
						)	
						(vla-put-textrotation mld 0.0)
                       (if (<= (car pnt) (car (trans pnt0 ent 1)))
                           (progn
                               (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(-1.0 0.0) 1 0 t)))
                               (vlax-invoke mld 'setleaderlinevertices 0 (append (trans pnt0 ent 0) (trans pnt 1 0)))
                           )
                           (vla-setdoglegdirection mld 0 (vlax-3D-point (trans '(1.0 0.0) 1 0 t)))
                       )
                       (vla-regen (LM:acdoc) acactiveviewport)
                       t
                   )
               )
           )
       )
       (princ)
    )
     
    ;; ObjectID  -  Lee Mac
    ;; Returns a string containing the ObjectID of a supplied VLA-Object
    ;; Compatible with 32-bit & 64-bit systems
     
    (defun LM:ObjectID ( obj )
       (eval
           (list 'defun 'LM:ObjectID '( obj )
               (if
                   (and
                       (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                       (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                   )
                   (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                  '(itoa (vla-get-objectid obj))
               )
           )
       )
       (LM:ObjectID obj)
    )
     
    ;; Active Document  -  Lee Mac
    ;; Returns the VLA Active Document Object
     
    (defun LM:acdoc nil
       (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
       (LM:acdoc)
    )
     
    (vl-load-com) (princ)

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

Перед (if (= at5 0) поставь точку останова и проверь,чему у тебя равны соответствующие переменные

[gomer]

Сообщение от Кулик Алексей aka kpblc Перед (if (= at5 0) поставь точку останова и проверь,чему у тебя равны соответствующие переменные

at5, я так подозреваю это строка, а 0 - число, вот и не срабатывает

[kacugu]

gomer, не совсем так. at5 возвращала не значение атрибута, а #VLA-Object что-то там.

[gomer]

Сообщение от kacugu at5 возвращала не значение атрибута, а #VLA-Object что-то там.

а, ну да, недоскроллил

[Vladimir_Sergeevich]

Хочу критики и советов.
Пишу на досуге большую страшную прогу, но есть сомнения в рациональности подхода.
Задача примерно такая: получаю 3 точки и по ним отрисовываю кучу всего. При этом необходимо просчитывать много других точек (пояснения в коде):

Код:

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

 ;;Начальное задание списка вне условий (универсальное)
(setq pt_lst (list ;;ассоциативный список координат точек
	(cons 0 p-vline) ;; нижняя выносная
	(cons 1 p-ntr)   ;; начало трубы
	(cons 2 p-ktr)   ;; конец трубы
	(cons 10 (polar p-vline (/ pi 2) 5))  ;;второй уровень размеров
	(cons 20 (polar p-vline (/ pi 2) 10)) ;;третий
	(cons 30 (polar p-vline (/ pi 2) 15)) ;;четвертый
));;ассоциативный список координат точек

;;потом в теле ветвления я этот список расширяю (тут частный случай, где то точек больше, где то меньше, размеры другие и прочее)
(setq pt_lst (sad-add-or-subst pt_lst 2 (polar (cdr (assoc 2 pt_lst)) a-dim -0.1))) ;;тут a-dim угол наклона трубы в радианах
(setq pt_lst (sad-add-or-subst pt_lst 3 (polar (cdr (assoc 1 pt_lst)) a-dim d-tr)))
(setq pt_lst (sad-add-or-subst pt_lst 4 (polar (cdr (assoc 2 pt_lst)) (+ a-dim pi) d-tr)))
(setq pt_lst (sad-add-or-subst pt_lst 5 (polar (cdr (assoc 1 pt_lst)) a-dim  (/ (distance p-ntr p-ktr) 2))))
(setq pt_lst (sad-add-or-subst pt_lst 7 (polar (cdr (assoc 1 pt_lst)) a-dim (+ d-tr 1.5))))
(setq pt_lst (sad-add-or-subst pt_lst 8 (polar (cdr (assoc 2 pt_lst)) (+ a-dim pi) (+ d-tr 1.5))))
(setq pt_lst (sad-add-or-subst pt_lst 50 (polar (cdr (assoc 3 pt_lst)) (+ a-dim (* pi 0.5)) d-tr))) 	;;верх звена слева
(setq pt_lst (sad-add-or-subst pt_lst 51 (polar (cdr (assoc 4 pt_lst)) (+ a-dim (* pi 0.5)) d-tr))) 	;;верх звена слева
(setq pt_lst (sad-add-or-subst pt_lst 60 (polar (cdr (assoc 50 pt_lst)) (+ a-dim (* pi 0.5)) 3.5))) 	;;верх оголовка справа
(setq pt_lst (sad-add-or-subst pt_lst 61 (polar (cdr (assoc 51 pt_lst)) (+ a-dim (* pi 0.5)) 3.5))) 	;;верх оголовка справа
(setq pt_lst (sad-add-or-subst pt_lst 101 (polar (cdr (assoc 1 pt_lst)) a-dim d-tr)))		;;начальная первой подушки
(setq pt_lst (sad-add-or-subst pt_lst 105 (polar (cdr (assoc 2 pt_lst)) (+ a-dim pi) d-tr)))	;;начальная второй подушки
(setq pt_lst (sad-add-or-subst pt_lst 102 (polar (cdr (assoc 101 pt_lst)) (+ a-dim (* pi 1.5)) (* h_freez 10))))
(setq pt_lst (sad-add-or-subst pt_lst 106 (polar (cdr (assoc 105 pt_lst)) (+ a-dim (* pi 1.5)) (* h_freez 10))))
(setq pt_lst (sad-add-or-subst pt_lst 103 (polar (cdr (assoc 102 pt_lst)) a-dim 5)))
(setq pt_lst (sad-add-or-subst pt_lst 107 (polar (cdr (assoc 106 pt_lst)) a-dim -5)))
(setq pt_lst (sad-add-or-subst pt_lst 104 (polar (cdr (assoc 103 pt_lst)) (+ 0.927295 a-dim) 22.2145)))
(setq pt_lst (sad-add-or-subst pt_lst 108 (polar (cdr (assoc 107 pt_lst)) (+ 2.2143 a-dim) 22.2145)))
(setq pt_lst (sad-add-or-subst pt_lst 109 (polar (cdr (assoc 101 pt_lst)) (+ a-dim (* pi 1.5)) 12.2)))
(setq pt_lst (sad-add-or-subst pt_lst 110 (polar (cdr (assoc 101 pt_lst)) (+ a-dim (* pi 1.5)) 13.2)))
(setq pt_lst (sad-add-or-subst pt_lst 111 (polar (cdr (assoc 110 pt_lst)) a-dim 3.0)))
(setq pt_lst (sad-add-or-subst pt_lst 112 (polar (cdr (assoc 109 pt_lst)) a-dim 3.0)))
(setq pt_lst (sad-add-or-subst pt_lst 113 (polar (cdr (assoc 105 pt_lst)) (+ a-dim (* pi 1.5)) 12.2)))
(setq pt_lst (sad-add-or-subst pt_lst 114 (polar (cdr (assoc 105 pt_lst)) (+ a-dim (* pi 1.5)) 13.2)))
(setq pt_lst (sad-add-or-subst pt_lst 115 (polar (cdr (assoc 114 pt_lst)) a-dim -3.0)))
(setq pt_lst (sad-add-or-subst pt_lst 116 (polar (cdr (assoc 113 pt_lst)) a-dim -3.0)))

;;используемая функция добавления точечных пар
(defun sad-add-or-subst (lst key value)
  (if (assoc key lst)
    (subst (cons key value)
           (assoc key lst)
           lst
           ) ;_ end of subst
    (append lst (list (cons key value)) )
    ) ;_ end of if
  ) ;_ end of defun

С одной стороны, смотрится жутко громоздко, с другой - это лучшее до чего я пока додумался.

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

Я бы загнал все в цикл и внутри него уже делал. ИМХО получится проще, быстрее и короче.

[Vladimir_Sergeevich]

не совсем понимаю как это сделать. с одной точки максимум цепочка до 4 значений идет. разве что каким то боком прописать:
(foreach 'item (<список из rez sourse angle dist>) (setq pt_lst (sad-add-or-subst pt_lst rez (polar (cdr (assoc sourse pt_lst)) angle dist))) ;;тут rez sourse - номера кодов списка причем не явно , а cdr cadr и тд из item
Ты об этом?

Код:

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

 (foreach item (list ;;<список из rez sourse angle dist>
	(list 3 1 a-dim 14.7)
	(list 4 2 (+ a-dim pi) 14.7)
	(list 5 1 a-dim  (/ (distance p-ntr p-ktr) 2))
	(list 6 3 a-dim 27)
	(list 7 3 a-dim 3.6)
	(list 8 4 (+ a-dim pi) 3.6)
	(list 50 3 (+ a-dim (* pi 0.5)) d-tr)
	(list 51 4 (+ a-dim (* pi 0.5)) d-tr)
	(list 60 50 (+ a-dim (* pi 0.5)) 5.0)
	(list 61 51 (+ a-dim (* pi 0.5)) 5.0)
	
	) ;;<список из rez sourse angle dist>
	(setq pt_lst (sad-add-or-subst pt_lst (car item) (polar (cdr (assoc (cadr item) pt_lst)) (caddr item) (cadddr item))))
);;foreach

В этом варианте коды 100-116 не нужны, в принципе смотрится компактней и все так же работает на ура... на 4 варианта третий способ реализации

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

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

[Vladimir_Sergeevich]

Весь список у меня состоит из пар кода и точки. на стадии получения исходных данных задаются коды 1 2 - начало и конец трубы 0 10 20 30 - уровни размерных линий
далее идет анализ содержимого, и получаем ключ (тип трубы) для дальнейшей работы
и в границах cond для каждого случая прописано расширение списка в соответствии с нужными размерами и прочими потребностями. Собственно в #2575 и выложил расширение списка для последнего варианта. Дальше уже по этому списку ведутся построения размеров, а в одном из вариантов и полилиний дополнительных (те самые точки 101-116)

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

Offtop: Скажу честно: у меня сейчас мозг затрмучен своими задачками, подробно вникнуть не могу

[Vladimir_Sergeevich]

И еще хочу попросить критики на такое творчество:

Код:

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

 ;|функция отрисовки полилинии по координатам. генерация типа линий включена
!!Все настройки (слой/цвет/вес и пр) принимаются текущими!!
!!Рисует в активном пространстве!!
(sad-draw-lwpline pt_list blg_list nil t) 
аргументы:
  * список точек WCS
  * список кривизн list/nil
  * глобальная ширина real/nil
  * флаг замкнутости t/nil
возвращаемое значение:
  * ename созданного объекта
|;
(defun sad-draw-lwpline (pt_list blg_list widht fl_close / vertices_list)
	(foreach item pt_list 
		(progn (setq vertices_list (append vertices_list (list 
			(cons 10 item)
			(if blg_list (cons 42 (car blg_list))  (cons 42 0)) ;;blg 
			(cons 91 0) 
			)
			)
			blg_list (cdr blg_list)
			);;setq
		)
	);;foreach
  (entmakex (append 
    (list
		(cons 0 "LWPOLYLINE") 
		(cons 100 "AcDbEntity") 
		(cons 100 "AcDbPolyline")
		;;(cons 6 "ByBlock");linetype
		;;(cons 8 "0");layer
		(cons 62 0)
		(cons 90 (length pt_list)) ;;Number of vertices
		(if fl_close (cons 70 129) (cons 70 128)) 	;;flag
		(if widht (cons 43 widht) (cons 43 0)) 		;;Constant width 
    );;list 1
	vertices_list
	;;(list 210 0.0 0.0 1.0) ;;нормаль
	);;append
  ) ;;_ end of entmakex
);;end sad-draw-lwpline

Собственно, стоит ли расширить список аргументов для возможности задания слоя/цвета/веса/типа линии не по текущим настройкам?

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

Я бы задавал. Только с "перегрузкой": http://autolisp.ru/2009/10/21/lisp-overloading/

[skkkk]

Offtop:

Сообщение от Vladimir_Sergeevich (sad-draw-lwpline...

А почему она "грустная"? Или печальная?

[ShaggyDoc]

Вот как я рисую полилинию.

Код:

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

 (defun ru-pline-add (points is_closed width lineweight ltype / obj)
;| Пример:
(ru-pline-add (list (list 0 0) (list 10000 1000) (list 10000 20000) (list 0 20000)) nil  0 50 "HIDDEN")
|;
  (ru-error-catch
    (function
      (lambda ()
        (setq  obj (vla-addlightweightpolyline (ru-obj-active-space)
                (ru-conv-list-points-to-variant-array
                  (apply
                    'append
                    (mapcar 'ru-conv-3dpoint-to-2dpoint  points
                    ) ;_ end of mapcar
                  ) ;_ end of apply
                ) ;_ end of ru-conv-list-points-to-variant-array
              ) ;_ end of vla-addlightweightpolyline
        ) ;_ end of setq
        (cond
          ((and
             (vlax-read-enabled-p obj)
             (vlax-write-enabled-p obj)
           ) ;_ end of and
           (if is_closed
             (vla-put-closed obj :vlax-true)
           ) ;_ end of if
           (if width
             (vla-put-constantwidth obj width)
           ) ;_ end of if
           (ru-lw-set-for-obj obj lineweight)
           (if Ltype
             (ru-ltype-apply obj Ltype)
           ) ;_ end of if
           (vla-update obj)
           obj
          )
        ) ;_ end of cond
      ) ;_ end of lambda
    ) ;_ end of function
    (function (lambda (x)
                (princ (strcat "\nОШИБКА RU-PLINE-ADD " x))
                nil
              ) ;_ end of lambda
    ) ;_ end of function
  ) ;_ end of ru-error-catch                
) ;_ end of defun

Особенности:
1. Могут быть заданы Ширина, вес, тип линии. Слой всегда текущий, если нужен иной - устанавливается до вызова.
2. Все действия завернуты в ловушку ошибок. При сбое по каким-то причинам вернется NIL и сообщение
3. Список координат "нормализуется".

Назначение функций с именами ru-xxx понятно из их названий.

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

Из-за того, что у меня иногда идет обновление или полное изменение функционала (при условии сохранения, я предпочитаю задавать один-два параметра. Ну, например, для создания той же LWPOLYLINE будет всего 2 параметра: первый - список оординат вершин, второй - список из необязательных параметров типа '(("lw" . <Вес>) ("lt" . <Тип>) ("color" . <ICA-цвет>) ...) Если во втором списке что-то пропущено, берем либо текущее значение, либо "по умолчанию" - зависит от назначения функции.
Но это дело вкуса Просто мне держать в голове параметров больше, чем 3 штуки, тяжеловато )))

[Дима_]

Сообщение от Vladimir_Sergeevich И еще хочу попросить критики на такое творчество: Код: [Выделить все] ...(foreach item pt_list (progn (setq vertices_list (append vertices_list (list...

Ну если критики - уже не раз писал, и "разжевывал", что использование append в цикле - это не православно.

[Vladimir_Sergeevich]

Offtop:

Сообщение от skkkk А почему она "грустная"? Или печальная?

Исторически так сложилось, еще с первого курса пошло тут читай как транслитерацию и аббревиатуру
Дима_, по поводу append нашел только это: "для добавления одного элемента append, да еще и в цикле логарифмически увеличивает время выполнения".
Это все интересно, но... видел еще пяток таких же способов формирования списка и как то альтернативы не попадалось и у самого не придумывается. (Да и не думаю, что придется строить линии больше десятка точек... по крайней мере пока что были максимум по 4)
Дочитал там же замечание, что основной инструмент будет cons, но:

Код:

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

 (append '((0 0) (1 1) (2 2)) '((3 3) (4 4)) )
((0 0) (1 1) (2 2) (3 3) (4 4))

(cons '((0 0) (1 1) (2 2)) '((3 3) (4 4))  )
(((0 0) (1 1) (2 2)) (3 3) (4 4)) ;;лишние скобочки остаются

Алексей, с перегрузкой - интересная идея, покурю на досуге.

[Дима_]

В общем еще раз - список это не изменяемая стуктура. Функция cons не создает новый список а свзязывает "голову" с "хвостом" - то есть просто говорит - за данным элементом идет такой-то - в случае если "такой-то" это список - то мы можем пробежаться по данной цепочки от начала до конца, при том что в разных точках программы мы можем ссылаться на разные начала одного и того-же списка. В конец неизменяемого списка добавить ничего нельзя, функция append, создает новый список пересчитывая тем-же cons'ом свои аргументы. То есть на каждой итерации мы пересчитываем весь список заново, а если у нас программа чуть посложней и хранит ссылки на свои предыдущие шаги - то хранит она и соответственное количество одинаковых списков - да если и не хранит у Вас основное время не программа, а автоматический сборщик мусора работает.

[Vladimir_Sergeevich]

Переработал функцию:

Код:

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

 ;|функция отрисовки полилинии по координатам. генерация типа линий включена
!!Рисует в активном пространстве!!
(sad-draw-lwpline pt_list blg_list (("lweignt" 30) ("widht" 0) ("color" -3) ("ltype" "ByBlock") ("layer" "0") ("closed" t)) ) 
аргументы:
  * список точек WCS
  * список кривизн list/nil
  * список опций (("lweignt" 30) ("widht" 0) ("color" -3) ("ltype" "ByBlock") ("layer" "0") ("closed" t))                 
 возвращаемое значение:
  * ename созданного объекта
|;
(defun sad-draw-lwpline (pt_list blg_list opt_list / obj_lst)
(setq obj_lst nil
	blg_list (reverse blg_list))
(foreach item (reverse pt_list) 
	(setq 
		obj_lst (cons (cons 91 0) obj_lst)
		obj_lst (cons (if blg_list (cons 42 (car blg_list)) (cons 42 0)) obj_lst) ;;blg
		obj_lst (cons (cons 10 item) obj_lst) 
		blg_list (cdr blg_list)
		);;setq
	);;foreach
(foreach item
    (list
		(if (cadr (assoc "widht" opt_list)) (cons 43 (cadr (assoc "widht" opt_list))) (cons 43 0)) 		;;Constant width ++
		(if (cadr (assoc "closed" opt_list)) (cons 70 129) (cons 70 128)) 	;;flag ++
		(cons 90 (length pt_list)) ;;Number of vertices
		(if (cadr (assoc "lweignt" opt_list)) (cons 370 (cadr (assoc "lweignt" opt_list))) ) ;lweignt
		(if (cadr (assoc "color" opt_list)) (cons 62 (cadr (assoc "color" opt_list))) ) ;color
		(if (cadr (assoc "ltype" opt_list)) (cons 6 (cadr (assoc "ltype" opt_list))) ) ;linetype
		(if (cadr (assoc "layer" opt_list)) (cons 8 (cadr (assoc "layer" opt_list))) ) ;layer
		(cons 100 "AcDbPolyline")
		(cons 100 "AcDbEntity") 
		(cons 0 "LWPOLYLINE") 
    );;list
	(setq obj_lst (cons item obj_lst))
	);;foreach
(entmakex  (vl-remove nil obj_lst)) ;;_ end of entmakex
);;end sad-draw-lwpline

Дима_, так лучше будет?
Алексей, прикрутил список необязательных параметров. Что то мне понравилась эта идея, переписал все три своих функции рисования благо они только в одном коде пользовались и то только одна...

[Дима_]

Сообщение от Vladimir_Sergeevich Дима_, так лучше будет?

Я пишу несколько в другом стиле - сами судите - лучше Вам такая версия или нет - Вам пользоваться.

[gomer]

Сообщение от Vladimir_Sergeevich так лучше будет?

не слушайте никого, как вам удобнее, так и пишите

[Vladimir_Sergeevich]

Дима_, я о том спрашивал, что исключил append из кода совсем. У меня нет таких глубоких знаний, как у Вас, о внутренностях и механике Лиспа и к советам стараюсь прислушиваться.

[Vladimir_Sergeevich]

Есть вопрос по поводу (sssetfirst nil ss), а именно о подсветке примитивов внешних ссылок/блоков.
Собственно вершинки то показывает, но хочется немного другого.
Например, выполняя _trim, при указании примитива внешней ссылки, примитив подсвечивается (становится пунктирным), как сделать так же программно?

[MrBrown]

Здравствуйте!
Создаю макрос простановки направлений и длин фрагментов полилиний.

Пока сваял вот такое (не без помощи VVA - http://forum.dwg.ru/showthread.php?t=121171 :

Код:

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

 (defun C:DATAR ()

(vl-load-com)
	
  (setq |CMDECHO| (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (setvar "osmode" 512)	
	
	(setq pl (entsel "\nВыберите фрагмент полилинии/отрезок: "))
	(setq point (cadr pl)
	      pl (vlax-ename->vla-object(car pl))
	      )
	;;;В point - точка выбора полилинии
	;;;Находим ближайшую точку полилинии
	(setq point (vlax-curve-getClosestPointTo pl point))
	;;;Узнаем параметр полилинии в точке
	;;;Параметр целая часть - номер вершины, начиная с 0
	(setq param (vlax-curve-getParamAtPoint pl point))
	(setq vx1 (vlax-curve-getPointAtParam pl (fix param))) ;_предыдущая вершина
	(setq vx2 (vlax-curve-getPointAtParam pl (1+ (fix param)))) ;_следующая вершина

	(setq ang (angtos (- (/ pi 2) (angle vx1 vx2)) 1 4))
	; Последние две цифры - это представление угла и кол-во знаков после запятой.
		; Представление: 
			; 0 - градусы
			; 1 - градусы, минуты, секунды
			; 2 - грады
			; 3 - радианы
			; 4 - геодезическое представление (с указанием сторон света)

	(setq len (rtos (distance vx1 vx2) 2 3))	
	
	
	

  (setq PT1 (getpoint "Укажите точку вставки середины текста: "))
  (setq PT2 (getpoint pt1 "\nУкажите направление текста: "))
;;;Text data
  (setq TAG (strcat ang "\n(" len " м)"))
  (setq ang (angle PT1 PT2))
  ;;;TEXT TO PRINT ON SCREEN
  (entmake (list
	     (cons 0 "MTEXT")
	     (cons 100 "AcDbEntity")
	     (cons 100 "AcDbMText")
	     (cons 7 "Standart")
	     (cons 8 "Направление-расстояние")
	     (cons 71 5)
	     (cons 72 5) ;выравнивание текста (5 - середина)
	     (cons 73 1)
	     (cons 10 PT1)
	     (cons 11 (list 1.0 0.0 0.0))
	     (cons 50 ANG)
	     (cons 41 19.35)
	     (cons 40 (* 0.1 (strlen TAG)))
	     (cons 44 1.0)
	     (cons 1 TAG)
	   )
  )
  (setvar "osmode" 0)
  (setvar "cmdecho" 1)
  (redraw)
  (princ)
  )

Прошу, ответьте на вопросы и дайте подсказки:
1. макрос работает и без объявления переменных. Улучшится ли работа макроса, если их (переменные) объявить в строке "defun ()"?
2. Стоит ли выключать в начале и включать в конце привязки?
3. В М-тексте градусы обозначаются буквой "d". Как сделать замену на значок градуса (верхний кружок)?
4. В функции entmake создания М-текста непонятны строки с dxf-кодом 100. Ну, вторая строчка прямо указывает на М-текст. А первая?Что она означает? И, если это разные понятия, то почему обозначены одним dxf-кодом?
5. Что выполняет строчка (cons 41 19.35)?
6. Как дополнить макрос, чтобы он, кроме полилиний, работал и применительно к отрезкам?
7. Почему-то разные М-тексты получаются разной высоты. У одного фрагмента полилинии, например, высота букв 2.0, у другого 2.2, у третьего - 1.8. Как добиться однообразия?
8. Укажите на явные "ляпы" и потенциальные трудности, чтобы знать, в каком направлении "копать" дальше в освоении AutoLISP.
Спасибо.
p.s. вдогонку: можно ли что-то добавить, чтобы при указании фрагмента полилинии, он подсвечивался?

[gomer]

-1.да
-2.нет
-3.%%d
-4.разные
-5.Reference rectangle width
-6.никак, параметр для линий и полилиний - разные понятия

[MrBrown]

gomer,
3. Это сочетание я знаю и часто пользуюсь им в автокаде. Но, как "прикрутить" его в макросе к этой строчке:

Код:

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

 (setq ang (angtos (- (/ pi 2) (angle vx1 vx2)) 1 4))

или в другом месте?
5. Это понятие я нашел и перевел. Но не увидел разницы работы макроса при изменении значения (cons 41 ...). Поэтому и спросил.
6. Значит, для линий - отдельный макрос? Или же какая-то отдельная VL- функция, которую можно "прикрутить" к уже существующему макросу?
________________________
через 15 минут: догадываюсь, что по пункту третьему можно сделать функцию замены "d" на значок градуса. И потом, при формировании м-текста её как-то использовать.
Или есть способ проще?

[gomer]

Сообщение от MrBrown как "прикрутить" его в макросе к этой строчке:

(strcat (rtos (dtr (- (/ pi 2) (angle vx1 vx2)))) "%%d")

Сообщение от MrBrown Значит, для линий - отдельный макрос?

не обязательно отдельный, но что такое ветвление, надеюсь не нужно рассказывать.

Сообщение от MrBrown Или же какая-то отдельная VL- функция, которую можно "прикрутить" к уже существующему макросу?

бесполезно искать "волшебные" функции, священный грааль в автолиспе отсутствует
зы неужели так трудно догадаться, что для отрезков "соседние точки" - это начальная и конечная точка отрезка, которые находятся элементарно по кодам 10 и 11???

[MrBrown]

gomer, благодарю за помощь, за ответы и подсказки. Ну да, VLISP-это для меня пока ещё волшебство на грани "Грааля"
Про коды отрезков знаю, но мне хочется "тыкать курсором" не в концы отрезка, а в его середину. А макрос - не хочет (пока не хочет).
_________________________
Обозначение градуса - не работает. Возможно я не точно выразил мысль.
На приложенной картинке - результат работы макроса. Это м-текст, состоящий из двух строк. Вот в первой строчке находится эта злосчастная буква "d". А её надо заменить на значок градуса. Как?

[gomer]

Сообщение от MrBrown Вот в первой строчке находится эта злосчастная буква "d". А её надо заменить на значок градуса. Как?

надо почитать справку, в старых версиях она была более удобная есть целый ряд функций для работы со строками, например (vl-string-translate "d" "%%d" str)

Сообщение от MrBrown Про коды отрезков знаю, но мне хочется "тыкать курсором" не в концы отрезка, а в его середину. А макрос - не хочет (пока не хочет).

во первых, это совсем не макрос, во-вторых, макрос - сущность неодушевленная, она не может хотеть или не хотеть, мочь и не мочь она тоже не может. программа делает только то, что вы в нее заложили: не заложили обработку отрезков, вот она их и не обрабатывает. Еще раз повторяю ВЕТВЛЕНИЕ!!! Вы ж научиться хотите, а не чтоб вам написали задаром?

[MrBrown]

gomer,
Offtop: "Вы ж научиться хотите, а не чтоб вам написали задаром?" - увы, приходится учиться на старости, халява не проходит (http://forum.dwg.ru/showthread.php?t=120470).
Я просто вынужден освоить хотя бы основы, чтобы более-менее ориентироваться в несложных кодах. А эти основы приходится изучать, анализируя практические коды с приложенными комментариями. Полещук с Кудрявцевым и иже с ними - это, конечно, весьма полезно, но, сами понимаете, из-за одной-двух программок в два десятка строчек штудировать всего "Маркса" (читай "Полещука") - это на грани научного мазохизма. И я благодарен вам, всем мастерам AutoLISP, помогающим нам, независимо от реальной причины и мотива того или иного "чайника", обратившегося за помощью на форум. Спасибо.

[MrBrown]

Здравствуйте! Анализируя коды, обратил внимание, что мастера автолиспа одну строку кода комментируют одним знаком ";", а общие комментарии - тремя, вот так: ";;;". Хотя и одного достаточно. Это что, такой стиль или элемент культуры программирования?

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

А кто как, я думаю.

[Vladimir_Sergeevich]

В Notepad++ есть подсветка синтаксиса и Коментарии с ;; там затеняются, а с ; нет.

[ShaggyDoc]

Сообщение от MrBrown Здравствуйте! Анализируя коды, обратил внимание, что мастера автолиспа одну строку кода комментируют одним знаком ";", а общие комментарии - тремя, вот так: ";;;". Хотя и одного достаточно. Это что, такой стиль или элемент культуры программирования?

Стиль каждый вырабатывае сам. На стиль влияет и разная подсветка (затенение) в разных редакторах кода, и автоматическое форматирование. Каждый может выработать свой стиль. Особенно важно выработать стиль именования функций и переменных. И всё это является элементами культуры программирования.

[gomer]

Сообщение от MrBrown Здравствуйте! Анализируя коды, обратил внимание, что мастера автолиспа одну строку кода комментируют одним знаком ";", а общие комментарии - тремя, вот так: ";;;". Хотя и одного достаточно. Это что, такой стиль или элемент культуры программирования?

Сообщение от Кулик Алексей aka kpblc А кто как, я думаю.

Сообщение от ShaggyDoc Стиль каждый вырабатывае сам.

Объясню тут первый и последний раз. Так как у Полещука эта тема раскрыта достаточно вяло, а пользуются комментами действительно в стиле "кто в лес, кто по дрова".

На самом деле есть 5 видов комментов: ";", ";_", ";;", ";;;" и ";||;".
1.1 Строчный комментарий - краткое пояснение строки, пишется в конце комментируемой строки. Выравнивается посередине строки.
1.2 Строчный комментарий - вставляется автоматически vlide при форматировании и засирает и без того непонятный код. Выравнивается в конец строки кода.
2. Надстрочный комментарий - однострочный коммент, пишется над комментируемой строкой. Используется когда для п.1 не хватает места. Выравнивается по позиции комментируемой строки. Часто бывает псевдомногострочным.
3. Заголовочный однострочный комментарий - используется для описания функций и больших кусков кода. Выравнивается по началу строки. Часто бывает псевдомногострочным.
4. Заголовочный многострочный комментарий - используется для описания функций, больших кусков кода и коротких вставок внутри строки кода. Выравнивается только начало.

Код:

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

 
;|
  заголовочный комментарий файла строка 1
  заголовочный комментарий файла строка 2
                            |;
(defun foo ()
;;; заголовочный комментарий функции строка 1
;;; заголовочный комментарий функции строка 2

  ;; бесполезный надстрочный комментарий
  (vl-load-com) ;  бесполезный строчный комментарий

  ;; надстрочный комментарий строка 1
  ;; надстрочный комментарий строка 2
  (princ ;|сейчас будет строка->|; "\nHello, World!")

  (princ) ;_  бесполезный строчный комментарий

)  ;_ конец defun

Каждый тип комментария имеет свою реакцию на форматирование во vlide, неправильное использование комментов приводит к неудобочитаемости кода

[Vladimir_Sergeevich]

, что за мистика?

Код:

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

!obj
(#<VLA-OBJECT IAcadLWPolyline 17cf2384>) ;;создан программно и сохранен в obj

(vlax-curve-getEndParam obj)
; ошибка: не удается получить идентификационный код объекта: (#<VLA-OBJECT IAcadLWPolyline 17cf2384>)

(vlax-ename->vla-object (car (entsel)))
Выберите объект: #<VLA-OBJECT IAcadLWPolyline 17cf2384> ;;имя объекта одно и то же

(vlax-curve-getEndParam (vlax-ename->vla-object (car (entsel))))
Выберите объект: 1.0      ;;и таким макаром отрабатывает нормально

В чем прикол?
з.ы. Сам дурак всего то надо было car сделать...

[skkkk]

Сообщение от MrBrown ";", а общие комментарии - тремя, вот так: ";;;". Хотя и одного достаточно. Это что, такой стиль или элемент культуры программирования?

Хоть я и не мастер, но отвечу за себя. Я пишу код в Notepad++, настроенном под LISP. Там есть сочетания клавиш для того, чтоб закомментировать или раскомментировать строку или несколько строк выделенного текста. Это сочетание добавляет одну точку с запятой в начало строки, если ее нет, и убирает одну же, если она есть. Если в коде из нескольких строк одна строка закомментирована, и я хочу закомментировать весь "абзац", то при применении сочетания клавиш абзац закомментируется, а стоявшая точка с запятой уберется, то есть одна закомментированная строка "раскомментируется". Чтобы такого не происходило, приходится ставить две и более точек с запятой в тех строках, которые еще могут понадобиться, но на данный момент в тестировании кода не участвуют. Может, откуда-то отсюда ноги растут у стремления вставить не один символ. А вообще, я думаю, что это все на усмотрение каждого отдельно взятого индивида-кодировщика. По крайней мере, о каких то правилах, даже негласных, по этому поводу я не слышал.

----- добавлено через ~13 мин. -----
Во блин, пропустил целую страницу обсуждения

Сообщение от Vladimir_Sergeevich В Notepad++ есть подсветка синтаксиса и Коментарии с ;; там затеняются, а с ; нет.

Vladimir_Sergeevich, у меня затеняется даже с одной ";". А вот подсветка на форуме с одной срабатывает только если между ; и строкой перед ней есть хотя бы один пробел.
gomer, откуда дровишки? Интересная информация, и я даже склоняюсь к тому, чтобы пользоваться подобными соглашениями, мне нравится. Может, вообще стоит создать темку для обсуждения культуры программирования, форматирования, оформления, в которую собрать все принятые соглашения и правила написания кодов? Может, уже такая и была... Самого иногда бесит бардак в кодах функций, особенно в тех, что писались первыми и понятия не было еще ни о какой культуре. Сижу порой и думаю, что я хотел изобразить пару лет назад столь замысловатым поворотом кодов . Хоть такое бывает и редко, в основном я помню все свои мысли при написании того или иного кода, но думаю это оттого, что срок пока мал, да и кодов еще не так много. Но пришел к тому, что подробные комментарии крайне необходимы. Даже для того же поиска фрагмента кода через Ctrl+F. Постепенно перерабатываю все свои коды в удобоваримый вид. При этом новые с некоторых пор добротными комментариями снабжаю. Даже почитав чей-то совет когда-то тут на форуме, стал сначала построчно в редакторе в комментариях подробно прописывать алгоритм предстоящей функции, а затем приступать к написанию кода. Удобно - сразу знаешь, что делать, а после знаешь, что понаделал.

[Vladimir_Sergeevich]

Вопрос: можно ли из лиспа создать новый каталог без участия пользователя? Сколько искал: все в интерактивном режиме через кнопочку и ручной ввод.

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

http://autolisp.ru/2011/11/24/create-folde/

[Vladimir_Sergeevich]

Алексей, благодарю! Как то я пропустил mkdir, хоть и перечитал весь раздел методов по новой. для моих нужд хватит и стандартного метода без рекурсий.

[Vladimir_Sergeevich]

И снова я с глупыми вопросами...
Допиливал одну программку и захотелось к ней прикрутить прогресс-бар. проштудировав Полещука написал рабочий вариант через dcl.
И все бы хорошо, но создание нового документа вышибает dcl. это нормально?

Код:

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

 (setq doc (vla-get-Documents (vlax-get-acad-object))) ;;семейство документов
(vla-add doc "udp_plan.dwt") ;;создание нового документа на основе шаблона

Пока старт диалога поставил после создания всех нужных документов и все корректно завершается.
Диалог и функции управления прилагаются, если интересно.

[Vladimir_Sergeevich]

Возможно ли обновить внешние ссылки для неактивного документа?
Никак не пойму почему для активного документа такая конструкция работает, а для неактивного ни в какую

Код:

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

 	(vlax-for blkitem (vla-get-Blocks doc) ;;получаем семейство блоков каждого документа здесь doc - указатель на нужный чертеж
		;;почему то не срабатывает условие
		(if (= (vla-get-IsXref blkitem) :vlax-true) ;;проверка на внешнюю ссылку каждого блока в чертеже
			;;точнее условие срабатывает, но пишет, что отсутствует описание
			(progn (vla-Reload blkitem) ;;обновление блока внешней ссылки
			(princ "\nreloaded") 
			)
		)
	) ;;for

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

А зачем это делать? Если ссылка была изменена, она автоматически обновится при открытии документа.

[Vladimir_Sergeevich]

Суть в следующем:
-создаю пачку чертежей
-сохраняю с нужным именем и в нужные каталоги
-вставляю в каждый перекрестные ссылки и подоснову (cond по имени файла)
-сохраняю изменения
-вот здесь надо воткнуть обновление ссылок, потому что без обновления подоснова (вставленная ссылка) видна только в одном чертеже, а надо что бы она утащилась на все чертежи
-дальше настройка слоев подосновы (без обновления ссылок обрабатываются только в одном чертеже)
-сохранение и закрытие все документов

Задним местом чую, что можно все закрыть и открыть снова... но так же проще было бы
з.ы. вторая неделя уже пошла, как ковыряю это место. Условие точно выполнятся. получение false проходит корректно, а при true вылетает ошибка "отсутствует описание". уже и в ловушку ошибок завернул - тупо пролетает мимо этого участка и хоть убей.

[kakt00z]

если команда vla-Reload не запрашивает документ, то подозреваю она заточена на активный...
и конечно тогда она не найдет в активном документе описание блока из другого документа...
можно попробовать sendcommand

[Vladimir_Sergeevich]

kakt00z, даже если sendcommand пройдет в неактивный документ, как обновить ссылку? _externalreferences работает только в оконном режиме, а других способов я не знаю (по крайней мере в cui их нет).

If the drawing specified is not active, it will be made active.

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

p.s. vla-put-property тоже не спрашивает документ, но получая указатель на объект в неактивном документе меняет свойства там где надо, а не в активном. (в моем случае -LineWeight для слоев)

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

Vladimir_Sergeevich, ИМХО тебе надо будет сначала поменять VISRETAIN. Потом уже менять настройки слоев для ссылок. Перегружать ссылку при этом не надо.
ПРавда, я не знаю всей задачи.

[Vladimir_Sergeevich]

Кулик Алексей aka kpblc, судя по описанию переменной, её надо будет менять во всех кроме того, куда вставлена подоснова, потому что мы её обнуляем уже в настройках текущего чертежа, Тот что дают изыскатели остается неизменным и обновляется ими же. Таким образом "главной таблицей" будет план с подосновой, или же в в других чертежах при VISRETAIN 0 "главной таблицей" останется изыскательская?
(это делается что бы все линии топоосновы были с весом 0, а топографы в своем отчете кромку асфальта делаю 0,3 и еще всякие мелочи бывают)

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

Vladimir_Sergeevich, добро пожаловать в тему "Подготовка подосновы".

[trushev]

Добрый день! Встретил (ssget "X" ((-4 . "<OR") (0 . "TEXT") (0 . "MTEXT") (-4 . "OR>"))). Подскажите где найти подробную информацию на русском по (-4 . "<OR")?

[Дима_]

dxf reference - но насчет русского не уверен. Кстати данный пример можно заменить на (0 . "*TEXT")

[Сергей812]

Да чего вы так английского боитесь-вам же на нем не разговаривать, а просто понимать с листа)
ssget

You can also use the OR logical filter, but to do this you must inform AutoLisp first. To do this you use a special type of associative code, the -4. (setq sel1 (ssget '((-4 . "<OR")(8 . "STEEL")(8 . "PIPE")(-4 . "OR>"))))

т.е. чтобы в фильтр добавить несколько значений с одним dxf кодом - надо заключить в группы "-4".

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

Сообщение от Сергей812 чтобы в фильтр добавить несколько значений с одним dxf кодом

Кто сказал, что обязательно с одним? ))

[Сергей812]

Сообщение от Кулик Алексей aka kpblc Кто сказал, что обязательно с одним? ))

Это был вольный перевод к приведенному примеру)

Есть, например, замечательные справочники типа "AutoLisp и VisualLisp", где выделена отдельная глава про фильтры со сложными условиями. На русском языке

[trushev]

Сообщение от Сергей812 чтобы в фильтр добавить несколько значений с одним dxf кодом - надо заключить в группы "-4".

Спасибо, хоть какое-то понимание.

Сообщение от Сергей812 Есть, например, замечательные справочники типа "AutoLisp и VisualLisp", где выделена отдельная глава на русском языке

У Полещука не нашел. Если не сложно дать информацию где найти.

[Сергей812]

Сообщение от trushev У Полещука не нашел. Если не сложно дать информацию где найти.

в издании 2006 года ищите функцию ssget.. и в этой же главе будет тема про фильтры со сложными условиями на пару страниц. Номер не скажу - книга дома осталась)

[Vladimir_Sergeevich]

1.12.14.1 фильтры со сложными условиями ... стр 124

[trushev]

Спасибо всем! Книгу вычислил:
Название: AutoLISP и Visual LISP в среде AutoCAD
Автор: Николай Полещук, Петр Лоскутов
Издательство: БХВ-Петербург
Год: 2006
ISBN: 5-94157-738-9
Вечером дома скачаю.

[Дима_]

Имей в виду - оба автора участники этого форума.

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

И не только этого )))

[trushev]

Халяву предпочитаю не использовать.
Нашел другой вариант: Э.Т. Романычева, Т.М. Сидорова, С. Ю. Сидоров AutoCad Практическое руководство Версии 12, 13, 14 "ДМК" Москва 1997
Правда от стиля авторов закипаю.

[Сергей812]

Offtop: Книжка "AutoLISP и Visual LISP в среде AutoCAD" 2006г. стоит на том же озоне меньше 500р, по объему и организации информации - 100% окупается просто за счет сокращения времени на первоначальное обучение, имхо.

[Inferi]

Добрый день! Подскажите как решить следующую задачу: вставляю блок тройника, но не знаю как проверить ориентацию (верный угол поворота блока), как лучше удлинить мультилинию до точки пересечения pp?

Код:

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

(vl-load-com)
(setq obj1 (car (entsel "\nВыбери магистраль"))
      V1 (VLax-ename->vla-object obj1)
      lst_ml1 (entget obj1)
      coor1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 11)) lst_ml1))
      pm11 (nth 0 coor1)
      pm12 (nth 1 coor1)
      alf1 (angle pm11 pm12)
      alf1g (/ (* alf1 180) pi)
      RazP1 (vlax-ldata-get V1 "Razmer"))
      
(setq obj2 (car (entsel "\nВыбери ответвление"))
      V2 (VLax-ename->vla-object obj2)
      lst_ml2 (entget obj2)
      coor2 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 11)) lst_ml2))
      pm21 (nth 0 coor2)
      pm22 (nth 1 coor2)
      alf2 (angle pm21 pm22)
      alf2g (/ (* alf2 180) pi)
      RazP2 (vlax-ldata-get V2 "Razmer"))

(setq pp (inters pm11 pm12 pm21 pm22 nil))
(setq path (strcat "C:/MyLisp/КругТройник/" RazP1 "/" "Тройник " RazP1 "-" RazP2))
(command "_-insert" path "_non" pp 1 1 alf2g)

[skkkk]

Offtop:

Сообщение от trushev Халяву предпочитаю не использовать.

А в чем принципиальная разница этого и предыдущего указанного изданий? В том, что авторы второго не заходят на этот сайт? Не факт ведь, что не заходят. "Другой вариант", стало быть - тоже "халява", раз скачан бесплатно?

[trushev]

Offtop:

Сообщение от Сергей812 стоит на том же озоне меньше 500р

485р

Сообщение от skkkk "Другой вариант", стало быть - тоже "халява", раз скачан бесплатно

Приобретен еще в прошлом веке. Если не изменяет память на книжной ярмарке в Олимпийском.

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

Inferi, картинок не видно. Тебе что мешает их в пост прикрепять?

[Inferi]

Спасибо за внимание!

[mkung]

Подскажите - как назначить объекту цвет RGB (например 40,87,130)?
Через свойство Color, я так понял, только индексные цвета.
Через свойства TrueColor и EntityColor - 32 разрядное число, которое не понятно как получить.
Чего-то не догоняю.
Прошу помощи.

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

Поищи по форуму - решения по преобразованию rgb в truecolor были. Во, пока отвечал, нашел:

Код:

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

 (defun _kpblc-conv-color-rgb-to-true (red green blue)
                                     ;|
*    Создание TrueColor-цвета на основе его RGB-представления
*    Параметры вызова:
  red  значение Red
  green  то же, Green
  blue  то же, Blue
|;
  (+ (lsh (fix (cond (red)
                     (t 0)
                     ) ;_ end of cond
               ) ;_ end of fix
          16
          ) ;_ end of lsh
     (lsh (fix (cond (green)
                     (t 0)
                     ) ;_ end of cond
               ) ;_ end of fix
          8
          ) ;_ end of lsh
     (lsh (fix (cond (blue)
                     (t 0)
                     ) ;_ end of cond
               ) ;_ end of fix
          ) ;_ end of lsh
     ) ;_ end of +
  ) ;_ end of defun

[mkung]

За код спасибо!
Но все равно что-то не получается...

Код:

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

 (setq actdoc (vla-get-ActiveDocument (vlax-get-acad-object)) 
      vla_layer (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) "layer 1")
      vla_color (vla-GetInterfaceObject (vlax-get-acad-object) (strcat "Autocad.AcCmColor." (substr (getvar "ACADVER") 1 2)))
)
(setq tc (+ (lsh (fix (cond (40) 
                                   (t 0) 
                             ) ;_ end of cond 
                        ) ;_ end of fix 
                        16 
                   ) ;_ end of lsh 
                   (lsh (fix (cond (87) 
                                   (t 0) 
                             ) ;_ end of cond 
                        ) ;_ end of fix 
                        8 
                   ) ;_ end of lsh 
                   (lsh (fix (cond (130) 
                                   (t 0) 
                             ) ;_ end of cond 
                        ) ;_ end of fix 
                   ) ;_ end of lsh 
                )  
); end of setq
(vla-put-EntityColor vla_color tc)
(vla-put-TrueColor vla_layer vla_color)

(vla-put-EntityColor vla_color tc) выдает ; ошибка: Ошибка Automation. Отсутствует описание.

Вроде в примере у Полещука последние 2 строки так же написаны....
Смущает, что там -1036280892 вместо tc
vla-get-TrueColor тоже выдает число такого же порядка
А вычисление дает 2643842
Чего-то я, видимо, еще не понимаю.

[skkkk]

RGB_color в OLE_color как это сделать?
Оно?
А также функция rgb->ole-samocad от mmax здесь.

[mkung]

Сообщение от skkkk RGB_color в OLE_color как это сделать? Оно? А также функция rgb->ole-samocad от mmax здесь.

Спасибо.
Эти функции дают результат отличающийся от функции kpblc, совпадают с тем, что я вычисляю на калькуляторе по правилу, но...
Беру в свой пример значение из примера Полещука:

Код:

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

 (vla-put-EntityColor vla_color -1036280892)
(vla-put-TrueColor vla_layer vla_color)

Слою назначается цвет 55,155,196. Вычисляю:

Код:

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

 (RGB->OLE-SAMOCAD 55 155 196)

Результат: 12884791
Если подставляю это значение, то ; ошибка: Ошибка Automation. Отсутствует описание.
То есть эти функции вычисляют явно не то значение, которое ждет vla-put-EntityColor
Как получить то, что нужно функции vla-put-EntityColor?

[Ubivec81]

Здравствуйте!
Под рабочие цели написал такой вот код с разбивкой полилинии по пикетажу и подписями этого пикетажа.
Возникает проблема что на пустом чертеже все работает хорошо а при запуске на чертеже с масштабными планами текст не становится перпендикулярно линии разбивки, а идет с одним углом поворота.
Если у кого нибудь есть какие мысли подскажи что делаю не так. Заранее спасибо!!!

Код:

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

 (defun c:piketag_500 (/ piket pk_kl schet ugl tchk2 txtslyle ves cvet styl tchk)
  	(defun *error*(msg);Функция проверки на ошибки 
    		(princ msg) ; Отменено пользователем
    		(if c (setvar "OSMODE" c))
	  	(if txtslyle(setvar "textstyle" txtslyle))
	  	(if ves (setvar "CELWEIGHT" ves))
                (if cvet (setvar "CECOLOR" cvet))
	 	(if styl (setvar "clayer" styl))
  	);Конец *error*
  	(command "_.undo" "_begin")
  	(setq txtslyle (getvar "textstyle"))
  	(command "_-style" "1111111" "simplex8.shx" 1.25 0.7 10 "" "" "" )
  	(Setq c (getvar "osmode"));Сохранение значения привязок
  	(setq ves (getvar "CELWEIGHT"))
  	(setq cvet (getvar "CECOLOR"))
  	(setq styl (getvar "clayer"))
	(setvar "CELWEIGHT" 25)
  	(setvar "CECOLOR" "послою")
  	(command "_.-layer" "_make" "пикетаж_пути" "_color" "18" "" "_L" "continuous" "" "")
  	(setvar "osmode" 0)

  
  	(if (tblsearch "block" "razmetka");блок есть?
	  	(command "_measure" pause "б" "razmetka" "Д" "50"); да есть размечаем линию
	  	(progn (command "_line" '(0 0) '(0 2) ""); нет блока! рисуем линию
		  	(command "_-block" "razmetka" '(0 1) "_l" "");создаем блок
		  	(command "_measure" pause "Б" "razmetka" "Д" "50" ); размечаем путь
		 );end PROGN
	 ); end IF
  	
  	(INITGET 4)
  	(setq PK (getint "\n С КАКОГО ПИКЕТА НУМЕРОВАТЬ? <ПК 0>: "))
  	(IF ( = PK nil)
	  	(setq PK 0)
	 )
  	(command "_zoom" "_all")
	(setq piket (ssget "_P"));список точек после разбивки
  	(setq pk_kl (sslength piket)); количество точек в пикетном списке
  	(setq schet 0);счетчик
  	(while (< schet pk_kl)
	  	(setq tchk (cdr(assoc 10 (entget(ssname piket schet)))))
	  	(setq ugl(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5)));получение угла поворота каждого блока
	  	(cond((and(>= ugl 90) (<= ugl 180)) (setq tchk2 (polar tchk (+ 180 ugl) 1 ))(setq ugl(+(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))180)));вычисление 
		     ((and(> ugl 180) (<= ugl 270)) (setq tchk2 (polar tchk (+ 180 ugl)  1 ))(setq ugl(+(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))180)));точек вставки
		     ((and(> ugl 270) (<= ugl 360)) (setq tchk2 (polar tchk  (+ 180 ugl)  1 ))(setq ugl(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))));текста и угла его
		     ((and(>= ugl 0) (< ugl 90)) (setq tchk2 (polar tchk  (+ ugl 180)  1 ))(setq ugl(atof(angtos(cdr(assoc 50(entget(ssname(ssget tchk)0))))0 5))));наклона
		  )
	  	(command "_text" tchk2 ugl (strcat "ПК " (itoa(+ 1 schet PK))) "")
	  	(redraw)
	  	(setq schet (1+ schet))
  	);end_WHILE
  	(setvar "osmode" C)
	(setvar "textstyle" txtslyle)
	(setvar "CELWEIGHT" ves)
	(setvar "CECOLOR" cvet)
	(setvar "clayer" styl)
	(command "_.undo" "_end")
);END_DEFUN

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

Во-первых, где файл, на котором неправильно срабатывает?
Во-вторых, не советую преобразовывать углы в градусы - они и в радианах прекрасно обрабатываются (константу pi еще не отменили)
В-третьих, попробуй пошагово пройти и посмотреть, чему у тебя равны переменные в каждый момент.
В-четвертых, командами создавать текст? Ты отважный человек...

[perpetule]

тут есть готовая ф-ция
_DRPK
http://dwg.ru/dnl/13203

[Ubivec81]

Сообщение от Кулик Алексей aka kpblc Во-первых, где файл, на котором неправильно срабатывает? Во-вторых, не советую преобразовывать углы в градусы - они и в радианах прекрасно обрабатываются (константу pi еще не отменили) В-третьих, попробуй пошагово пройти и посмотреть, чему у тебя равны переменные в каждый момент. В-четвертых, командами создавать текст? Ты отважный человек...

1. Файл в принципе с любым масштабником.
2. если не преобразовывать углы то как выводить текст если не командами.
3. Пошагово делал. на новом чертеже все работает отлично, а на масштабнике почему то ugl берется один и тот же.

Сообщение от тут есть готовая ф-ция _DRPK [url http://dwg.ru/dnl/13203[/url]

Спасибо! погляжу как работает. но теперь уже хочется и для себя разобраться.

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

Сообщение от Ubivec81 Файл в принципе с любым масштабником.

Вот ты ни фига не объяснил.

Сообщение от Ubivec81 если не преобразовывать углы то как выводить текст если не командами.

Программно

Сообщение от Ubivec81 Пошагово делал. на новом чертеже все работает отлично, а на масштабнике почему то ugl берется один и тот же.

Значит проверяй вычисления.

[Ubivec81]

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

[ShaggyDoc]

Сообщение от Ubivec81 Здравствуйте! Возникает проблема что на пустом чертеже все работает хорошо а при запуске на чертеже с масштабными планами текст не становится перпендикулярно линии разбивки, а идет с одним углом поворота.

Проверяй количество ответов в опциях команды _TEXT с учетом того, назначил ли постоянную высоту при создания стиля.

[Ubivec81]

Сообщение от ShaggyDoc Проверяй количество ответов в опциях команды _TEXT с учетом того, назначил ли постоянную высоту при создания стиля.

Стиль я создаю еще в начале с указанием высоты текста. Быть может и правда проблема во вставке текста командным путем! Подскажите хоть куда глядеть что бы можно было текст вставлять программно.
Не могу я понять почему в одно файле все хорошо а в другом все не так как хочется)))

[ShaggyDoc]

Сообщение от Ubivec81 Стиль я создаю еще в начале с указанием высоты текста. Быть может и правда проблема во вставке текста командным путем! Подскажите хоть куда глядеть что бы можно было текст вставлять программно. Не могу я понять почему в одно файле все хорошо а в другом все не так как хочется)))

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

А "не так, как хочется" - потому, что допускается "ChildErrorNumer2" - неправильное использование команды. Если уж зачем-то создавать текст именно командным методом, надо это также вынести в отдельную функцию. Например так :

Код:

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

 (defun ru-text-draw (txt pnt height rotation justification)

  ;; пишет текст txt от точки pnt высотой height угол rotation выравнивание justification
  ;; независимо от текущей установки высоты
  ;; даже если она фиксированная
;|
Пример вызова:
(while (setq pt (ru-get-point-or-exit "Начало текста" nil)) (ru-text-draw "Проба" pt (ru-normal-text-height) 0 "R"))
|;
  (ru-var-clear-osnap)
  ;; Вариант с командой
   (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))) 	 0.0       )
;;;       ;; нулевая высота текста
       (if justification
 	(vl-cmdf "_.TEXT" "_J" justification pnt height rotation txt)
 	(vl-cmdf "_.TEXT" pnt height rotation txt)
       ) ;_ end of if
       ;; фиксированнная высота
       (if justification
 	(vl-cmdf "_.TEXT" "_J" justification pnt rotation txt)
 	(vl-cmdf "_.TEXT" pnt rotation txt)
       ) ;_ end of if
   ) ;_ end of if
  (ru-lw-set-for-ent (entlast) (ru-lw-calc-for-text height))
  (ru-var-restore-osnap)
)

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

Код:

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

 (defun ru-text-add (txt pnt height rotation justification / obj)
;;; ВНИМАНИЕ! для выравнивания A или F передается не точка текста, а список из двух точек!!
  ;|

  (if (null justification)
    (setq justification acalignmentleft)
  ) ;_ end of if
  (ru-error-catch
    (function
      (lambda ()
        (setq
          obj
           (vla-addtext
             (ru-obj-active-space)
             txt
             (if
               (or (= justification acalignmentaligned)
                   (= justification acalignmentfit)
               ) ;_ end of or
                (vlax-3d-point (car pnt))
                (vlax-3d-point pnt)
             ) ;_ end of if
             height
           ) ;_ end of vla-AddText
        ) ;_ end of setq
        (ru-lw-set-for-obj obj (ru-lw-calc-for-text height))
        (cond
          ((= justification acalignmentleft)
           (vla-put-rotation obj rotation)
          )
          ((or (= justification acalignmentaligned)
               (= justification acalignmentfit)
           ) ;_ end of or
           (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint
             obj
             (vlax-3d-point (cadr pnt))
           ) ;_ end of vla-put-textalignmentpoint
          )
          (t
           (vla-put-alignment obj justification)
           (vla-put-textalignmentpoint obj (vlax-3d-point pnt))
           (vla-put-rotation obj rotation)
          )
        ) ;_ end of cond
        (vla-update obj)
        obj
      ) ;_ end of lambda
    ) ;_ end of cond
    (function (lambda (x) (princ (strcat "\nОШИБКА RU-TEXT-ADD: " x)) nil))
  ) ;_ end of ru-error-catch
) ;_ end of defun

[alex8888]

Я себе вот такую функцию написал, тоже текст программно вставляет.
Ее можно использовать и без параметров - вот так: (at_text nil), тогда она будет запросит точку вставки и сам текст, а остальные параметры подставит по умолчанию. В моем случае слой "Scrift", высота 30, угол поворота 0°, выравнивание по центру.

После функции я вписал то, что у меня идет как загрузка расширений и находится в других файлах, ну чтобы для полноты картины так сказать (чтобы заработала).

Код:

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

 
;|****************************************************************************
*            Модуль вставки текста                                           *
*   Пример вызова:                                                           *
*         (at_text (list ptm "сам текст" "schrift" 30 ugol 4))               *
*                 где ptm - точка вставки текста, обязательный параметр      *
*                     "сам текст" - текст сообщения, обязательный параметр   *
*                     "schrift" - слой для текста,  nil = "schrift"          *
*                     30 - высота текста, nil = 30                           *
*                     ugol - угол поворота текста в градусах, nil = 0        *
*                     4  - выравнивание, nil = acAlignmentMiddle             *
*      Составлен 20.07.2010  Автор: АТ                                       *
*      Изменения    20.09.2010-23.09.2010 ,09.11.2010                        *
******************************************************************************|;
(defun at_text (text_list	/		insert_point
		insert_text	text_layer	text_hoehe
		text_winkel	text_alignment	text_obj
	       )
;-------------------- Загрузка расширений -----------------------------------
  (vl-load-com)
  (begin_activex)

;-------------------- Разбор входящего списка -------------------------------
  (mapcar 'set '(insert_point insert_text text_layer text_hoehe text_winkel text_alignment) text_list)
;--------- Анализ входящих и получение значений по умолчанию ----------------
  (if (= insert_point nil)
    (progn
      (initget (+ 1 2 4))
      (setq  insert_point (getpoint "\nInsert Point: "))
       )					;progn
  )					;if
  (if (= insert_text nil)
    (setq insert_text
      (getstring T "\nInput Text: ")
        )					;getstring
  )					;if
(if (or (= text_layer nil)
    	(null (tblsearch "layer" text_layer))
     );or
    	(setq text_layer "schrift")
);if
  (if (= text_hoehe nil)
    (setq text_hoehe 30)
  )
  (if (= text_winkel nil)
    (setq text_winkel 0)
  )
  (if (= text_alignment nil)
    (setq text_alignment 4)
  )
  (if (= (type text_winkel) 'STR)
    (setq text_winkel (atof text_winkel))
  )					;if
  (if (= (type text_hoehe) 'STR)
    (setq text_hoehe (atof text_hoehe))
  )					;if
  (if (= (type insert_point) 'LIST)
    (setq insert_point (vlax-3d-point insert_point))
  )					;if
;-------------------- Тело функции ---------------------------------------
  (ru-error-catch
    (function
      (lambda ()
	(setq text_winkel (degrees_to_radians text_winkel)
	      text_obj	  (vla-addtext
			    model_space
			    insert_text
			    insert_point
			    text_hoehe
			  );vla-addtext
	);setq
	(vla-put-alignment text_obj text_alignment) ;см. Выравнивание
	(if (/= text_alignment 0)(vla-put-textalignmentpoint text_obj insert_point))
	(vla-put-layer text_obj text_layer)
	(vla-put-color text_obj 256)
	(vla-put-Rotation text_obj text_winkel)
	(vla-update text_obj)
      )	;lambda
    );function
    (function
      (lambda (x)
	(princ (strcat "\nFunktion at_text ERROR: " x))
	nil
      );lambda
    );function
  );ru-error-catch
  (princ)
);defun
;----------------------- Памятка ---------------------------------------
;Выравнивание:
; 0 acAlignmentLeft 
; 1 acAlignmentCenter 
; 2 acAlignmentRight 
; 3 acAlignmentAligned 
; 4 acAlignmentMiddle 
; 5 acAlignmentFit 
; 6 acAlignmentTopLeft 
; 7 acAlignmentTopCenter 
; 8 acAlignmentTopRight 
; 9 acAlignmentMiddleLeft 
; 10 acAlignmentMiddleCenter 
; 11 acAlignmentMiddleRight 
; 12 acAlignmentBottomLeft 
; 13 acAlignmentBottomCenter 
; 14 acAlignmentBottomRight



;-----------------------------------------------------------------------------------------------------------------------
; дополнительно



(defun begin_activex (/)
  
  (vl-load-com)				;Загрузка расширенний VLisp
  
  (setq acad_application (vlax-get-acad-object)
  					;док-т Автокада
        active_document (vla-get-ActiveDocument acad_application)
					;активный док-т Автокада
        model_space (vla-get-modelspace active_document)
					;пр-во модели активного док-та
        paper_space (vla-get-paperspace active_document)
					;пр-во листа активного док-та
   );setq
  
	(at_create_layer)		;пользовательские слои
  
)					;defun

;|****************************************************************************
*                                                                            *
*            Функция создания слоя                                           *
*                                                                            *
*   Пример вызова:                                                           *
*         at_create_layer "Имя"                                              *
*                                                                            *
*   Составлена 08.09.2010  Автор: от Reinaldo Togores <rtogores@mundivia.es> *
*                                                                            *
******************************************************************************
|;
(defun at_create_layer ( / laynam)	; 

    ; (setq laynam (getstring "\nНазвание слоя: "));получение имени слоя
      ; (entmake	
        ; (list
          ; '(0 . "LAYER")	;тип примитива - слой
          ; '(5 . "28") ; метка примитива
          ; '(100 . "AcDbSymbolTableRecord") ;маркер данных подкласса
          ; '(100 . "AcDbLayerTableRecord")	;маркер данных подкласса
          ; (cons 2 laynam) ;наименование слоя
          ; '(70 . 64); режим ?
          ; '(62 . 7) ;цвет слоя
          ; '(6 . "CONTINUOUS") ;тип линий слоя
      ; )
    ; )

;layer "schrift"
	(entmake	
        (list
           '(0 . "LAYER")	;тип примитива - слой
           '(5 . "28") ; метка примитива
           '(100 . "AcDbSymbolTableRecord") ;маркер данных подкласса
           '(100 . "AcDbLayerTableRecord")	;маркер данных подкласса
           '(2 . "schrift") ;наименование слоя
           '(70 . 64); режим ?
           '(62 . 4) ;цвет слоя
           '(6 . "CONTINUOUS") ;тип линий слоя
		)
	)	

;layer "TEXT"
	(entmake	
        (list
           '(0 . "LAYER")	;тип примитива - слой
           '(5 . "28") ; метка примитива
           '(100 . "AcDbSymbolTableRecord") ;маркер данных подкласса
           '(100 . "AcDbLayerTableRecord")	;маркер данных подкласса
           '(2 . "TEXT") ;наименование слоя
           '(70 . 64); режим ?
           '(62 . 2) ;цвет слоя
           '(6 . "CONTINUOUS") ;тип линий слоя
		)
	)	
)

)

[Vladimir_Sergeevich]

Господа товарищи, заболел новой идеей! Суть такова: на плане сгенерировнным робуром надо:
1) Найти группы объектов (это я сделал в первом приближении)
2) Преобразовать эти группы в анонимные аннотативные блоки.
Насколько это реализуемо и в какую сторону рыть?
Для наглядности прикладываю пример рисунка: прямоугольниками обведены те самые группы объектов, которые надо преобразовывать (элементы кривых в плане) собственно их рисовал программно по ним же и идет выбор "_WP"
P.S. Аннотативность нужна до зарезу, с анонимностью спорно, но желательно, ибо осей может быть много и каждый должен быть индивидуальным.

[T.Bagdat]

Извиняюсь за дилетантщину, но надеюсь, тут все к этому привыкли, поэтому всё же осмелюсь спросить.

В лиспе небезызвестной pltools, в команде MPL есть такие строки:

Код:

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

	  (setq	dL
		 (if
		   (setq dL (getint "\nКоличество опорных точек <100>: "))
		    dL
		    100
		 )
	  )

И каждый раз при вызове, команда, запрашивая число опорных точек, по умолчанию предлагает 100.

А вот родная автокадовская команда OFFSET при новом вызове помнит, какое расстояние вводили в прошлый раз, и при очередном запуске предлагает значение, которое весит в памяти.

Можно ли это в лиспе реализовать, и если можно то как? Вот объявил я глобальную переменную, ну скажем velichina. Задал её при первом вызове команды, и хочу, чтобы при новом вызове предлагалось текущее значение. Если пишу "\nКоличество опорных точек <velichina>: ", то он так же и выдаёт <velichina>. Пишу с восклицательным знаком, и выдаёт с восклицательным. Как заставить выводить значение переменной, а не её имя?

[kakt00z]

(setq dL
(if
(setq dL (getint (strcat "\nКоличество опорных точек <" (itoa dL) ">: ")))
dL
100
)
)

[T.Bagdat]

kakt00z, большое спасибо за подсказку.
Данный код имеет огрех. Если значение переменной уже отличается от 100, и составляет, к примеру 50, то запрос будет выглядеть так:

Количество опорных точек <50.0000>:

Но при нажатии Enter, в переменную всё равно вносится значение 100
Победил следующим образом:
dL - глобальная переменная
dl1 - локальная переменная

Код:

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

	  (setq	dL1 dl)
	  (setq	dL
		 (if
		   (setq dL (getreal (strcat "\nКоличество опорных точек <" (rtos dL) ">: ")))
		    dL
		    dL1
		 )
	  )
	  (setq	dL1 dL)

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

А если примерно так:

Код:

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

 (setq dl (cond
           ((getreal (strcat "\nКоличество опорных точек <"
                             (rtos (cond
                                     (dl)
                                     (t 100.)
                                     ) ;_ end of cond
                                   2
                                   2
                                   ) ;_ end of rtos
                             "> : "
                             ) ;_ end of strcat
                     ) ;_ end of getreal
            )
           (dl)
           (t 100.)
           ) ;_ end of cond
      ) ;_ end of setq

[gomer]

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

Для преобразования целого в строку существует функция itoa

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

Ага, целого. А запрашивается real, хранится real. В любом случае, в качестве иллюстрации будет достаточно, я думаю.

[T.Bagdat]

gomer, код из MPL я привёл лишь в качестве примера, а мне требуется именно вещественное число.

Кулик Алексей aka kpblc, очень изящное решение. Удалось сэкономить на одной переменной. Большое спасибо.

[gomer]

Сообщение от T.Bagdat очень изящное решение.

корявое это решение... хотя бы так

Код:

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

 (or (numberp dl)
    (setq dl 100.0)
)

(setq dl (cond ((getreal
                  (strcat "\nУкажите вещественное число "
                          "<"
                          (rtos dl 2 (getvar 'luprec))
                          "> : "
                  )
                )
               )
               (dl)
         )
)

[mkung]

Добрый день.
Можно ли из Автокада работать с объектной моделью другого запущенного приложения?
Например, получить ссылку на файл из системы документооборота?
Если да - то как "залезть" в чужую модель?
Заранее благодарен.

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

Сообщение от mkung Можно ли из Автокада работать с объектной моделью другого запущенного приложения?

Можно. При соблюдении хотя бы одного из условий: у другого приложения реализована СОМ-модель либо есть файлы библиотек (tlb), к которым можно "подконнектиться".

----- добавлено через 35 сек. -----

Сообщение от mkung как "залезть" в чужую модель?

Поищи примеры работы с файлами Excel - в качестве примера покатит, думаю.

[mkung]

Сообщение от Кулик Алексей aka kpblc Можно. При соблюдении хотя бы одного из условий: у другого приложения реализована СОМ-модель

Можно ли Лиспом еще как-то посмотреть свойства и методы если:
(vlax-dump-object (vlax-get-or-create-object "LotsiaPDM.Application"))
; Объект не поддерживает интерфейс ITypeInfo

----- добавлено через ~4 ч. -----
Программист ЛОЦИИ написал на С# как добраться до нужного пути к файлу:

1 Создание экземпляра Лоции GlobalVar.LPDM = new LotsiaPDM.Application(); 2 Создание сервисного объекта GlobalVAR.Service = GlobalVAR.LPDM.CreateObjectService(); 3. Инициализация действия в Лоции (выполнение метода) DPDMOperation selectOper = GlobalVar.LPDM.GetOperation(70000235); 4. Выполнение действия (выполнение метода) selectOper.Execute() 5. Получения переменной из действия decimal idDocSignLarge = selectOper.GetVarValue("SignLargeDoc"); decimal idDocSignSmall = selectOper.GetVarValue("SignSmallDoc"); decimal idDocSignVect = selectOper.GetVarValue("SignVectDoc"); 6. Получение документа (картинки) по его id DPDMDocumentVersion docVer = GlobalVAR.Service.GetDocumentVersion(idDocSignVect); 7. Открытие документа в лоции string pathFile = GlobalVAR.LPDM.OpenDocumentVersion(docVer.ID, true); в результате в переменной pathFile будет полный путь до файла 8. Закрыть документ Лоции, обязательно. GlobalVAR.LPDM.CloseDocumentVersion(docVer.ID);

Может ли кто-то помочь перевести это в ЛИСП. Что-то у самого не получается...

[posetitel]

извините за глупый вопрос, но сам не разобрался:
как сделать, чтобы при вызове команды, присваивался определенный параметр автоматически?
например, я набираю "-слой", и мне предлагается несколько вариантов параметров, а мне необходимо, чтобы сразу выбирался параметр "С" (создать), т.е. по команде "-слой" сразу же создавался новый слой, а я вводил только его имя.
(пробовал код Крыса: (command "_.-layer" "_n" "Layer2" ""), но он у меня почему-то не работает )

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

mkung, боюсь, что никак. Если не удается создать объект (или получить на него указатель), то дальше можно особо не рыпаться.

----- добавлено через 20 сек. -----
posetitel, Download -> "В.Свет Язык макрокоманд".

[Дима_]

можно - в поиск по словам autolisp excel (просто это самый частый подобный вопрос).
ops. - это я кажется с десяток другой сообщений пропустил
з.ы. нет всего пять

[mkung]

Сообщение от Кулик Алексей aka kpblc mkung, боюсь, что никак. Если не удается создать объект (или получить на него указатель), то дальше можно особо не рыпаться.

Да указатель то на объект LotsiaPDM.Application я получаю.
А вот дальше с методами - что-то все nil возвращается...

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

Тогда попробуй использовать vla-invoke-method, vlax-invoke, vlax-put-property, vlax-get-property. Названия методов и свойств, а также количество и возможные значения параметров надо будет брать из руководства по программированию для Лоции.

[Vladimir_Sergeevich]

mkung, можно, если эта сисема имеет com-модель. Подробнее у Полещука "10.4 Пример работы с внешним приложением". Ну и в довесок, на форуме были примеры экспорта/импорта из экселя

[ShaggyDoc]

Сообщение от Vladimir_Sergeevich mkung, можно, если эта сисема имеет com-модель.

Не просто COM-модель, а должен быть Automation Object, а не COM object. Иначе из "скриптовых" языков, таких как Lisp, доступа не будет.

[mkung]

Сообщение от ShaggyDoc Не просто COM-модель, а должен быть Automation Object, а не COM object. Иначе из "скриптовых" языков, таких как Lisp, доступа не будет.

Как это проверить?

[T.Bagdat]

Сообщение от gomer хотя бы так Код: [Выделить все] (or (numberp dl) (setq dl 100.0) ) (setq dl (cond ((getreal (strcat "\nУкажите вещественное число " "<" (rtos dl 2 (getvar 'luprec)) "> : " ) ) ) (dl) ) )

Сначала у меня это не заработало. Потом на пару недель замотался. А сейчас вернулся к этому, и заменив

Код:

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

(or (numberp dl)
    (setq dl 100.0)
)

на

Код:

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

(if (null dl)
    (setq dl 100.0)
)

получил вполне годный алгоритм.

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

[gomer]

Сообщение от T.Bagdat Сначала у меня это не заработало. Потом на пару недель замотался. А сейчас вернулся к этому, и заменив Код: [Выделить все] (or (numberp dl) (setq dl 100.0) ) на Код: [Выделить все] (if (null dl) (setq dl 100.0) ) получил вполне годный алгоритм.

что значит не заработало? второй вариант имеет уязвимость, так как (null dl)==> nil не означает (numberp dl) ==> T. кроме этого момента эти варианты эквивалентны

[trushev]

Согласно описанию функция работает с символами LISP.
У меня список с вложенными списками.
На простом примере получаю ожидаемый результат:

Код:

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

           ;        0           1           2                 3            4
(setq sp (list '(1 2 3 4 5) '(6 7 8 9) '("a" "b" "c" "d") '(3 2 5) '("a" "d" 7.2 3.7))
       s (subst (list "f" "s") (list "a" "b" "c" "d") sp)
)

выполняет замену 2-го элемента на новый.
Но на более сложном списке с 22 подсписками с суммарной длиной порядка 6000 символов замены на новый элемент не происходит.
Не могу поймать свою ошибку. Или у функции есть ограничения?

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

Ты в качестве "старого" значения попробуй подставлять не вбитое вручную, а полученное через nth или assoc значение. Ну и проверь на повторы - тоже бывают забавные случаи.

[trushev]

Сообщение от Кулик Алексей aka kpblc бывают забавные случаи.

Заработало! Не выполнялось обновление "нового". Списки "новый" и "старый" были идентичны.

[T.Bagdat]

gomer, видимо, с определённой кривизной рук даже в ctrl+C > ctrl+V можно запутаться
Попробовал ещё раз, и впрямь всё работает. Спасибо.

[Wolkodaw]

Добрый день! Возможно ли на лиспе сделать сортировку списка vla-объектов по координате х левого нижнего угла? Пробую функцией vl-sort, но как туда записать метод vla-GetBoundingBox, которая не возвращает значение, ума не приложу. Кто-нибудь может подсказать как можно сделать?

[P_S]

Wolkodaw, всё это есть в Help:
(vla-GetBoundingBox vla-obj 'MinPt 'MaxPt), и имеешь 2 переменные MinPt и MaxPt с присвоенными им значениями. Только апострофы поставить не забудь.

[Wolkodaw]

я в курсе может я не ясно выразился, но спрашивал не как пользоваться методом vla-GetBoundingBox, а как сортировать по 'MinPt список? а точнее по координате х левого нижнего угла список vla-объектов?

[P_S]

Хотя бы так: если lst - это список vla-объектов,

Код:

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

 (mapcar(function cadr)
 (vl-sort      
(mapcar '(lambda (x)(vla-GetBoundingBox x 'MinPt 'MaxPt)
	   (list (vlax-safearray->list MinPt) x))lst);mapcar
(function(lambda (e1 e2)(< (caar e1) (caar e2))))
);vl-sort
       );mapcar

[Wolkodaw]

Спасибо большое, а то вообще голову сломал, попробуем...

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

Или так:

Код:

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

 (defun test (/ selset)
  (setq selset (ssget)
        selset ((lambda (/ tab item)
                  (repeat (setq tab  nil
                                item (sslength selset)
                                ) ;_ end setq
                    (setq tab (cons (ssname selset (setq item (1- item))) tab))
                    ) ;_ end of repeat
                  ) ;_ end of lambda
                )
        ) ;_ end of setq
  (vl-sort
    (mapcar (function vlax-ename->vla-object) selset)
    (function (lambda (a b / minpa minpb maxp)
                (vla-getboundingbox a 'minpa 'maxp)
                (vla-getboundingbox b 'minpb 'maxp)
                (setq minpa (vlax-safearray->list minpa)
                      minpb (vlax-safearray->list minpb)
                      ) ;_ end of setq
                (< (car minpa) (car minpb))
                ) ;_ end of lambda
              ) ;_ end of function
    ) ;_ end of vl-sort
  ) ;_ end of defun

Но при условии одинаковых координат по Х результат может быть странноватым ))

[mihamster]

почитал форум, как понял "переменные во вне документном пространстве" такая, больная темка на данный момент)
у меня не совсем про это вопрос, но новую тему создать не решился)

возникло непонимание..
необходимо вынести во вне документное пространство переменную со списком характеристик примитива('ов).
но при попытках сделать это через vl-bb-set или vl-propagate выходит ошибка "неверный импорт\экспорт между док-ми <имя объекта......>"
возникает она из за наличия в списке пар с dxf-кодами -1 и 330.. т.е. в которых после кода стоит "<имя объекта.....>", если их убрать никаких проблем не возникает, и переменная со списком спокойно передается и считывается в другом документе.
подскажите, что это и с чем едят или направьте куда)

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

dxf reference - там написано, что в какой группе лежит.

[mihamster]

Я понимаю, что -1 это имя объекта.. 330 это id..
Этим данным запрещено передаваться в другие док-ты?

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

330 (по умолчанию) - указатель на "владельца" примитива.
Вообще говоря, я не очень понимаю, зачем надо хранить полное представление примитива во внедокументном пространстве. Может, проще выполнить нечто типа _.wblock в указанный файл, а в переменную просто загонять полное имя созданного файла? Ну и при необходимости его и обрабатывать.
P.S. Хотя для работы с неактивным документом можно и без этого обойтись.

[frostmourn]

mihamster, vl-princ-to-string не подойдёт? В таком виде передаётся.

[mihamster]

Действительно, сами имена объекта и id владельца мне в списке не нужны.
Но они неотъмлемая часть списка извлекаемого entget.
И получается проще их просто удалить.
Просто думал, может есть какая то хитрость или что то простое в решении.
Спасибо.

[skkkk]

Столкнулся в 2011-м Автокаде с такой незадачей: если в имени слоя присутствует знак диаметра, то при обращении к этому имени лисп видит вместо знака диаметра вопросительный.
В связи с этим, обращение к этому слою через имя провоцирует ошибку. Например:

Код:

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

 (vla-get-Lock 
	(vla-Item 
		(vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object)))
		(vla-get-Layer (vlax-ename->vla-object (car (entsel))))))

; ошибка: Ошибка Automation. Ключ не найден

Я понимаю, что не стоит использовать подобного рода знаки для именования слоев, особенно, если я хочу работать программно с этим файлом, однако имеем то, что имеем, и всё же: как можно в таком случае проверить на блокировку слой выбранного объекта?

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

Нну... Полагаю, тут дело в "нехватке" стандартной кодировки.

[skkkk]

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

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

Не использовать символы типа диаметра )))

[skkkk]

А мыслей, как обратиться к слою некоего объекта, НЕ через его (слоя) имя у тебя нет?

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

Без файла и конкретной задачи - пока нет.

[skkkk]

Это можно. Оставил в файле только то, что лаконично необходимо и достаточно для понимания смысла, который вложил во все это автор. Теперь мне приходится программно работать с объектами на таких слоях, вот в частности мой код несколькими постами выше не срабатывает.

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

ПОпробовал нечто типа

Код:

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

 (setq lst ((LAMBDA( / res ) (vlax-for item(vla-get-layers (vla-get-ActiveDocument(vlax-get-acad-object)))
(setq res (cons (vlax-vla-object->ename item) res)))res)))

Обнаружил прикольный момент: vla-get-name подставляет "?", а (cdr(assoc 2 (entget ...))) - "\U+2205108x4.0". Может, в эту сторону покопаться?

[skkkk]

Алексей, знаешь, я и проверять почему-то сразу даже не стал через (entget), подумал, что раз уж продвинутая объектная модель не умеет кодировки понимать, куда уж там... А вот тебе, бабушка, и автолиспов день!
В общем, не мудрствуя, обнаружилось, что конструкция

Код:

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

 (vla-get-Lock (vla-Item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (cdr (assoc 8 (entget (car (entsel)))))))

сработала без лишних вопросов. Как всегда спасибо чрезвычайное тебе, Алексей .
Offtop: А вы всё vla-vla-vla...

[gomer]

Сообщение от skkkk А вот тебе, бабушка, и автолиспов день!

а функцию tblsearch не знал да еще и забыл?

[sathalex]

Подскажите, что мне поправить в этом коде, чтоб высота текста была не 3, а 0.3 ? Спасибо.

Код:

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

 (defun c:date_MV( / dat tday tmon tyer strok pt pt1 old_cmd osm *error*) 
 (defun *error* (msg)(princ msg)(setvar "OSMODE" osm)) 
 (setq old_cmd  (getvar "CMDECHO") 
           osm  (getvar "OSMODE")) 
 (setvar "CMDECHO" 0) 
  
 (setq dat (itoa (fix(getvar "CDATE"))) 
      tday (substr dat 7 2) 
      tmon (substr dat 5 2) 
      tyer (substr dat 3 2) 
    strok (strcat "" tday "." tmon "." tyer "") 
        pt (getpoint "\nТочка вставки текста: ") 
 ) 
 (setq pt (list (+(car pt) 1.) (+(cadr pt) 1.))) 
 (setq pt1 (list (+(car pt) 8.) (+(cadr pt) 0.))) 
 (setvar "OSMODE" 0) 
(if (zerop (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))) 
  (COMMAND "_TEXT" "_j" "_f" pt pt1 3.0 strok) ;_ нулевая высота текста Будет запрос высоты 
  (COMMAND "_TEXT" "_j" "_f" pt pt1 strok)     ;_ фиксированнная высота Запроса не будет 
  );_end of if
 ;;;Высота 3 ===== 
 (setq strok (entget(entlast))) 
 (setq strok (subst (cons 40 3.0)(assoc 40 strok) strok)) 
 (entmod strok) 
 ;;;======  
 (setvar "CMDECHO" old_cmd) 
 (setvar "OSMODE" osm) 
 (princ) 
)

[Vladimir_Sergeevich]

строки 19 и 23.
По идее можно только в 23, ибо там все равно исправит на нужный (cons 40 0.3)

[sathalex]

Сообщение от Vladimir_Sergeevich строки 19 и 23. По идее можно только в 23, ибо там все равно исправит на нужный (cons 40 0.3)

Спасибо. А как бы мне еще сделать чтоб вставлялось не текст, а мтекст?

[skkkk]

Сообщение от sathalex как бы мне еще сделать чтоб вставлялось не текст, а мтекст?

Посмотреть опции команды MTEXT, а лучше -MTEXT, например, здесь и прописать их в тех же строках, начинающихся с (command.... Опции - в кавычках, предваряя знаком подчеркивания (например, "_J"), а переменные (strok) - без кавычек. Возможно, придется чуток поэкспериментировать.

[kurstep]

Кто нибудь сталкивался с тем что при копировании через буфер обмена русского текста в редактор visual lisp иногда вместо символов текста выводятся знаки вопроса. Тут видимо дело в кодировке. Есть ли способ избавиться от этого?

[Сергей812]

Сообщение от kurstep Кто нибудь сталкивался с тем что при копировании через буфер обмена русского текста в редактор visual lisp иногда вместо символов текста выводятся знаки вопроса. Тут видимо дело в кодировке. Есть ли способ избавиться от этого?

перед копированием и в источнике, и в редакторе lisp перейдите на русский.. а потом лишь копируйте... такая же ерунда в редакторе VBA - думаю, поможет)

[Jerald]

Коллеги, не подскажите, как отключить предупреждение системы безопасности при автоподгрузке .lsp?

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

http://adn-cis.org/search.html?query=secure
http://adn-cis.org/acad2016-news.html
http://adn-cis.org/webinar-acad2016-news-report.html

[sathalex]

Сообщение от Jerald как отключить предупреждение системы безопасности при автоподгрузке .lsp?

Вот так...

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

Не советую поступать именно так.

[trushev]

Сообщение от Кулик Алексей aka kpblc Не советую поступать именно так.

А если так:
Включить в "Доверенное местоположение". (Настройки-Файлы). Путь с именем папки, где размещенны lisp-файлы (включая вложенные папки), завершить флешем с троеточием - \...

[mkung]

Удалено

[kacugu]

Offtop: удалил

[kacugu]

Offtop: удалил

[mkung]

Хранится ли в чертеже информация о том, в каком вертикальном приложении он был создан (Electrical, Civil 3D и т.д.)?
Если да - то где и как достать Лиспом?
Заранее благодарен.

[gomer]

Всех с праздничком!

[Neo]

помогите понять идеологию работы со списками. есть список вида (("1" "a" "b") ("1" "c" "d") ("2" "e" "f")), полученный в результате sql запроса. Как получить ассоциативный список вида: (("1" ("a" "b")("c" "d"))("2" ("e" "f"))).

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

Neo, теоречически - получаешь список первых элементов, убираешь дубликаты, а потом проходишь по всему списку и группируешь остатки.

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

Код:

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

 (defun test (lst / res)
  (mapcar
    (function
      (lambda (x)
        (if (member (car x) (mapcar (function car) res))
          (setq res (subst (cons (car x) (append (list (cdr (assoc (car x) res))) (list (cdr x))))
                           (assoc (car x) res)
                           res
                           ) ;_ end of subst
                ) ;_ end of setq
          (setq res (cons x res))
          ) ;_ end of if
        ) ;_ end of lambda
      ) ;_ end of function
    lst
    ) ;_ end of mapcar
  res
  ) ;_ end of defun
;|
_$ (test '(("1" "a" "b") ("1" "c" "d") ("2" "e" "f")))
(("2" "e" "f") ("1" ("a" "b") ("c" "d")))
|;

[Neo]

Спасибо. буду разбираться. А объясни использование (function (lambda вместо '(lambda. При добавлении function компилятор оптимизирует функцию, как и где это заметить?

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

Где проверить: http://autolisp.ru/2009/09/20/execution-speed-check/
И у применения function есть еще один плюс: можно поставить точку останова внутри анонимной функции. Иногда полезно.

[frostmourn]

Доброго дня. Можно ли как-нибудь без полного открытия файла чертежа достать из него системную переменную? Пока делаю так

Код:

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

 (vla-open (vla-get-documents (vlax-get-acad-object)) (vla-get-path <тут название>) :vlax-true)

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

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

Ну так открывай через ObjectDBX, получай указатель на объект документа, а потом (vla-getvariable УказательНаДокумент НазваниеПеременной)

[frostmourn]

Так он (ODBX) не даёт же доступа к системным переменным?..
И при попытке сделать (vla-getvariable ...) говорит - неизвестное имя: GetVariable.

[Pavel_GP]

Привет.
Есть код автор ув. akka_KPbIC

Код:

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

  (defun test (/ _kpblc-conv-list-to-2dpoints _kpblc-conv-vla-to-list ent bit coords idx)
  (defun _kpblc-conv-list-to-2dpoints (lst / res)
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-2dpoints (cddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
    (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 vlax-for
       ) ;_ end of cond
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (car (entsel "\nSelect LWPolyline <Cancel> : "))
                                    ) ;_ end of LAMBDA
                                  ) ;_ end of function
                                ) ;_ end of VL-CATCH-ALL-APPLY
                          ) ;_ end of setq
                    ) ;_ end of type
              'ename
              ) ;_ end of =
           (setq ent (vlax-ename->vla-object ent))
           (= (vla-get-objectname ent) "AcDbPolyline")
           ) ;_ end of and
    (progn
      (setq bit 0
            idx 0
            ) ;_ end of setq
      (foreach vertex (_kpblc-conv-list-to-2dpoints (_kpblc-conv-vla-to-list (vla-get-coordinates ent)))
;;; Здесь ты делаешь то, что считаешь нужным
        (setq coords (cons (cond
                             ((= bit 0) (list (+ (car vertex) 10.) (cadr vertex)))
                             ((= bit 1) (list (car vertex) (+ (cadr vertex) 10.)))
                             ((= bit 2) (list (- (car vertex) 10.) (cadr vertex)))
                             ((= bit 3) (list (car vertex) (- (cadr vertex) 10.)))
                             ) ;_ end of cond
                           coords
                           ) ;_ end of cons
              bit    (if (> bit 2)
                       0
                       (1+ bit)
                       ) ;_ end of if
              ) ;_ end of setq
        ) ;_ end of foreach
      (setq coords (apply (function append) (reverse coords)))
;;; И теперь чохом назначаешь все координаты в полилинию
      (vla-put-coordinates ent
                           (vlax-make-variant
                             (vlax-safearray-fill
                               (vlax-make-safearray
                                 vlax-vbdouble
                                 (cons 0 (1- (length coords)))
                                 ) ;_ end of vlax-make-safearray
                               coords
                               ) ;_ end of vlax-safearray-fill
                             ) ;_ end of vlax-make-variant
                           ) ;_ end of vla-put-Coordinates
      (vla-update ent)
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

, тему начали тут http://forum.dwg.ru/showthread.php?t=65178&page=2
По размыслив почитав vla-семейства, попытаюсь написать, как я понимаю твое решение:
1. Создал две функции преобразований списка координат в список чисел и обратно.
2. Далее, выбираем полилинию и если это полилиния, то идем далее
3. Потом не плохой ухват, запуск цикла функцией foreach и тут внутри цикла есть доп.вопросики:
а. Внутри цикла это не пример? а необходимый код?
б. Из vertex я могу достать X и Y, они мне нужны для корректировки, у меня будет формула их изменения.
4. После того как координаты изменились у вершин полилинии можно строить новую полилинию, но вопросик где прописано постройка новой полилинии? Вроде пока всё.

Да, чуть не забыл, кто не в курсе вопрос стоял в том, что есть полилиния (простая), изменяя координаты вершин полилинии (любые математические действия), строим рядом новую полилинию.
Спс.

[Sleekka]

Скажите, что сделать то нужно.

[Pavel_GP]

Сообщение от Sleekka Скажите, что сделать то нужно.

Есть полилиния, необходимо построить новую, изменяя координаты вершин исходной полилинии. Координаты изменяются по формуле (какие-то математические действия с координатой X и Y). Полилиния м.б. много вершинная от 2 до ...
Вот ещё что, у меня полилиния нового формата не LWpolyline, а просто Polyline
При выборе полилинии равенство подтверждается

Код:

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

 (= (vla-get-objectname ent) "AcDbPolyline")

.

Идем далее

Код:

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

 (setq coords (cons (cond
                             ((= bit 0) (list (+ (car vertex) 10.) (cadr vertex)))
                             ((= bit 1) (list (car vertex) (+ (cadr vertex) 10.)))
                             ((= bit 2) (list (- (car vertex) 10.) (cadr vertex)))
                             ((= bit 3) (list (car vertex) (- (cadr vertex) 10.)))
                             ) ;_ end of cond
                           coords
                           ) ;_ end of cons
              bit    (if (> bit 2)
                       0
                       (1+ bit)
                       ) ;_ end of if
              ) ;_ end of setq

тут я понял ты привел пример получения новых координат вершин, тогда вопрос:
bit почему именно до 3, какую роль они играют в твоем решении (примера)? В моем случае одна формула будет для всех X и одна для всех Y

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

Pavel_GP, так тебе надо строить новую или менять существующую? Разница принципиальная: у меня код меняет существующую полилинию. Попробую ответить по пунктам

Сообщение от Pavel_GP 1. Создал две функции преобразований списка координат в список чисел и обратно.

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

Сообщение от Pavel_GP 2. Далее, выбираем полилинию и если это полилиния, то идем далее

Верно

Сообщение от Pavel_GP 3. Потом не плохой ухват, запуск цикла функцией foreach и тут внутри цикла есть доп.вопросики:

Не совсем так. Запускается foreach, объявляется итератор (ну типа счетчика) и сразу вычисляется список, по которму будет выполняться проходка. Вычисление выполняется только при старте foreach.

Сообщение от Pavel_GP Внутри цикла это не пример? а необходимый код?

Пополам. Результат вычислений где-то надо бы сохранить, для этого служит coords

Сообщение от Pavel_GP Из vertex я могу достать X и Y, они мне нужны для корректировки, у меня будет формула их изменения.

Да легко!

Сообщение от Pavel_GP После того как координаты изменились у вершин полилинии можно строить новую полилинию, но вопросик где прописано постройка новой полилинии? Вроде пока всё.

Почти. Вычисленные новые координаты приводятся в вид variant (т.н. безопасный массив) и подставляются как координаты старой полилинии. В результате она получит новые координаты вершин. Ширина, кривизна и проч. не меняются

Сообщение от Pavel_GP bit почему именно до 3, какую роль они играют в твоем решении (примера)? В моем случае одна формула будет для всех X и одна для всех Y

Это как раз пример. Если у тебя вычисление новой координаты выполняется какой-то функцией типа (eval-new-coords x y), то и пиши (setq coords (cons (eval-new-coords (car vertex) (cadr vertex)) coords)) - этого по идее должно быть достаточно.

[Pavel_GP]

Спасибо, что разжевал всё подробно

Сообщение от Кулик Алексей aka kpblc надо строить новую

Верно новую.

Будут вопросики отпишу. Пока тестю.

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

Если новую, то сразу вопросы: слой, тип и вес линии откуда брать? Elevation, Thickness, слой? Как учитывать кривизну элементов? Предустановленную ширину сегментов (возможно, переменную)?

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Если новую, то сразу вопросы: слой, тип и вес линии откуда брать? Elevation, Thickness, слой? Как учитывать кривизну элементов? Предустановленную ширину сегментов (возможно, переменную)?

слой тот же, тип линии CONTI, вес линии 0.3, цвет Красный.
Подскажи плз функцию выбора, как в функции offset, когда пользователю предоставляется выбор кликнуть мышкой с какой стороны построить. У меня сложный расчет изменения координат вершин, (я пытаюсь создать программку на подобие оффсета, только расстояние у меня будет не на плоскости на эллипсоиде, поэтому и приходится формулой преобразовывать координаты вершин), будет задействован угол (перпендикуляр к полилинии).

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

Во-первых, есть метод vla-offset. Во-вторых, для вычисления первой и второй производной в любой точке любой кривой есть функции vlax-curve-getfirstderiv и vlax-curve-getsecondderiv. Описание есть в справке

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc метод vla-offset.

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

Сообщение от Кулик Алексей aka kpblc функции vlax-curve-getfirstderiv и vlax-curve-getsecondderiv

С помощью этих функций можно вычислить координаты вершин, только не понимаю, как мне их применить?, и зачем мы уже их вычислили

С можешь отредактировать нижнюю часть своего решения? ( см. #2726)

Работаю пока над основной формулой вычисления внутри foreach

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

Так создавай новую полилинию, через vla-addlightweightpolyline, задавай полученному примитиву нужные свойства. Принцип не изменится: получить примитив, собрать координаты, создать новый.
P.S. В принципе, можно и через ename сделать - возможно, так даже будет более интересно.

[Pavel_GP]

Спс. тут я понял.
Вопрос:
Мне необходимо получение угла( это все нужно в формулу получения новых координат вершин, которая определяется внутри foreach), после выбора стороны смещения

Код:

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

 (setq	pt
		 (getpoint "\n Уажите точку, определяющую сторону смещения"
		 )
	  ) ;_end setq pt

Это угол будет меняться от сегмента к сегменту пока не дойдет до последней вершины. Угол равен + - 90° (зависти от стороны смещения) от направления сегмента полилинии
и куда его вставить в твое решение?

[Pavel_GP]

Привет.

Код:

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

 (setq n 0)
	      (while (/= (nth (1+ n) xy_v) nil)
		(setq angl_1 (append
			     angl_1
			     (list (- pi
				      (angle (nth n xy_v) (nth (1+ n) xy_v))
				   )
			     )
			   )
		      n	   (1+ n)
		) ;_end setq
	      ) ;_end while

, где xy_v список координат ( (x1 y1) (x2 y2) .... (xn yn))
Как составить такой вариант список углов (угол (/ (угол+угол1) 2.) (/ (угол1+угол2) 2.) .... уголn)
Спс.

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

(append angl_1 (list (car angl_1)))

[Pavel_GP]

Это замыкать (1 2 3 4 1)
Я просил такой тип (a (/ (a+b) 2.) (/ (b+c) 2.) ... (/ (g+n) 2.) n), где второй список это среднее между 1 и 2 углами и т.д. а последний угол это просто угол.
Пример: Полилиния из двух сегментов список такой (a ((a+b)/2) b) (три угла)
Полилиния из пяти сегментов список такой (a ((a+b)/2) ((b+c)/2) ((c+d)/2) ((d+e)/2) e) (шесть углов)

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

Pavel_GP, ты отредактировал пост позднее, чем я дал ответ.

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc (append angl_1 (list (car angl_1)))

Вместо car ты наверное хотел поставить cdr

----- добавлено через 54 сек. -----

Сорь, мысли гуляют пытаюсь внятное подать

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

Ты сначала просил дополнить список - поставить в конец первый элемент. Я дал решение.
P.S. С

Сообщение от Pavel_GP (a (/ (a+b) 2.) (/ (b+c) 2.) ... (/ (g+n) 2.) n), где второй список это среднее между 1 и 2 углами и т.д. а последний угол это просто угол

просто угол - это откуда докуда угол? В качестве варианта:

Код:

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

 (defun tt (lst / res count)
  ;; (tt (mapcar 'cdr (vl-remove-if-not '(LAMBDA(x)(=(car x) 10)) (entget(car(entsel))))))
  (setq count 0)
  (mapcar
    (function
      (lambda (x / tmp)
          ;  (- pi
        (cond
          ((= count 0)
           (setq tmp   (angle x (nth (1+ count) lst))
                 count (1+ count)
                 ) ;_ end of setq
           tmp
           )
          ((= count (1- (length lst))) (angle (nth (1- count) lst) x))
          (t
           (setq tmp   (* (+ (angle (nth (1- count) lst) x)
                             (angle x (nth (1+ count) lst))
                             ) ;_ end of +
                          0.5
                          ) ;_ end of *
                 count (1+ count)
                 ) ;_ end of setq
           tmp
           )
          ) ;_ end of cond
          ; ) ;_ end of -
        ) ;_ end of lambda
      ) ;_ end of function
    lst
    ) ;_ end of mapcar
  ) ;_ end of defun

[Pavel_GP]

Спс.
1. Куда вставить функцию, где ее применить?
2. Если применить вот так ( setq ugol (tt angl_1)), то не правильный тип аргумента 2D/3D, скорее всего ругается функция angle.
3. Если убрать комментарий (;; (tt ....)), то требуется выбрать объект.

Сообщение от Кулик Алексей aka kpblc просто угол - это откуда докуда угол?

см. вложение.

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

Pavel_GP, я в комментарии специально показал пример вызова. Скопируй код и вызывай так, как написано в комментарии.

[Pavel_GP]

Отлично!!!

Только можно отредактировать чтобы не запрашивал выбрать объект, я его уже выбираю до функции.
Спасибо.
А есть у тебя lisp функции offset (которая родная в автокаде)?

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

Сообщение от Pavel_GP можно отредактировать чтобы не запрашивал выбрать объект, я его уже выбираю до функции.

Можно. Редактируй.

Сообщение от Pavel_GP есть у тебя lisp функции offset (которая родная в автокаде)?

Нет. У тебя более чем достаточно информации для того, чтобы сделать нужный тебе функционал самостоятельно.

[Pavel_GP]

"блин" сам допер, туплю, ну извиняйте... (entsel) заменил на свою переменную obj

[Pavel_GP]

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

----- добавлено через ~19 ч. -----

Сообщение от Pavel_GP 1. Посмотри плз код и помоги с расстановкой глобальных переменных. 2. Если начать следующее построение, то после построения полилинии цепляются к ней (строятся все заново) прошлые построения. Спс.

Вопрос снят.

Сообщение от Pavel_GP Если не трудно где добавить и что, чтобы полилиния строилась красного цвета вес 0.3

Вопрос открыт снят.

Код:

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

 (setq entg (entget (entlast)))
	    (entmod (append entg (list (cons 370 30) (cons 62 1))))

[Pavel_GP]

Привет. Нужна функция сумма чисел в списке.
Пример: lst (1 2 3 4) 10, могут быть и не целые.
Спс. Вопрос снят.

Код:

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

 (apply '+ lst)

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] (defun tt (lst / res count) ;; (tt (mapcar 'cdr (vl-remove-if-not '(LAMBDA(x)(=(car x) 10)) (entget(car(entsel)))))) (setq count 0) (mapcar (function (lambda (x / tmp) ; (- pi (cond ((= count 0) (setq tmp (angle x (nth (1+ count) lst)) count (1+ count) ) ;_ end of setq tmp ) ((= count (1- (length lst))) (angle (nth (1- count) lst) x)) (t (setq tmp (* (+ (angle (nth (1- count) lst) x) (angle x (nth (1+ count) lst)) ) ;_ end of + 0.5 ) ;_ end of * count (1+ count) ) ;_ end of setq tmp ) ) ;_ end of cond ; ) ;_ end of - ) ;_ end of lambda ) ;_ end of function lst ) ;_ end of mapcar ) ;_ end of defun

Ув. akka_KPblC, поправь плз код согласно вложения: Красный цвет углов, это как щас строит, Зеленый цвет, как пока нужно.

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

Pavel_GP, я не вникал в твой алгоритм, я всего лишь его адаптировал. Сними комментарии со строк 7 и 27 - попробуй. Похоже, я скинул какой-то из тестовых вариантов.

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Pavel_GP, я не вникал в твой алгоритм, я всего лишь его адаптировал. Сними комментарии со строк 7 и 27 - попробуй. Похоже, я скинул какой-то из тестовых вариантов.

Комментарии я снимал.
Извини откорректировал вложение.

----- добавлено через ~3 мин. -----
1. Если тебе это поможет, то углы между вершинами автокад вычисляет от оси Х против часовой стрелки
2. Еще дополню, а углы которые я нарисовал - это азимуты от оси Y по часовой стрелки.
3. В ком. (7,27) я подставляю значения либо pi или 2pi., но они на алгоритм не влияют, мне кажется дело в этой функции.
4. Еще дополню, в ком (7) знак сменить на "+", вместо pi поставить коэффициент (к), который будет равен либо 0 либо pi, в зависимости от стороны смещения вправо=0, влево=pi. Отсюда следует при выборе справо, угол (между двумя вершина) будет равен Азимуту, но при угле=0, Азимут=180. Азимут это результат твоей функции.
5. Когда вычисляем среднее между Азимутами, нужно учесть, что если значение у крайних азимутов больше 360° (6.283185307179586), то (у каждого которого > 360°) перед вычислением среднего, от полученного значения отнять 360°

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

Pavel_GP, ты про углы в курсе? Что pi = 180°, а (* 2. pi) = 360°? У тебя абсолютно непонятные требования - и при этом ты почему-то не показываешь свой код. И не показываешь, на каком месте у тебя "спотык".

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Pavel_GP, ты про углы в курсе?

Семен Семеныч, я в курсе, я для подробно описываю ситуацию, чтоб тщательнее разобраться.

Код:

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

 ;;; Аналог off_set только для проекции Меркатора
;;; Большая отдельная благодарность Кулик Алексей akka_KPbIC http://forum.dwg.ru
(defun C:PPM (/	     dtr    ao	   bo	  f_ps	 fg	e1     e1_2
	      e2     e2_2   s	   sfg2	  ko	 pt	xi     tt
	      azimut_s	    Az	   coords *cdl_actvdoc*	LWPoly vertex
	      x1     x2	    ugol1  ugol2  obj	 ent	OSM    k
	      y_pt   y1	    y2
	     )
  (setq OSM (getvar "OSMODE"))		;запоминаем значение объективной привязки
  (setvar "OSMODE" 0)			;выключаем объективную привязку
  (vl-load-com)
;;; Настраиваем систему координат WGS84
;;; Вспомогательные функции
  (defun dtr (a) (* pi (/ a 180.)))
  (defun deg (r) (/ (* r 180.) pi))

;;; -----------------параметры эллипсоида WGS84----------------------
  (setq	ao   6378137.			;большая полуось
	bo   6356752.3142		;малая полуось
	f_ps (/ 1. 298.25722356)	;первое сжатие
	e1   0.0818191909289067		;первый эксцентриситет
	e1_2 (sqrt (/ (- (expt ao 2.) (expt bo 2.)) (expt bo 2.)))
					;второй эксцентриситет
	e2_2 (expt e1_2 2.)
	e2   (* f_ps (- 2. f_ps))
  )
  (setq fg (getreal "\n Введите главную параллель, xx.xxx°: "))
  (setq fg (dtr fg))			;перевод градусов в радианы
  (setq s (getdist "\n Укажите расстояние смещения, метры:"))
  (setq sfg2 (expt (sin fg) 2.))
  (setq	ko (/ (cos
		fg
	      ) ;_end of cos
	      (expt (- 1. (* e2 sfg2)) 0.5)
	   ) ;_end of /
  ) ;_end of setq ko

  (if (setq obj (entsel "\n Выбрать полилинию : ")) ;|<Имя объекта:|;
    (progn
      (if (and (= (type	(setq ent (vl-catch-all-apply ;|#<VLA-OBJECT|;
				    (function
				      (lambda ()
					(car obj)
				      ) ;_ end of LAMBDA
				    ) ;_ end of function
				  ) ;_ end of VL-CATCH-ALL-APPLY
			) ;_ end of setq ent
		  ) ;_ end of type
		  'ename
	       ) ;_ end of =
	       (setq ent (vlax-ename->vla-object ent))
	       (= (vla-get-objectname ent) "AcDbPolyline")
	  ) ;_ end of and
	(progn
	  (setq	pt
		 (getpoint "\n Уажите точку, определяющую сторону смещения"
		 )
	  ) ;_end setq pt
	  (setvar "OSMODE" OSM)		;включаем объективную привязку
;;;получение списка координат вершин полилинии
	  (setq
	    xy_v (mapcar 'cdr
			 (vl-remove-if-not
			   '(lambda (x) (= (car x) 10))
			   (entget (car obj))
			 ) ;_end vl-remove-if-not
		 ) ;_end of mapcar
	  ) ;_end of setq xy_v

;;; записываем азимуты
	  (defun tt (xy_v / res count)
	    (setq ugol1	(angle (car xy_v) pt) ;вспомогательные величины
		  ugol2	(angle (car xy_v) (cadr xy_v))
					;для определения			
		  x1	(caar xy_v)	;стороны смещения
		  x2	(caadr xy_v)
		  y_pt	(cadr pt)
		  y1	(cadar xy_v)
		  y2	(cadadr xy_v)
	    ) ;_end of setq(s)
	    (cond ((and (= y1 y2) (= ugol2 0) (< y_pt y1))
		   (setq k pi)
		  )
		  ((and (= y1 y2) (> ugol2 ugol1))
		   (setq k pi)
		  )
		  ((and (= y1 y2) (< ugol2 ugol1))
		   (setq k (* 2. pi))
		  )
		  ((and (= x1 x2) (> ugol2 ugol1))
		   (setq k pi)
		  )
		  ((and (= x1 x2) (< ugol2 ugol1))
		   (setq k (* 2. pi))
		  )
		  ((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1) (< y1 y2))
		   (setq k pi)
		  )
		  ((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1))
		   (setq k (* 2. pi))
		  )
		  ((and (< x1 x2) (< y1 y2) (< ugol2 ugol1) (< y_pt y1))
		   (setq k pi)
		  )
		  ((and (> ugol2 ugol1) (< x1 x2))
		   (setq k pi)
		  )
		  ((and (< ugol2 ugol1) (< x1 x2))
		   (setq k (* 2. pi))
		  )
		  ((and (> ugol2 ugol1) (> x1 x2))
		   (setq k pi)
		  )
		  ((and (< ugol2 ugol1) (> x1 x2))
		   (setq k (* 2. pi))
		  )
	    ) ;_end of cond
	    (setq count 0)
	    (mapcar
	      (function
		(lambda	(x / tmp)
		  (-
		  k
		  (cond
		    ((= count 0)
		     (setq tmp	 (angle x (nth (1+ count) xy_v))
			   count (1+ count)
		     ) ;_ end of setq
		     tmp
		    )
		    ((= count (1- (length xy_v)))
		     (angle (nth (1- count) xy_v) x)
		    )
		    (t
		     (setq tmp	 (* (+ (angle (nth (1- count) xy_v) x)
				       (angle x (nth (1+ count) xy_v))
				    ) ;_ end of +
				    0.5
				 ) ;_ end of *
			   count (1+ count)
		     ) ;_ end of setq
		     tmp
		    )
		  ) ;_ end of cond
					) ;_ end of -
		) ;_ end of lambda
	      ) ;_ end of function
	      xy_v
	    ) ;_ end of mapcar
	  ) ;_ end of defun

	  (setq	azimut_s ;|список азимутов|;
		 (tt (mapcar 'cdr
			     (vl-remove-if-not
			       '(LAMBDA (x) (= (car x) 10))
			       (entget (car obj))
			     ) ;_end of vl-remove-if-not
		     ) ;_end of mapcar
		 ) ;_end of tt
	  ) ;_end of setq
;;; получаем новый список координат вершин
	  (setq n 0)
	  (foreach vertex xy_v
	    (setq Az (nth n azimut_s))
	    (defun eval-new-coords (x	  y	/     mo    f_r	  l_r
				    nym2  c	Nm    Mm    betta gamma
				    alfa  b	w     fnew_r	  lnew_r
				    x0	  y0	tan   xy_new
				   )
	      (setq mo (- (/ pi 2.)
			  (* 2.
			     (atan (exp	(/ (* -1. y) (* ao ko))
				   ) ;_end of exp
			     ) ;_end of atan
			  ) ;_end of *
		       ) ;_end of -
	      ) ;_end of setq mo
;;; преобразование прямоугольных в географические координаты
	      (setq f_r
		     (+	(+ (+ (+ mo
				 (* (sin (* 2. mo))
				    (+ (+ (+ (/ (expt e1 2.) 2.)
					     (* 5. (/ (expt e1 4.) 24.))
					  ) ;_end of +
					  (/ (expt e1 6.) 12.)
				       ) ;_end of +
				       (* 13. (/ (expt e1 8.) 360.))
				    ) ;_end of +
				 ) ;_end of *
			      ) ;_end of +
			      (* (sin (* 4. mo))
				 (+ (+ (* 7. (/ (expt e1 4.) 48.))
				       (* 29. (/ (expt e1 6.) 240.))
				    ) ;_end of +
				    (* 811. (/ (expt e1 8.) 11520.))
				 ) ;_end of +
			      ) ;_end of *
			   ) ;_end of +
			   (* (sin (* 6. mo))
			      (+ (* 7. (/ (expt e1 6.) 120.))
				 (* 81. (/ (expt e1 8.) 1120.))
			      ) ;_end of +
			   ) ;_end of *
			) ;_end of +
			(* (sin (* 8. mo))
			   (* 4279. (/ (expt e1 8.) 161280.))
			) ;_end of *
		     ) ;_end of +
	      ) ;_end of setq f_r
	      (setq f_r	  (abs f_r)	; широта в радианах
		    l_r	  (/ x (* ao ko))
		    l_r	  (abs l_r)	; долгота в радианах
;;; вычисление новых координат вершин

;;; **************************************************************
		    nym2  (* e2_2 (expt (cos f_r) 2.))
		    c	  (* bo (+ 1. e2_2))
		    Nm	  (/ c (sqrt (+ 1. nym2)))
		    Mm	  (/ Nm (+ 1. nym2))
		    betta (/ (* s (cos Az)) Mm)
		    gamma (/ (* s (sin Az)) (* Nm (cos f_r)))
		    alfa  (sin f_r)
		    b	  (* betta (1+ (/ (+ (* 2. (expt gamma 2.))) 24.)))
	      ) ;_end of setq(s)
	      (setq
		w (* gamma
		     (1+ (/ (- (expt alfa 2.) (expt betta 2.)) 24.))
		  ) ;_end of *
	      ) ;_end of setq w
	      (setq fnew_r (+ f_r b))	;широта новой вершины
	      (setq lnew_r (+ l_r w))	;долгота новой вершины

;;; **************************************************************		  

	      (setq x0 (* (* ao ko) lnew_r))
	      (setq tan	(/ (sin (+ (/ pi 4.) (/ fnew_r 2.)))
			   (cos (+ (/ pi 4.) (/ fnew_r 2.)))
			) ;_end of /
	      ) ;_end of setq tan
	      (setq y0 (* (* ao ko)
			  (log (* tan
				  (expt	(/ (- 1. (* e1 (sin fnew_r)))
					   (+ 1. (* e1 (sin fnew_r)))
					) ;_end of /
					(/ e1 2.)
				  ) ;_end of expt
			       ) ;_end of *
			  ) ;_end of expt
		       ) ;_end of *
	      ) ;_end of setq y0
	      (setq xy_new (list x0 y0)); список прямоугольных координат новой вершины
	    ) ;_end of defun eval-new-coords
;;; список прямоугольных координат новых вершин
	    (setq coords
		   (cons (eval-new-coords (car vertex) (cadr vertex))
			 coords
		   ) ;_end of cons
	    ) ;_end of setq coords
	    (setq n (1+ n))
	  ) ;_end of foreach

	  (setq	*cdl_actvdoc*
		 (vla-get-ActiveDocument
		   (vlax-get-acad-object)
		 ) ;_end of vla-get-ActiveDocument
	  ) ;_end of setq *cdl_actvdoc*
;;; Строим полилинию по новым вершинам
	  (defun LWPoly	(coords / templst entg)
	    (vla-AddLightWeightPolyline
	      (vla-get-Block (vla-get-ActiveLayout *cdl_actvdoc*))
	      (vlax-safearray-fill
		(vlax-make-safearray
		  vlax-vbDouble
		  (vl-list* 0
			    (1-	(length	(setq templst
					       (apply
						 'append
						 (mapcar
						   (function
						     (lambda (x)
						       (cond
							 ((= 3 (length x))
							  (reverse (cdr (reverse x)))
							 )
							 (T x)
						       ) ;_end of cond
						     ) ;_end of lambda
						   ) ;_end of function
						   coords
						 ) ;_end of mapcar
					       ) ;_end of apply
					) ;_end of setq templst
				) ;_end of length
			    ) ;_end of 1-
		  ) ;_end of vl-list*
		) ;_end of vlax-make-safearray
		templst
	      ) ;_end of vlax-safearray-fill
	    ) ;_end of vla-AddLightWeightPolyline
	    (setq entg (entget (entlast)))
	    (entmod (append entg (list (cons 370 30) (cons 62 1))))
	  ) ;_end of defun LWPoly
	  (LWPoly coords)
	) ;_end of progn
	(princ "\n Это не тип полилинии.")
      ) ;_end of if
    ) ;_end of progn
    (princ "\n Объект не выбран.")
  ) ;_end of if
  (princ)
  (gc)
) ;_end of defun C:PPM

Пояснение к работе с кодом:
1. Загрузи dwg (см. вложение).
2. Прими по запросу систему координат.
3. параллель 75
4. для удобства работы смещение ввожу 50

Сообщение от Кулик Алексей aka kpblc на каком месте у тебя "спотык".

Как такого "стоптыка" нет, По моему мнению не правильные значения получает azimut_s строка 152

----- добавлено через ~4 ч. -----
Добавлю:
1. Строки 72-117, расчет вспомогательного коэффициента при выборе стороны смещения. Я лично не могу сейчас додуматься, как конкретно программно при выборе стороны смещения (вправо/влево), программа понимала что, где вправо, а где влево. Поэтому я прописываю такие вычисления, скорее всего все намного проще.
2. 94 просмотра вложения, ни одного ответа

[Jerald]

Как программно переключить цвет?

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

Сообщение от Pavel_GP 94 просмотра вложения, ни одного ответа

Особенность движка - это не количество скачиваний, а количество просмотров страницы

Сообщение от Jerald Как программно переключить цвет?

Цвет чего?

[Jerald]

Сообщение от Кулик Алексей aka kpblc Цвет чего?

Текущий цвет.

[ProPeller]

Сообщение от Jerald Текущий цвет.

например

Код:

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

 (setvar "cecolor" "1")

[Pavel_GP]

Сообщение от Кулик Алексей aka kpblc Pavel_GP,ты почему-то не показываешь свой код.

Что скажешь по коду, жду твоего ответа...

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

Pavel_GP, у меня уже второй день на работе завал. С тобой поделиться задачками?

[Pavel_GP]

Я жду, а не требую, инет на работе упал, сижу на смартфоне.

[Jerald]

Сообщение от ProPeller например Код: [Выделить все] (setvar "cecolor" "1")

А как рандом задать в диапазоне?

[ProPeller]

Сообщение от Jerald А как рандом задать в диапазоне?

Какой диапазон?

[Jerald]

Любой. Дайте синтаксис. Я сам разберусь.
Последовательно переключаться между цветами, нажимая на одну кнопку, я так понимаю посложнее будет, так как где-то придётся хранить переменную последнего значения?

[ProPeller]

Сообщение от Jerald Любой. Дайте синтаксис. Я сам разберусь.

Любой, так любой. Разбирайтесь.

Код:

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

 (substr (rtos (getvar "cdate") 2 8) 16)

[gomer]

Сообщение от Pavel_GP Что скажешь по коду

что тут говорить, печальный копипаст...

[Pavel_GP]

Сообщение от gomer что тут говорить, печальный копипаст...

Ты лучше по делу бы сказал, а языком чесать каждый может
Слова твои ничем не подкреплены, опять болтовня...
Подскажи решение, если есть что сказать?

[gomer]

Сообщение от Pavel_GP Ты лучше по делу бы сказал, а языком чесать каждый может Слова твои ничем не подкреплены, опять болтовня... Подскажи решение, если есть что сказать?

Нажмите для просмотра

http://www.youtube.com/watch?v=goRyvCyikNwзы, что тут говорить, когда ты не хочешь понимать, что, где, куда и зачем ты копипастишь. может ты спец по дельфинам, но в лиспе ты бегиннер, так что оставь свое высокомерие и rtfm
зызы от меня тебе только один совет: не все, что ты видишь, достойно подражания и не все выглядит так, как ты это себе представляешь

[Pavel_GP]

Сообщение от gomer бла бла бла

no comments...
Я не думал, что на таком специфическом форуме могут быть тролли и флудерасты, которые кроме своего носа ничего не видят, даже название топика, жаль...

[Jerald]

Сообщение от ProPeller (substr (rtos (getvar "cdate") 2 8) 16)

Как понять, в каком это диапазоне?

Вот такая конструкция разве не должны работать?
(setvar "cecolor" "(substr (rtos (getvar "cdate") 2 8) 16)")

[ProPeller]

Сообщение от Jerald Как понять, в каком это диапазоне?

Вы, вроде как, грозились разобраться самостоятельно. Вам дали алгоритм. К чему теперь эти вопросы?

Сообщение от Jerald Вот такая конструкция разве не должны работать? (setvar "cecolor" "(substr (rtos (getvar "cdate") 2 8) 16)")

Так работать не будет. Из (substr (rtos (getvar "cdate") 2 8) 16) уже полчается строка. Заключать данное выражение в кавычки, неминуемо приведет к ошибке.

Код:

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

 (setvar "cecolor" (substr (rtos (getvar "cdate") 2 8) 16))

[Jerald]

Сообщение от ProPeller Вы, вроде как, грозились разобраться самостоятельно. Вам дали алгоритм. К чему теперь эти вопросы?

Сбрехал нечаянно. Но, синтаксис выражения в программировании обычно не так дают. А с указанием переменных и регулярных выражений.

[ProPeller]

Сообщение от Jerald Но, синтаксис выражения в программировании обычно не так дают.

Ну вам-то виднее, как синтаксис дают. Странно, что вы тогда не можете решить простейших задач.

Вы хотели с переменными? Вот вам с переменными. С Глобальными!

Код:

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

 (setq RndCol (substr (rtos (getvar "cdate") 2 8) 16))
(setvar "cecolor" RndCol)

[skkkk]

Offtop: Когда мы с братом или с сестрой в детстве ссорились или даже дрались, бабушка поговаривала: "Один задириха, другой неспустиха"

Сообщение от Jerald Цитата: Сообщение от ProPeller Посмотреть сообщение (substr (rtos (getvar "cdate") 2 8) 16) Как понять, в каком это диапазоне?

Чтобы понять, в каком это диапазоне, нужно понять, что это вообще такое. А это - подстрока (начиная с 16-го символа) строки, образованной переводом переменной CDATE в строку посредством функции rtos с округлением до 8 знаков после запятой. И если посетить в Сети буквально пару-тройку страниц по теме, то можно понять, что эти два последних символа обозначают сотые доли секудны текущего времени. Соответственно интервал, подразумеваемый ProPeller'ом - от "00" (что соответствует значению "ПоБлоку") до "99". Правда, в зависимости от значения переменной DIMZIN строка, например "10" может превратиться в "1", что в данном случае не критично, ибо нужны случайные числа, но она также может превратиться и в просто "" при "00", а такое значение переменной CECOLOR системой отвергнется. Не универсальное, однако, решение - в одном случае из ста вылетит с ошибкой, если DIMZIN установлен в 8, как по умолчанию.

[ProPeller]

Сообщение от skkkk Не универсальное, однако, решение

Дык я и хотел помочь. Написал бы ему нормальный рандом в диапазоне от 0-255 и было бы счастье, а мне сказали мол "дай алгоритм" и все тут. Вот я и дал.
Offtop: Просто на работе куча таки "пассажиров", которые сначала делают вид, что все поняли, а потом начинаю с вопросами бегать. Это у меня уже рефлекс наверное. Я так-то не злой))

[Pavel_GP]

Подскажите с помощью функции inters, возможно найти координаты точки тх, если известны координаты точек (1-4)? (Пример см. вложение)
спс.

[ProPeller]

Сообщение от Pavel_GP Подскажите с помощью функции inters, возможно найти координаты точки тх, если известны координаты точек (1-4)? (Пример см. вложение) спс.

Последним аргументом укажите nil

Например:

Код:

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

 (inters pnt1 pnt2 pnt3 pnt4 nil)

[Jerald]

Сообщение от ProPeller Ну вам-то виднее, как синтаксис дают. Странно, что вы тогда не можете решить простейших задач. Вы хотели с переменными? Вот вам с переменными. С Глобальными! Код: [Выделить все] (setq RndCol (substr (rtos (getvar "cdate") 2 8) 16)) (setvar "cecolor" RndCol)

Вы получаете случайное число взятием остатка от деления текущего времени? И вы делаете это как бы "вручную"? Разве в лиспе нету функции, которая это всё делает сама?

Вот, к примеру, рандом в php
int rand ( int $min , int $max )

Вот в C++
int a = random(N); //генерит число в промежутке [0; N)

[ProPeller]

Сообщение от Jerald Разве в лиспе нету функции, которая это всё делает сама?

К сожалению нет.

Может вас спасет вот эта программка, будет как

функция, которая это всё делает сама

[Pavel_GP]

Кулик Алексей, как время будет пересмотри в другой вариант по примеру

Код:

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

 (defun tt (lst / res count)
 ;; (tt (mapcar 'cdr (vl-remove-if-not '(LAMBDA(x)(=(car x) 10)) (entget(car(entsel))))))
 (setq count 0)
 (mapcar
   (function
     (lambda (x / tmp)
         ;  (- pi
       (cond
         ((= count 0)
          (setq tmp   (angle x (nth (1+ count) lst))
                count (1+ count)
                ) ;_ end of setq
          tmp
          )
         ((= count (1- (length lst))) (angle (nth (1- count) lst) x))
         (t
          (setq tmp   (* (+ (angle (nth (1- count) lst) x)
                            (angle x (nth (1+ count) lst))
                            ) ;_ end of +
                         0.5
                         ) ;_ end of *
                count (1+ count)
                ) ;_ end of setq
          tmp
          )
         ) ;_ end of cond
         ; ) ;_ end of -
       ) ;_ end of lambda
     ) ;_ end of function
   lst
   ) ;_ end of mapcar
 ) ;_ end of defun

Пришлось все кардинально поменять,
Пример на выходе (у1 у1 у2 у2 у3 у3 .... уn уn), где у - углы. Если 2 сигмента то 4 угла и т.д.
Спс.

----- добавлено через ~21 ч. -----
Ребята, Пока основной учитель занят, подскажите как получить:
Пример (lst (1 2 3 4 5 6...n)), преобразовать в (lst (1 1 2 2 3 3 4 4 ... n n)), ну если кому не трудно. спс.

[trushev]

Сообщение от Pavel_GP Ребята, Пока основной учитель занят, подскажите как получить: Пример (lst (1 2 3 4 5 6...n)), преобразовать в (lst (1 1 2 2 3 3 4 4 ... n n)), ну если кому не трудно. спс.

Не профессионально, но наиболее просто и понятно

Код:

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

(setq lst 'nil)
(foreach k '(1 2 3 4 5 6 ... n)
            (setq lst (cons k lst)
                     lst (cons k lst)
            )
);foreach
(setq lst (reverse lst))

[ProPeller]

Сообщение от Pavel_GP Ребята, Пока основной учитель занят, подскажите как получить: Пример (lst (1 2 3 4 5 6...n)), преобразовать в (lst (1 1 2 2 3 3 4 4 ... n n)), ну если кому не трудно. спс.

Код:

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

 (apply 'append (mapcar '(lambda (l1) (list l1 l1)) lst))

[gomer]

Сообщение от ProPeller (apply 'append (mapcar '(lambda (l1) (list l1 l1)) lst))

можно проще

Код:

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

 (apply 'append (mapcar 'list lst lst))

[ProPeller]

Сообщение от gomer можно проще

Чёт я тупанул

[trushev]

Замечательный урок оптимизации.

[Pavel_GP]

Сообщение от Pavel_GP Пример на выходе (у1 у1 у2 у2 у3 у3 .... уn уn), где у - углы. Если 2 сигмента то 4 угла и т.д.

Спс ребятам.
получилось вот так

Код:

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

 (setq count 0)
	  (while (< count (1- (length xy_v)))
	    (setq az0 (angle (nth count xy_v) (nth (1+ count) xy_v)))
	    (setq az_s (append az_s (list az0)))
	    (setq count (1+ count))
	  )
	  (setq azimut_s (apply 'append (mapcar 'list az_s az_s)))

[ProPeller]

Сообщение от Pavel_GP получилось вот так

чутка оптимизировал

Код:

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

  (setq
  az_s	   (mapcar 'angle (reverse (cdr (reverse xy_v))) (cdr xy_v))
  azimut_s (apply 'append (mapcar 'list az_s az_s))
 )

[Pavel_GP]

Сообщение от ProPeller чутка оптимизировал

Добро!

----- добавлено через ~3 ч. -----
Мне необходимо к каждому элементу списка (+ или -) коэффициент (пример к=pi)

Код:

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

 (mapcar '(lambda (e) (+ e pi)) azimut_s)

Хорошо?
Объединяем в один код

Код:

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

(setq
 az_s	   (mapcar 'angle (reverse (cdr (reverse xy_v))) (cdr xy_v))
 azimut_s (apply 'append (mapcar 'list az_s az_s))
k pi
azimut_s (mapcar '(lambda (e) (+ e k)) azimut_s)
)

----- добавлено через ~1 ч. -----
есть список (lst (1 2 3...n)), необходимо получить на выходе (1 2 2 3 3...n)
Решение:

Код:

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

 (reverse
		 (cdr (reverse
			(cdr (apply 'append (mapcar 'list lst lst)))
		      ) ;_end of reverse
		 ) ;_end of cdr
	       ) ;_end of reverse

Правильно?

[ProPeller]

Сообщение от Pavel_GP есть список (lst (1 2 3...n)), необходимо получить на выходе (1 2 2 3 3...n) Правильно?

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

Код:

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

 (cdr (apply 'append (mapcar 'list lst lst)))

Сообщение от Pavel_GP Объединяем в один код

Незачем так извращаться.

Код:

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

 (setq
 k pi
 az_s     (mapcar '(lambda (l1 l2) (+ k (angle l1 l2))) (reverse (cdr (reverse xy_v))) (cdr xy_v))
 azimut_s (apply 'append (mapcar 'list az_s az_s))
)

[Pavel_GP]

Вопрсик:
Есть список координат (lst ((x1 y1) (x2 y2) (x3 y3) (x4 y4)...(xn yn))), необходимо получить:
1. координаты пересечений между отрезками (01 02 ... 0n), где 01 ((x1 y1) (x2 y2)), 02 ((x3 y3) (x4 y4)), координаты пересечений (x_pt1 y_pt1) и т.д.
2. создать новый список ((x1 y1) (x_pt1 y_pt1) (x_pt2 y_pt2) ... (xn yn)), первый и последний списки координат не изменяются.
Благодарствую.

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

Сообщение от ProPeller Если нужно избавиться только от первого элемента списка, то достаточно лишь

Спс. Я сам ошибся избавиться от первого и последнего

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

Сообщение от ProPeller Незачем так извращаться.

За оптимизацию спасибо!

[trushev]

Сообщение от ProPeller Незачем так извращаться.

Смущает строка 2. Почему нельзя pi применить напрямую?

[ProPeller]

Сообщение от trushev Смущает строка 2. Почему нельзя pi применить напрямую?

Конечно можно. Просто автор обмолвился, мол (пример к=pi). Вдруг там будет присваиваться другой коэффициент.

Сообщение от Pavel_GP Вопрсик: Есть список координат (lst ((x1 y1) (x2 y2) (x3 y3) (x4 y4)...(xn yn))), необходимо получить: 1. координаты пересечений между отрезками (01 02 ... 0n), где 01 ((x1 y1) (x2 y2)), 02 ((x3 y3) (x4 y4)), координаты пересечений (x_pt1 y_pt1) и т.д. 2. создать новый список ((x1 y1) (x_pt1 y_pt1) (x_pt2 y_pt2) ... (xn yn)), первый и последний списки координат не изменяются.

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

Код:

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

 (defun PPT:2D->StEnd (tmplst)
 (if
  (and
   tmplst
   (= (rem (VL-LIST-LENGTH tmplst) 4) 0)
  )
  (cons
   (inters
    (car tmplst)
    (cadr tmplst)
    (caddr tmplst)
    (cadddr tmplst)
    nil
   )
   (PPT:2D->StEnd (cddddr tmplst))
  )
 )
)

(append
 (list (car lst))
 (PPT:2D->StEnd lst)
 (list (last lst)
)

[Pavel_GP]

Сообщение от trushev Почему нельзя pi применить напрямую?

pi - это значение коэффициента k (как пример)

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

Сообщение от ProPeller Лучше всего будет использовать рекурсию. Но для начала обязательно нужно проверить чтобы список был кратный 4-м.

Спасибо большое , не успеваю проверить убегаю - до понедельника.

[Pavel_GP]

ув. ProPeller. Большое спасибо за твой труд.
Немного уточню что я хотел в итоге получить, и чтоб ты смог поправить свое решение если не трудно:
1.

Сообщение от Pavel_GP 1. координаты пересечений между отрезками (01 02 ... 0n), где 01 ((x1 y1) (x2 y2)), 02 ((x3 y3) (x4 y4)), координаты пересечений (x_pt1 y_pt1) и т.д.

Здесь я хотел указать на то, первое пересечение понятно из примера, а вот последующие должны быть такими берется отрезок 02 и 03 ((x5 y5) (x6 y6)) и т.д.
2. Пример: Если полилиния состоит трех сегментов то итог : ((x1 y1) (xpt1 ypt1) (xpt2 ypt2) (xn yn)), где xpt1 ypt1 - координаты первой точки пересечения 2-х сегментов (01 и 02), xpt2 ypt2 - ... (02 и 03), а x1 y1 - координата точки первого сегмента, xn yn - координата точки последнего сегмента.
Спс.

----- добавлено через ~1 ч. -----
3. Если один сегмент, то

Код:

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

 (append
 (list (car lst))
 (list (last lst)
)

)), проще = lst

[ProPeller]

Сообщение от Pavel_GP и чтоб ты смог поправить свое решение если не трудно

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

Короче, мой код отсюда высчитывал координаты пересечений между отрезками 1 - 2, 3 - 4, 5 - 6 и т.д. Насколько я понял из последнего поста, нужно сделать 1 - 2, 2 - 3, 3 - 4 и т.д., тогда код будет таким.

Код:

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

  (defun PPT:2D->StEnd (tmplst)
 (if
  (and
   tmplst
   (= (rem (VL-LIST-LENGTH tmplst) 4) 0)
  )
  (cons
   (inters
    (car tmplst)
    (cadr tmplst)
    (caddr tmplst)
    (cadddr tmplst)
    nil
   )
   (PPT:2D->StEnd (cddr tmplst))
  )
 )
)

(append
 (list (car lst))
 (PPT:2D->StEnd lst)
 (list (last lst))
)

[Pavel_GP]

Что-то нето...
С твоего позволения добавил скобку
(append
(list (car lst))
(PPT:2D->StEnd lst)
(list (last lst))
)

Пример: lst ((3.72449e+006 3.00249e+006) (3.72356e+006 3.00125e+006) (3.72355e+006 3.00131e+006) (3.72475e+006 3.00041e+006) (3.72476e+006 3.00035e+006) (3.72313e+006 2.99882e+006))
на выходе получаем: ((3.72449e+006 3.00249e+006) (3.72313e+006 2.99882e+006)), должно быть четыре точки, а тут две начало и конец

[ProPeller]

Сообщение от Pavel_GP Что-то нето... С твоего позволения добавил скобку (append (list (car lst)) (PPT:2D->StEnd lst) (list (last lst)) ) Пример: lst ((3.72449e+006 3.00249e+006) (3.72356e+006 3.00125e+006) (3.72355e+006 3.00131e+006) (3.72475e+006 3.00041e+006) (3.72476e+006 3.00035e+006) (3.72313e+006 2.99882e+006)) на выходе получаем: ((3.72449e+006 3.00249e+006) (3.72313e+006 2.99882e+006)), должно быть четыре точки, а тут две начало и конец

Изменил условие рекурсии. Должно работать.

Код:

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

 (defun PPT:2D->StEnd (tmplst)
 (if
  (and
   tmplst
   (<= 4 (VL-LIST-LENGTH tmplst))
  )
  (cons
   (inters
    (car tmplst)
    (cadr tmplst)
    (caddr tmplst)
    (cadddr tmplst)
    nil
   )
   (PPT:2D->StEnd (cddr tmplst))
  )
 )
)

(append
 (list (car lst))
 (PPT:2D->StEnd lst)
 (list (last lst))
)

[Pavel_GP]

Спс. Большое. Всё работает!

Есть решение моего вопроса, мы все кто смог помочь его решили

Код:

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

;;; Аналог off_set только для проекции Меркатора
;;; Большая отдельная благодарность Кулик Алексей akka_KPbIC, ProPeller http://forum.dwg.ru
(defun C:PPM (/	     dtr    ao	   bo	  f_ps	 fg	e1     e1_2
	      e2     e2_2   s	   sfg2	  ko	 pt	xi     tt
	      azimut_s	    Az	   *cdl_actvdoc* LWPoly	vertex x1
	      x2     ugol1  ugol2  obj	  ent	 OSM	k      y_pt
	      y1     y2	    az_s   az0	  xy_v	 coords	pts
	     )
  (setq OSM (getvar "OSMODE"))		;запоминаем значение объективной привязки
  (setvar "OSMODE" 0)			;выключаем объективную привязку
  (vl-load-com)
;;; Настраиваем систему координат WGS84
;;; Вспомогательные функции
  (defun dtr (a) (* pi (/ a 180.)))
  (defun deg (r) (/ (* r 180.) pi))

;;; -----------------параметры эллипсоида WGS84----------------------
  (setq	ao   6378137.			;большая полуось
	bo   6356752.3142		;малая полуось
	f_ps (/ 1. 298.25722356)	;первое сжатие
	e1   0.0818191909289067		;первый эксцентриситет
	e1_2 (sqrt (/ (- (expt ao 2.) (expt bo 2.)) (expt bo 2.)))
					;второй эксцентриситет
	e2_2 (expt e1_2 2.)
	e2   (* f_ps (- 2. f_ps))
  )
  (setq fg (getreal "\n Введите главную параллель, xx.xxx°: "))
  (setq fg (dtr fg))			;перевод градусов в радианы
  (setq s (getdist "\n Укажите расстояние смещения, метры:"))
  (setq sfg2 (expt (sin fg) 2.))
  (setq	ko (/ (cos
		fg
	      ) ;_end of cos
	      (expt (- 1. (* e2 sfg2)) 0.5)
	   ) ;_end of /
  ) ;_end of setq ko

  (if (setq obj (entsel "\n Выбрать полилинию : ")) ;|<Имя объекта:|;
    (progn
      (if (and (= (type	(setq ent (vl-catch-all-apply ;|#<VLA-OBJECT|;
				    (function
				      (lambda ()
					(car obj)
				      ) ;_ end of LAMBDA
				    ) ;_ end of function
				  ) ;_ end of VL-CATCH-ALL-APPLY
			) ;_ end of setq ent
		  ) ;_ end of type
		  'ename
	       ) ;_ end of =
	       (setq ent (vlax-ename->vla-object ent))
	       (= (vla-get-objectname ent) "AcDbPolyline")
	  ) ;_ end of and
	(progn
	  (setq	pt
		 (getpoint "\n Уажите точку, определяющую сторону смещения"
		 )
	  ) ;_end setq pt
	  (setvar "OSMODE" OSM)		;включаем объективную привязку
;;;получение списка координат вершин полилинии
	  (setq
	    xy (mapcar 'cdr
		       (vl-remove-if-not
			 '(lambda (x) (= (car x) 10))
			 (entget (car obj))
		       ) ;_end vl-remove-if-not
	       ) ;_end of mapcar
	  ) ;_end of setq xy
	  (setq
	    xy_v (reverse
		   (cdr	(reverse
			  (cdr (apply 'append (mapcar 'list xy xy)))
			) ;_end of reverse
		   ) ;_end of cdr
		 ) ;_end of reverse
	  ) ;_end of setq xy_v

;;; записываем азимуты

	  (setq	ugol1 (angle (car xy_v) pt) ;вспомогательные величины
		ugol2 (angle (car xy_v) (cadr xy_v))
					;для определения			
		x1    (caar xy_v)	;стороны смещения
		x2    (caadr xy_v)
		y_pt  (cadr pt)
		y1    (cadar xy_v)
		y2    (cadadr xy_v)
	  ) ;_end of setq(s)
	  (cond	((and (= y1 y2) (= ugol2 0) (< y_pt y1))
		 (setq k pi)
		)
		((and (= y1 y2) (> ugol2 ugol1))
		 (setq k pi)
		)
		((and (= y1 y2) (< ugol2 ugol1))
		 (setq k (* 2. pi))
		)
		((and (= x1 x2) (> ugol2 ugol1))
		 (setq k pi)
		)
		((and (= x1 x2) (< ugol2 ugol1))
		 (setq k (* 2. pi))
		)
		((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1) (< y1 y2))
		 (setq k pi)
		)
		((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1))
		 (setq k (* 2. pi))
		)
		((and (< x1 x2) (< y1 y2) (< ugol2 ugol1) (< y_pt y1))
		 (setq k pi)
		)
		((and (> ugol2 ugol1) (< x1 x2))
		 (setq k pi)
		)
		((and (< ugol2 ugol1) (< x1 x2))
		 (setq k (* 2. pi))
		)
		((and (> ugol2 ugol1) (> x1 x2))
		 (setq k pi)
		)
		((and (< ugol2 ugol1) (> x1 x2))
		 (setq k (* 2. pi))
		)
	  ) ;_end of cond
	  
	  (setq
	    az_s (mapcar '(lambda (l1 l2) (- k (angle l1 l2)))
			 (reverse (cdr (reverse xy)))
			 (cdr xy)
		 ) ;_end of mapcar
	    az0	 (apply 'append (mapcar 'list az_s az_s)) ;список Азимутов
	  )

;;; получаем новый список координат вершин
	  (setq n 0)
	  (foreach vertex xy_v
	    (setq Az (nth n az0))
	    (defun eval-new-coords (x	  y	/     mo    f_r	  l_r
				    nym2  c	Nm    Mm    betta gamma
				    alfa  b	w     fnew_r	  lnew_r
				    x0	  y0	tan   xy_new
				   )
	      (setq mo (- (/ pi 2.)
			  (* 2.
			     (atan (exp	(/ (* -1. y) (* ao ko))
				   ) ;_end of exp
			     ) ;_end of atan
			  ) ;_end of *
		       ) ;_end of -
	      ) ;_end of setq mo
;;; преобразование прямоугольных в географические координаты
	      (setq f_r
		     (+	(+ (+ (+ mo
				 (* (sin (* 2. mo))
				    (+ (+ (+ (/ (expt e1 2.) 2.)
					     (* 5. (/ (expt e1 4.) 24.))
					  ) ;_end of +
					  (/ (expt e1 6.) 12.)
				       ) ;_end of +
				       (* 13. (/ (expt e1 8.) 360.))
				    ) ;_end of +
				 ) ;_end of *
			      ) ;_end of +
			      (* (sin (* 4. mo))
				 (+ (+ (* 7. (/ (expt e1 4.) 48.))
				       (* 29. (/ (expt e1 6.) 240.))
				    ) ;_end of +
				    (* 811. (/ (expt e1 8.) 11520.))
				 ) ;_end of +
			      ) ;_end of *
			   ) ;_end of +
			   (* (sin (* 6. mo))
			      (+ (* 7. (/ (expt e1 6.) 120.))
				 (* 81. (/ (expt e1 8.) 1120.))
			      ) ;_end of +
			   ) ;_end of *
			) ;_end of +
			(* (sin (* 8. mo))
			   (* 4279. (/ (expt e1 8.) 161280.))
			) ;_end of *
		     ) ;_end of +
	      ) ;_end of setq f_r
	      (setq f_r	  (abs f_r)	; широта в радианах
		    l_r	  (/ x (* ao ko))
		    l_r	  (abs l_r)	; долгота в радианах
;;; вычисление новых координат вершин

;;; **************************************************************
		    nym2  (* e2_2 (expt (cos f_r) 2.))
		    c	  (* bo (+ 1. e2_2))
		    Nm	  (/ c (sqrt (+ 1. nym2)))
		    Mm	  (/ Nm (+ 1. nym2))
		    betta (/ (* s (cos Az)) Mm)
		    gamma (/ (* s (sin Az)) (* Nm (cos f_r)))
		    alfa  (sin f_r)
		    b	  (* betta (1+ (/ (+ (* 2. (expt gamma 2.))) 24.)))
	      ) ;_end of setq(s)
	      (setq
		w (* gamma
		     (1+ (/ (- (expt alfa 2.) (expt betta 2.)) 24.))
		  ) ;_end of *
	      ) ;_end of setq w
	      (setq fnew_r (+ f_r b))	;широта новой вершины
	      (setq lnew_r (+ l_r w))	;долгота новой вершины

;;; **************************************************************		  

	      (setq x0 (* (* ao ko) lnew_r))
	      (setq tan	(/ (sin (+ (/ pi 4.) (/ fnew_r 2.)))
			   (cos (+ (/ pi 4.) (/ fnew_r 2.)))
			) ;_end of /
	      ) ;_end of setq tan
	      (setq y0 (* (* ao ko)
			  (log (* tan
				  (expt	(/ (- 1. (* e1 (sin fnew_r)))
					   (+ 1. (* e1 (sin fnew_r)))
					) ;_end of /
					(/ e1 2.)
				  ) ;_end of expt
			       ) ;_end of *
			  ) ;_end of expt
		       ) ;_end of *
	      ) ;_end of setq y0
	      (setq xy_new (list x0 y0)); список прямоугольных координат новой вершины
	    ) ;_end of defun eval-new-coords
;;; список прямоугольных координат новых вершин
	    (setq coords
		   (cons (eval-new-coords (car vertex) (cadr vertex))
			 coords
		   ) ;_end of cons
	    ) ;_end of setq coords
	    (setq n (1+ n))
	  ) ;_end of foreach

	  (defun PPT:2D->StEnd (tmplst)
	    (if
	      (and
		tmplst
		(<= 4 (VL-LIST-LENGTH tmplst))
	      ) ;_end of and
	       (cons
		 (inters
		   (car tmplst)
		   (cadr tmplst)
		   (caddr tmplst)
		   (cadddr tmplst)
		   nil
		 ) ;_end of inters
		 (PPT:2D->StEnd (cddr tmplst))
	       ) ;_end of cons
	    ) ;_end of if
	  ) ;_end defun PPT:2D->StEnd

	  (setq	pts (append
		      (list (car coords))
		      (PPT:2D->StEnd coords)
		      (list (last coords))
		    ) ;_end append
	  ) ;_end of pts

	  (setq	*cdl_actvdoc*
		 (vla-get-ActiveDocument
		   (vlax-get-acad-object)
		 ) ;_end of vla-get-ActiveDocument
	  ) ;_end of setq *cdl_actvdoc*
;;; Строим полилинию по новым вершинам
	  (defun LWPoly	(pts / templst entg)
	    (vla-AddLightWeightPolyline
	      (vla-get-Block (vla-get-ActiveLayout *cdl_actvdoc*))
	      (vlax-safearray-fill
		(vlax-make-safearray
		  vlax-vbDouble
		  (vl-list* 0
			    (1-	(length	(setq templst
					       (apply
						 'append
						 (mapcar
						   (function
						     (lambda (x)
						       (cond
							 ((= 3 (length x))
							  (reverse (cdr (reverse x)))
							 )
							 (T x)
						       ) ;_end of cond
						     ) ;_end of lambda
						   ) ;_end of function
						   pts
						 ) ;_end of mapcar
					       ) ;_end of apply
					) ;_end of setq templst
				) ;_end of length
			    ) ;_end of 1-
		  ) ;_end of vl-list*
		) ;_end of vlax-make-safearray
		templst
	      ) ;_end of vlax-safearray-fill
	    ) ;_end of vla-AddLightWeightPolyline
	    (setq entg (entget (entlast)))
	    (entmod (append entg (list (cons 370 30) (cons 62 1))))
	  ) ;_end of defun LWPoly
	  (LWPoly pts)
	) ;_end of progn
	(princ "\n Это не тип полилинии.")
      ) ;_end of if
    ) ;_end of progn
    (princ "\n Объект не выбран.")
  ) ;_end of if
  (princ)
  (gc)
) ;_end of defun C:PPM

Это аналог функции оффсет только для моих условий.
Что можешь посоветовать по решению такой вот проблемки:
Когда я выбираю сторону отложения новой полилинии мне приходится прописать ряд функций (начиная со строки (setq ugol1...), на мой взгляд это не правильно мне кажеться что-то должно быть чтоб автокад понимал где право а где лево.

Код:

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

 (setq	ugol1 (angle (car xy_v) pt) ;вспомогательные величины
		ugol2 (angle (car xy_v) (cadr xy_v))
					;для определения			
		x1    (caar xy_v)	;стороны смещения
		x2    (caadr xy_v)
		y_pt  (cadr pt)
		y1    (cadar xy_v)
		y2    (cadadr xy_v)
	  ) ;_end of setq(s)
	  (cond	((and (= y1 y2) (= ugol2 0) (< y_pt y1))
		 (setq k pi)
		)
		((and (= y1 y2) (> ugol2 ugol1))
		 (setq k pi)
		)
		((and (= y1 y2) (< ugol2 ugol1))
		 (setq k (* 2. pi))
		)
		((and (= x1 x2) (> ugol2 ugol1))
		 (setq k pi)
		)
		((and (= x1 x2) (< ugol2 ugol1))
		 (setq k (* 2. pi))
		)
		((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1) (< y1 y2))
		 (setq k pi)
		)
		((and (< x1 x2) (> y_pt y1) (> ugol2 ugol1))
		 (setq k (* 2. pi))
		)
		((and (< x1 x2) (< y1 y2) (< ugol2 ugol1) (< y_pt y1))
		 (setq k pi)
		)
		((and (> ugol2 ugol1) (< x1 x2))
		 (setq k pi)
		)
		((and (< ugol2 ugol1) (< x1 x2))
		 (setq k (* 2. pi))
		)
		((and (> ugol2 ugol1) (> x1 x2))
		 (setq k pi)
		)
		((and (< ugol2 ugol1) (> x1 x2))
		 (setq k (* 2. pi))
		)
	  ) ;_end of cond

[ProPeller]

Сообщение от Pavel_GP Есть решение моего вопроса, мы все кто смог помочь его решили

Рекомендую описание функции PPT:2D->StEnd переместить из цикла по списку (foreach), например в начало описания программы, где у тебя комментарий ;;; Вспомогательные функции, иначе функция будет переопределяться столько раз, сколько элементов у тебя будет в списке.

Сообщение от Pavel_GP мне приходится прописать ряд функций

Не очень понятно, что у тебя и откуда. Нужно рассматривать на реальном примере. Что касается твоего примера, то тут нужна оптимизация и что-то мне подсказывает, что есть некторое количество неучтённых вариантов определения сторонности которые приведут к ошибке.
Если мы на сто процентов уверены, что существует только лишь два варианта k, то я бы начал с этого, а потом стал бы думать дальше.

Код:

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

 (setq
 ugol1 (angle (car xy_v) pt) 
 ugol2 (angle (car xy_v) (cadr xy_v)) 		
 x1    (caar xy_v) 
 x2    (caadr xy_v)
 y_pt  (cadr pt)
 y1    (cadar xy_v)
 y2    (cadadr xy_v)
 k     (if
	(or
	 (and (= y1 y2) (= ugol2 0) (< y_pt y1))
	 (and (= y1 y2) (> ugol2 ugol1))
	 (and (= x1 x2) (> ugol2 ugol1))
	 (and (< x1 x2) (> y_pt y1) (> ugol2 ugol1) (< y1 y2))
	 (and (< x1 x2) (< y1 y2) (< ugol2 ugol1) (< y_pt y1))
	 (and (> ugol2 ugol1) (< x1 x2))
	 (and (> ugol2 ugol1) (> x1 x2))
	)
	pi
	(* 2 pi)
       )
)

Сообщение от Pavel_GP на мой взгляд это не правильно мне кажеться что-то должно быть чтоб автокад понимал где право а где лево.

Нет, он не способен это определить. Понятие лево и право субъективно, а соответственно неконкретно. Как говорится "Смотря, как смотреть."

[Pavel_GP]

Сообщение от ProPeller Рекомендую описание функции PPT:2D->StEnd переместить из цикла по списку (foreach), например в начало описания программы, где у тебя комментарий ;;; Вспомогательные функции, иначе функция будет переопределяться столько раз, сколько элементов у тебя будет в списке.

Спс. Поправил.

Сообщение от ProPeller Если мы на сто процентов уверены, что существует только лишь два варианта k, то я бы начал с этого, а потом стал бы думать дальше.

Понял. спс.

ProPeller подскажи, что прописать, чтобы после построения опять появлялся вопрос какое смещение ввести и указать сторону? пока не нажму отмена.

[Pavel_GP]

Попробовал с помощью цикла, но тогда построения тянуться друг за другом.

[Fedorino]

Здравствуйте! Подскажите, пожалуйста, как добраться до свойств примитивов входящих в описание блока?
До свойств самого блока добраться легко, а вот до примитивов в блоке пока не представляю как.
В какую сторону копать, подскажите.

[gomer]

Сообщение от Fedorino В какую сторону копать, подскажите.

rкопай в сторону entnext

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

А не проще найти темы "Нормализация блоков" и "Подготовка подосновы"? Там вариантов "захода внутрь блока" - тьма!

[ProPeller]

Сообщение от Fedorino До свойств самого блока добраться легко

Не совсем правильное определение. То что вы называете блоком, на самом деле является ссылкой на блок или же Reference.
Если знакомы с технологией ActiveX, то рекомендую воспользоваться следующими командами.

Код:

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

 (vl-load-com)
;;;Подгрузка ActiveX
(setq BlkFam (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object))))
;;;Получили сенмейство блоков в текущем чертеже
(setq ParBlk (vla-item BlkFam "Имя_блока"))
;;;Получили указатель на исходный блок
(vlax-for v1 ParBlk (setq BlkEntLst (cons v1 BlkEntLst)))
;;;Получили список указателей на примитивы блока

;;;В упрощенном варианте будет выглядеть так

(vlax-for v1 (vla-item (vla-get-blocks
			(vla-get-ActiveDocument (vlax-get-acad-object))
		       )
		       "Имя_блока"
	     )
 (setq BlkEntLst (cons v1 BlkEntLst))
)

[Fedorino]

Сообщение от gomer rкопай в сторону entnext

Начал копать в сторону entnext, действительно можно добраться до примитивов.

Код:

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

(defun vvv ( / vb v_lst)
	(setq vb (cdr (assoc -2 (tblnext "BLOCK" "имя блока"))))
		(while (/= nil vb)
			(setq v_lst (cons vb v_lst))
			(setq vb (entnext vb))
		)
	(length v_lst)
)

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

ProPeller, спасибо за информацию, попробую использовать active x.

[Jerald]

Сообщение от ProPeller К сожалению нет. Может вас спасет вот эта программка, будет как

Не могу адаптировать эту функцию в команду:
Команда: (setvar "cecolor" (LM:randrange 0 10))
; ошибка: Настройка переменной AutoCAD отвергнута: "cecolor" 2

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

Код:

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

  (setvar "cecolor" (itoa (fix (LM:randrange 0 10))))

[Fedorino]

Здравствуйте! Пишу в ветку для чайников, так как сам пока не могу сообразить то, каким образом решить свою проблему.
Lisp знаю неважно, а методы АктивХ вообще плохо. Поэтому решил написать сюда, может кто-то поможет советом.
Есть задача, используя метод Актив Х, добраться до свойств блока, лучше конечно до атрибутов, но хотя бы просто до блока расположенного на листе.
Назрело несколько вариантов
Вариант 1.
Активный документ-семейство блоков-подсчет количества-переборка всех блоков.
Но тут запинка - не знаю как распознать на каком листе лежит тот или иной блок.
Блоки нашел с листами связать не знаю как.

Вариант 2.
Активный документ-семейство листов-подсчет количества-переборка всех листов.
Но и тут увы проблема, как на листе искать нужный блок?
Искать в пространстве PaperSpace или Layout?
Наоборот, листы нашел, как искать блоки на них?

Вопросов море, ответов мало. Направьте заблудшего дальше, прошу.

[ProPeller]

Сообщение от Fedorino Есть задача, используя метод Актив Х, добраться до свойств блока, лучше конечно до атрибутов, но хотя бы просто до блока расположенного на листе. Назрело несколько вариантов Наоборот, листы нашел, как искать блоки на них? Вопросов море, ответов мало. Направьте заблудшего дальше, прошу.

Если блок не динамический, то будет проще. Если блок динамический, да еще у него изменен какой-то параметр, то придется ковырять глубже, но тоже все вполне выполнимо.
Перед тем как давать советы, хотелось бы узнать, по каким свойствам данный блок должен находиться (Имя, Имя листа, цвет, запах и т.д.)? Это значительно уменьшит количество советов и направит в нужное русло.
Заодно можете приложить файл с этим блоком, расположенным там где его нужно искать. Там можно уже будет подсказать, как добраться до атрибутов.

[Fedorino]

ProPeller, спасибо за проявленный интерес, выкладываю файл.
В файле лситы с блоком основной надписи, блок динамический.
Итоговая задача-максимум пройти каждый лист чертежа, найти блок "Осннадпись" и в зависимости от параметра видимости в блоке,
считывать информацию из атрибута "НАЗВАНИЕ-ТЕКУЩ-ЛИСТА", запоминая ее.
Затем данную инфу размещаем в таблице ведомости листов.
Атрибуты считывать я научился, правда пока у простых блоков, инфу запоминать и размещать в таблице тоже.
А вот оперируя методами актив Х добраться до блока пока не хватает опыта и знаний.
Поэтому, прошу, подскажите каким образом оптимальнее добраться до блока.

[kacugu]

Fedorino, посмотрите эту тему http://forum.dwg.ru/showthread.php?t=14548

[ProPeller]

Сообщение от Fedorino ProPeller, спасибо за проявленный интерес, выкладываю файл. В файле лситы с блоком основной надписи, блок динамический. Итоговая задача-максимум пройти каждый лист чертежа, найти блок "Осннадпись" и в зависимости от параметра видимости в блоке, считывать информацию из атрибута "НАЗВАНИЕ-ТЕКУЩ-ЛИСТА", запоминая ее. Затем данную инфу размещаем в таблице ведомости листов. Атрибуты считывать я научился, правда пока у простых блоков, инфу запоминать и размещать в таблице тоже. А вот оперируя методами актив Х добраться до блока пока не хватает опыта и знаний. Поэтому, прошу, подскажите каким образом оптимальнее добраться до блока.

Так, ну для начала можно достать все блоки со всех листов. Если прогнать этот код, то получим список1, состоящий из списков2. Каждый из списков2, содержит название листа и указатели на все блоки "Осннадпись", найденные на этом листе. Этого достаточно? Или будем ковырять дальше?))

Код:

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

 (mapcar
 '(lambda (l1)
   (cons l1
	 (vl-remove-if-not
	  '(lambda (l2)
	    (= (vla-get-EffectiveName l2)
	       "Осннадпись"
	    )
	   )
	  (mapcar
	   'vlax-ename->vla-object
	   (mapcar
	    'cadr
	    (ssnamex
	     (ssget "_X"
		    (list (cons 0 "INSERT")
			  (cons 2 "Осннадпись,`*U*")
			  (cons 410 l1)
		    )
	     )
	    )
	   )
	  )
	 )
   )
  )
 (reverse (layoutlist)))

[Fedorino]

kacugu, спасибо за ссылочку, гляну.
ProPeller, спасибо за код, а вообще возможно полноценно использовать АктивХ, т.е. добраться до блоков через семейства?
Например, через семейство листов - найти нужный лист, оттуда выудить инфу о семействе блоков - затем о нужном блоке.
Или сразу через семейство блоков получить инфу о нужном блоке, а из него выудить на каком он листе располагается.
Таким образом до объектов можно добираться или же все же придеться использовать стандартные lisp функции?

[ProPeller]

Сообщение от Fedorino ProPeller, спасибо за код, а вообще возможно полноценно использовать АктивХ, т.е. добраться до блоков через семейства?

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

Сообщение от Fedorino Например, через семейство листов - найти нужный лист, оттуда выудить инфу о семействе блоков - затем о нужном блоке.

Вот тут сразу нужно понять, что семейство блоков одно для всего чертежа.

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

Исходя из сказанного мной выше, так сделать нельзя.

Сообщение от Fedorino Таким образом до объектов можно добираться или же все же придеться использовать стандартные lisp функции?

Добраться до этих блоков можно как стандартными средствами, так и посредством ActiveX, но вот например добраться до атрибутов этих блоков стандартными средствами скорее всего не получится, а уж до параметров динамического блока тем более.

Отсюда вывод. В связи с тем что AutoCAD хранит информацию об объектах одним целым, не разделяя её на листы и т.д., приходится искать нужные объекты посредством анализа их свойств.

[Fedorino]

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

В связи с тем что AutoCAD хранит информацию об объектах одним целым, не разделяя её на листы и т.д.,

Посмотрел справку, там по поводу BlockRef object написано

Access via: ModelSpace.Item PaperSpace.Item Block.Item SelectionSet.Item Group.Item

PaperSpace - это разве не пространство листа?
Или я в чем то ошибаюсь?

[ProPeller]

Сообщение от Fedorino PaperSpace - это разве не пространство листа?

Да, это пространство листа. Именно листа, а не листов, к тому же именно последнего активного листа.

[Fedorino]

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

[ProPeller]

Сообщение от Fedorino Ясно, последовательное активирование листов и поиск нужного блока, увеличат время работы программы, по сравнению с алгоритмом поиска сразу всех блоков и анализа их свойств.

Не совсем так. Даже активировав нужный лист, найти блоки с помощью PaperSpace скорее всего не получится.
В том варианте который я предложил, как раз и происходит поочередная фильтрация по листам, но на скорость это не сильно влияет. Я бы даже сказал наоборот, что это наиболее быстрый вариантом поиска. Более того, даже несколько тысяч таких блоков, расположенных на разных листах, найдутся в течении 1-2 секунд.
П.С. Если бы блок был не динамическим и мы бы точно знали в каком листе искать, то код сократился бы втрое.

[Doctor_Che]

Здравствуйте.

Подскажите как реализовать выбор диапазона вручную в LibreOffice Calc?
Есть пример для Excel, но простая замена не проходит. Ругается на отсутствие свойств ActiveX:

Код:

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

 Application aborted: ActiveX Server возвратил ошибку: неизвестное имя: VISIBLE
Application aborted: ActiveX Server возвратил ошибку: неизвестное имя: SELECTION

Код:

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

 ;указать диапазон вручную
            (princ "\nDictionary is not found. Please type data area manualy")
            (vlax-put-property ExcelApp 'Visible :vlax-true) ;помигать екселем
            (getstring "\nselect data area in Excel and then press enter"); ожидать нажатие клавиши
            (setq used_range (vlax-get-property ExcelApp 'Selection)); получение указателя на выделенную область
            (setq lst (vlax-safearray->list (vlax-variant-value (vlax-get-property used_range 'Value)))) ;; получение списка данных с екселя
            (setq WorkBook (vlax-get-property ExcelApp "ActiveWorkBook"))

[Сергей812]

может, SDK поможет?

[kacugu]

Вечер добрый. Пока на работе тихо, решил допилить свой старый код. Но возникла непонятка.
В файле dcl заданы элементы:

Код:

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

: row {
   	: popup_list 
			{label = "Диаметр:"; 
			key = "eb_DiamGor"; 
			list = "0" "\n6"; 
			edit_width=5;}
   	: edit_box 
			{label = "Шаг:"; 
			key = "eb_StepGor"; 
			edit_width=15; 
			value = "200";}
   	: edit_box 
			{label = "Длина:"; 
			key = "eb_LengthGor"; 
			edit_width=15; 
			value = "2000";}
} // конец row

Считываю значения в лиспе:

Код:

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

 (setq StepGor (atoi (get_tile "eb_StepGor"))) 
(setq LengthGor (atoi (get_tile "eb_LengthGor")))

И почему-то в StepGor передается значение "eb_LengthGor", а в LengthGor - значение "eb_StepGor", когда должно быть наоборот.
Почему такое может происходить?

[ProPeller]

Сообщение от kacugu Вечер добрый. Пока на работе тихо, решил допилить свой старый код. Но возникла непонятка. Считываю значения в лиспе: Код: [Выделить все] (setq StepGor (atoi (get_tile "eb_StepGor"))) (setq LengthGor (atoi (get_tile "eb_LengthGor"))) И почему-то в StepGor передается значение "eb_LengthGor", а в LengthGor - значение "eb_StepGor", когда должно быть наоборот. Почему такое может происходить?

Поставьте точку останова и посмотрите какие значения и где присваиваются. Для того чтобы понять в чем проблема, недостаточно двух строчек с setq. Может быть у вас потом идет переопределение переменных, а вы просто этого не увидели. Скиньте весь код.

[kacugu]

Сообщение от ProPeller Скиньте весь код.

Добавил в приложение. Пришлось dcl файлу поменять расширение на .lsp - при загрузке возникала ошибка "некорректный файл".
Смысл лиспа: ввожу данные арматурной сетки, выбираю точку вставки, отрисовывается сетка и вставляется спецификация в виде блока.

[trushev]

Заменить list = "0" "\n6"; на list = "0\n6";

[ProPeller]

Сообщение от kacugu Добавил в приложение. Пришлось dcl файлу поменять расширение на .lsp - при загрузке возникала ошибка "некорректный файл". Смысл лиспа: ввожу данные арматурной сетки, выбираю точку вставки, отрисовывается сетка и вставляется спецификация в виде блока.

Ошибка находится здесь, сразу после закрытия окна. Строка 591.

Код:

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

 (if (= ddi 1) (TEST2 N KOL KOD Armclass Armgost Armmat Armmatgost TN DiamGor LengthGor StepGor DiamVert LengthVert StepVert Vlevo Vpravo Vverh Vniz))

В описании функции TEST2 у вас LengthGor и StepGor стоят в другом порядке, вот и все.

Код:

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

 (defun TEST2 ( N KOL KOD Armclass Armgost Armmat Armmatgost TN DiamGor StepGor LengthGor DiamVert StepVert LengthVert Vlevo Vpravo Vverh Vniz)...

[kacugu]

trushev, ничего не изменилось.
ProPeller, спасибо! так заработало. Offtop: сам бы ещё нескоро заметил

[kolya161]

Здравствуйте!
Имеется вот такой код для внедрения внешних ссылок:

Код:

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

 
(defun test (path / ent doc)
  (vl-load-com)
  (setq *docs* (vla-get-documents (vlax-get-acad-object)))
  (setq doc (vla-open *docs* path))
  (vlax-for ent	(vla-get-blocks doc)
    (if	(= (vla-get-isxref ent) :vlax-true)
      (progn (vla-bind ent :vlax-true) (princ "\nСсылка внедрена"))
    ) ;_ end of if
  ) ;_ end of vlax-for
  (vla-save doc)
  (vla-close doc)
) ;_ end of defun
 

После открытия файла происходит ошибка: Ошибка Automation. Ключ не найден.
И соответственно ссылки не внедрены, файл остается открытым.
Подскажите, как можно решить такой вопрос?

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

Если у тебя файл не открывается, то какие претензии к коду? Проверяй и файл-получатель, и файлы ссылок на ошибки, мусор и т.п.

[kolya161]

Файл открывается. Ошибки и прочее проверил и почистил, а ситуация не меняется.

[Red Nova]

Доброго.

После того как поставил реактор на отслеживание и возврат SAVETIME Прокат отказывается работать.
Выдает либо

Код:

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

Command: _prokat bad argument type: numberp: "SAVETIME"AutoCAD variable setting rejected: "osmode" nil

либо Internal error с последующим вылетом.

Возможно ли подружить

Реактор привожу ниже.

Код:

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

 {code}
(defun C:ALERTME ()
(vl-load-com)
(setq VTFRXN (vlr-editor-reactor nil '((:VLR-sysVarChanged . VTF))))
)


(defun VTF (CALL CALLBACK)
(if (and
(= (strcase (car CALLBACK)) (setq str "SAVETIME"))
(not (eq (getvar str) 5))
)
(progn
(princ (strcat "Warning: Someone or something has changed your Autosave settings.\n" str " has been changed back"))
(setvar "SAVETIME" 5)
)
)
)
(setvar "SAVETIME" 5)
(c:alertme)
{code}

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

Ну, во-первых, сделай переменные локальными. Во-вторых, ты внутри реактора меняешь системную переменную, на которую настроен этот реактор. Бесконечный цикл, здрасьте!

[Red Nova]

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

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

Примерно так:

Код:

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

 (defun c:alertme ()
  (vl-load-com)
  (setq vtfrxn (vlr-editor-reactor nil '((:vlr-sysvarchanged . vtf))))
  ) ;_ end of defun


(defun vtf (call callback / str)
  (if (and
        (= (strcase (car callback)) (setq str "SAVETIME"))
        (not (eq (getvar str) 5))
        (not *rednova-savetime*)
        ) ;_ end of and
    (progn
      (princ (strcat "Warning: Someone or something has changed your Autosave settings.\n"
                     str
                     " has been changed back"
                     ) ;_ end of strcat
             ) ;_ end of princ
      (setq *rednova-savetime* t)
      (setvar "SAVETIME" 5)
      ) ;_ end of progn
    (setq *rednova-savetime* nil)
    ) ;_ end of if
  ) ;_ end of defun

(setvar "SAVETIME" 5)

(c:alertme)

[Red Nova]

Спасибо маестро.
На 2013 заработало. На 2015 есть еще какая то проблема с Прокатом Кондрата, но о ней не тут.
Оказывается я изначально писал не в той теме. Я думал что пишу в топике "Обновление программы «Прокат» Василия Кондрата" ))).
Продолжу по правильному адресу.

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

У тебя проблема не связана с "Прокатом", так что посты я не перенес.

[Red Nova]

Я то думал у меня совсем с памятью худо стало ))).

Наверное так имелось ввиду.

У тебя проблема не связана с "Прокатом", так что посты я не перенес.

[mkung]

На некоторых компьютерах время от времени Автокад начинает загружаться с отключенной командой "ОТМЕНА".
Понятно, что за это отвечает переменная "UNDOCTL", но она "только для чтения" и SETVAR не работает.
Придумал вот такую проверку с исправлением:

Код:

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

 (if (= (rem (getvar "UNDOCTL") 2) 0) (command "_undo" "В"))

Но как-то неаккуратно через команду...
Можно ли включать "ОТМЕНУ" поизящнее что-ли?

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

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

[mkung]

Сообщение от Кулик Алексей aka kpblc Для начала отключи все дополнения, которые у тебя используются. Практически гарантирую, что проблема кроется в них.

Чаще всего это на AutoCAD Electrical происходит. Встречал вопросы по такой теме в Интернете.
Ну и набор софта стандартный... Как его менять?!

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

В автозагрузку добавь лисп типа

Код:

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

 (vl-load-com)
(defun endmark()
(repeat 3 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))))

(endmark)

[gomer]

Сообщение от mkung (if (= (rem (getvar "UNDOCTL") 2) 0) (command "_undo" "В"))

Первый раз вижу такой идиотизм...
1) Если группа отмен активна, она завершается
2) Новая группа отмен начинается ВСЕГДА!!!

[Inferi]

Добрый день, помогите преобразовать список:
(x1 y1 x2 y2 x3 y3 x4 y4...) => ((x1 y1 0.0) (x2 y2 0.0) (x2 y2 0.0) (x3 y3 0.0) (x3 y3 0.0) (x4 y4 0.0) (x4 y4 0.0)...)

[kurstep]

Сообщение от Inferi Добрый день, помогите преобразовать список: (x1 y1 x2 y2 x3 y3 x4 y4...) => ((x1 y1 0.0) (x2 y2 0.0) (x2 y2 0.0) (x3 y3 0.0) (x3 y3 0.0) (x4 y4 0.0) (x4 y4 0.0)...)

Код:

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

 (setq spis (list 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 ))

(setq n -2
      a nil
spis2 nil
      )
(repeat (/ (length spis) 2)
  (setq n (+ 2 n))
  (setq a (list (nth n spis) (nth (1+ n) spis) 0.0))
  (setq spis2  (append  spis2 (list a))))

[ciril]

Код:

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

 (cdr
  ((eval
     (setq la0 (function (lambda (e00 / a00 a01)
                           (if (setq a00 (cddr e00))
                             (append (list (setq a01 (list (car e00) (cadr e00) 0.0)) a01) ((eval la0) a00)))))))
    '(1 2 3 4 5 6 7 8 9 0)))

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

Написано на коленке, критику приму, но переделывать не буду: некогда

Код:

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

 (defun list-to-3 (lst)
  (cond
    ((not lst) nil)
    ((= (length lst) 1)
     (list (list (car lst) 0. 0.))
     )
    ((= (length lst) 2)
     (list (list (car lst) (cadr lst) 0.))
     )
    (t
     (cons (list (car lst) (cadr lst) 0.) (list-to-3 (cddr lst)))
     )
    ) ;_ end of cond
  ) ;_ end of defun

Код:

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

 _$ (LIST-TO-3 '(1 2 3 4 5 6))
((1 2 0.0) (3 4 0.0) (5 6 0.0))
_$ (LIST-TO-3 '(1 2 3 4 5 ))
((1 2 0.0) (3 4 0.0) (5 0.0 0.0))

[ciril]

Сообщение от Inferi Добрый день, помогите преобразовать список: (x1 y1 x2 y2 x3 y3 x4 y4...) => ((x1 y1 0.0) (x2 y2 0.0) (x2 y2 0.0) (x3 y3 0.0) (x3 y3 0.0) (x4 y4 0.0) (x4 y4 0.0)...)

(x1 y1 0.0) - встречается только один раз?
И да, если список из двух элементов, то поправил:

Код:

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

 (cdr
  ((eval
     (setq la0 (function (lambda (e00 / a00 a01)
                           (if (setq a00 (cddr e00))
                             (append (list (setq a01 (list (car e00) (cadr e00) 0.0)) a01) ((eval la0) a00))
                             (list (append (mapcar (function (lambda (e10)
                                                               (if e10
                                                                 e10
                                                                 0.0)))
                                                   (list (car e00) (cadr e00)))
                                           '(0.0))))))))
    '(1 1 2 2 3 3 4 4 5)))

[Inferi]

Первый и последний элемент по задумке встречается только один раз. Спасибо всем!

[ciril]

Сообщение от Inferi Первый и последний элемент по задумке встречается только один раз. Спасибо всем!

вдогон поправил

[ProPeller]

Чет как-то сложно у вас тут.

Код:

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

 (defun Lst->Flat3D (lst)
   (if lst
    (cons (list (car lst) (cadr lst) 0.0)
	  (Lst->Flat3D (cddr lst))
    )
   )
  )

[ciril]

Первый элемент в результирующем встретится только один раз?
Последний элемент встретиться только один раз?
Остальные элементы дублируются?
Каждый третий элемент куда денется? Гы
А так, да, сложно ))

[ProPeller]

Сообщение от ciril Первый элемент в результирующем встретится только один раз? Последний элемент встретиться только один раз? Остальные элементы дублируются? Каждый третий элемент куда денется? Гы А так, да, сложно ))

С какой стати дублироваться каким-то элементам и встречаться вновь первому и последнему? О каком третьем элементе идет речь?
Просто коды описанные выше, это какое-то извращение прям. В них сам черт ногу сломит.

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

ProPeller, ты в свой код подставь список длиной 5 символов

[ciril]

Сообщение от ProPeller С какой стати дублироваться каким-то элементам и встречаться вновь первому и последнему? О каком третьем элементе идет речь? Просто коды описанные выше, это какое-то извращение прям. В них сам черт ногу сломит.

А ты почитай, как требовалось преобразовывать список и решения предлагай согласно, хм, ТЗ

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

Я начинаю подозревать, что человек хочет по списку точек строить массив отрезков.

[ciril]

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

[ProPeller]

Сообщение от ciril А ты почитай, как требовалось преобразовывать список и решения предлагай согласно, хм, ТЗ

Сорян. Я что-то и правда затупил ))
Конец рабочего дня и бла-бла-бла ))

[Inferi]

Всем доброго дня! Хочу вывести две строчки рядом с курсором. Нашел много полезных лиспов, в частности очень понравилась реализация от Евгения Елпанова: http://www.theswamp.org/index.php?topic=32971.0
Вопрос следующий, можно ли малой кровью добиться, чтобы функция Евгения (eea-abc str cb cf) выводила динамически изменяющиеся строчки (как изначально реализовано через prompt):

Код:

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

 ;*****************************************************************************
; INSPECTOR - Command to Inspect Objects by Moving the Crosshairs Over Them. *
; =========                                                                  *
;             Didge, 2006.                                                   *
;*****************************************************************************
(defun C:INSPECTOR (/ INPUT INPUT_COORD ENTITY_FOUND ENTITY_NAME ENTITY_LIST ENTITY_TYPE ENTITY_LAYER)
  (prompt "\nMove Crosshairs To Inspect Objects.")
  (while (and (setq INPUT (grread T)) (= (car INPUT) 5))
      (setq INPUT_COORD (cadr INPUT))
      (setq ENTITY_FOUND (ssget INPUT_COORD))
      (if ENTITY_FOUND
         (progn
	    (setq ENTITY_LIST (entget (ssname ENTITY_FOUND 0)))
            (setq ENTITY_TYPE (cdr (assoc 0 ENTITY_LIST)))
            (setq ENTITY_LAYER (cdr (assoc 8 ENTITY_LIST)))
	    ;(prompt (strcat "\rObject: " ENTITY_TYPE "    Layer: " ENTITY_LAYER "                     "))
            (eea-abc (strcat ENTITY_TYPE "\n" ENTITY_LAYER) 7 5)
	 )
      )
  )
  (princ)
)

Через форум находил готовые решения от Lee Mac, но там проблемы с кириллицей. Спасибо за внимание!

[ProPeller]

Сообщение от Inferi Всем доброго дня! Хочу вывести две строчки рядом с курсором. Нашел много полезных лиспов, в частности очень понравилась реализация от Евгения Елпанова: http://www.theswamp.org/index.php?topic=32971.0 Вопрос следующий, можно ли малой кровью добиться, чтобы функция Евгения (eea-abc str cb cf) выводила динамически изменяющиеся строчки (как изначально реализовано через prompt):[/lisp][/code] Через форум находил готовые решения от Lee Mac, но там проблемы с кириллицей. Спасибо за внимание!

Функцию eea-abc-то покажите

----- добавлено через ~4 мин. -----
И куда должны выводиться и какие динамические строчки?

[Inferi]

Код:

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

(defun c:test ()
 (eea-abc
  "
***************************************************************

by ElpanovEvgeniy

mail: elpanov@gmail.com
web: www.elpanov.com

***************************************************************

Program for displaying any text near the cursor on the screen.

Date of creation 01.02.2006
Last edition 06.02.2008

arguments:

str - a text string to display
cb - the background color
cf - color of text

***************************************************************
" 7
  5
 )
)
(defun eea-abc (str cb cf / *ERROR* C GR I IL INT IY L L-ST MX S ST X Y)
               ;|
*****************************************************************************************

by ElpanovEvgeniy

mail: elpanov@gmail.com
web: www.elpanov.com

*****************************************************************************************

Программа для отображения любого текста возле курсора на экране. 

Дата создания 01.02.2006
последняя редакция 06.02.2008

аргументы:

str - текстовая строка для отображения
cb - цвет фона
cf - цвет текста

*****************************************************************************************

Program for displaying any text near the cursor on the screen.

Date of creation 01.02.2006
Last edition 06.02.2008

arguments:

str - a text string to display
cb - the background color
cf - color of text

*****************************************************************************************

(eea-abc
 " !\"#$%&'()*+,-./0123456789:;<=>?@
ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`
abcdefghijklmnopqrstuvwxyz{|}~‚„…‰‹‘’“”•–—™¤¦§Ё©«¬*®°±·ё»
АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя"
 7
 5
)

(eea-abc "0.0" 1 2)

(eea-abc
"
(setq l (append (list (list -3. (setq i (1+ i)))
 (list (+ x 3.) i)
 (list -3. (setq i (1+ i)))
 (list (+ x 3.) i)
 (list -2. (setq i (1+ i)))
 (list (+ x 2.) i)
 (list 0. (setq i (1+ i)))
 (list x i)
 ) ;_ list
 l
 ) ;_ append
 il nil
)
"
7 5
)

(setq str(getstring t "\n Введите строку:\t"))
(eea-abc str 7 5)

*****************************************************************************************
|;
 (defun *ERROR* (m) (REDRAW) (princ))
 (while (setq i (VL-STRING-POSITION 10 str))
  (setq il  (cons (substr str 1 i) il)
        str (substr str (+ i 2))
  )
 )
 (setq il   (cons str il)
       int  nil
       i    0
       y    0
       st   '(" "   "\t"  "!"   "\""  "#"   "$"   "%"   "&"   "'"   "("   ")"   "*"   "+"   ","   "-"   "."   "/"   "0"   "1"   "2"   "3"   "4"
              "5"   "6"   "7"   "8"   "9"   ":"   ";"   "<"   "="   ">"   "?"   "@"   "A"   "B"   "C"   "D"   "E"   "F"   "G"   "H"   "I"   "J"
              "K"   "L"   "M"   "N"   "O"   "P"   "Q"   "R"   "S"   "T"   "U"   "V"   "W"   "X"   "Y"   "Z"   "["   "\\"  "]"   "^"   "_"   "`"
              "a"   "b"   "c"   "d"   "e"   "f"   "g"   "h"   "i"   "j"   "k"   "l"   "m"   "n"   "o"   "p"   "q"   "r"   "s"   "t"   "u"   "v"
              "w"   "x"   "y"   "z"   "{"   "|"   "}"   "~"   "‚"   "„"   "…"   "‰"   "‹"   "‘"   "’"   "“"   "”"   "•"   "–"   "—"   "™"   "¤"
              "¦"   "§"   "Ё"   "©"   "«"   "¬"   "*"   "®"   "°"   "±"   "·"   "ё"   "»"   "А"   "Б"   "В"   "Г"   "Д"   "Е"   "Ж"   "З"   "И"
              "Й"   "К"   "Л"   "М"   "Н"   "О"   "П"   "Р"   "С"   "Т"   "У"   "Ф"   "Х"   "Ц"   "Ч"   "Ш"   "Щ"   "Ъ"   "Ы"   "Ь"   "Э"   "Ю"
              "Я"   "а"   "б"   "в"   "г"   "д"   "е"   "ж"   "з"   "и"   "й"   "к"   "л"   "м"   "н"   "о"   "п"   "р"   "с"   "т"   "у"   "ф"
              "х"   "ц"   "ч"   "ш"   "щ"   "ъ"   "ы"   "ь"   "э"   "ю"   "я"
             )
       l-st '((" ")
              ("\t")
              ("!" 39 41 48 50 66 68 75 77 83 87 92 96 101 105 111 113)
              ("\"" 86 88 95 97 104 106 91 93 100 102 109 111)
              ("#" 113 115 104 106 86 88 77 79 68 70 50 52 41 43 38 40 47 49 55 62 65 67 74 76 83 85 91 98 101 103 110 112)
              ("$" 104 106 21 23 30 32 50 52 38 42 46 48 59 61 67 69 75 77 83 85 91 93 100 102 110 114 120 122 129 131)
              ("%" 51 53 42 44 31 34 39 41 48 50 58 61 46 47 55 57 65 67 75 77 85 87 95 97 105 106 91 94 102 104 111 113 99 101 108 110 118 121)
              ("&" 42 44 50 52 59 61 67 71 38 41 46 48 55 57 64 66 73 75 103 105 94 96 83 86 91 93 100 102 110 113)
              ("'" 93 95 102 104 111 113)
              ("(" 112 114 22 24 47 49 30 32 39 41 56 58 65 67 93 95 102 104 74 76 83 85)
              (")" 110 112 20 22 49 51 30 32 39 41 58 60 67 69 76 78 85 87 93 95 102 104)
              ("*" 59 61 56 58 66 69 73 80 84 87 95 97 92 94)
              ("+" 57 59 66 68 84 86 93 95 73 79)
              ("," 21 23 31 33 39 42 48 51)
              ("-" 73 79)
              ("." 39 42 48 51)
              ("/" 28 30 37 39 47 49 56 58 66 68 75 77 85 87 94 96 104 106 113 115)
              ("0" 105 107 95 98 86 89 78 80 69 71 60 62 51 53 39 43 47 49 56 59 65 68 74 76 83 85 92 94 101 103 111 115)
              ("1" 40 42 49 51 58 60 67 69 76 78 85 87 91 96 102 105 112 114)
              ("2" 37 43 46 48 56 58 66 68 76 78 86 88 95 97 104 106 91 93 100 102 110 114)
              ("3" 59 61 50 52 38 42 46 48 55 57 68 70 75 78 86 88 95 97 104 106 91 93 100 102 110 114)
              ("4" 41 43 50 52 95 97 86 88 77 79 68 70 55 62 64 66 74 76 83 85 92 94 101 103 110 112)
              ("5" 37 41 49 51 59 61 68 70 73 78 82 84 91 93 100 102 109 115)
              ("6" 77 79 68 70 59 61 50 52 38 42 46 48 55 57 64 66 73 75 82 87 92 94 102 104 111 114)
              ("7" 109 115 104 106 94 96 85 87 75 77 66 68 56 58 47 49 38 40)
              ("8" 50 52 59 61 67 70 86 88 95 97 104 106 110 114 100 102 91 93 82 85 74 78 64 66 55 57 46 48 38 42)
              ("9" 77 79 86 88 95 97 104 106 110 114 100 102 91 93 82 84 73 75 65 70 58 60 48 50 38 41)
              (":" 39 42 48 51 84 87 93 96)
              (";" 84 87 93 96 12 14 22 24 30 33 39 42)
              ("<" 41 43 49 51 57 59 65 67 73 75 83 85 93 95 103 105 113 115)
              ("=" 64 70 82 88)
              (">" 109 111 101 103 93 95 85 87 77 79 67 69 57 59 47 49 37 39)
              ("?" 39 41 48 50 66 68 75 77 85 87 95 97 104 106 91 93 100 102 110 114)
              ("@" 78 80 69 71 58 62 66 68 75 77 85 89 96 98 105 107 37 44 45 47 54 56 63 65 72 74 81 83 90 92 99 101 109 115)
              ("A" 95 97 86 88 77 79 59 61 50 52 41 43 37 39 46 48 55 57 64 70 73 75 82 84 91 93 101 105 111 113)
              ("B" 104 106 95 97 86 88 68 70 59 61 50 52 37 42 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 114)
              ("C" 104 106 95 97 59 61 50 52 38 42 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 114)
              ("D" 103 105 95 97 86 88 77 79 68 70 59 61 49 51 37 41 46 48 55 57 64 66 73 75 82 84 91 93 100 102 109 113)
              ("E" 37 43 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 115)
              ("F" 109 115 100 102 91 93 82 84 73 78 64 66 55 57 46 48 37 39)
              ("G" 104 106 95 97 67 70 59 61 50 52 38 43 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 114)
              ("H" 113 115 104 106 95 97 86 88 68 70 59 61 50 52 41 43 37 39 46 48 55 57 64 66 73 79 82 84 91 93 100 102 109 111)
              ("I" 38 42 48 50 57 59 66 68 75 77 84 86 93 95 102 104 110 114)
              ("J" 113 115 104 106 95 97 86 88 77 79 68 70 59 61 50 52 38 42 46 48 55 57)
              ("K" 113 115 104 106 94 96 85 87 67 69 58 60 50 52 41 43 37 39 46 48 55 57 64 66 73 77 82 84 91 93 100 102 109 111)
              ("L" 37 43 46 48 55 57 64 66 73 75 82 84 91 93 100 102 109 111)
              ("M" 42 44 51 53 60 62 69 71 78 80 87 89 114 116 105 107 95 98 67 68 76 77 85 86 37 39 46 48 55 57 64 66 73 75 82 84 91 94 100 102 109
               111)
              ("N" 42 44 51 53 60 62 68 71 76 80 87 89 96 98 105 107 114 116 109 111 100 102 91 94 82 86 73 75 64 66 55 57 46 48 37 39)
              ("O" 104 106 95 97 86 88 77 79 68 70 59 61 50 52 38 42 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 114)
              ("P" 104 106 95 97 86 88 37 39 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 114)
              ("Q" 104 106 95 97 86 88 77 79 68 70 59 61 50 52 23 25 31 33 38 42 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 114)
              ("R" 41 43 50 52 59 61 67 69 86 88 95 97 104 106 37 39 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 114)
              ("S" 104 106 110 114 100 102 91 93 83 85 75 77 67 69 59 61 50 52 46 48 38 42)
              ("T" 39 41 48 50 57 59 66 68 75 77 84 86 93 95 102 104 109 115)
              ("U" 113 115 104 106 95 97 86 88 77 79 68 70 59 61 50 52 38 42 46 48 55 57 64 66 73 75 82 84 91 93 100 102 109 111)
              ("V" 113 115 104 106 95 97 86 88 77 79 68 70 59 61 39 41 47 51 55 57 64 66 73 75 82 84 91 93 100 102 109 111)
              ("W" 41 43 50 52 59 61 69 71 78 80 87 89 96 98 105 107 114 116 85 86 76 77 67 68 38 40 47 49 56 58 64 66 73 75 82 84 91 93 100 102 109
               111)
              ("X" 113 115 104 106 95 96 41 43 50 52 59 61 67 69 37 39 46 48 55 57 65 66 75 77 84 86 92 94 100 102 109 111)
              ("Y" 113 115 104 106 95 97 86 88 39 41 48 50 57 59 66 68 74 78 82 84 91 93 100 102 109 111)
              ("Z" 37 43 46 48 55 57 65 67 75 77 85 87 95 97 104 106 109 115)
              ("[" 2 6 11 15 20 22 29 31 38 40 47 49 56 58 65 67 74 76 83 85 92 94 101 103 110 114)
              ("\\" 32 34 41 43 49 51 58 60 66 68 75 77 83 85 92 94 100 102 109 111)
              ("]" 110 114 2 6 11 15 22 24 31 33 40 42 49 51 58 60 67 69 76 78 85 87 94 96 103 105)
              ("^" 113 115 109 111 119 123 129 131)
              ("_" 0 8 9 17)
              ("`" 112 114 120 122 128 131)
              ("a" 38 43 50 52 59 61 46 48 55 57 65 70 77 79 86 88 92 96)
              ("b" 50 52 59 61 68 70 77 79 86 88 37 42 46 48 55 57 64 66 73 75 82 84 91 96 100 102 109 111)
              ("c" 86 88 50 52 38 42 46 48 55 57 64 66 73 75 82 84 92 96)
              ("d" 86 88 77 79 68 70 59 61 50 52 38 43 46 48 55 57 64 66 73 75 82 84 92 97 104 106 113 115)
              ("e" 86 88 77 79 38 42 46 48 55 57 64 70 73 75 82 84 92 96)
              ("f" 111 115 101 103 92 94 83 85 73 79 65 67 56 58 47 49 38 40)
              ("g" 86 88 77 79 68 70 59 61 50 52 1 6 10 15 23 25 32 34 38 43 46 48 55 57 64 66 73 75 82 84 92 97)
              ("h" 41 43 50 52 59 61 68 70 77 79 86 88 37 39 46 48 55 57 64 66 73 75 82 84 91 96 100 102 109 111)
              ("i" 37 43 48 50 57 59 66 68 75 77 84 86 91 95 111 113 120 122)
              ("j" 1 5 10 14 22 24 31 33 40 42 49 51 58 60 67 69 76 78 85 87 92 96 112 114 121 123)
              ("k" 41 43 50 52 58 60 95 97 86 88 76 78 37 39 46 48 55 57 64 68 73 75 82 84 91 93 100 102 109 111)
              ("l" 37 43 48 50 57 59 66 68 75 77 84 86 93 95 102 104 109 113)
              ("m" 42 44 51 53 60 62 69 71 78 80 87 89 85 86 76 77 67 68 58 59 49 50 37 39 46 48 55 57 64 66 73 75 82 84 91 97)
              ("n" 41 43 50 52 59 61 68 70 77 79 86 88 37 39 46 48 55 57 64 66 73 75 82 84 91 96)
              ("o" 50 52 59 61 68 70 77 79 86 88 92 96 82 84 73 75 64 66 55 57 46 48 38 42)
              ("p" 50 52 59 61 68 70 77 79 86 88 1 3 10 12 19 21 28 30 37 42 46 48 55 57 64 66 73 75 82 84 91 96)
              ("q" 5 7 14 16 23 25 32 34 50 52 59 61 68 70 77 79 86 88 38 43 46 48 55 57 64 66 73 75 82 84 92 97)
              ("r" 95 97 85 88 37 39 46 48 55 57 64 66 73 76 82 84 91 93)
              ("s" 37 42 50 52 59 61 65 69 73 75 82 84 92 97)
              ("t" 39 43 47 49 56 58 65 67 74 76 83 85 91 97 101 103 110 112)
              ("u" 95 97 86 88 77 79 68 70 59 61 50 52 38 43 46 48 55 57 64 66 73 75 82 84 91 93)
              ("v" 95 97 86 88 77 79 68 70 59 61 39 41 47 51 55 57 64 66 73 75 82 84 91 93)
              ("w" 96 98 87 89 78 80 69 71 60 62 41 43 50 52 85 86 76 77 67 68 58 59 38 40 47 49 55 57 64 66 73 75 82 84 91 93)
              ("x" 95 97 86 88 41 43 37 39 50 52 46 48 56 60 66 68 74 78 82 84 91 93)
              ("y" 0 4 9 13 21 23 31 33 95 97 86 88 77 79 68 70 59 61 50 52 38 42 46 48 55 57 64 66 73 75 82 84 91 93)
              ("z" 37 43 46 48 56 58 66 68 76 78 86 88 91 97)
              ("{" 22 24 30 32 39 41 48 50 56 58 64 66 74 76 84 86 93 95 102 104 112 114)
              ("|" 3 5 12 14 21 23 30 32 39 41 48 50 57 59 66 68 75 77 84 86 93 95 102 104 111 113)
              ("}" 20 21 30 32 39 41 48 50 58 60 68 70 76 78 84 86 93 95 102 104 110 112)
              ("~" 115 116 105 107 94 97 102 104 90 91 99 101 109 112)
              ("‚" 21 23 31 33 39 42 48 51)
              ("„" 23 25 33 35 41 44 50 53 19 21 29 31 37 40 46 49)
              ("…" 36 38 45 47 42 44 51 53 39 41 48 50)
              ("‰" 43 44 33 34 51 52 30 31 40 42 38 39 48 49 36 37 45 47 55 57 65 67 75 77 85 87 95 97 105 106 100 101 110 111 108 109 118 119)
              ("‹" 40 42 48 50 56 58 64 66 74 76 84 86 94 96)
              ("‘" 103 104 111 113 120 121)
              ("’" 103 104 112 114 122 123)
              ("“" 104 105 112 114 121 122 101 102 109 111 118 119)
              ("”" 123 124 113 115 104 105 101 102 110 112 120 121)
              ("•" 66 68 74 78 84 86)
              ("–" 74 78)
              ("—" 73 79)
              ("™" 97 98 106 107 114 116 104 105 93 94 102 103 91 92 100 101 108 113)
              ("¤" 59 61 55 57 86 88 77 79 65 69 73 75 82 84 104 106 92 96 100 102)
              ("¦" 3 5 12 14 21 23 30 32 39 41 48 50 75 77 84 86 93 95 102 104 111 113)
              ("§" 19 21 2 6 11 15 23 25 32 34 39 42 47 51 59 61 68 70 55 57 64 66 74 78 104 106 83 86 91 93 100 102 110 114)
              ("Ё" 37 43 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 115 131 133 140 142 127 129 136 138)
              ("©" 86 87 68 69 57 59 65 66 74 75 83 84 93 95 105 107 97 98 88 89 79 80 70 71 61 62 51 53 37 43 45 47 54 55 63 64 72 73 81 82 90 91 99
               101 109 115)
              ("«" 42 44 50 52 58 60 68 70 78 80 38 40 46 48 54 56 64 66 74 76)
              ("¬" 59 61 68 70 73 79)
              ("*" 73 79)
              ("®" 86 87 77 78 59 60 56 57 65 68 74 75 83 84 92 95 105 107 97 98 88 89 79 80 70 71 61 62 51 53 37 43 45 47 54 55 63 64 72 73 81 82 90
               91 99 101 109 115)
              ("°" 113 115 104 106 92 96 100 102 109 111 119 123)
              ("±" 37 43 57 59 66 68 73 79 84 86 93 95)
              ("·" 75 78 84 87)
              ("ё" 38 43 46 48 55 57 86 88 77 79 64 70 73 75 82 84 92 96 113 115 122 124 109 111 118 120)
              ("»" 40 42 50 52 60 62 68 70 76 78 36 38 46 48 56 58 64 66 72 74)
              ("А" 95 97 86 88 77 79 59 61 50 52 41 43 37 39 46 48 55 57 64 70 73 75 82 84 91 93 101 105 111 113)
              ("Б" 77 79 68 70 59 61 50 52 37 42 46 48 55 57 64 66 73 75 82 87 91 93 100 102 105 106 109 115)
              ("В" 104 106 95 97 86 88 68 70 59 61 50 52 37 42 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 114)
              ("Г" 37 39 46 48 55 57 64 66 73 75 82 84 91 93 105 106 100 102 109 115)
              ("Д" 33 35 50 52 59 61 68 70 77 79 86 88 95 97 104 106 27 29 36 44 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 115)
              ("Е" 37 43 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 115)
              ("Ж" 43 44 51 53 60 61 69 70 39 41 48 50 57 59 66 68 36 37 45 47 55 56 64 65 73 79 83 87 105 106 114 116 111 113 102 104 91 97 100 101
               108 110)
              ("З" 38 42 46 48 55 56 50 52 59 61 68 70 75 78 84 87 95 97 104 106 91 92 100 102 110 114)
              ("И" 42 44 51 53 60 62 69 71 114 116 105 107 96 98 86 89 76 80 37 39 46 48 55 58 64 68 73 75 82 84 91 93 100 102 109 111)
              ("Й" 42 44 51 53 60 62 69 71 114 116 105 107 96 98 86 89 76 80 37 39 46 48 55 58 64 68 73 75 82 84 91 93 100 102 112 113 121 123 131 132
               109 111)
              ("К" 41 43 50 52 58 60 67 69 85 87 94 96 104 106 113 115 37 39 46 48 55 57 64 66 73 77 82 84 91 93 100 102 109 111)
              ("Л" 41 43 50 52 59 61 68 70 77 79 86 88 95 97 104 106 36 38 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 115)
              ("М" 42 44 51 53 60 62 69 71 78 80 87 89 114 116 105 107 95 98 67 68 76 77 85 86 37 39 46 48 55 57 64 66 73 75 82 84 91 94 100 102 109
               111)
              ("Н" 42 44 51 53 60 62 69 71 87 89 96 98 105 107 114 116 37 39 46 48 55 57 64 66 73 80 82 84 91 93 100 102 109 111)
              ("О" 104 106 95 97 86 88 77 79 68 70 59 61 50 52 38 42 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 114)
              ("П" 42 44 51 53 60 62 69 71 78 80 87 89 96 98 105 107 37 39 46 48 55 57 64 66 73 75 82 84 91 93 100 102 109 116)
              ("Р" 104 106 95 97 86 88 37 39 46 48 55 57 64 66 73 78 82 84 91 93 100 102 109 114)
              ("С" 96 97 104 106 60 61 50 52 38 42 46 48 55 57 64 66 73 75 82 84 91 93 100 102 110 114)
              ("Т" 39 41 48 50 57 59 66 68 75 77 84 86 93 95 102 104 109 115)
              ("У" 46 48 38 42 50 52 59 61 65 70 77 79 86 88 95 97 104 106 113 115 73 75 82 84 91 93 100 102 109 111)
              ("Ф" 69 71 78 80 87 89 96 98 93 95 84 86 75 77 66 68 39 41 48 50 55 61 63 65 72 74 81 83 90 92 100 106 111 113)
              ("Х" 41 43 50 52 59 60 67 69 37 39 46 48 56 57 65 66 75 77 84 86 113 115 104 106 95 96 92 94 100 102 109 111)
              ("Ц" 33 35 50 52 59 61 68 70 77 79 86 88 95 97 104 106 113 115 37 44 46 48 55 57 64 66 73 75 82 84 91 93 100 102 109 111)
              ("Ч" 113 115 104 106 95 97 86 88 77 79 41 43 50 52 59 61 65 70 73 75 82 84 91 93 100 102 109 111)
              ("Ш" 51 53 60 62 69 71 78 80 87 89 96 98 105 107 114 116 112 113 103 104 94 95 85 86 76 77 67 68 58 59 49 50 37 44 46 48 55 57 64 66 73
               75 82 84 91 93 100 102 109 111)
              ("Щ" 114 116 105 107 96 98 87 89 78 80 69 71 60 62 51 53 112 113 103 104 94 95 85 86 76 77 67 68 58 59 49 50 33 35 37 44 46 48 55 57 64
               66 73 75 82 84 91 93 100 102 109 111)
              ("Ъ" 68 70 59 61 50 52 37 42 46 48 55 57 64 66 73 78 82 84 91 93 99 102 108 111)
              ("Ы" 114 116 105 107 96 98 87 89 78 80 42 44 67 71 58 62 49 53 37 41 46 48 55 57 64 66 73 77 82 84 91 93 100 102 109 111)
              ("Ь" 68 71 59 62 50 53 37 43 46 48 55 57 64 66 73 79 82 84 91 93 100 102 109 111)
              ("Э" 55 56 46 48 38 42 50 52 59 61 68 70 75 79 86 88 95 97 104 106 91 92 100 102 110 114)
              ("Ю" 57 59 48 50 40 43 51 53 60 62 69 71 78 80 87 89 96 98 105 107 93 95 102 104 112 115 36 38 45 47 54 56 63 68 72 77 81 86 90 92 99
               101 108 110)
              ("Я" 41 43 37 39 50 52 59 61 46 48 56 58 66 70 74 79 86 87 82 84 95 97 91 93 104 106 100 102 110 115)
              ("а" 42 44 50 52 59 61 38 41 46 48 55 57 65 70 77 79 86 88 92 96)
              ("б" 68 70 59 61 50 52 38 42 46 48 55 57 64 66 73 78 82 84 92 97 105 106)
              ("в" 86 88 77 79 59 61 50 52 37 42 46 48 55 57 64 69 73 75 82 84 91 96)
              ("г" 37 39 46 48 55 57 64 66 73 75 82 84 91 97)
              ("д" 86 88 77 79 68 70 59 61 50 52 33 35 28 30 37 44 47 49 56 58 65 67 74 76 83 85 92 97)
              ("е" 86 88 77 79 38 43 46 48 55 57 64 70 73 75 82 84 92 96)
              ("ж" 43 44 51 53 40 41 49 50 37 38 46 48 56 61 66 69 87 89 97 98 94 95 85 86 74 79 82 84 91 92)
              ("з" 50 52 38 42 46 48 59 61 66 69 77 79 86 88 82 84 92 96)
              ("и" 95 97 85 88 76 79 59 61 50 52 41 43 37 39 46 49 55 58 64 70 73 75 82 84 91 93)
              ("й" 41 43 50 52 59 61 76 79 85 88 95 97 122 123 112 114 102 104 91 93 82 84 73 75 64 70 55 58 46 49 37 39)
              ("к" 42 43 50 52 58 60 76 78 86 88 96 97 37 39 46 48 55 57 64 68 73 75 82 84 91 93)
              ("л" 77 79 68 70 59 61 50 52 41 43 37 39 47 48 56 58 66 67 75 76 84 88 94 97)
              ("м" 42 44 51 53 60 62 69 71 96 98 86 89 77 80 58 59 67 68 37 39 46 48 55 57 64 66 73 75 82 85 91 93)
              ("н" 41 43 50 52 59 61 77 79 86 88 95 97 91 93 82 84 73 75 64 70 55 57 46 48 37 39)
              ("о" 50 52 59 61 68 70 77 79 86 88 92 96 82 84 73 75 64 66 55 57 46 48 38 42)
              ("п" 41 43 50 52 59 61 68 70 77 79 86 88 37 39 46 48 55 57 64 66 73 75 82 84 91 97)
              ("р" 50 52 59 61 68 70 77 79 86 88 1 3 10 12 19 21 28 30 37 42 46 48 55 57 64 66 73 75 82 84 91 96)
              ("с" 50 52 38 42 46 48 55 57 64 66 73 75 82 84 86 88 92 96)
              ("т" 39 41 48 50 57 59 66 68 75 77 84 86 91 97)
              ("у" 19 21 2 6 11 15 23 25 32 34 41 43 47 52 59 61 68 70 77 79 86 88 95 97 55 57 64 66 73 75 82 84 91 93)
              ("ф" 60 62 69 71 78 80 87 89 85 86 76 77 67 68 58 59 31 32 40 41 47 52 55 57 64 66 73 75 82 84 103 104 92 97)
              ("х" 41 43 50 52 37 39 46 48 56 60 66 68 95 97 86 88 74 78 82 84 91 93)
              ("ц" 95 97 86 88 77 79 68 70 59 61 50 52 33 35 37 44 46 48 55 57 64 66 73 75 82 84 91 93)
              ("ч" 95 97 86 88 77 79 68 70 41 43 50 52 56 61 64 66 73 75 82 84 91 93)
              ("ш" 51 53 60 62 69 71 78 80 87 89 96 98 49 50 58 59 67 68 76 77 85 86 94 95 91 93 82 84 73 75 64 66 55 57 46 48 37 44)
              ("щ" 33 35 49 50 58 59 67 68 76 77 85 86 94 95 96 98 87 89 78 80 69 71 60 62 51 53 37 44 46 48 55 57 64 66 73 75 82 84 91 93)
              ("ъ" 60 62 51 53 38 43 47 49 56 58 65 70 74 76 82 85 91 94)
              ("ы" 96 98 87 89 78 80 69 71 58 62 49 53 42 44 37 41 46 48 55 57 64 68 73 75 82 84 91 93)
              ("ь" 59 61 50 52 37 42 46 48 55 57 64 69 73 75 82 84 91 93)
              ("э" 46 48 38 42 50 52 59 61 66 70 77 79 86 88 82 84 92 96)
              ("ю" 85 86 94 97 87 89 78 80 69 71 60 62 51 53 49 50 40 43 37 39 46 48 55 59 64 68 73 77 82 84 91 93)
              ("я" 50 52 41 43 37 39 47 49 57 61 65 70 77 79 86 88 73 75 82 84 92 97)
             )
       l-st (mapcar (function (lambda (b)
                               (cons (car b)
                                     (mapcar (function (lambda (a)
                                                        (if a
                                                         (list (rem a 9) (/ a 9))
                                                        )
                                                       )
                                             )
                                             (cdr b)
                                     )
                               )
                              )
                    )
                    l-st
            )
       iy   (* (length il) 16)
       mx   (* (apply (function max) (mapcar (function strlen) il)) 8)
 )
 (repeat (length il)
  (setq i   0
        str (car il)
  )
  (repeat (strlen str)
   (setq c (substr str 1 1))
   (cond ((= c " ")
          (setq i   (+ i 8)
                str (substr str 2)
          )
         )
         ((= c "\t")
          (setq i   (+ i 32)
                str (substr str 2)
          )
         )
         ((= c ""))
         (t
          (setq int (cons (mapcar (function (lambda (a)
                                             (if a
                                              (list (+ (car a) i) (+ (cadr a) y))
                                             )
                                            )
                                  )
                                  (cdr (nth (vl-position c st) l-st))
                          )
                          int
                    )
                str (substr str 2)
                i   (+ i 8)
          )
         )
   )
  )
  (setq y  (+ y 16)
        il (cdr il)
  )
 )
 (setq int (apply (function append) int)
       x   mx
       i   0
       y   iy
       l   (list '(0. -3.)
                 (list x -3.)
                 '(-2. -2.)
                 (list (+ x 2.) -2.)
                 '(-3. -1.)
                 (list (+ x 3.) -1.)
                 '(-3. 0.)
                 (list (+ x 3.) 0.)
           )
 )
 (repeat y (setq l (cons (list -4. (setq i (1+ i))) (cons (list (+ x 4.) i) l))))
 (setq l (append (list (list -3. (setq i (1+ i)))
                       (list (+ x 3.) i)
                       (list -3. (setq i (1+ i)))
                       (list (+ x 3.) i)
                       (list -2. (setq i (1+ i)))
                       (list (+ x 2.) i)
                       (list 0. (setq i (1+ i)))
                       (list x i)
                 )
                 l
         )
 )
 (while (= (car (setq gr (grread nil 5 0))) 5)
  (setq s  (/ (getvar "viewsize") (cadr (getvar "SCREENSIZE")))
        gr (trans (cadr gr) 1 3)
  )
  (redraw)
  (grvecs (append (cons cb l) (cons cf int))
          ((lambda (c x y) (list (list c 0. 0. x) (list 0. c 0. y) (list 0. 0. c 0.) '(0. 0. 0. 1.))) s
                                                                                                      (+ (car gr) (* 15 s))
                                                                                                      (+ (cadr gr) (* 15 s))
          )
  )
 )
 (redraw)
 (princ)
)
;|«Visual LISP© Format Options»
(150 1 16 2 nil nil 90 90 0 0 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;

[Inferi]

Всем привет! Помогите применить функцию vl-remove-if-not к списку вида ("%%C100" "%%C100" "%%C100" "%%C125" "%%C125" "%%C160" "%%C200" "%%C200" "%%C200") для удаления повторяющихся элементов списка. На выходе соответственно => ("%%C100" "%%C125" "%%C160 "%%C200"). Спасибо за внимание!

[gomer]

Сообщение от Inferi Помогите применить функцию

Код:

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

 (defun unq (w)
  (if w (cons (car w) (unq (vl-remove (car w) w)))))

[ciril]

Ну или:

Код:

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

 ((eval (setq la0 (function (lambda (e00 / a00 a01)
                             (if (setq a00 (car e00))
                               (if (eq a00 (car (setq a01 ((eval la0) (cdr e00)))))
                                 a01
                                 (cons a00 a01)))))))
  '("%%C100" "%%C100" "%%C100" "%%C125" "%%C125" "%%C160" "%%C200" "%%C200" "%%C200"))

[Nike]

А как посчитать сколько каких повторяющихся элементов в списке?

----- добавлено через ~1 мин. -----
(("%%C100" . 3) ("%%C125" . 2) ("%%C160" . 1) ("%%C200" . 3)) получить чтоб

[ciril]

А в каком виде вывести результат подсчета?

[Nike]

ciril, списком вида (("%%C100" . 3) ("%%C125" . 2) ("%%C160" . 1) ("%%C200" . 3))

[ciril]

Код:

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

 ((eval (setq la0 (function (lambda (e00 / a00 a01)
                               (if (setq a00 (cdr e00))
                                 (if (setq a01 (assoc (car e00) (setq a00 ((eval la0) a00))))
                                   (cons (cons (car a01) (1+ (cdr a01))) (cdr a00))
                                   (cons (cons (car e00) 1) a00))
                                 (list (cons (car e00) 1)))))))
    '("%%C100" "%%C100" "%%C100" "%%C125" "%%C125" "%%C160" "%%C200" "%%C200" "%%C200"))

[Nike]

ciril, класс! Спасибо!

[ciril]

Не за что

[gomer]

можно и проще вообще не обязательно выворачивать код наизнанку

Код:

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

 (defun clc (w)
  ((lambda (tail)
     (if w (cons (cons (car w) (- (length w) (length tail))) (clc tail))))
    (vl-remove (car w) w)))

[Дима_]

То Gomer - ИХМО - ты достиг Lisp Level 80!

[skkkk]

Offtop:

Сообщение от Дима_ То Gomer - ИХМО - ты достиг Lisp Level 80!

Стесняюсь спросить: "А с какого именно уровня донесся этот спич?"

[Дима_]

В этом вопросе мнения расходятся...

[kakt00z]

Господа!
из списка '("A" "B" "C" "D")
нужно сделать список '(("A" "B") ("A" "C") ("A" "D") ("B" "C") ("B" "D") ("C" "D"))
по сути выдать перечень сторон + диагоналей многоугольника
написал такой код

Код:

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

 (setq tmp '("A" "B" "C" "D" "E"))

(defun tst (tmp)
  (if tmp
    (append
    (mapcar
      '(lambda (x)
	 (list (car tmp) x)
	 )
      (cdr tmp))
    (tst (cdr tmp))
    )
  )
  )
(tst tmp)

но подозреваю что написал много лишнего и интуиция подсказывает что можно сделать красивее

[Дима_]

Да нормально все написано - я бы конечно предпочел пары а не списки - вместо (list (car tmp) x) -> (cons (car tmp) x)

[Jerald]

Как программно переключить визуальные стили?

[Inferi]

Всем доброго времени суток! Прикрепляю к примитиву данные: (vlax-ldata-put <vla_примитив> "mleader_name_blk" value). Как получить pickset или просто список с условием типа (= value (vlax-ldata-get <vla_примитив> "mleader_name_blk")). Пробовал конструкцию типа:

Код:

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

(setq list_mleader (_dwgru-conv-pickset-to-list (ssget)))
(setq list_mleader_ldata
        (vl-remove-if
	  '(=
	   (function
            (lambda (x)
              (vlax-ldata-get (vlax-ename->vla-object (car x))) "mleader_name_blk")
	    )
	   )
	    value
	   )
	list_mleader
	)
)

(defun _dwgru-conv-pickset-to-list (value)
  (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex value)))
)

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

Попробуй нечто типа

Код:

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

 (setq list_mleader_ldata
       (vl-remove-if
         (function (lambda (x)
                     (member value (vlax-ldata-get (vlax-ename->vla-object (car x)) "mleader_name_blk"))
                     ) ;_ end of lambda
                   ) ;_ end of function
         (_dwgru-conv-pickset-to-list (ssget))
         ) ;_ end of vl-remove-if
      ) ;_ end of setq

(defun _dwgru-conv-pickset-to-list (value)
  (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex value)))
  ) ;_ end of defun

[Inferi]

Сообщение от Кулик Алексей aka kpblc Попробуй нечто типа Код: [Выделить все] (setq list_mleader_ldata (vl-remove-if (function (lambda (x) (member value (vlax-ldata-get (vlax-ename->vla-object (car x)) "mleader_name_blk")) ) ;_ end of lambda ) ;_ end of function (_dwgru-conv-pickset-to-list (ssget)) ) ;_ end of vl-remove-if ) ;_ end of setq (defun _dwgru-conv-pickset-to-list (value) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex value))) ) ;_ end of defun

Спасибо, но выдает "неверный тип аргумента: consp <Имя объекта: >"

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

Надо все-таки отдыхать иногда Замени (car x) на x.

[Inferi]

(member <выражение> <список>)
Эта функция просматривает <список> - встречается ли <выражение> и возвращает часть <списка>, начинающуюся с первого найденного <выражения>. Если в <списке> нет <выражения>, MEMBER возвращает nil.
Например:
(member 'c '(a b c d e)) возвращает (C D E)
(member 'q '(a b c d e)) возвращает nil

Работает вот так, но возвращает список имен с первого найденного выражения и до конца, а нужно пройтись по списку и выбрать только те имена которые удовлетворяют условию соответствия по ldata:

Код:

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

(setq list_mleader_ldata
       (vl-remove-if
         (function (lambda (x)
                     (member value (list (vlax-ldata-get (vlax-ename->vla-object x) "mleader_name_blk")))
                     ) ;_ end of lambda
                   ) ;_ end of function
         (_dwgru-conv-pickset-to-list (ssget))
         ) ;_ end of vl-remove-if
      ) ;_ end of setq

(defun _dwgru-conv-pickset-to-list (value)
  (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex value)))
  ) ;_ end of defun

----- добавлено через ~1 ч. -----
Нашел решение, функция возвращает список имен примитивов с фильтрацией по ldata и его значению:

Код:

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

(defun lst_nameobj_ldatavalue (ldata ldatavalue)
(setq list_nameobj_ldata
       (vl-remove-if-not
         (function (lambda (x)
                     (equal ldatavalue (vlax-ldata-get (vlax-ename->vla-object x) ldata))
                     ) ;_ end of lambda
                   ) ;_ end of function
         (_dwgru-conv-pickset-to-list (ssget))
         ) ;_ end of vl-remove-if
      ) ;_ end of setq
);_ end of defun

аргументы:
ldata - строка
ldatavalue -строка
пример вызова: (lst_nameobj_ldatavalue ldata ldatavalue)

----- добавлено через ~12 ч. -----
Чего то совсем в тупик зашел, необходимо сравнить элементы списков, и объединить их, может кому не лень поломать голову
Имеем:
список 1 - (("строка1" <Имя объекта: ...>) ("строка2" <Имя объекта: ...>) ...)
список 2 - (("строка1" "номер1") ("строка2" "номер2") ...)
На выходе список - 3:
список 3 - (("строка1" <Имя объекта: ...> "номер1") ("строка2" <Имя объекта: ...> "номер2") ...)
Примечание:
Список 3, полученный объединением элементов списка 1 с строками списка 2 ("номер1", "номер2"), при условии равенства первых строк "строка1"="строка1".
Для примера два списка:

Код:

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

(setq lst1 '(("Отвод круглый %%C125-45%%D" <Имя объекта: 7ff7a6d07510>) ("Отвод круглый %%C125-45%%D" <Имя объекта: 7ff7a6d074c0>) ("Переход 250x150-%%C125" <Имя объекта: 7ff7a6d07280>) ("Отвод круглый %%C100-90%%D" <Имя объекта: 7ff7a6d070a0>) ("Отвод круглый %%C100-90%%D" <Имя объекта: 7ff7a6d07050>) ("Отвод круглый %%C100-90%%D" <Имя объекта: 7ff7a6d07000>) ("Отвод круглый %%C100-90%%D" <Имя объекта: 7ff7a6d04f20>))
      lst2 '(("" "Подсчет блоков на чертеже") ("Имя блока" "    ") ("Отвод круглый %%C100-90%%D" "1") ("Отвод круглый %%C125-45%%D" "2") ("Переход 250x150-%%C125" "3") ("Всего" "")))

Спасибо за внимание!

[aaalenaaa]

Здравствуйте Уважаемые форумчане!!! Очень нужна ваша помощь!!! Нужно сделать выборку блоков по значению атрибута. Много примерных программ, но что-то никак не получается итог.Помогите пожалуйста чем можете, За любой совет буду благодарна!!!

[Сергей812]

ну так выкладывайте, что не получается)
задача сводиться к двум подзадачам:
1. Получение выборки (ssget) с чертежа с использованием фильтра: тип примитивов - вставка блока, слой - такой-то и т.д.
2. Проход по полученному списку вставок блока, и если в блоке есть указанный атрибут и значение атрибута совпадает с искомым - занести в выходной список.

[aaalenaaa]

http://experement.spb.ru/wiki/doku.p...ickselectblock
Программка на этой странице замечательно мне подходит, но почему-то по завершению выборки не происходит(((( Помогите пожалуйста, очень нужно!!!

----- добавлено через ~7 мин. -----
http://experement.spb.ru/wiki/doku.p...ickselectblock
Ссылка, по которой можно скачать программку, котоая мне идеально подходит,но по итогу выборки не происходит без какой либо ошибки.

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

aaalenaaa, приведи свой код - тогда и можно будет научить. А сделать за тебя и для тебя программу - это в Поиск исполнителей.

[aaalenaaa]

А бы очень-очень хотела научиться сама писать или хотя бы править лисп. А то у меня идей куча, чтоб свою работу в атокаде оптимизировать, а реализовать сложно. Если есть ссылки, что почитать про создание лисп - буду благодарна!!! Даже не для этого примера очень хочу разобраться, но я не программист.
А по этой теме: вот этот лисп как мне кажется должен мне подходить, только выбирать нужно все блоки с одинаковым значением атрибута, и их нужно оставлять выделенными, чтоб можно было править. И еще он почему то не работает.Почему? А то может он мне как раз подойдет. Посмотрите пожалуйста хоть работает он и что делает? Спасибо!!!

[Alan]

Сообщение от aaalenaaa хотела научиться сама писать или хотя бы править лисп.

Используй тег Код

[aaalenaaa]

Код:

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

;;; (ax:FindBlockTagValue (vla-get-activedocument
;;; (vlax-get-acad-object)) "blockname" "tagname" "tagvalue")
(defun ax:FindBlockTagValue
       (doc bn tagname value / layout i atts tag sset c)
  (vlax-for layout (vla-get-layouts doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (= (strcase (vla-get-name i)) (strcase bn))
          )
        (if (and
              (= (vla-get-hasattributes i) :vlax-true)
              (safearray-value
                (setq atts
                       (vlax-variant-value
                         (vla-getattributes i)
                       )
                )
              )
            )
          (progn
            (foreach tag (vlax-safearray->list atts)
              (if (and
                    (= (strcase tagname)
                       (strcase (vla-get-TagString tag))
                    )
                    (= value (vla-get-TextString tag))
                  )
                (progn
                  (if (not sset)
                    (setq sset (ssadd (vlax-vla-object->ename i)))
                    (ssadd (vlax-vla-object->ename i) sset)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (sssetfirst nil sset)
)

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

Код:

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

// Основной модуль
using System;
using System.Collections.Generic;
using System.Linq;
using System.Windows.Forms;
 
using App = Autodesk.AutoCAD.ApplicationServices;
using cad = Autodesk.AutoCAD.ApplicationServices.Application;
using Db = Autodesk.AutoCAD.DatabaseServices;
using Ed = Autodesk.AutoCAD.EditorInput;
using Gem = Autodesk.AutoCAD.Geometry;
using Rtm = Autodesk.AutoCAD.Runtime;
using Gi = Autodesk.AutoCAD.GraphicsInterface;
 
namespace QuickSelect
{
    public class Commands
    {
        public static List<string> AttList = new List<string>();
        public static string AttValue = "";
        private static string Exit = "Exit";
 
        static public void ClearAttListValue()
        {
            AttValue = "";
            AttList.Clear();
            AttList.Add(Exit);
        }
 
 
        [Rtm.CommandMethod("bx_quickselect", Rtm.CommandFlags.UsePickSet  |
                                             Rtm.CommandFlags.Redraw |
                                             Rtm.CommandFlags.Modal)]
        static public void bx_quickselect()
        {
 
            // Получение текущего документа и базы данных
            App.Document acDoc = App.Application.DocumentManager.MdiActiveDocument;
            Db.Database acCurDb = acDoc.Database;
            Ed.Editor acEd = acDoc.Editor;
            ClearAttListValue();
 
            //Секция предварительного выбора
            Ed.PromptSelectionResult acSSPrompt = acEd.SelectImplied();
            Ed.SelectionSet acSSet = null;
 
            // Если статус запроса OK, объекты были выбраны перед запуском команды
            if (acSSPrompt.Status == Ed.PromptStatus.OK)
                            acSSet = acSSPrompt.Value;
 
            Dictionary<Db.ObjectId, string> ObjID_Dic = new Dictionary<Db.ObjectId, string>();
 
            Ed.PromptEntityOptions EntOpt = new Ed.PromptEntityOptions("\n Select block:");
            EntOpt.SetRejectMessage("\n Entity must be a block.");
            EntOpt.AddAllowedClass(typeof(Db.BlockReference), false);
            EntOpt.AllowObjectOnLockedLayer = true;
            Ed.PromptEntityResult EntRes = acEd.GetEntity(EntOpt);
 
            if (EntRes.Status != Ed.PromptStatus.OK)
            {
                acEd.WriteMessage("\n Cencel.");
                return;
            }
 
            String acBlockName = "0";
 
            // старт транзакции
            // Ищу истенное имя выбранного блока и читаю его атрибуты
            using (Db.Transaction acTrans = acCurDb.TransactionManager.StartOpenCloseTransaction())
            {
                // Открытие таблицы Блоков для чтения
                Db.BlockTable acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, 
                                                Db.OpenMode.ForRead) as Db.BlockTable;
                // Открытие записи таблицы Блоков пространства Модели для записи
                Db.BlockTableRecord acBlkTblRecMS = acTrans.GetObject(acBlkTbl[Db.BlockTableRecord.ModelSpace],
                                                Db.OpenMode.ForRead) as Db.BlockTableRecord;
 
 
                //Получаю выбранный блок
                Db.BlockReference acBlock = acTrans.GetObject(EntRes.ObjectId, Db.OpenMode.ForRead) as Db.BlockReference;
                //Получаю определение блока в таблице блоков
                Db.BlockTableRecord acBlkTblRec = acTrans.GetObject(acBlock.BlockTableRecord, Db.OpenMode.ForRead) 
                    as Db.BlockTableRecord;
 
 
                // Получаю определение блока в таблице динамических блоков
                // Запоминаю истинное имя блока
                acBlockName = acBlock.Name;
 
                if (acBlock.IsDynamicBlock)
                {
                    acBlkTblRec = acTrans.GetObject(acBlock.DynamicBlockTableRecord, Db.OpenMode.ForRead) as Db.BlockTableRecord;
                    Db.BlockTableRecord blr_nam = acTrans.GetObject(acBlkTblRec.ObjectId, Db.OpenMode.ForRead) as Db.BlockTableRecord;
                    acBlockName = blr_nam.Name;
                }
 
                if (acBlkTblRec.HasAttributeDefinitions)
                {
                    foreach (Db.ObjectId objID in acBlkTblRec)
                    {
                        Db.DBObject dbObj = acTrans.GetObject(objID, Db.OpenMode.ForRead) as Db.DBObject;
                        if (dbObj is Db.AttributeDefinition)
                        {
                            Db.AttributeDefinition acAtt = dbObj as Db.AttributeDefinition;
                            if (AttList.Contains(acAtt.Tag) != true)
                                AttList.Add(acAtt.Tag);
                        }
                    }
                }
                //Я в этой транзакции ничего не меняю, Все открываю только для чтения.
                //соответственно и вносить изменения не нужно.
                //acTrans.Commit();
            }
 
 
            if (AttList.Count == 1)
                return;
 
            QuickSelect.Form1 myform_name = new QuickSelect.Form1();
            Autodesk.AutoCAD.ApplicationServices.Application.ShowModalDialog(myform_name);
 
            if (AttValue == Exit)
                return;
 
            string AttName = AttValue;
            // Вот тут нужно очистить переменные
            ClearAttListValue();
            //// тут получить все возможние значения данного атрибута и 
            //// заполним массив AttList снова вызвать форму
            using (Db.Transaction acTrans = acCurDb.TransactionManager.StartOpenCloseTransaction())
            {
                if (acSSet == null)
                {
                    Db.TypedValue[] acTypValAr = new Db.TypedValue[1];
                    Db.TypedValue typedValue = new Db.TypedValue(0, "INSERT");
                    acTypValAr.SetValue(typedValue, 0);
                    Ed.SelectionFilter acSelFtr = new Ed.SelectionFilter(acTypValAr);
                    acSSPrompt = acEd.SelectAll(acSelFtr);
                    acSSet = acSSPrompt.Value;
                }
 
                foreach (Db.ObjectId objID in acSSet.GetObjectIds())
                {
                    // Проверка, нужно убедится в правильности полученного объекта
                    if (objID != null)
                    {
                        // Открытие объекта для
                        Db.Entity dbObj = acTrans.GetObject(objID, Db.OpenMode.ForRead) as Db.Entity;
                        if (dbObj != null)
                        {
                            if (dbObj is Db.BlockReference)
                            {
                                Db.BlockReference acBlock = dbObj as Db.BlockReference;
                                Db.BlockTableRecord acBlkTblRec;
                                acBlkTblRec = acTrans.GetObject(acBlock.BlockTableRecord, Db.OpenMode.ForRead) as Db.BlockTableRecord;
 
                                String BlockName = acBlock.Name;
                                if (acBlock.IsDynamicBlock)
                                {
                                    acBlkTblRec = acTrans.GetObject(acBlock.DynamicBlockTableRecord, Db.OpenMode.ForRead) as Db.BlockTableRecord;
                                    Db.BlockTableRecord blr_nam = acTrans.GetObject(acBlkTblRec.ObjectId, Db.OpenMode.ForRead) as Db.BlockTableRecord;
                                    BlockName = blr_nam.Name;
                                }
 
                                if (BlockName == acBlockName)
                                {
                                    if (acBlkTblRec.HasAttributeDefinitions)
                                    {
                                        foreach (Db.ObjectId objID_In_Block in acBlock.AttributeCollection)
                                        {
                                            Db.DBObject dbObj_In_Block = acTrans.GetObject(objID_In_Block, Db.OpenMode.ForRead) as Db.DBObject;
                                            if (dbObj_In_Block is Db.AttributeReference)
                                            {
                                                Db.AttributeReference acAtt = dbObj_In_Block as Db.AttributeReference;
                                                if (acAtt.Tag == AttName)
                                                {
                                                    ObjID_Dic.Add(acBlock.ObjectId, acAtt.TextString);
 
                                                    if (AttList.Contains(acAtt.TextString) == false)
                                                        AttList.Add(acAtt.TextString);
                                                }
                                            }
                                        }
                                    }
                                }
                            }
                        }
                    }
                }
                //Я в этой транзакции ничего не меняю, Все открываю только для чтения.
                //соответственно и вносить изменения не нужно.
                //acTrans.Commit();
            }
 
           //Выводим форму для выбора значения
            QuickSelect.Form1 myform_value = new QuickSelect.Form1();
            Autodesk.AutoCAD.ApplicationServices.Application.ShowModalDialog(myform_value);
 
            if (AttValue == Exit)
                return;
            // Добавляем в набор выбираемых объекты удовлетворяющие условию
            IEnumerable<Db.ObjectId> L = from KeyValuePair<Db.ObjectId, string> q in ObjID_Dic
                                         where q.Value.ToString() == AttValue.ToString()
                                         select q.Key;
            //Подсвечиваем объекты
            Db.ObjectId[] idarrayEmpty = L.ToArray();
            acEd.SetImpliedSelection(idarrayEmpty);
        }
    }
}

Вот это идеальная программка для меня, только по итогу выборка не происходит((( Почему-ответьте мне пожалуйста!!Очень-очень буду благодарна любой помощи!!!!Спасибо заранее!!!

[aaalenaaa]

Здравствуйте все!!! Опять я со своей выборкой. http://dwg.ru/dnl/9204 - Вот ссылка на лисп с этого сайта, который идеально мне подходит, но по окончанию операции выборки не происходит. В командной строке написано "выбранных объектов 0". Помогите пожалуйста!!!! Он в формате быстрозагружаемого файла, поэтому не могу открыть его для редактирования.И вот файл, в котором выборку произвожу.)Подскажите, что не так!!! Пожалуйста!!!

[gomer]

Сообщение от aaalenaaa Помогите пожалуйста!!!!

обратитесь к автору сего лиспа, возможно он учтет ваши пожелания

[aaalenaaa]

Написала автору, пока не ответил. Но мне по сути менять ничего не нужно, только чтоб работал как в описании. Он и работает, запрашивает все как нужно, а по итогу-выборки нет, и ошибки никакой не пишет-вот в чем вопрос!! Посмотрите пожалуйста, если есть возможность на прикрепленном файле - проверьте пожалуйста как работает!!!1

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

Сообщение от aaalenaaa Код: [Выделить все] ;;; (ax:FindBlockTagValue (vla-get-activedocument ;;; (vlax-get-acad-object)) "blockname" "tagname" "tagvalue") (defun ax:FindBlockTagValue (doc bn tagname value / layout i atts tag sset c) (vlax-for layout (vla-get-layouts doc) (vlax-for i (vla-get-block layout) (if (and (= (vla-get-objectname i) "AcDbBlockReference") (= (strcase (vla-get-name i)) (strcase bn)) ) (if (and (= (vla-get-hasattributes i) :vlax-true) (safearray-value (setq atts (vlax-variant-value (vla-getattributes i) ) ) ) ) (progn (foreach tag (vlax-safearray->list atts) (if (and (= (strcase tagname) (strcase (vla-get-TagString tag)) ) (= value (vla-get-TextString tag)) ) (progn (if (not sset) (setq sset (ssadd (vlax-vla-object->ename i))) (ssadd (vlax-vla-object->ename i) sset) ) ) ) ) ) ) ) ) ) (sssetfirst nil sset) ) ----- добавлено через ~29 мин. ----- Код: [Выделить все] // Основной модуль using System; using System.Collections.Generic; using System.Linq; using System.Windows.Forms; using App = Autodesk.AutoCAD.ApplicationServices; using cad = Autodesk.AutoCAD.ApplicationServices.Application; using Db = Autodesk.AutoCAD.DatabaseServices; using Ed = Autodesk.AutoCAD.EditorInput; using Gem = Autodesk.AutoCAD.Geometry; using Rtm = Autodesk.AutoCAD.Runtime; using Gi = Autodesk.AutoCAD.GraphicsInterface; namespace QuickSelect { public class Commands { public static List<string> AttList = new List<string>(); public static string AttValue = ""; private static string Exit = "Exit"; static public void ClearAttListValue() { AttValue = ""; AttList.Clear(); AttList.Add(Exit); } [Rtm.CommandMethod("bx_quickselect", Rtm.CommandFlags.UsePickSet | Rtm.CommandFlags.Redraw | Rtm.CommandFlags.Modal)] static public void bx_quickselect() { // Получение текущего документа и базы данных App.Document acDoc = App.Application.DocumentManager.MdiActiveDocument; Db.Database acCurDb = acDoc.Database; Ed.Editor acEd = acDoc.Editor; ClearAttListValue(); //Секция предварительного выбора Ed.PromptSelectionResult acSSPrompt = acEd.SelectImplied(); Ed.SelectionSet acSSet = null; // Если статус запроса OK, объекты были выбраны перед запуском команды if (acSSPrompt.Status == Ed.PromptStatus.OK) acSSet = acSSPrompt.Value; Dictionary<Db.ObjectId, string> ObjID_Dic = new Dictionary<Db.ObjectId, string>(); Ed.PromptEntityOptions EntOpt = new Ed.PromptEntityOptions("\n Select block:"); EntOpt.SetRejectMessage("\n Entity must be a block."); EntOpt.AddAllowedClass(typeof(Db.BlockReference), false); EntOpt.AllowObjectOnLockedLayer = true; Ed.PromptEntityResult EntRes = acEd.GetEntity(EntOpt); if (EntRes.Status != Ed.PromptStatus.OK) { acEd.WriteMessage("\n Cencel."); return; } String acBlockName = "0"; // старт транзакции // Ищу истенное имя выбранного блока и читаю его атрибуты using (Db.Transaction acTrans = acCurDb.TransactionManager.StartOpenCloseTransaction()) { // Открытие таблицы Блоков для чтения Db.BlockTable acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, Db.OpenMode.ForRead) as Db.BlockTable; // Открытие записи таблицы Блоков пространства Модели для записи Db.BlockTableRecord acBlkTblRecMS = acTrans.GetObject(acBlkTbl[Db.BlockTableRecord.ModelSpace], Db.OpenMode.ForRead) as Db.BlockTableRecord; //Получаю выбранный блок Db.BlockReference acBlock = acTrans.GetObject(EntRes.ObjectId, Db.OpenMode.ForRead) as Db.BlockReference; //Получаю определение блока в таблице блоков Db.BlockTableRecord acBlkTblRec = acTrans.GetObject(acBlock.BlockTableRecord, Db.OpenMode.ForRead) as Db.BlockTableRecord; // Получаю определение блока в таблице динамических блоков // Запоминаю истинное имя блока acBlockName = acBlock.Name; if (acBlock.IsDynamicBlock) { acBlkTblRec = acTrans.GetObject(acBlock.DynamicBlockTableRecord, Db.OpenMode.ForRead) as Db.BlockTableRecord; Db.BlockTableRecord blr_nam = acTrans.GetObject(acBlkTblRec.ObjectId, Db.OpenMode.ForRead) as Db.BlockTableRecord; acBlockName = blr_nam.Name; } if (acBlkTblRec.HasAttributeDefinitions) { foreach (Db.ObjectId objID in acBlkTblRec) { Db.DBObject dbObj = acTrans.GetObject(objID, Db.OpenMode.ForRead) as Db.DBObject; if (dbObj is Db.AttributeDefinition) { Db.AttributeDefinition acAtt = dbObj as Db.AttributeDefinition; if (AttList.Contains(acAtt.Tag) != true) AttList.Add(acAtt.Tag); } } } //Я в этой транзакции ничего не меняю, Все открываю только для чтения. //соответственно и вносить изменения не нужно. //acTrans.Commit(); } if (AttList.Count == 1) return; QuickSelect.Form1 myform_name = new QuickSelect.Form1(); Autodesk.AutoCAD.ApplicationServices.Application.ShowModalDialog(myform_name); if (AttValue == Exit) return; string AttName = AttValue; // Вот тут нужно очистить переменные ClearAttListValue(); //// тут получить все возможние значения данного атрибута и //// заполним массив AttList снова вызвать форму using (Db.Transaction acTrans = acCurDb.TransactionManager.StartOpenCloseTransaction()) { if (acSSet == null) { Db.TypedValue[] acTypValAr = new Db.TypedValue[1]; Db.TypedValue typedValue = new Db.TypedValue(0, "INSERT"); acTypValAr.SetValue(typedValue, 0); Ed.SelectionFilter acSelFtr = new Ed.SelectionFilter(acTypValAr); acSSPrompt = acEd.SelectAll(acSelFtr); acSSet = acSSPrompt.Value; } foreach (Db.ObjectId objID in acSSet.GetObjectIds()) { // Проверка, нужно убедится в правильности полученного объекта if (objID != null) { // Открытие объекта для Db.Entity dbObj = acTrans.GetObject(objID, Db.OpenMode.ForRead) as Db.Entity; if (dbObj != null) { if (dbObj is Db.BlockReference) { Db.BlockReference acBlock = dbObj as Db.BlockReference; Db.BlockTableRecord acBlkTblRec; acBlkTblRec = acTrans.GetObject(acBlock.BlockTableRecord, Db.OpenMode.ForRead) as Db.BlockTableRecord; String BlockName = acBlock.Name; if (acBlock.IsDynamicBlock) { acBlkTblRec = acTrans.GetObject(acBlock.DynamicBlockTableRecord, Db.OpenMode.ForRead) as Db.BlockTableRecord; Db.BlockTableRecord blr_nam = acTrans.GetObject(acBlkTblRec.ObjectId, Db.OpenMode.ForRead) as Db.BlockTableRecord; BlockName = blr_nam.Name; } if (BlockName == acBlockName) { if (acBlkTblRec.HasAttributeDefinitions) { foreach (Db.ObjectId objID_In_Block in acBlock.AttributeCollection) { Db.DBObject dbObj_In_Block = acTrans.GetObject(objID_In_Block, Db.OpenMode.ForRead) as Db.DBObject; if (dbObj_In_Block is Db.AttributeReference) { Db.AttributeReference acAtt = dbObj_In_Block as Db.AttributeReference; if (acAtt.Tag == AttName) { ObjID_Dic.Add(acBlock.ObjectId, acAtt.TextString); if (AttList.Contains(acAtt.TextString) == false) AttList.Add(acAtt.TextString); } } } } } } } } } //Я в этой транзакции ничего не меняю, Все открываю только для чтения. //соответственно и вносить изменения не нужно. //acTrans.Commit(); } //Выводим форму для выбора значения QuickSelect.Form1 myform_value = new QuickSelect.Form1(); Autodesk.AutoCAD.ApplicationServices.Application.ShowModalDialog(myform_value); if (AttValue == Exit) return; // Добавляем в набор выбираемых объекты удовлетворяющие условию IEnumerable<Db.ObjectId> L = from KeyValuePair<Db.ObjectId, string> q in ObjID_Dic where q.Value.ToString() == AttValue.ToString() select q.Key; //Подсвечиваем объекты Db.ObjectId[] idarrayEmpty = L.ToArray(); acEd.SetImpliedSelection(idarrayEmpty); } } } Вот это идеальная программка для меня, только по итогу выборка не происходит((( Почему-ответьте мне пожалуйста!!Очень-очень буду благодарна любой помощи!!!!Спасибо заранее!!!

Во-первых, что здесь делает C#-код? Во-вторых, научить можно только если есть конкретные вопросы. А у тебя же вопрос (точнее, запрос) только один - сделайте мне программу. Проанализируй ее, пошагово пройди, проверяй значения переменных, интересуйся описаниями и параметрами вызываемых функций - тогда и станет более-менее понятно: какие вопросы задавать и по каким конкретно строкам.

[aaalenaaa]

Спасибо за ответ в любом случае!!!
Что ж вы так строго. Я разбираюсь потихоньку по более простым программам, сравниваю похожие, нахожу где что заменили, что на что влияет.
А в конкретном примере программа на сайте есть, менять ее не надо, просто итог ее я не вижу- вот в чем вопрос-запрос -просьба. Мне не нужно, чтоб кто-то ее менял, просто скажите, у вас она работает и в моем примере она может работать? Все запросы она делает верно, и выборку замечательно проводит- а итог Нет выбранных объектов. пока только в этом вопрос! Если эт сложно проверить - так и скажите. Буду дальше искать решение. Спасибо!!!

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

Проверь функцию sssetfirst и ее параметры.

[aaalenaaa]

Спасибо, посмотрю сейчас!

----- добавлено через ~20 ч. -----
Здравствуйте уважаемые!!! Я все с выборкой - программа по выборке работает хорошо на других файлах, кроме необходимого мне. Я так понимаю проблема в том, что у меня атрибут имеет в названии два слова и между ними пробел, а первое слово входит в состав всех остальных атрибутов. При указании слова для фильтра нужно похоже заменить чем то пробел - подскажите пожалуйста, чем можно заменить пробел??? И правильно ли я определила проблему??
Не судите строго, я только разбираюсь во всем этом)))

[aaalenaaa]

Здравствуйте уважаемые!!! Помогите пожалуйста!!! Программа по ссылке http://dwg.ru/dnl/9204 работает прекрасно со всеми моими чертежами, кроме того, который нужен. Нужный мне файл я выгружаю из геокада,через мапинфо. Атрибуты им заданы автоматом. Из них нужно производить выборку по Категории земель, их виды (значения атрибутов) следующие: Земли лесного фонда; Земли сельскохозяйственного назначения и т.п. Так вот, при запуске программы по выборке, она запрашивает блок, спрашивает по какому атрибуту производить выбор и какое значение атрибута искать. Все указываю, нажимаю применить, итог - выбран 1 объект, который я указывала как исходный(((. Ну что не так? Программа в файле, типа *.fas, открыть его я не могу, чтобы посмотреть код. В справке к программе по ссылке есть символы, для обозначения различных знаков, что можно было пыталась вставить вместо пробела в значении атрибута, типа Земли?лесного?фонда, нет итога и все. ((( Или уже скажите мне,чтоб я отстала от этого файла*.fas!!!

[gomer]

Сообщение от aaalenaaa Или уже скажите мне,чтоб я отстала от этого файла*.fas!!!

еще раз, пишите автору, только у него есть исходник, при запуске команды в командной строке можно увидеть мейл, куда надо стучаться

[VVA]

Сообщение от aaalenaaa Или уже скажите мне,чтоб я отстала от этого файла*.fas!!!

попробуй поискать в этой теме Выбор блоков по значению атрибутов.

[aaalenaaa]

Огромное вем спасибо за ответы-советы.
Подскажите еще,если можете, как запустить вот этот лисп.

Код:

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

;;; (ax:FindBlockTagValue (vla-get-activedocument
;;; (vlax-get-acad-object)) "blockname" "tagname" "tagvalue")
(defun ax:FindBlockTagValue
       (doc bn tagname value / layout i atts tag sset c)
  (vlax-for layout (vla-get-layouts doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (= (strcase (vla-get-name i)) (strcase bn))
          )
        (if (and
              (= (vla-get-hasattributes i) :vlax-true)
              (safearray-value
                (setq atts
                       (vlax-variant-value
                         (vla-getattributes i)
                       )
                )
              )
            )
          (progn
            (foreach tag (vlax-safearray->list atts)
              (if (and
                    (= (strcase tagname)
                       (strcase (vla-get-TagString tag))
                    )
                    (= value (vla-get-TextString tag))
                  )
                (progn
                  (if (not sset)
                    (setq sset (ssadd (vlax-vla-object->ename i)))
                    (ssadd (vlax-vla-object->ename i) sset)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (sssetfirst nil sset)
)

----- добавлено через ~2 мин. -----
Огромное всем спасибо за ответы-советы!
Подскажите еще,если можете, как запустить вот этот лисп:

Код:

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

;;; (ax:FindBlockTagValue (vla-get-activedocument
;;; (vlax-get-acad-object)) "blockname" "tagname" "tagvalue")
(defun ax:FindBlockTagValue
       (doc bn tagname value / layout i atts tag sset c)
  (vlax-for layout (vla-get-layouts doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (= (strcase (vla-get-name i)) (strcase bn))
          )
        (if (and
              (= (vla-get-hasattributes i) :vlax-true)
              (safearray-value
                (setq atts
                       (vlax-variant-value
                         (vla-getattributes i)
                       )
                )
              )
            )
          (progn
            (foreach tag (vlax-safearray->list atts)
              (if (and
                    (= (strcase tagname)
                       (strcase (vla-get-TagString tag))
                    )
                    (= value (vla-get-TextString tag))
                  )
                (progn
                  (if (not sset)
                    (setq sset (ssadd (vlax-vla-object->ename i)))
                    (ssadd (vlax-vla-object->ename i) sset)
                  )
                )
              )
            )
          )
        )
      )
    )
  )
  (sssetfirst nil sset)
)

Заранее большое спасибо!!!

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

Сообщение от aaalenaaa как запустить вот этот лисп:

В самом начале приведен пример. Если убрать комментарии, получится:

Код:

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

 (ax:FindBlockTagValue (vla-get-activedocument (vlax-get-acad-object)) "blockname" "tagname" "tagvalue")

[aaalenaaa]

Огромное-огромное спасибо!!!
Какой же замечательный форум на этом сайте!!! Да и сам сайт!!! Я так много нового узнала здесь!!!
Спасибо всем!!!!

[Neo]

подскажите пожалуйста, как лучше нарисовать полилинию по координатам из списка двух Variant. смысл вот в чем: хочу соединить атрибуты блока полилинией. атрибуты обхожу mapcar и по условию вывожу InsertionPoint. список чищу от nill и получаю точки для полилинии. как "красивее" нарисовать линию, чтобы поменьше кода

[VVA]

Здесь есть из чего выбрать
нарисовать полилинию из списка с координатами точек (lisp)
Команда _pline и список точек переменной длины

[Neo]

VVA спасибо. я для себя хотел понять как оптимальнее получить из списка Variant-ов один Variant, для построения по нему LWPolyline

[trushev]

Здравствуйте! Голова совсем отупела.
Не получается ни решить вопрос ни найти решение для вложенных диалоговых окон.

Как автоматически вернуться во вложенное диалоговое окно после временного закрытия окон?

Есть a.dcl и управляющий им a.lsp. Открытие вложенного окна выполняется выбором строки в поле list-box основного окна.
Далее во вложенном окне необходимо выполнить выбор с рисунка, для чего закрываются оба окна. После выбора возврат
происходит только к первому окну. Автоматический возврат к вложенному окну не получается. Что не так?

a.dcl

Код:

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

d_vvo : dialog {label = "ГЛАВНОЕ ОКНО";
             alignment = centered;
       spacer_1;
       : list_box {label = "ВЫБОР ВЛОЖЕННОГО ОКНА";
                    list = "0\n1\n2";
                     key = "vvo";
                  height = 4;
                   width = 40;
       }
       spacer_1;
       : row {fixed_width = true; alignment = centered;
          : button {fixed_width = true;
                          width = 8;
                      alignment = centered;
                          label = "OK";
                            key = "ok";
                   }
          : button {fixed_width = true;
                      is_cancel = true;
                          width = 8;
                      alignment = centered;
                          label = "Выход";
                            key = "canc";
                    }
          : button {fixed_width = true; width = 8; alignment = centered; label = "Инструкция"; key = "hlp";}
       }
}
vvo0 : dialog {label = "ОКНО 0";
             alignment = centered;
       spacer_1;
       : row {fixed_width = true; alignment = centered;
          : button {fixed_width = true;
                          width = 8;
                      alignment = centered;
                          label = "OK";
                            key = "ok";
                   }
          : button {fixed_width = true;
                      is_cancel = true;
                          width = 8;
                      alignment = centered;
                          label = "Выход";
                            key = "canc";
                    }
          : button {fixed_width = true;
                          width = 8;
                      alignment = centered;
                          label = "Временное закрытие";
                            key = "vzak";
          }
       }
}
vvo1 : dialog {label = "ОКНО 1";
             alignment = centered;
       spacer_1;
       : row {fixed_width = true; alignment = centered;
          : button {fixed_width = true;
                          width = 8;
                      alignment = centered;
                          label = "OK";
                            key = "ok";
                   }
          : button {fixed_width = true;
                      is_cancel = true;
                          width = 8;
                      alignment = centered;
                          label = "Выход";
                            key = "canc";
                    }
          : button {fixed_width = true;
                          width = 8;
                      alignment = centered;
                          label = "Временное закрытие";
                            key = "vzak";
          }
       }
}
vvo2 : dialog {label = "ОКНО 2";
             alignment = centered;
       spacer_1;
       : row {fixed_width = true; alignment = centered;
          : button {fixed_width = true;
                          width = 8;
                      alignment = centered;
                          label = "OK";
                            key = "ok";
                   }
          : button {fixed_width = true;
                      is_cancel = true;
                          width = 8;
                      alignment = centered;
                          label = "Выход";
                            key = "canc";
                    }
          : button {fixed_width = true;
                          width = 8;
                      alignment = centered;
                          label = "Временное закрытие";
                            key = "vzak";
          }
       }
}

a.lsp

Код:

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

(defun aaa (/
            f_vvo
            ;
            dlg
            f
           )
            ;
           (defun f_vvo (val
                         dlg
                         /
                         f
                        )
                        (cond ((= val "0")
                               (if (new_dialog "vvo0" dlg)
                                   (progn
                                   (action_tile "vzak" "(done_dialog 3)")
                                   (setq f (start_dialog))
                                   );progn
                                  ;ИНАЧЕ сбой работы программы 
                                   (alert (strcat "Сбой функции открытия диалогового окна"
                                                  "\n"
                                                  "\n  \"ОКНО 0\""
                                          )
                                   )
                               );if (new_dialog "vvo0" dlg)
                              )
                              ((= val "1")
                               (if (new_dialog "vvo1" dlg)
                                   (progn
                                   (action_tile "vzak" "(done_dialog 3)")
                                   (setq f (start_dialog))
                                   );progn
                                  ;ИНАЧЕ сбой работы программы 
                                   (alert (strcat "Сбой функции открытия диалогового окна"
                                                  "\n"
                                                  "\n  \"ОКНО 1\""
                                          )
                                   )
                               );if (new_dialog "vvo1" dlg)
                              )
                              ((= val "2")
                               (if (new_dialog "vvo2" dlg)
                                   (progn
                                   (action_tile "vzak" "(done_dialog 3)")
                                   (setq f (start_dialog))
                                   );progn
                                  ;ИНАЧЕ сбой работы программы 
                                   (alert (strcat "Сбой функции открытия диалогового окна"
                                                  "\n"
                                                  "\n  \"ОКНО 2\""
                                          )
                                   )
                               );if (new_dialog "vvo2" dlg)
                              )
                        );cond
                        f
           );defun f_vvo
            ;;;;
            ;;;;
            ;;;;
           (setq f 3
               dlg (load_dialog "a.dcl")
           )
            ;
           (while (= f 3)
                  (if (new_dialog "d_vvo" dlg)
                      (progn
                      (action_tile "vvo" "(if (= (f_vvo $value dlg) 3) (done_dialog 3))")
                      (setq f (start_dialog))
                      );progn
                     ;ИНАЧЕ сбой работы программы 
                      (alert (strcat "Сбой функции открытия диалогового окна"
                                     "\n"
                                     "\n  \"ГЛАВНОЕ ОКНО\""
                             )
                      )
                  );if (not (new_dialog "papka" dlg)
                  (if (= f 3)
                      (alert "ВСЕ ОКНА ЗАКРЫТЫ")
                  );if (= f 3)
           );while (= f 3)
            ;
           (unload_dialog dlg)
);defun aaa
(aaa)

[kurstep]

Всем привет. Очень нужна одна функция, а как ее сотворить не имею представления... Есть два чертежа - один основной с чертежами и размерами, во втором задан нужный по шаблону размерный стиль.
Нужно сделать программу которая заменяла все размеры чертежа на размеры с нужным стилем (который во втором чертеже) -
Причем желательно сделать с таким условием :
если первоначальный размер имеет высоту текста 2.5 - задавать ему шаблонный аннотативный стиль 1:1
250 - 1:100
500 - 1:200 и т.д.
Заранее спасибо)

[skkkk]

Сообщение от kurstep Очень нужна одна функция, а как ее сотворить не имею представления...

А что тут иметь? Я бы раскопал тему "Программное создание размерного стиля", подставил бы туда нужные значения (разобравшись, какие из них - нужные), и создав столько размерных стилей, сколько надо, а потом запустил бы что-либо типа такого:

Код:

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

 (vl-load-com)
(defun C:TEST ( / ss vla_dim text_height)
	(setq ss (ssget '((0 . "DIMENSION")))) ;;; получаем набор размеров
	(if ss ;;; если набор создан, то
		(repeat (setq i (sslength ss)) ;;; прогоняем процедуру с каждым из объектов набора по очереди
			(setq vla_dim (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ;;; получаем vla-указатель на объект размера
				  text_height (vla-get-TextHeight vla_dim) ;;; получаем высоту текста
			) ;_end of setq
			(cond ;;; назначаем размерный стиль в зависимости от высоты текста
			  (	(= text_height 2.5)(vla-put-StyleName vla_dim "1:1")) ;;; в кавычках надо вписать имя нужного 
			  (	(= text_height 250)(vla-put-StyleName vla_dim "1:100")) ;;; текстового стиля, который уже должен 
			  (	(= text_height 500)(vla-put-StyleName vla_dim "1:200")) ;;; присутствовать в чертеже
			) ;_end of cond
		) ;_end of repeat
	) ;_end of if
);_end of defun

И дело с концом.

[gomer]

если стиль размера переопределен, то это может ничего не дать

[skkkk]

gomer, если я правильно понял суть замечания, то это опять же к вопросу программного создания размерного стиля. Если при попытке создания он уже есть и (возможно) переопределен, то привести все его настройки в соответствие со "стандартными". А вот если речь о переопределении вручную объектов-размеров, то это действительно может ничего не дать. Не скажу особо точно о программной правке размеров - банально не сталкивался - всегда создавал программно размерные стили, по одному на каждую из нужд и сразу наносил размеры "правильно", чтоб потом не править.
И вообще, если нужна надежная рабочая и безотказная "одна функция", то на много еще таких "Как?" и "А что если..?" придется ответить.

А в конце окажется, что лучше всего было бы использовать аннотативность...

[kurstep]

Спасибо большое за ответы, но мне надо не совсем это, стиль размера у меня будет один, - нужно просто чтобы у каждого размера был свой аннотативный масштаб, если размер текста 2.5 1:1, 250- 1:100....
Вопрос в том через какую функцию добавляется аннотативное свойство и добавляются аннатотивные масштабы к объекту

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

http://autolisp.ru/2011/03/17/howto-...tyle-or-block/

[Frigate]

Приветствую коллег!

Прошу подсказать, как программно вытащить, а также записать путь, который по умолчанию предлагается для печати чертежа в pdf?
Команда печати стандартная:

Код:

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

 (command "_.plot"    "_Yes"	 "model"
					;Имя листа или [?] <Модель>: 
		 printer		;напр., "HP LaserJet 5200 PCL 6 uchastok"
					;Имя устройства вывода 
		 format			;Формат листа бумаги, напр.: "A4"
		 "Millimeters"		;Единицы измерения размеров листа
		 orientation		;Ориентация чертежа
		 "_No"			;Перевернуть чертеж?
		 "_Window"		;Печатаемая область
		 xy1			;Первая точка окна 
		 xy2			;Вторая точка окна 
		 "_fit"			;[Вписать]
		 "_center"		;Смещение от начала (x,y) pdили [Центрировать]
		 "_yes"			;Учитывать стили печати?
		 style			;"acad.ctb" - имя таблицы стилей печати - "monochrome.ctb"	
		 "_yes"			;Учитывать веса линий?
		"As displayed"		;Режим вывода раскрашенных ВЭ		 

		 ;для большинства принтеров:
;;;		 "_No"			;Запись чертежа в файл
;;;		 "_n"			;Сохранить изменения параметров листа
;;;		 "_yes"			;Перейти к печати

		 ;для dwg-to-pdf:
		 pause		 	;тут вбиваем на клаве название файлу pdf: "01", "02" и т.д.
		 "_n"			;Сохранить изменения параметров листа
		 "_yes"			;Перейти к печати

		 
		 
		) ;_ end of command

[Сергей812]

Сообщение от Frigate Прошу подсказать, как программно вытащить, а также записать путь, который по умолчанию предлагается для печати чертежа в pdf?

Возможно, в этой ветке.

[mkung]

Удалено

[Сет]

Подскажите, как программно достать точку вставки блока?

[Nike]

Сообщение от Сет Подскажите, как программно достать точку вставки блока?

(cdr (assoc 10 (entget (ssname (ssget "_:S" '((0 . "INSERT"))) 0))))
(cdr (assoc 10 (entget (car (entsel "\nУкажите блок: ")))))

[Сет]

Сообщение от Nike (cdr (assoc 10 (entget (ssname (ssget "_:S" '((0 . "INSERT"))) 0)))) (cdr (assoc 10 (entget (car (entsel "\nУкажите блок: ")))))

А если средствами ActiveX?

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

vla-get-insertionpoint

[Сет]

Никак не пойму - можно ли сортировать vla-объекты в наборе по определенному условию? Создаю набор таким образом:

Код:

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

 
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))

(setq ssetObj (vla-Add (vla-get-SelectionSets doc) "TEST_SSET"))
    
(vla-SelectOnScreen ssetObj)

Нужно отсортировать элементы по координате "y". Допустим с помощью метода vla-get-InsertionPoint получу доступ к точке вставки (я не проверял работоспособность этого метода, но в справке у объекта block почему-то нет свойства InsertionPoint). Но ведь к этому набору не применить метод типа vl-sort?.. Эта функция работает со списками. Или придется преобразовывать набор объектов в список и как-то так сортировать?..

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

Во-первых, не путай BlockDefinition и BlockReference. Во-вторых, твою задачу легче решать через обычный lisp, без применения ActiveX. ПРимерно так:

Код:

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

 (defun test (/ ss)
  (if (= (type (setq ss (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT")))))))) 'pickset)
    (vl-sort ((lambda (/ tab item)
                (repeat (setq tab  nil
                              item (sslength ss)
                              ) ;_ end setq
                  (setq tab (cons (ssname ss (setq item (1- item))) tab))
                  ) ;_ end repeat
                ) ;_ end of LAMBDA
              )
             (function (lambda (a b) (< (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
             ) ;_ end of vl-sort
    ) ;_ end of if
  ) ;_ end of defun

Код писал "насухую", без проверок.

[Neo]

как получить имя блока через его атрибут?
выбираю на экране атрибут: (car (nentsel "\nSelect block:")), далее хочу получить значение другого атрибута ("tag") этого блока.
спасибо

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

Может, проще будет сначала все же вхождение блока получить?

[skkkk]

В возвращаемом списке (nentsel) один из элементов как раз - объект блока.
Прошу прощения, был неправ (с учетом следующего поста) - совершенно позабыл.

[P_S]

В возвращаемом списке (nentsel) один из элементов как раз - объект блока.

Неправда ваша (если выбирать именно атрибут, а не блок). Если выбирать атрибут, то нужно раскручивать вопрос с именами как-то так:

Код:

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

 (vlax-vla-object->ename 
(vla-ObjectIDtoObject(vla-get-ActiveDocument(vlax-get-acad-object))
(vla-get-OwnerID(vlax-ename->vla-object(car (nentsel "\nSelect block:"))))))

[Neo]

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

В возвращаемом списке (nentsel) один из элементов как раз - объект блока.

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

UPD: to P_S OwnerID подходит лучше, спасибо

[Сергей812]

Сообщение от Neo идея такая, что мышкой указываю на атрибут, а в отчет (электрические схемы подключения ) будет уходить "tag"+"указанный атрибут". два выбора мышкой не хочу, т.к. возможно ошибиться. пока решил, для всех блоков, создать ассоциативный список всех Handle атрибутов и самого блока, а там искать по Handle

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

[Neo]

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

тут идея создать отчет в последовательности указанной пользователем

[Сергей812]

Сообщение от Neo тут идея создать отчет в последовательности указанной пользователем

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

[Сет]

Я некоторые атрибуты делаю скрытыми и храню в них какие-то данные, связанные с конкретным экземпляром блока. Например атрибут "ДЛИНА", где записывается какое-то число. Чтобы извлечь это значение я получаю атрибуты блока, прохожусь по ним в цикле и если таг очередного атрибута "ДЛИНА" - считываю его значение. Немного напрягает такой способ своей нерациональностью. Было бы гораздо проще, если бы вот это числовое значение извлекалось по какому-то ключу или заранее определенному индексу. Можно ли цеплять к блокам такие данные?

[Сергей812]

Расширенные данные?

[Сет]

Сообщение от Сергей812 Расширенные данные?

Ну я не знаю, потому и спрашиваю. Поясните простым примером.

[Сергей812]

так поищите в инете.. lisp работа с расширенными данными. А еще словари есть

[George_D]

Добрый день, список представляет собой следующий вид ( (сила ( координаты точки приложения) (сила ( координаты точки приложения) и тд. ......). Не получается отсортировать его по возрастанию суммы координат (x+y) точек приложения.
Т.е. Из такого списка ((5.5 (3000.0 3000.0 0.0)) (10.0 (4500.0 3000.0 0.0)) (7.6 (1500.0 3000.0 0.0))) должен получиться ((7.6 (1500.0 3000.0 0.0)) (5.5 (3000.0 3000.0 0.0)) (10.0 (4500.0 3000.0 0.0)))

Пробую

Код:

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

 (setq list_tochek_sil ( list ( list  5.5 ( list 3000.0 3000.0 0.0)) ( list 10.0 ( list 4500.0 3000.0 0.0)) (list 7.6 (list 1500.0 3000.0 0.0))) )
(vl-sort  list_tochek_sil (function ( lambda ( e1 e2) (>
   (+(nth 0 (nth 0 (cdr e1))) (nth 1 (nth 0 e1))))
   (+(nth 0 (nth 0 (cdr e2))) (nth 1 (nth 0 (cdr e2))))				     
		)))

не выходит . Подскажите , пожалуйста, как это сделать?

[Neo]

to Сет : да и я тоже так делаю. В принципе у меня в блоках атрибутов не так и много, и пройтись циклом по каждому много времени не займет, но согласен, что рационально как-то. А если "ДЛИНА" будет не в атрибуте, то как её задавать на чертеже?

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

Код:

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

 (defun test (/ list_tochek_sil)
  (setq list_tochek_sil
         (list (list 5.5 (list 3000.0 3000.0 0.0))
               (list 10.0 (list 4500.0 3000.0 0.0))
               (list 7.6 (list 1500.0 3000.0 0.0))
               ) ;_ end of list
        ) ;_ end of setq
  (vl-sort list_tochek_sil (function (lambda (a b) (> (apply '+ (cadr a)) (apply '+ (cadr b))))))
  ) ;_ end of defun

[George_D]

Спасибо

[Сет]

Сообщение от Neo А если "ДЛИНА" будет не в атрибуте, то как её задавать на чертеже?

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

[Neo]

Сообщение от Сет Проходить циклом по каждому атрибуту и сравнивать каждый атрибут с требуемым именем в поисках нужного - довольно корявое решение.

как я понял, в vlisp нету хеш-таблиц, и assoc тоже работает перебором, правильно?

[Дима_]

Сообщение от Neo как я понял, в vlisp нету хеш-таблиц, и assoc тоже работает перебором, правильно?

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

[Сет]

удалено

[Fedorino]

Добрый день!
Подскажите пожалуйста, ответ на такой вопрос.
При переключении между листами, лисп рисующий примитивы прерывает свою работу.
Подскажите, как сделать так чтобы переключение между листами не влияло на его работу, т.е. он продолжал свою работу.
Допустим лисп такой:

Код:

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

 (setq obj (vla-get-PaperSpace actdoc))
(while (/= nil (setq pnt (getpoint "Начертите контур: ")))
					(setq spln1 (vla-AddTorus obj (vlax-3D-point pnt) 0.3 0.3))
					(setq spln1_lst (cons spln1 spln1_lst))
					(setq pnt_msv (cons pnt pnt_msv))
					(setq pnt_lst (append pnt pnt_lst))
)

[vik74]

Сообщение от TararykovDG Redj, попробуй так (Используется реактор)

Этот код сохранить как .lsp?
А как запустить?

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

http://dwg.ru/pub/9

[vik74]

Сообщение от Кулик Алексей aka kpblc Обращение ко мне - на "ты". Все, что сказано - личное мнение.

Я эту статью читал не раз. но в этот раз не получается, вот и спросил.
Что не так я делаю?
Вот команды:
Команда: _appload Numer.lsp успешно загружено.


Команда: ; ошибка: считан неверный символ (восьмеричный): 0

Команда:
Команда: (objectAppended)
; ошибка: no function definition: OBJECTAPPENDED

Команда: (vl-load-com)

Команда: (objectAppended)
; ошибка: no function definition: OBJECTAPPENDED

Сам lisp прикреплен

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

Не знаю почему, но в файле нарушена кодировка. Должна быть Windows-1251

[vik74]

Сообщение от Кулик Алексей aka kpblc Не знаю почему, но в файле нарушена кодировка. Должна быть Windows-1251

.
Вот, это уже дельный ответ!!! Если не секрет, как это определил?
Спасибо Алексей!
p.s. код скопирован с форума и вставлен в notepad++, буду разбираться, где напутал

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

Открыл в VLIDE, а там вместо гарантированно русских символов чертовщина какая-то. Открыл в Notepad++ и там преобразовал в Windows-1251. Все получилось нормально вроде бы )

[vik74]

Сообщение от Кулик Алексей aka kpblc Открыл в VLIDE, а там вместо гарантированно русских символов чертовщина какая-то. Открыл в Notepad++ и там преобразовал в Windows-1251. Все получилось нормально вроде бы )

Все равно не получается запустить.
Код с форума http://forum.dwg.ru/showthread.php?p=814881&#post814881
пост 1655.

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

Так код-то будет срабатывать только при копировании мультивыноски, насколько я вижу.

[vik74]

но как заставить автоматом менять нумерацию?

[Nike]

Товарищи, подскажите пожалуйста!

Заменяю в строке символы /,*? с помощью (vl-string-translate "/,*?"

Как бы в этот список еще кавычку " внедрить? Она ведь синтаксис функции ломает..

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

Попробуй использовать

Код:

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

\"

[Inferi]

Всем привет, может кто подскажет как получить число стрелок мультивыноски?

----- добавлено через ~2 ч. -----

Сообщение от Inferi Всем привет, может кто подскажет как получить число стрелок мультивыноски?

вроде разобрался:

Код:

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

(setq mleader (vlax-ename->vla-object (car (entsel)))
      leaderLineIndexes (vla-getLeaderLineIndexes mleader 0)
      indexList (vlax-safearray->list (variant-value leaderLineIndexes))
      quantity (length indexList)
)

[Neo]

Подскажите как "по лисповски" правильно применять функцию к списку. например форматирование таблицы я сделал так

Код:

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

 (mapcar	(function (lambda (x)
		    (vla-SetColumnWidth comp_list_tbl (car x) (cadr x))
		    ) ;_ end of lambda
		  ) ;_ end of function
	'((0 20) (1 25) (2 35) (3 110) (4 115) (5 15) (6 15) (7 60))
	) ;_ end of mapcar

Что не нравится: mapcar возвращает список, а мне это не нужно
может лучше это сделать через foreach? или еще как

[Дима_]

"По лисповски" или по автолисповски? ИХМО - если не уверен, что написал ты раз и навсегда - лучше используй mapcar с игнорированием результатов - они конечно добавляют работы GC, но эта та мелочь которая вряд-ли будет практически заметна, но зато если понадобится, что-то добавить, что возвращает результат - то не надо будет ломать структуру.
Если совсем по лисповски - то vla-SetColumnWidth - это "обертка" не из его парадигмы (в функциональном варианте она-бы возвращала новый объект таблицы с измененным столбцом - который надо-бы было обрабатывать через "свертку" списка).
з.ы. в данном примере можно рассмотреть вариант (apply 'vla-SetColumnWidth (cons comp_list_tbl x))

[gomer]

Сообщение от Дима_ (cons comp_list_tbl x)

действительно ?

[Neo]

подскажите как выделить только те объекты xref, которые остались после clip.
В чертеж вставлены xref на другие чертежи, и обрезаны clip. Составляю перечень элементов: все блоки текущего чертежа + видимые блоки xref-ов. Ко всем блокам xref-ов добрался, а как выбрать только те, что видно на чертеже?

[Vladimir_Sergeevich]

Возник один вопрос. Сейчас собирал программку автоматической настройки среды для отдела.
Уперся в один момент: у нас есть пара программок, которые лежат в автозагрузке "Сервис-приложения-автозагрузка".
Сколько не искал по форуму - было единственное предложение дописывать в acaddoc.lsp, чего делать не хочется (уж проще руками их добавить через окна).
Расковыривая объектную модель, тоже ничего похожего на правду не нашел.
Есть ли, все таки, способ добраться до списка этих приложений через AutoLisp или дело совсем гиблое?

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

http://adn-cis.org/posledovatelnost-...v-autocad.html
http://adn-cis.org/autocad-autoload-security.html

[frostmourn]

Пока разбирался тут с ssget-ом, заметил, что фактические цвета рамки выбора (переменные windowareacolor и crossingareacolor) не соответствуют таковым в окне выбора цвета, видимо, из-за прозрачности. После экспериментов со сменой цвета и проверкой в паинте выяснилось, что величины RGB компонент меньше примерно в 4 раза. Но если пробовать вычислять цвет так, то на некоторых значениях отличается на несколько единиц, а хочется, конечно, точно. Так вот, как определить "настоящий" цвет заливки?

[ZloyEjik]

Есть имя переменной взятое из файла (пр. "SAPsto")
Есть значение переменной взятое из файла (пр. "KRF-107")
Вопрос:
Как в LISP составить команду (setq SAPsto "KRF-107") ?
Имя переменной получается из файла и может меняться.
Попробовал (atoi "(setq SAPsto "KRF-107")") - не получилось.

Или другой вариант той же проблемы:
Есть цикл, в нем N = N+1
В первом повторении цикла должны получить (setq testN 1), где testN = test1
Во втором (setq testN 1), где testN = test2

[Сергей812]

Сообщение от ZloyEjik Есть имя переменной взятое из файла (пр. "SAPsto") Есть значение переменной взятое из файла (пр. "KRF-107") Вопрос: Как в LISP составить команду (setq SAPsto "KRF-107") ? Имя переменной получается из файла и может меняться. Попробовал (atoi "(setq SAPsto "KRF-107")") - не получилось. Или другой вариант той же проблемы: Есть цикл, в нем N = N+1 В первом повторении цикла должны получить (setq testN 1), где testN = test1 Во втором (setq testN 1), где testN = test2

С циклом - на верном пути, в принципе: открываете файл, считываете в цикле оттуда построчно значения и присваиваете их testN.

[ZloyEjik]

Сообщение от Сергей812 С циклом - на верном пути, в принципе: открываете файл, считываете в цикле оттуда построчно значения и присваиваете их testN.

Тут вопрос по поводу возможности изменения переменной. Возможно ли записать кучу переменных через цикл.
(setq test1 "1")
(setq test2 "1")
(setq test3 "1")
(setq test4 "1")
...
(setq testN "1")
Другими словами, чтобы имя переменной тоже было переменно

Другими способами я уже решил задачу. (1ая через cond):
(while (setq stroka (read-line sett))
(cond
( (wcmatch stroka "*SAPsto*") (setq SAPsto (substr stroka 1 (vl-string-position (ascii ";") stroka)))) ; Стойка
( (wcmatch stroka "*SAPrigF*") (setq SAPrigF (substr stroka 1 (vl-string-position (ascii ";") stroka)))) ; Ригель с фрезеровкой
....
))
(2ую можно записывать не одну переменную а добавлять в один список (list) все переменные, а потом считывать)

Но интересно, можно ли решить задачу через изменение имени переменной.

[Сергей812]

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

[VVA]

Сообщение от ZloyEjik Есть имя переменной взятое из файла (пр. "SAPsto") Есть значение переменной взятое из файла (пр. "KRF-107") Вопрос: Как в LISP составить команду (setq SAPsto "KRF-107") ? Имя переменной получается из файла и может меняться.

Ассоциативный список?
Примеры функций
DwgRuLispLib: Две функции работы со списками
_dwgru-assoc и _dwgru-assoc-multi

[trushev]

Часто возникает необходимость функцией setq присвоить значения нескольким переменным.
Какие преимущества/недостатки вариантов решения этой задачи?
(setq a 1)
(setq b 2)
...
(setq z N)
Или
(setq a 1
b 2
...
z N
);setq

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

Второй вариант обычно быстрее. И читается, как правило, проще.

[gomer]

Сообщение от trushev Какие преимущества/недостатки вариантов решения этой задачи?

Самый распространенный недостаток - трудность переделки кода, ты не можешь просто так скопировать/перенести определение в другое место, только в такой же блок определений

[Сергей812]

ну и комментарии писать проще - за что какая переменная отвечает. Комментарии писать очень желательно, если в дальнейшем планируется модернизация программы или использования кода из нее в других программах.

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

Уууу, робяты, ну вы и тему подняли

Копирастинг кода - зло. Если какая-то последовательность действий выполняется больше чем 1 раз, стоит рассмотреть необходимость ее выноса в отдельную функцию. Например, функция создания слоя с различными параметрами, или функция вставки блока / ссылки, или функция открытия стороннего файла dwg, или функция сохранения лога, или... Короче, общий принцип понятен.
При таком подходе не надо комментировать код внутри функции, достаточно дать ее внятное описание, рассказать, какой параметр за что отвечает и теде. Функция (что бы она ни делала) работает так, как написано, и возвращает строго определенные типы результатов.

Постарайтесь все же найти "САПР на базе AutoCAD - как это делается" - там много интересного.

[Сергей812]

Алексей, к сожалению IDE Lisp и того же VBA уже настолько отстал от других сред разработки, что без копипастинга трудновато обойтись)

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

Кому как, кому как ))) У меня сейчас больше 700 функций, копипастингом не занимаюсь принципиально. Вопрос в организации работы, я думаю. Ну, все, пофлудил - и будя

[trushev]

Имеется функция:

Код:

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

(defun test (sp_peremen  ; список имен переменных
             sp_klpoley  ; список ключей полей диалогового окна
                         ;(количество и последовательность элементов списка sp_klpoley соответствуют списку sp_peremen)
             /
             sp_rezultat ;список результатов расчета
            )
             ;
             ;Присвоение значений переменным
             ;
            (foreach k sp_peremen
                     (set k (get_tile (car sp_klpoley)))
                     (setq sp_klpoley (cdr sp_klpoley))
            );foreach sp_peremen
             ;
             ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
             ;
             ;Выполнение вычислений с записью результатов в sp_rezultat
             ;
             ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
             ;
             ;Обнуление используемых переменных
             ;
            (foreach k sp_peremen  ; список имен переменных
                     (set k 'nil)
            );foreach k
             ;
             ;На выходе список результатов расчета
             ;
            sp_rezultat
);defun test

Как объявить локальными переменные из списка sp_peremen?

PS Вышел из отпуска, благодарю за отклики по "setq".

[skkkk]

Сообщение от trushev Как объявить локальными переменные из списка sp_peremen?

Может, я не совсем правильно понял, но (даже не вникая в суть кода) разве это переменная? Все, что до знака "/" - это аргументы функции, а sp_peremen, стало быть - один из них, представленный списком. И этот аргумент может стать переменной в функции более высокого уровня, и тогда его нужно локализовать в ней, но уже после "/". При этом, по-моему, придется локализовать и все остальные переменные, которые этот список будет в себя включать. Могу ошибаться, но, кажется, нельзя локализовать все переменные, локализовав одну, содержащую в себе их в виде списка.

[trushev]

Сообщение от skkkk Может, я не совсем правильно понял

Постараюсь дать более подробные пояснения.
В коде выполнена попытка унифицировать считывание данных с различных диалоговых окон. Не знаю на сколько эта идея бредовая.
sp_peremen аргумент функции test является списком произвольного числа произвольных имен переменных и может иметь вид:
(list 'ed1 'ed2 'tg1) или
(list 'ed5 'ed6 'ed7 'ls1 'tg4 'tg8) или нечто иное.
sp_klpoley аргумент функции test является списком ключей полей диалогового окна. Количество элементов списка и их последовательность
должны соответствовать списку sp_peremen. sp_klpoley может иметь вид:
(list "ed1" "ed2" "tg1") или
(list "ed5" "ed6" "ed7" "ls1" "tg4" "tg8") или нечто иное.
В цикле с использованием функции "set" (не setq) выполняется присвоение переменным значений.

Сообщение от skkkk И этот аргумент может стать переменной в функции более высокого уровня, и тогда его нужно локализовать в ней

Агументы {все между "(" и "/"} и рабочие переменные {все между "/" и ")"} пользовательской функции объединяются в локальные переменные и дополнительной локализации не требуют.
Ничего не нашел по локализации вложенной функции. Скорее всего ее имя должно фигурировать в перечне локальных переменных основной функции. Но подтверждение этому не нашел.

Сообщение от skkkk кажется, нельзя локализовать все переменные, локализовав одну, содержащую в себе их в виде списка

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

[skkkk]

Сообщение от trushev Ничего не нашел по локализации вложенной функции. Скорее всего ее имя должно фигурировать в перечне локальных переменных основной функции.

Так и есть. Это легко проверить, например, загрузив в Автокад лисп, в котором будет локализованная и нелокализованная функция, выполнить его и в командной строке после восклицательного знака вбить имя сначала одной, затем другой. Локализованная вернет nil.

Сообщение от trushev Значит без принудительного обнуления переменных из списка не обойтись.

А чем смущает такой подход? Причем, я бы даже добавил это в локальный *error* и вызывал бы его в конце выполнения кода.

[trushev]

Сообщение от skkkk А чем смущает такой подход?

Существует вероятность, хотя и малая, совпадения имен с ранее введенной глобальной переменной.

----- добавлено через ~18 ч. -----
skkkk, спасибо за уделенное время. Приятно было пообщаться.

[George_D]

Добрый день, подскажите , пожалуйста, есть ли возможность с помощью Lisp преобразовать объект в блок и программно добавить к полученному блоку атрибут? Пытаюсь выполнить следующие преобразования: пользователь выбирает полилинию-полилиния преобразуется в блок-атрибут блока пользователь выбирает с помощью выпадающего DCl списка-итог, блок состоящий из полилинии с невидимым атрибутом в нем.

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

_.attsync или его альтернативы (написанные самостоятельно)

[Сергей812]

Сообщение от George_D Добрый день, подскажите , пожалуйста, есть ли возможность с помощью Lisp преобразовать объект в блок и программно добавить к полученному блоку атрибут? Пытаюсь выполнить следующие преобразования: пользователь выбирает полилинию-полилиния преобразуется в блок-атрибут блока пользователь выбирает с помощью выпадающего DCl списка-итог, блок состоящий из полилинии с невидимым атрибутом в нем.

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

[skkkk]

Кулик Алексей aka kpblc, я тоже подумал об этом в первую очередь, но почему-то решил, что человек, создающий атрибуты программно, должен бы уже знать, что их нужно синхронизировать. Ведь без этого даже ручное создание не обойдется. Думаю, что тут дело в чем-то другом, хотя без кода и файла-примера сказать что-то не возьмусь.

[Inferi]

Доброго времени суток. Помогите решить задачу:
есть динамический блок ent_vla "Отвод круглый %%C315-90%%D (подъем)" с параметром поворота "Угол1";
если блок зеркалим или поворачиваем стандартными командами автокада, то реактор выполняет присвоение значения "Угол1" = (- (* 2 pi) (vla-get-rotation ent_vla))).
Пока код выглядит следующим образом:

Код:

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

 
(defun c:reac_dyn_blk_rotate (/ Reac)
  (vl-load-COM)

  (if (setq Reac
        (vl-some
          (function
            (lambda (reactor)
              (if (eq "dyn_blk_rotate"
                    (vlr-data reactor)) reactor)))

          (cdar (vlr-reactors :vlr-command-reactor))))

    (if (vlr-added-p Reac)
      
      (vlr-remove Reac)
      (vlr-add Reac))

    (setq Reac
      (vlr-command-reactor "dyn_blk_rotate"
        (list
          (cons :vlr-commandEnded 'dyn_blk_rotate)))))

  (if (vlr-added-p Reac)
    (princ "\n** dyn_blk_rotate Reactor Activated **")
    (princ "\n** dyn_blk_rotate Reactor Deactivated **"))

  (princ))

(defun dyn_blk_rotate (Reactor Args / )
 (setq ent_vla (vlax-ename->vla-object (entlast)))
  (if
    (eq (LM:effectivename ent_vla) "Отвод круглый %%C315-90%%D (подъем)")
      (LM:setdynpropvalue ent_vla "Угол1" (- (* 2 pi) (vla-get-rotation ent_vla)))
  );end if
(princ))

; -------------------------------------------------------------------------------------------------
(defun LM:setdynpropvalue ( blk prp val )
    (setq prp (strcase prp))
    (vl-some
       '(lambda ( x )
            (if (= prp (strcase (vla-get-propertyname x)))
                (progn
                    (vla-put-value x (vlax-make-variant val (vlax-variant-type (vla-get-value x))))
                    (cond (val) (t))
                )
            )
        )
        (vlax-invoke blk 'getdynamicblockproperties)
    )
)
; ------------------------------------------------------------------------------------------------
(defun LM:effectivename ( obj )
    (vlax-get-property obj
        (if (vlax-property-available-p obj 'effectivename)
            'effectivename
            'name
        )
    )
)
; ------------------------------------------------------------------------------------------------

Как грамотно реализовать для группы последних зеркаленых/повернутых блоков? Все вхождения блока с указанным именем перебирать не хочу.

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

Как вариант - попробовать получить (ssget "_I"), но я не уверен, что это сработает. Если не повезет с ssget, можно попытаться через ActiveX получить набор выделенных объектов и проходить уже по ним.

[Red Nova]

Аффтора темы еще примите тут на консультацию?
Подскажите плиз если кто знает как получить аннотативный масштаб объекта?
Пока ничего внятного не нашел.
При помощи vla-get-XScaleFactor можно получить масштаб блока, но все остальное (размер, текст, заливка и т.п.) не поддаются.

Код:

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

 (vla-get-XScaleFactor (vlax-ename->vla-object(car(entsel))))

Кроме того, все что я нашел в сети выдает не сам масштаб а коэффициент уменьшения (опять таки только для блоков). Так что если масштаб задан в империальном формате, то, даже получив коэффициент, не понять был этот масштаб метрический или империальный (к примеру для 1/2" = 1'-0" получим на выходе 24).

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

cannoscale? cannoscalevalue?

[Red Nova]

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

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

Когда-то я разбирался с аннотативностью: http://autolisp.ru/2011/03/17/howto-...tyle-or-block/
Может быть, подскажет решение? Честно - сейчас слишком сильно устамши, работать не могу от слова совсем

[Vladimir_Sergeevich]

Когда то тоже копал в эту сторону. Докопал до сих:

Код:

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

 (vla-GetXData (vlax-ename->vla-object (car (entsel))) "AcadAnnotative" 'type 'val)
(foreach it (vlax-safearray->list val) (princ (vlax-variant-value it)))
;;;AcadAnnotativeAnnotativeData{11}

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

Код:

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

 ("AcadAnnotative"
   (1000 . "AnnotativeData")
   (1002 . "{")
   (1070 . 1)
   (1070 . 1)
   (1002 . "}")
   )

Но это все касается только собственно свойства аннотативности. До списка масштабов я так и не докопался.

з.ы.
Можно покопать в эту сторону:

Код:

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

 (vlax-dump-object (vla-item (vla-item (vla-GetExtensionDictionary (vlax-ename->vla-object (car (entsel)))  ) 0) 0) t)
; IAcadDictionary: Объект-контейнер для хранения и получения других объектов.
; Значения свойств:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 013091b4>
;   Count (RO) = 6
;   Document (RO) = #<VLA-OBJECT IAcadDocument 1339bf60>
;   Handle (RO) = "9AB"
;   HasExtensionDictionary (RO) = 0
;   Name = "ACDB_ANNOTATIONSCALES"
;   ObjectID (RO) = 2129707480
;   ObjectName (RO) = "AcDbDictionary"
;   OwnerID (RO) = 2129707472
; Поддерживаемые методы:
;   AddObject (2)
;   AddXRecord (1)
;   Delete ()
;   GetExtensionDictionary ()
;   GetName (1)
;   GetObject (1)
;   GetXData (3)
;   Item (1)
;   Remove (1)
;   Rename (2)
;   Replace (2)
;   SetXData (2)

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

Давай немного вернемся назад. Ты хочешь получить масштаб аннотативного объекта - а для каких условий? Для текущего масштаба аннотативности? Для указанного видового экрана? Выяснить, вообще какие масштабы объекту назначены?

[Inferi]

Доброго времени суток, как грамотно применить mapcar "два раза", если скажем нужно выполнить действие на каждым элементом списка вида:
((a1 b1 c1) (a2 b2 c2) ... (a... b... c...))

[VVA]

Сообщение от Red Nova А мне нужно получить аннотативный масштаб примитива.

Сообщение от Vladimir_Sergeevich До списка масштабов я так и не докопался.

Вот что нашел у себя в заначках. Не проверял

Код:

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

  (defun GetAnnoScales (e / dict lst rewind res)
;;; Argument: the ename of an annotative object.
;;; Returns the annotative scales associated with the 
;;; ename as a list of strings.
;;; Example: ("1:1" "1:16" "1:20" "1:30")
;;; Returns nil if the ename is not annotative. 
;;; Can be used to test whether ename is annotative or not.
;;; Works with annotative objects: text, mtext, leader, mleader, 
;;; dimension, block reference, tolerance and attribute.
;;; Based on code by Ian Bryant.


;;;Joe Burk
;;;http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/how-do-i-make-hatch-annotative-via-vlisp-almost-there/m-p/2080831    
;; Argument: an ename or vla-object.
;; Return T if object is annotative, otherwise nil.
;;;(defun IsAnnotative (e)
;;;(if (not (eq (type e) 'ENAME))
;;;(setq e (vlax-vla-object->ename e))
;;;)
;;;(if (assoc -3 (entget e '("AcadAnnotative"))) T)
;;;)

;;;(defun IsAnnotative (e)
;;;(and e
;;;(setq e (cdr (assoc 360 (entget e))))
;;;(setq e (dictsearch e "AcDbContextDataManager"))
;;;(setq e (dictsearch (cdr (assoc -1 e)) "ACDB_ANNOTATIONSCALES"))
;;;(assoc 350 e)
;;;)
;;;)
    

    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq e      (cdr (assoc 340 lst))
                 res    (cons (cdr (assoc 300 (entget e))) res)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
       ) ;_ end of progn
    ) ;_ end of if
    (reverse res)
  )                                               ;end


  (defun CheckHandles (e / dict lst rewind nlst d42 d43 n p ptlst)
;;; Argument: the ename of annotative mtext object.
;;; Returns T if the object has only one scale or
;;; the handles for all scales are proportionally the
;;; same and all scales use the same insertion point.
    (if
      (and
        e
        (setq dict (cdr (assoc 360 (entget e))))
        (setq lst (dictsearch dict "AcDbContextDataManager"))
        (setq lst
               (dictsearch (cdr (assoc -1 lst)) "ACDB_ANNOTATIONSCALES")
        ) ;_ end of setq
        (setq dict (cdr (assoc -1 lst)))
      ) ;_ end of and
       (progn
         (setq rewind t)
         (while (setq lst (dictnext dict rewind))
           (setq nlst   (cons lst nlst)
                 rewind nil
           ) ;_ end of setq
         ) ;_ end of while
         (cond
           ((= 1 (length nlst)))
           (t
            ;; lst is nil so reuse it.
            (foreach x nlst
                                                  ;Horizontal width. Can be zero, a null text string.
              (setq d42   (cdr (assoc 42 x))
                                                  ;Vertical height cannot be zero so a divide 
                                                  ;by zero error can't happen.
                    d43   (cdr (assoc 43 x))
                    n     (/ d42 d43)
                    lst   (cons n lst)
                                                  ;Insertion point
                    p     (cdr (assoc 11 x))
                    ptlst (cons p ptlst)
              ) ;_ end of setq
            ) ;_ end of foreach
            (and
              (vl-every '(lambda (x) (equal n x 1e-4)) lst)
              (vl-every '(lambda (x) (equal p x 1e-4)) ptlst)
            ) ;_ end of and
           )
         ) ;_ end of cond
       ) ;_ end of progn
    ) ;_ end of if
  )                                               ;end

----- добавлено через ~11 ч. -----

Сообщение от VVA Не проверял

Проверил. Работает

Команда: (GetAnnoScales (car(entsel))) Выберите объект: ("1:1" "1:50" "2:1")

[Red Nova]

VVA, Спасибо. Как отпуск прошел?
Обнаружил что для империальных масштабов добавляется лишний символ обратной скобки. К чему бы это?

Command: (GetAnnoScales (car(entsel))) Select object: ("1/4\" = 1'-0\"")

Вместо 1/4\" = 1'-0\" должно быть 1/4" = 1'-0"

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

[VVA]

Сообщение от Red Nova Вместо 1/4\" = 1'-0\" должно быть 1/4" = 1'-0"

Это не лишний символ. Двойная кавычка ("), как и обратный слеш (backslash) — символ (\) служебные символы. Если ты хочешь использовать в строке как символы, то их нужно экранировать обратным слэшем

[Red Nova]

VVA
Спасибо. На основе этого кода я собрал вот эти команды

[Дима_]

Сообщение от Inferi Доброго времени суток, как грамотно применить mapcar "два раза", если скажем нужно выполнить действие на каждым элементом списка вида: ((a1 b1 c1) (a2 b2 c2) ... (a... b... c...))

можно двумя вложенными mapcar'ами:

Код:

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

 (mapcar '(lambda (lst2) (mapcar '1+ lst2)) '((1 2 3) (4 5 6) (7 8 9)))

Если-же копнуть поглубже, то можно и на любую глубину вложенности:

Код:

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

 (defun fun (fn lst)
  (if (listp lst)
      (mapcar '(lambda (x) (fun fn x)) lst)
      (fn lst)))

;; пример вызова (fun 1+ '(1 2 (3 4 (5 6) 7) 8 9))

[Jerald]

Подскажите.
Такой алгоритм: Сохранить как -> Формат файла.
Можно макрос. Если не трудно.

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

Тебе команду надо? Тогда смотри опции _.-save
Лиспом? См. варианты vla-save, vla-saveas

[Jerald]

Сообщение от Кулик Алексей aka kpblc Тогда смотри опции _.-save

Не вызывается в прозрачном режиме.
Команда: _.-save
Неизвестная команда "-SAVE". Для вызова справки нажмите F1.

Вот макрос кнопки ^C^C_saveas
Сделал так:
^C^C_saveas_AutoCAD 2007/LT2010(*.dxf)

Не работает.

AutoCAD 2015 рус

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

Тьфу, косяк... Сначала выставляй тогда filedia в 0, потом сохраняй, и восстанавливай filedia:

Код:

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

Command: filedia
Enter new value for FILEDIA <1>: 0
Command: saveas
Current file format: AutoCAD 2007 Drawing
Enter file format [R14(LT98&LT97)/2000(LT2000)/2004(LT2004)/2007(LT2007)/Standards/DXF/Template] <2007>: dxf
Current DXF settings: Precision= 16 Format= ASCII Preview= No Version= 2007
Enter decimal places of accuracy (0 to 16) or [Binary/select Objects/Preview/Version] <16>: 16
Save drawing as <C:\Users\a.kulik\Documents\Drawing1.dxf>:
Command: filedia
Enter new value for FILEDIA <0>: 1

Но я как-то не очень понимаю: сохраняешь-то ты активный документ. Оно точно надо именно так?