[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

_____________________________________________________________________________________________________________

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

[Vladimir_Sergeevich]

Сообщение от koMon эпичная/не эпичная, но решить её универсальным инструментом вряд ли получится. в общем виде алгоритм видится имхо таким. 1. ищем в тексте "м". если литера встречается однажды по условию, то оно и к лучшему) 2. идём "налево" от найденной литеры в поиске цифр до первой не цифры. найденные цифры читаем в число метров. запоминаем индекс начала метров. 3. теперь идём "направо" через "/", через цифры до "'". запоминаем индекс "'", если нашёлся или индекс "м", если не нашёлся. 4. режем строку по найденным индексам и вставляем новую подстроку метры/футы вместо вырезанной. 5. обновляем текст.

В моем предыдущем посте вариант попроще будет:
1.строка кромсается кодом Евгения на куски
2.каждый кусок проверяется через numberp. если число - запомнили и преобразовали обратно в строку. В этом конкретном примере запомнится только последнее число в списке
3. пересчитали число на новые единицы
4. склеиваем список обратно в строку и пришиваем новый кусок с хвоста, результат загоняем в примитив.

[koMon]

1. работает ОДНОкратно на только текстах, нуно (0 . "*text"). при повторном использовании считает футы метрами и дописывает в конец новые футы
2. если метры в середине строки, то дописывает футы в конец строки
3. если в строке нет цифр - обрушение. если такая строка выбрана среди тех, что с цифрами, то результат над безцифровыми строками непредсказуем.

[Vladimir_Sergeevich]

Сообщение от koMon 1. работает ОДНОкратно на только текстах, нуно (0 . "*text"). при повторном использовании считает футы метрами и дописывает в конец новые футы 2. если метры в середине строки, то дописывает футы в конец строки

Ну первая позиция лечится просто заменой (sad-get-ss '((0 "TEXT") ) на (sad-get-ss '((0 "*TEXT") ) и да, защиты от дурака не предусмотрено...
А по второму пункту это уже выходит за рамки конкретного образца строки, представленного в #3979 и мы вернемся к "эпичности задачи по обработке всех вариантов в одном коде". Никто не запрещает добавить к анализу полученного числа проверку измерителя который можно найти в следующем по счету элементе списка... только надо вводить счетчик элементов или менять принцип обработки полностью. Вместо foreach прогонять repeat с отгрызанием просмотренных элементов cdr'ом, например.

з.ы. защиту от повторной обработки то и организовать не сложно: достаточно весь код повесить на (if (wcmatch str "*'*") nil (progn...))

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

з.з.ы. Добавил в #3999 защиту от повторной обработки и игнорирование строк без чисел

[koMon]

Сообщение от Vladimir_Sergeevich 046 * Написал Елпанов Евгений****** (ElpanovEvgeniy) 047 * 048 * дата создания (13/10/2007 a 11:42) 049 * написано во время конкурса на форуме: 050 * http://www.cadxp.com/XForum+viewthre...43-page-2.html

неожиданный поворот и конкурсы ведь были!

----- добавлено через ~5 мин. -----
4. если поменять число метров в строке уже с футами, то футы при выборе этой строки не меняются.

----- добавлено через ~12 мин. -----
Vladimir_Sergeevich, сдаётся мне что на твоём месте должен был бы быть тс!?

[Vladimir_Sergeevich]

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

Не совсем понял формулировки вопроса... вроде так и задумано
у меня там в 4 строке висит "(wcmatch (vla-get-TextString txt) "*'*") nil..." и если уже были ранее футы в строке, то nil и погнали на следующий.

Сообщение от koMon Vladimir_Sergeevich, сдаётся мне что на твоём месте должен был бы быть тс!?

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

[koMon]

Сообщение от Vladimir_Sergeevich Не совсем понял формулировки вопроса... вроде так и задумано

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

Сообщение от Vladimir_Sergeevich давно не кодил, работа утомила, надо было отвлечься...

and i have a strong feeling that topic caster would've definitely been amused amighty

[Vladimir_Sergeevich]

Сообщение от koMon и надо бы футы подтереть, а забыл где-то

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

[koMon]

[rusv]

Сообщение от koMon эпичная/не эпичная, но решить её универсальным инструментом вряд ли получится. в общем виде алгоритм видится имхо таким. 1. ищем в тексте "м". если литера встречается однажды по условию, то оно и к лучшему) 2. идём "налево" от найденной литеры в поиске цифр до первой не цифры. найденные цифры читаем в число метров. запоминаем индекс начала метров. 3. теперь идём "направо" через "/", через цифры до "'". запоминаем индекс "'", если нашёлся или индекс "м", если не нашёлся. 4. режем строку по найденным индексам и вставляем новую подстроку метры/футы вместо вырезанной. 5. обновляем текст.

Да, в целом задачку так и решил. Возникли трудности только с определением сколько пойти "налево", но так как в основном это тысячи, то обошелся константой "5".
Всем спасибо!!

[skkkk]

Сообщение от rusv Возникли трудности только с определением сколько пойти "налево", но так как в основном это тысячи, то обошелся константой "5".

Вот тут как раз можно "пощупать" номер символа, о котором я говорил в #3984, и до тех пор, пока он попадает в интервал, идти левее. А то 5 - как-то не универсально

[Vladimir_Sergeevich]

хм... что то лыжи не едут.
Вроде как с акад 2015 было новшество на тему командных методов command и vl-cmdf
Сейчас заметил, что в акад 2021 благополучно работают коды, которые работать и не должны бы... они что ли вернули поддержку command для обратной совместимости?

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

Ты не забывай еще и про наличие command-s.

----- добавлено через ~1 ч. -----
Сейчас проверил: независимо от результатов vl-cmdf всегда возвращает t, а command и command-s - nil. Логика не поменялась с 2015 версии. Возможно, в кодах есть логические ошибки

[Vladimir_Sergeevich]

Сообщение от Кулик Алексей aka kpblc Ты не забывай еще и про наличие command-s.

В том то и дело, что помню. Только раньше сидел на акад 2013 и не грузился этим. Вроде речь шла о том, что с 2015 command не должна работать от слова совсем? А она все равно работает без переписывания...

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

Кто это говорил и где? Она работает, только в другом режиме.

[Vladimir_Sergeevich]

Сообщение от Кулик Алексей aka kpblc Кто это говорил и где? Она работает, только в другом режиме.

видимо я 5 лет назад понял неверно и не сильно парился пока не пошли акад обновлять в конторе.

----- добавлено через ~1 ч. -----
хм... вот жеж засада...
Почему значение (vla-get-TextRotation obj) для объекта мультивыноски ("AcDbMLeader") зависит от текущей пск?
Озадачился тут обработкой систем координат и споткнулся там где не ждал.

[Browning Zed]

Уважаемые форумчане, помогите прояснить следующий момент. Пытаюсь добраться через реестр к параметрам текущего профиля юзера, чтобы изменить их конфигурацию. Например, меняю состояние статус-бара и добавляю туда циклический выбор:
(vl-registry-write (strcat "HKEY_CURRENT_USER\\" (vlax-product-key) "\\Profiles\\" (getvar "cprofile") "\\StatusBar\\Application" "SelectionCycling" "1"))
командная строка, при этом, возвращает T, но запись в реестре не изменяется, оставаясь со значением "0".
В чем может быть причина?

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

А не проще ли системную переменную менять?

[Browning Zed]

Через переменную можно активировать/деактивировать функцию, но не вывести (либо убрать) ее в статус-бар.

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

Ключи в реестре как правило все же меняются. Другой вопрос, что не стоит менять ключи, касающиеся самого ACAD'a. Так, например, можно поменять пути поддержки в реестре, и изменения даж сохранятся в реестре - но а) они не подхватятся и б) при закрытии ACAD'a все пути вернутся в начальное состояние. Поэтому и приходится работать через переменную окружения "ACAD".
По крайней мере такое было раньше, и я подозреваю, что вряд ли система изменилась.

[Browning Zed]

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

(setenv "SELECTIONCYCLING" "1") не дает должного эффекта, есть ли в данном случае выход из ситуации?

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

А с какого перепугу ты работаешь с переменной окружения, когда надо работать с системной переменной?
Не setenv / getenv, а setvar / getvar

[Browning Zed]

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

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

Провокационные вопросы
1. Если поменять в самом каде - в реестре данные меняются?
2. Если "снаружи" руками поменять в реестре данные - статусная строка меняется? Если да, то сразу или нет?
3. Если реестр правился снаружи, что будет после выхода из када?

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

[Browning Zed]

1. Да.
2. Статус-бар меняется, но только после перезапуска автокада.
3. Ничего необычного, стандартный выход из программы.

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

Ответ на второй вопрос - ключевой.
По поводу третьего: допустим, настройка включена. Меняется реестр, и тут же выход из ACAD. Что окажется в реестре?

[Browning Zed]

Сообщение от Кулик Алексей aka kpblc Ответ на второй вопрос - ключевой.

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

Сообщение от Кулик Алексей aka kpblc Меняется реестр, и тут же выход из ACAD. Что окажется в реестре?

Немного не понял как смоделировать подобную ситуацию. Изменить реестр с одновременным выходом из акада?

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

Изменить реестр. Закрыть кад. Проверить, что получилось в реестре.

[Browning Zed]

Остается значение, которое задавалось в реестре "вручную".

[AMDen]

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

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

Можно, почему нет?

[AMDen]

Сообщение от Кулик Алексей aka kpblc Можно, почему нет?

Как это сделать?

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

Примерно так же, как вызываются стандартные функции. Я искренне не понимаю, в чем собственно "затык"?

[AMDen]

(command "CFTALL")
Пишет Неизвестная команда. Хотя если ввести в ком. строке CFTALL, все работает.

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

Вызывай как

Код:

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

 (c:cftall)

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

[AMDen]

Сообщение от Кулик Алексей aka kpblc Вызывай как Код: [Выделить все] 1 (c:cftall)

Благодарю, теперь работает.

[posetitel]

Товарищи, помогите с командой: как сделать слой с именем из буфера обмена?
есть простой лисп
(defun c:sloy ()
(command "-слой" )
(command "с" pause ^C^C)
(command "ПЛИНИЯ")
)
нужно, чтобы имя слоя не вводилось руками, а бралось из буфера и дальше выполнялась команда "ПЛИНИЯ"

[Сергей812]

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

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

[posetitel]

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

[koMon]

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

Код:

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

 (defun c:pline_cb_layer ()
	(command "._pasteclip" '(1e10 1e10))
	(setq layer_mtext (entlast))
	(if (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object (setq layer_mtext (entlast)))))
			(progn
				(vl-catch-all-apply 'vla-add (list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) 
												   (setq layer_name (vla-get-textstring (vlax-ename->vla-object layer_mtext)))
											 )
				)
				(setvar 'clayer layer_name)
				(vla-erase (vlax-ename->vla-object layer_mtext))
				(command "_.pline" pause)
			)
			(progn
				(vla-erase (vlax-ename->vla-object layer_mtext))
				(alert "В буфере обмена не текст!")
			)
	)
)

[40in]

Добрый день всем гуру Автокада!
Я пересел на новый компьютер и столкнулся с проблемой. Перестали работать некоторые мои программы.
В частности перестали програмно заполнятся динамические блоки в мультивыноске. Вот такой кусочек кода:

Код:

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

 (setq dl_trass 1589.2658
      kab      "32"
)
(setq pktochisk (getpoint "ВВЕДИТЕ 1 ТОЧКУ\n"))
(command "_cMLEADERSTYLE" "ВыноскиТрасса")
(command				;Начало COMMAND
  "_mleader"
  "С"
  pktochisk
  (mapcar '+ '(5 5) pktochisk)
  "32"
  (rtos dl_trass 2 0)
)

На старом компе AutoCad 2014, WinXP, х32
Новый комп AutoCad 2020, Win10, х64
Может быть кто-нибудь подскажет что делать, и куда копать? А то не хочется переделывать кучу утилит.....

[Сергей812]

command-s вместо command?

[40in]

Простите не понял вопроса...

----- добавлено через ~37 мин. -----
Ура! Заработало!
Все дело оказалось в системной переменной ATTREQ. Сегодня перевел ее в "1" и все получилось. Только не понятно почему у меня вчера не получалось, я ведь ее менял. Вчера при ATTREQ="1" выскакивало окошко заполнения динамического блока вручную.... Видимо вчера я в процессе экспериментов изменил еще какую-то системную переменную... Вот бы узнать какую)))....

[AlexSheep]

>выскакивало окошко заполнения динамического блока вручную
Чтобы не выскакивали окошко, установи системную переменную
ATTDIA <0>

[megabeton]

Доброго дня!
Хочу создать набор примитивов (текстов), в который входили бы только тексты-числа (REAL и INT).
Что то голову сломал, с какой стороны подойти. Подскажите.

Через (vl-string->list (cdr (assoc 1 (entget (car (entsel)))))) получаю список кодов символов текста
Знаю, что точка и цифры 0-9 имеют коды (46 48 49 50 51 52 53 54 55 56 57)
Теперь вроде надо сравнить список кодов выбранного текста на наличие в нем кодов, не являющихся кодами точки и цифр, и вот тут что то у меня затык с исполнением.
Какую функцию применить и что сделать со списком, чтобы отсеять все примитивы (тексты), в которых присутствуют любые символы, кроме точки и цифр.

Может есть какой то более элегантный способ выбрать тексты-числа?

[koMon]

не элегантно

Код:

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

 (vl-some '(lambda (digit) (not (member digit '(46 48 49 50 51 52 53 54 55 56 57)))) (vl-string->list (cdr (assoc 1 (entget (car (entsel)))))))

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

Если однострочные тексты не содержат букв и начинаются с чисел (возможно, пробелов) - то как вариант:

Код:

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

(atof (cdr (assoc 1 (entget (car (entsel))))))

[40in]

Сообщение от AlexSheep >выскакивало окошко заполнения динамического блока вручную Чтобы не выскакивали окошко, установи системную переменную ATTDIA <0>

Вот именно это я наверное и сделал в процессе поиска решения проблемы. Спасибо! ..

[megabeton]

Добрый день!
Хочу построить перпендикулярный отрезок относительно точки на кривой.
Используя vlax-curve-getFirstDeriv получаю координаты вектора направленности в системе координат объекта (полилинии в моем случае).
В случае для полилинии-прямоугольника размерами 1000*1000 с параметром 0.5 (начальная точка полилинии отстоит от начала координат МСК) выдает (1000.0 0.0 0.0)
Пытаюсь преобразовать эти координаты в МСК, и не получается, функция на запрос
(trans (vlax-curve-getFirstDeriv (car (entsel)) 0.5) (car (entsel)) 0)
выдает тоже, что и
(vlax-curve-getFirstDeriv (car (entsel)) 0.5)
Что я делаю не так?

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

Возможно, ОСК и МСК совпадают.

[megabeton]

Сообщение от megabeton (начальная точка полилинии отстоит от начала координат МСК)

Все функции vlax-curve-... в случае выдачи результата в виде точки выдают их в МСК.
Исключением является vlax-curve-getFirstDeriv. Координаты вектора направленности выдаются в СКО.
Как эти координаты преобразовать в МСК?

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

Сообщение от megabeton Все функции vlax-curve-... в случае выдачи результата в виде точки выдают их в МСК. Исключением является vlax-curve-getFirstDeriv. Координаты вектора направленности выдаются в СКО.

В http://docs.autodesk.com/PLNT3D/2014...=ACDd30e619053 я такого навскидку не увидел.

[megabeton]

vlax-curve-getFirstDeriv
Returns the first derivative (in WCS) of a curve at the specified location
Возвращает первую производную (в WCS) кривой в указанном местоположении, т.е. в МСК

Чудеса.
Рисую прямоугольник 1000*1000 в произвольном месте - далеко от начала координат МСК
На всякий случай запрашиваю координаты начальной точки "кривой" в МСК
(vlax-curve-getStartPoint (car (entsel)))
Получаю нечто подобное (9685.63 6276.53 0.0)
Теперь запрашиваю
(vlax-curve-getFirstDeriv (car (entsel)) 0.5)
И получаю результат (1000.0 0.0 0.0), т.е. координаты явно не в МСК.
Это глюк автокада?
Кому не лень, попробуйте у себя пожалуйста проделать эти пару действий.

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

first deriv = первая производная от кривой в указанной точке. Вектор.
(vlax-curve-getPointAtParam (car (entsel)) 0.5) что вернет?

[koMon]

Сообщение от megabeton Исключением является vlax-curve-getFirstDeriv. Координаты вектора направленности выдаются в СКО.

из мануала
vlax-curve-getFirstDeriv (AutoLISP/ActiveX)
Returns the first derivative (in WCS) of a curve at the specified location

[megabeton]

Вычислит точку в МСК на кривой по заданному значению параметра. А какие могут быть варианты?

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

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

[megabeton]

Сообщение от koMon Returns the first derivative (in WCS) of a curve at the specified location

in WCS это же в МСК. То то и оно, что вычисляет (у меня по крайней мере) в ОСК

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

Какая система координат для значений векторов??

[megabeton]

Сообщение от Кулик Алексей aka kpblc Где эта точка будет лежать?

Параметр 0.5 говорит о том, что лежать она будет ровно посередине между нулевой и первой точкой полилинии. Функция vlax-curve-getPointAtParam вернет координаты этой точки в МСК, вот и все. Вектор направленности можно я так понимаю получить лишь функцией vlax-curve-getFirstDeriv

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

Сообщение от Кулик Алексей aka kpblc Какая система координат для значений векторов??

А как это определить? Есть какая то системная переменная?

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

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

[megabeton]

Сообщение от Кулик Алексей aka kpblc Получишь вторую производную - что будет?

получу координаты вектора второй производной

От первой производной получу координаты вектора первой производной.
Есть точка на кривой (в МСК), есть координаты вектора первой производной (в ОСК вопреки мануалу).
Имею 2 точки - могу построить нормаль, но надо перевести координаты вектора первой производной (вектора направленности) из ОСК в МСК.
КАК???

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

Я не могу объяснить, что вектор не имеет координат. У него есть только направление, и все.

[megabeton]

Ладно, как нормаль то построить тогда?

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

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

Призадумался я что то...

Физический смысл vlax-curve-getFirstDeriv я понимаю следующим образом.
Есть точка на кривой, она является НАЧАЛОМ ВЕКТОРА, результирующая точка функции vlax-curve-getFirstDeriv (первой производной) - КОНЕЦ ВЕКТОРА.
Конец вектора указывает его направление.

Прошу поправить, если неправ.

[koMon]

Сообщение от Кулик Алексей aka kpblc Я не могу объяснить, что вектор не имеет координат. У него есть только направление, и все.

Алексей, а разве может быть направление без координат точек, задающих это направление?

[megabeton]

Кому не лень, попробуйте пожалуйста в командной строке вбить следующий код (для полилинии желательно кратных размеров):

(vlax-curve-getFirstDeriv (car (entsel)) 0.5)

Какой у вас будет результат?

[koMon]

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

[megabeton]

Функция vlax-curve-getFirstDeriv
Вычисляет первую производную (в МСК) к кривой в точке, заданной параметром.
(vlax-curve-getFirstDeriv <кривая> <параметр>)
Аргументы: <кривая> - примитив или VLA-объект, соответствующий кривой;
<параметр> - значение параметра, определяющее положение точки на кривой.
Возвращаемое значение - список из трех вещественных чисел (координаты вектора первой производной).


Т.е первая точка вектора определяется аргументом <параметр>
Вторая точка вектора - результат функции vlax-curve-getFirstDeriv

Направление будет от первой точки (заданной аргументом параметр) ко второй (полученной из результата функции vlax-curve-getFirstDeriv)

Вся беда в том, что координаты второй точки выдаются вопреки мануалу не в МСК, а в системе координат объекта.
А функция trans их не преобразовывает, потому что, видимо, не воспринимает результат функции vlax-curve-getFirstDeriv как точку, а как "вектор" (чтобы дьявол его побери это не значило), хотя и принимает координаты конца вектора в качестве аргумента.

КТО НИБУДЬ, ПОПРОБУЙТЕ ПОЖАЛУЙСТА, ИСПОЛНИТЬ КОД У СЕБЯ В АВТОКАДЕ

Код:

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

 (vlax-curve-getFirstDeriv (car (entsel)) 0.5)

[skkkk]

Сообщение от megabeton ПОПРОБУЙТЕ ПОЖАЛУЙСТА, ИСПОЛНИТЬ КОД У СЕБЯ В АВТОКАДЕ

В произвольном месте начертил полилинию длиной 300.

Код:

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

Команда: (vlax-curve-getFirstDeriv (car (entsel)) 0.5)
Выберите объект: (300.0 0.0 0.0)

[megabeton]

Т.е мануалы автокада врут.
vlax-curve-getFirstDeriv возвращает координаты вектора первой производной в СКО, а не МСК.
И как тогда преобразовать координаты вектора первой производной из СКО в МСК
Код ниже их не преобразовывает
(trans (vlax-curve-getFirstDeriv (car (entsel)) 0.5) (car (entsel)) 0)

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

[koMon]

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

[megabeton]

Сообщение от koMon Да нет никакой координаты ско

(300.0 0.0 0.0) тогда что это, если не внутренняя координата второй (первой после нулевой) точки полилинии?

Сообщение от koMon Вектору направления касательной не нужна связь с искомой точкой

Вот это ничего себе

Сообщение от koMon направление касательно определяется от нуля мск до результата первой производной

не согласен

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

угол относительно каких точек берем?

----- добавлено через ~8 ч. -----
Все, понял. Неправ. Вечером уже тупил, с утра дошло.
Слишком буквально воспринимал значение вектора, как направленного отрезка. Начальная точка вектора жестко ассоциировалась с точкой на кривой.
Думаю слово АЗИМУТ быстрее вернуло бы меня в нужное русло))
Спасибо koMon skkkk kpblc

[1958]

Начертил полилинию длиной 300, получил следующее:
Команда: (vlax-curve-getFirstDeriv (car (entsel)) 0.5)
Выберите объект: (258.32 152.548 0.0)
AC2007

[megabeton]

1958 спасибо.
Разобрался что к чему (пост 4071). Направление задается от начала МСК, далее параллельным переносом уже определяем направление в искомой точке.

[koMon]

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

[megabeton]

Вторая производная по идее несет смысл степени изогнутости кривой в точке.
Для точки, лежащей посередине между двух точек прямой полилинии дает (0.0 0.0 0.0), т.е. изогнутость нулевая.
Для аналогичных условий с полилинией-дугой выдает нечто (4.51197e-014 736.86 0.0), только не понятно, как правильно это интерпретировать в данном случае. Это координаты (и координаты ли) чего интересно?

[koMon]

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

[megabeton]

Попробовал, да, для дуги отбивает вектор нормали относительно начала МСК.
Для прямого участка видимо сообщает (0.0 0.0 0.0) - участок прямой (не изгибается), строй нормаль по двум соседним точкам.

[megabeton]

Вопрос по функции if

Есть код примерно такого содержания
(if
(выполни команду подобие со смещением 100)
(что то сделай)
(сделай что другое)
)

Функция if реагирует на nil и T.
А что, если в ответ на какое то действие программа не возвращает ни nil ни T.
В конкретном примере при слишком большом смещении внутрь создается ситуация невозможности создания объекта, программа возвращает
"; ошибка: Ошибка Automation. Отсутствует описание."
То есть для IF это ни nil ни T.
Как правильно надо обходить это препятствие, чтобы выполнились дальнейшие действия, чтобы "Ошибка Automation" воспринималась как nil.

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

vl-catch-функции в руки Хотя я наверняка делал бы по-другому. Логику переписывал как минимум )

[megabeton]

Сообщение от Кулик Алексей aka kpblc Логику переписывал как минимум )

Если можно по подробнее. Мне тоже кажется это корявой конструкцией.

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

Сначала добейся, чтобы vla-offset (или что там на самом деле, не помню) нормально срабатывала. А потом уже можно хоть entlast сравнивать с предыдущим примитивом.

[koMon]

Сообщение от megabeton Есть код примерно такого содержания

megabeton, а какова самая конечная цель кодирования?

[megabeton]

Хочу отбить площадь полилинии в "идеальном" месте внутри полилинии. Методом лучевого траассирования точка внутри не всегда получается в "идеальном" месте, может оказаться близко к краю. Если реализовать идею с подобием, неважно, какой изначальной формы полилиния, после подобия внутрь она будет стремится к упрощению формы и одновременно будет стремиться к "идеальному" центру. Иногда, после подобия это будут несколько полилиний, соответственно нам надо только выбрать наибольшую по площади и дальше офсетить.
Вот в конце получается ситуация, при которой офсет невозможен, и при этом программа не возвратила ни nil, ни T. Хотел понять, как это обойти, чтобы продолжить выполнения кода. Я так понимаю vl-catch поможет, пока правда не пробовал, руки не дошли.
Сама конструкция кода неверная, привел для простого примера, такую вещь через while, а не через if надо реализовывать, но конечный затык в виде сообщения об ошибке идентичен.
Если не лень, буду благодарен за любую посильную помощь в достройке кода

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

Сообщение от koMon megabeton, а какова самая конечная цель кодирования?

Стоп, или это был философский вопрос, примерно как про смысл жизни?)

[koMon]

нет, это был не философский вопрос))))
а если по-простецки, через штриховку?

[megabeton]

Сообщение от koMon а если по-простецки, через штриховку?

Это как? Центр штриховки может лежать за пределами границ полилинии. Или я не понимаю?

[koMon]

может. это я видимо не догнал. автоматом "отбить" площадь?

[megabeton]

Да, автоматом. В смысле извлечения площади полилинии и отбивки ее автоматом проблемы нет. Тут именно реализация определения точки вставки через офсет интересна.

----- добавлено через ~11 мин. -----
Нечто такое
(while
(vla-offset (vlax-ename->vla-object (entlast)) -50)
(добавить в набор (entlast))
(после сообщения об ошибке в центре последней полилинии отбей точку)
)
(удалить элементы набора)

[koMon]

офсет внутрь (отрицательное смещение) определяется ещё и направлением следования вершин плинии. против часовой - внутрь, по часовой - наружу.

[megabeton]

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

----- добавлено через ~12 мин. -----
Собственно вопрос, while реагирует на nil, однако (vla-offset (vlax-ename->vla-object (entlast)) -50) на последней стадии выдаст ошибку и остановит дальнейшее выполнение всего кода.
Как правильно и во что обернуть (vla-offset (vlax-ename->vla-object (entlast)) -50), чтобы выдало в конце nil, а не ошибку?

[koMon]

Код:

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

 (setq pline_object (vlax-ename->vla-object (car (entsel)))
	  pline_object+1 (car (vlax-safearray->list (vlax-variant-value (vla-offset pline_object 1))))
	  offset_value 0
	  offset_stepping 5
	  offset_direction (if (> (vla-get-area pline_object+1) (vla-get-area pline_object)) -1 1)
)
(vla-erase pline_object+1)
(while (null (vl-catch-all-error-p (setq offset_variant (vl-catch-all-apply 'vla-offset (list pline_object (* offset_direction (setq offset_value (+ offset_value offset_stepping))))))))
	(foreach offsetted_pline (vlax-safearray->list (vlax-variant-value offset_variant))
		(setq raw_coordinates (vlax-get offsetted_pline 'coordinates))
		(vla-erase offsetted_pline)
	)
)
(setq index 0
	  area_x 0
	  area_y 0
)
(repeat (/ (length raw_coordinates) 2)
	(setq area_x (+ area_x (nth index raw_coordinates))
		  area_y (+ area_y (nth (1+ index) raw_coordinates))
		  index (+ index 2)
	)
)
(command "_point"  (trans (list (/ area_x (/ (length raw_coordinates) 2)) (/ area_y (/ (length raw_coordinates) 2))) 0 1))

точка в центроиде последнего получившегося офсета

[megabeton]

koMon испытал, супер! Пошел изучать код. Спасибо!

[megabeton]

Вопрос про отличие блоков, созданных разными способами.
Ситуация №1:
Создал блок с помощью

Код:

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

 
(command "_copybase" (getpoint) (car (entsel)) "")
(command "_pasteblock" (getpoint))

Добавляю в него точку

Код:

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

 
(vla-addpoint 
	(vla-item 
		(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 
		(vla-get-effectivename (vlax-ename->vla-object (car (entsel))))
	)
	(vlax-3d-point 0. 0. 0.)
)

Результат – точка добавилась в точку вставки блока и на чертеже совпадает с

Код:

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

 (cdr (assoc 10 (entget (car (entsel)))))

Ситуация №2
Создал блок через vla-copyobjects (взято отсюда https://forum.dwg.ru/showthread.php?t=76304)

Код:

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

 (setq
	pt	(getpoint)
	ss	(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
	blk	(vla-add (vla-get-blocks adoc) (vlax-3d-point pt) bname)
)
(vla-copyobjects
	adoc
	(vlax-make-variant 
		(vlax-safearray-fill 
			(vlax-make-safearray 
				vlax-vbobject 
				(cons 0 (1- (length ss)))
			)
			ss
		)
	)
	blk
)
(vla-insertblock
	(vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
	(vlax-3d-point pt)
	(vla-get-name blk)
	1.0
	1.0
	1.0
	0.0
)

Добавляю также в него точку

Код:

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

 
(vla-addpoint 
	(vla-item 
		(vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 
		(vla-get-effectivename (vlax-ename->vla-object (car (entsel))))
	)
	(vlax-3d-point 0. 0. 0.)
)

Результат – точка вставилась на чертеже в начало координат, а не в место вставки блока.
Почему в одном случае (vlax-3d-point 0. 0. 0.) вставляет точку в точку вставки блока, а в другом в начало координат?
Что нужно добавить в код к vla-copyobjects, чтобы он вел себя как при "_pasteblock"
Заметил, что у первого блока в свойствах указано "Единицы блока - миллиметры", у второго "Единицы блока - безразмерный".

[Vladimir_Sergeevich]

немного к предыдущей теме.

Сообщение от megabeton Разобрался что к чему (пост 4071). Направление задается от начала МСК, далее параллельным переносом уже определяем направление в искомой точке

Разве от начала мск? Всегда понимал как единичный вектор и использовал примерно в таком контексте: (angle pt_end_n (mapcar '+ pt_end_n (vlax-curve-getFirstDeriv curve-os (vlax-curve-getParamAtPoint curve-os pt_end_n)))), получая угол относительно МСК и уже дальше по углам определял что мне надо. тут pt_end_n - точка на кривой
В результате я определял положение точки относительно оси (криволинейной) таким куском кода:

Код:

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

 	(if	
		(or 
			(equal (angle pt_end pt_end_n) (- (angle pt_end_n (mapcar '+ pt_end_n (vlax-curve-getFirstDeriv curve-os (vlax-curve-getParamAtPoint curve-os pt_end_n)))) (* pi 0.5)) 0.1) 
			(equal (angle pt_end pt_end_n) (+ (angle pt_end_n (mapcar '+ pt_end_n (vlax-curve-getFirstDeriv curve-os (vlax-curve-getParamAtPoint curve-os pt_end_n)))) (* pi 1.5)) 0.1) 
		) 
		(setq is_right "слева") (setq is_right "справа")
	)

В случаях когда мне надо это использовать дальше по коду, вместо строк использовались t/nil

По текущему вопросу:

Сообщение от megabeton Результат – точка вставилась на чертеже в начало координат, а не в место вставки блока.

У меня поведение совпадает, vla-addPoint ставит точку внутрь описания в координату 0,0,0, которая по умолчанию считается точкой вставки.
Может, каким то невероятным образом, во втором случае базовая точка блока отличается от начала координат блока?

[gumel]

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

Стоит задача вычислить точки Ферма-Торричелли в произвольном треугольнике. Алгоритм довольно простой и тестовый алгоритм у меня работает, но только в тех случаях когда точки указываются по часовой стрелке. Код пока такой:

Код:

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

 
(defun C:TRP ()
  ; точки треугольника (важно указывать по часовой стрелке)
  (setq P1 (getpoint "\n >Укажите точку 1: "))
  (setq P2 (getpoint "\n >Укажите точку 2 (в направлении по часовой стрелке): "))
  (setq P3 (getpoint "\n >Укажите точку 3 (в направлении по часовой стрелке): "))

  ; исходный треугольник
  ;(command "_LINE" P1 P2 P3 "_C")

  ; длины сторон
  (setq L12 (distance P1 P2))
  (setq L23 (distance P2 P3))
  (setq L31 (distance P3 P1))

  ; углы наклона
  (setq Ang12 (angle P1 P2))
  (setq Ang23 (angle P2 P3))
  (setq Ang31 (angle P3 P1))

  ; потивоположные точки
  (setq P12 (polar P1 (+ Ang12 (/ PI 3)) L12))
  (setq P23 (polar P2 (+ Ang23 (/ PI 3)) L23))
  (setq P31 (polar P3 (+ Ang31 (/ PI 3)) L31))

  ; искомые линии
  (command "_LINE" P12 P3 "")
  (command "_LINE" P23 P1 "")
  (command "_LINE" P31 P2 "")

)

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

--------------
update

сделал через скалярное произведение

Код:

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

 
....     
  ; определим координаты точек
  (setq x1 (nth 0 P1) y1 (nth 1 P1)
	x2 (nth 0 P2) y2 (nth 1 P2)
	x3 (nth 0 P3) y3 (nth 1 P3))

  ;  Result := (P2.X - P1.X) * (P3.Y - P1.Y) >= (P2.Y - P1.Y) * (P3.X - P1.X); - формула для определения направления по часовой или против (если true то против)
  (if  (>= (* (- x2 x1) (- y3 y1))
	   (* (- y2 y1) (- x3 x1)))
          ; если условие меняется, то нужно поменять местами P2 и P3
	   (setq tmpP P2
		 P2 P3
		 P3 tmpP))
 ....

[Sege]

Что-то под конец рабочей недели запутался с формированием списков

Допустим есть список (setq A '("1A" "2A")) и на на выходе получаем ("1A" "2A")
есть другой список (setq B '("1B" "2B")) и на на выходе получаем ("1B" "2B")

Есть промежуточная итерация объединения списков (setq nabor (list A B)), на выходе получаем (("1A" "2A") ("1B" "2B"))

Далее нужно в уже сформированный список nabor добавить дополнительное значение из новой переменной (setq С '("3A" "3B"))
(setq nabor (list nabor C))
но на выходе получаем вложенный список ((("1А" "1B") ("2A" "2B")) ("3A" "3B"))

Как сделать чтобы получился список для переменной nabor без учета вложенности (("1A" "1B") ("2A" "2B") ("3A" "3B"))

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

(append (list a b) (list c))
(cons c (list a b))

[megabeton]

Подскажите, а есть простой способ удалить вершину полилинии средствами Activex, подобный vla-AddVertex, ну что то типа vla-RemoveVertex или там vla-DeleteVertex

[Сергей812]

Сообщение от megabeton Подскажите, а есть простой способ удалить вершину полилинии средствами Activex, подобный vla-AddVertex, ну что то типа vla-RemoveVertex или там vla-DeleteVertex

в явном виде метода нет. Как реализовать - можно посмотреть в этой теме, например - команда Pl-VxDel

----- добавлено через ~10 мин. -----
в том же ObjectArx/.Net есть метод RemoveVertexAt, но в ActiveX его решили не "вытаскивать" в публичные методы, видимо

[shishoq]

всех с новым годом однако!

теперь вопрос.
хочу ткнуть мышкой в экран и получить простенький текст с координатами ткнутой точки.
соорудил следующее:

(command "text" (setq TT (getpoint)) 1 0 TT)

получаю:

205.385389406629,27.86316521445838

по-моему первый раз, когда акад по доброй воле показал ТОЧНЫЕ координаты ))), но мне столько не надо!
Есть ли какая (не)общая переменная, определяющая точность вещ.чисел? (я верну!) -- мне 1-2 цифры после запятой хватило бы. -- просто не хочется rtos-ить, разбивать список на части и клеить обратно... хоцца както шоб логичнее было, стройнее...
(искал-ненашол ))

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

luprec ?

[shishoq]

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

= 2 ))

а вообще она до 8. ну тут очевидно, что нужно что-то посильнее ))

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

Я бы думал в сторону "не сильно простого" кода. Что-нибудь такого типа (варианты разных систем координат не учитываются):

Код:

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

 (defun t1 (/ adoc pt prec pt_str)
  (if (and (= (type (setq pt (vl-catch-all-apply (function (lambda () (getpoint "\nУкажите точку <Отмена> : ")))))
              ) ;_ end of type
              'list
           ) ;_ end of =
           pt
      ) ;_ end of and
    (progn (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (setq prec 2) ; точность координат после запятой
           (setq pt_str (mapcar (function (lambda (x) (rtos x 2 prec))) pt))
           (vla-addtext (vla-get-modelspace adoc)
                        (strcat (car pt_str)
                                (apply (function strcat) (mapcar (function (lambda (x) (strcat ", " x))) (cdr pt_str)))
                        ) ;_ end of strcat
                        (vlax-3d-point pt)
                        (getvar "textsize")
           ) ;_ end of vla-AddText
           (vla-endundomark adoc)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

[shishoq]

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

???

[Vladimir_Sergeevich]

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

Код:

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

 (if (null curve-os)
	(progn
		(setq curve-os (car (nentsel "\nУкажите ось: ")))
		(sssetfirst nil (ssadd curve-os))
	);progn
(sssetfirst nil (ssadd curve-os))
);if
(if (null luprec-pk)
(setq luprec-pk 1)
)
(while fl
(initget "Другая Изменить Change Luprec")
(setq pt  (getpoint "\nУкажите точку: [Другая ось/Изменить точность]") )
(cond 
	((or (= pt "Другая") (= pt "Change"))
	(setq curve-os (car (nentsel "\nУкажите другую ось: ")))
	(sssetfirst nil (ssadd curve-os))
	
	)
	((or (= pt "Изменить") (= pt "Luprec"))
	(setq luprec-pk (getint "\nУкажите требуемую точность: "))
	(sssetfirst nil (ssadd curve-os))
	) 
);cond
(if (listp pt) (setq fl nil))
)

если еще немножко поупарываться - завести свою веточку в \HKEY_CURRENT_USER\Software\ и писать значение прямо туда
с прошедшими

[Alxndr1697]

Здравствуйте. Я из начинающих липсогрызов, о которых в первом посте)

Подскажите, что у меня не так в программе. При открытии нового файла чертежа, она строит второй примитив, но некорректно, не строит в отрицательную сторону от точки 0.0.0. Потом "слетает" и выдает сообщение о том, что ящик нулевой длины не допускается. В консоли, списки координат выдает правильные.

----- добавлено через ~22 ч. -----
Разобрался. Привязки надо отключать.

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Потом можешь посмотреть на *error* и почти универсальный обработчик ошибок.

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

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

И при чем тут инетовская ошибка?

[Alxndr1697]

Прошел по указанной ссылке, там и есть ошибка 404. Не удается найти страницу.

----- добавлено через 52 сек. -----
Ссылка в посте 86.

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

А, сорри. Ну да, аркада померла уже очень давно
Как эрзац-альтернативу можно попытаться использовать https://autolisp.ru/2009/09/13/error-catch/ - но там совсем уж мало ((

[Alxndr1697]

Благодарю. Буду разбираться.

[Alxndr1697]

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

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

atoi заменить на atof ?

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc atoi заменить на atof ?

Именно так. Спасибо.


Теперь у меня не получается извлечь данные из выпадающего списка. (key = "S_ko", для переменной S_k)
(setq S_k atoi (get_tile "S_ko")) - не работает. Понимаю, что надо как-то порядковый номер в выпадающем списке воткнуть функцией nht, но вот как это оформить, не знаю.

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

1. Со скобками совсем бяда
2. Функции nht не знаю. nth - да, слышал
3. Без хоть какого-то куска кода дальше разговаривать особого смысла не вижу.

[Alxndr1697]

1. В сообщении, орфографические и программные. Но, я понял.
2. А вот это да, моя беда. Бывает, путаю местами буквы и потом теряю кучу времени на поиск ошибок.
3. Не хотел выкладывать, дабы не шокировать, но, видимо, придется.

И да, я знаю, как с новичками бывает трудно

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

Код:

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

 (setq s_k (atoi (get_tile "S_ko")))

Грабли еще не шандарахнули?
Offtop: Грабли №2 тоже могут подпортить жизнь.

Код:

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

dialog_shkaf: dialog {label = "Шкаф отдельный с двумя фасадами";
	:spacer{height=1;}
	:column {
		:row {
			:boxed_column {label = "Параметры шкафа :";
				:spacer{height=1;}
				:row {
					:boxed_column {label = "Размеры шкафа :";
						:spacer{height=1;}
						:edit_box {label = "Высота :"; key = "eb_H"; value = "2000"; edit_width = 8;}
						:edit_box {label = "Длина (ширина) :"; key = "eb_L"; value = "1000"; edit_width = 8;}
						:edit_box {label = "Глубина (без учета фасада):"; key = "eb_B"; value = "600"; edit_width = 8;}
						:edit_box {label = "Высота цоколя :"; key = "eb_Hz"; value = "50"; edit_width = 8;}
					}
					:boxed_column {label = "Толщина материала для :";
						:spacer{height=1;}
						:popup_list {label = "Корпуса :"; key = "S_ko"; width = "8"; list = "16\n12\n17\n18\n19\n22\n25";}
						:popup_list {label = "Фасада :"; key = "S_fo"; width = "8"; list = "18\n12\n17\n16\n19\n22\n25";}
						:popup_list {label = "Заднего полика :"; key = "S_po"; width = "8"; list = "6\n3\n4\n8\n10\n12\n16";}
					}
					:boxed_column {label = "Зазоры фасада :";
						:spacer{height=1;}
						:edit_box {label = "Зазор между фасадами :"; key = "o_Z"; value = "3"; edit_width = 8;}
						:edit_box {label = "Отступ от корпуса вперед :"; key = "o_Vp"; value = "2"; edit_width = 8;}
						:edit_box {label = "Отступ сверху :"; key = "o_V"; value = "1,5"; edit_width = 8;}
						:edit_box {label = "Отступ снизу :"; key = "o_N"; value = "1,5"; edit_width = 8;}
						:edit_box {label = "Отступ слева :"; key = "o_L"; value = "1,5"; edit_width = 8;}
						:edit_box {label = "Отступ справа :"; key = "o_R"; value = "1,5"; edit_width = 8;}
						:edit_box {label = "Четверть заднего полика :"; key = "o_Cht"; value = "13"; edit_width = 8;}
					}
				}
			}
		}
		:spacer{height=1;}
		:boxed_row {label = ""; ok_cancel;}
	}
}

А если еще и ключи ставить на первое место - совсем будет кучеряво

[Alxndr1697]

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

Код (setq s_k (atoi (get_tile "S_ko"))) возвращает номер строки выпадающего списка, а надо бы содержание.

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

Ну так примени nth, делов-то
Оформление lsp/dcl кода - чистой воды вкусовщина, на мое кривое-косое-лысое-седое-далее по тексту мнение можно не ориентироваться.

[Alxndr1697]

Применяю, - ничего не получается.

(setq s_k (nth (atoi (get_tile "S_ko")) <список> )) Что надо поставить на место списка?

----- добавлено через ~26 мин. -----
Если сам список создан в лисп-программе, примерно понятно, а если, как у меня, в dcl?

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

Ну так передавай в dcl не ключи, а списки через те же start_list, add_list, end_list
Если будет интересно что и как еще можно в dcl сделать: https://autolisp.ru/2015/02/05/dcl-develop/

[koMon]

Сообщение от Alxndr1697 (setq s_k (nth (atoi (get_tile "S_ko")) <список> )) Что надо поставить на место списка?

Получить строку списка для атрибута list, созданного в диалоге списка (get_attr "S_ko" ''list") и перелопатить её в список.

[Alxndr1697]

Алексей, koMon, спасибо, но, еще раз, - я совсем начинающий и "чего проще..." и "перелопатить в список", для меня не так просто и не совсем понятно.
В итоге, на сегодняшний день, у меня так ничего и не получается. Руки опускаются... Перепробовал уже все (на свой взгляд, конечно).
Прошу помощи в виде работающей функции. Только, пожалуйста, - попроще, чтобы можно было понять и разобраться новичку.

Проблемы с функцией -функция raz_panel-

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

Код:

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

panel_uch : dialog {label = "Панель";
          :spacer{height=1;}

          : boxed_column {label = "Размеры панели"; alignment = centered;
          :spacer{height=1;}

          :text {label = "Выберите :"; alignment = centered;}
          :spacer{height=1;}
          : popup_list {key = "L_o"; label = "Высота (длина) панели :"; width = "8"; list = "";}
          : popup_list {key = "B_o"; label = "Ширина панели :"; width = "8"; list = "";}
          : popup_list {key = "S_o"; label = "Толщина панели :"; width = "8"; list = "";}
                          }//end boxed_column

          :spacer{height=1;}
          :boxed_row {label = ""; ok_cancel;}

                   }//end dialog

----- добавлено через 29 сек. -----

Код:

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

(DEFUN c:panel_uch (/ L B S)
  
;-------------------------функция panel--------------------------------------------
(defun panel (/ S L B P_0 x_01 y_01 z_01 x_11 y_11 z_11)

   (setq
;;;         L 200
;;;         B 100
;;;         S 10
         P_0 (getpoint "\n Укажите базовую точку для построения бокса <по умолчанию (0,0,0)>")
   )
   (setq x_01 0
         y_01 0
         z_01 0
         x_11 (+ x_01 S)
         y_11 (+ y_01 B)
         z_11 (+ z_01 L)
   )

    (setq osm (getvar "osmode"))
    (setvar "osmode" 0)
    (command "_UCS" "_o" P_0)
    (command "_box" (list x_01 y_01 z_01) (list x_11 y_11 z_11))
    (command "_UCS" "_w")
    (setvar "osmode" osm)

 );end defun panel

  ;------------------------------------------функция raz_panel----------------------------

  (defun raz_panel ()
      (setq L (nth (atoi (get_tile "L_o")) o_l))
      (setq B (nth (atoi (get_tile "B_o")) o_b))
      (setq S (nth (atoi (get_tile "S_o")) o_s))
   );end raz_panel

  ;-------------------------функция замены выпадающего списка окна диалога------------------------------------

  (defun iz_raz_dial (/ );временные переменные не добавлять они используются за пределами этой функции
     (setq o_l (list "100" "200" "300" "400" "500"))
        (start_list "L_o")
          (mapcar 'add_list o_l)
              (end_list)
     (setq o_b (list "50" "150" "250" "350" "450"))
        (start_list "B_o")
          (mapcar 'add_list o_b)
             (end_list)
     (setq o_s (list "8" "10" "12" "16"))
        (start_list "S_o")
           (mapcar 'add_list o_s)
              (end_list)
    ) 
;-------------------------------------------Диалоговое окно----------------------------------------

(setq dcl_id (load_dialog "D:/MyLISP/001_SHKAF/Forum/panel_uch.DCL"))
  (if (not (new_dialog "panel_uch" dcl_id)) (exit))
(iz_raz_dial) ;функция замены выпадающего списка окна диалога
     (action_tile "accept" "(raz_panel) (done_dialog 1)")
        (action_tile "cancel" "(done dialog 0)")
           (setq ddi (start_dialog))
              (unload_dialog dcl_id)
(if (= ddi 1) (panel))
(princ)
;-------------------------------------------------------------------------------------------------

  );end defun panel_uch

Буду рад любой критике и поправкам!

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

1. Принцип 20/80 никуда не девается. 20% времени код пишется, 80% - читается. К вопросу о форматировании, именовании переменных и функций
2. Любая функция / модуль должна работать только с теми данными, которые ей "прилетают" и не затрагивать глобальные переменные. Не надо делать т.н. "GodObject" (божественные объекты) с массой ответственности. Если такое появляется - это отличный шанс выстрелить себе в ногу в самый непредсказуемый момент.
3. Следствие: любую локальную функцию можно "вытащить" наружу и проверить ее работу. И она должна работать!
4. Крайне желательно разобраться с видимостью переменных и функций. Если код оставить как есть - в какой-то момент он может запросто перестать работать. Или не он, а соседний, но который использует таким же манером именованные переменные / функции.
5. Для решения предыдущего вопроса - скопировать любую функцию, вставить в новый файл, и нажать Ctrl+Shift+C (если не ошибаюсь) - в отчете будут видны все незалокаленные переменные и функции.

На переработку кода времени нет ((

[koMon]

без изяществ)

Код:

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

 (DEFUN c:panel_uch (/ L B S)

;-------------------------функция panel--------------------------------------------
(defun panel (S L B / P_0 x_01 y_01 z_01 x_11 y_11 z_11)

   (if (null (setq P_0 (getpoint "\n Укажите базовую точку для построения бокса <по умолчанию (0,0,0)>")))
   			(setq P_0 (list 0 0 0))
   )
;         x_11 (+ x_01 S)
;         y_11 (+ y_01 B)
;         z_11 (+ z_01 L)
;   )

;    (setq osm (getvar "osmode"))
;    (setvar "osmode" 0)
;    (command "_UCS" "_o" P_0)
;    (command "_box" (list x_01 y_01 z_01) (list x_11 y_11 z_11))
    (command "_box" "_none" P_0 "_l" s b l)
;    (command "_UCS" "_w")
;    (setvar "osmode" osm)

 );end defun panel

  ;------------------------------------------функция raz_panel----------------------------

;  (defun raz_panel (_list selection)
;      (setq L (nth (atoi (get_tile "L_o")) o_l))
;      (setq B (nth (atoi (get_tile "B_o")) o_b))
;      (setq S (nth (atoi (get_tile "S_o")) o_s))
;   );end raz_panel

  ;-------------------------функция замены выпадающего списка окна диалога------------------------------------

;  (defun iz_raz_dial (/ );временные переменные не добавлять они используются за пределами этой функции
;     (setq o_l (list "100" "200" "300" "400" "500"))
;        (start_list "L_o")
;          (mapcar 'add_list o_l)
;              (end_list)
;     (setq o_b (list "50" "150" "250" "350" "450"))
;        (start_list "B_o")
;          (mapcar 'add_list o_b)
;             (end_list)
;     (setq o_s (list "8" "10" "12" "16"))
;        (start_list "S_o")
;           (mapcar 'add_list o_s)
;              (end_list)
;    )

	(defun populate_list ( list_key list_to_process )
		(start_list list_key 3)
			(mapcar 'add_list
				  	(mapcar '(lambda (list_element)
				  			 	(strcat "\n" list_element)
				  			 )
				  			 list_to_process
				  	)
			)
		(end_list)
	)

;-------------------------------------------Диалоговое окно----------------------------------------

(setq L_o_list (list "100" "200" "300" "400" "500")
	  B_o_list (list "50" "150" "250" "350" "450")
	  S_o_list (list "8" "10" "12" "16")
)

(if (null L_o_selection) (setq L_o_selection "0"))
(if (null B_o_selection) (setq B_o_selection "0"))
(if (null S_o_selection) (setq S_o_selection "0"))


;(setq dcl_id (load_dialog "D:\\MyLISP\\001_SHKAF\\Forum\\panel_uch.DCL"))
(setq dcl_id (load_dialog "z:\\work\\АТ БН-600\\panel_uch.DCL"))

;  (if (not (new_dialog "panel_uch" dcl_id)) (exit))
;(iz_raz_dial) ;функция замены выпадающего списка окна диалога
;     (action_tile "accept" "(raz_panel) (done_dialog 1)")
;        (action_tile "cancel" "(done dialog 0)")
;           (setq ddi (start_dialog))
;              (unload_dialog dcl_id)
;(if (= ddi 1) (panel))
;(princ)

(if (not (minusp dcl_id))
	(if (new_dialog "panel_uch" dcl_id)
		(progn

			(populate_list "L_o" L_o_list)
			(populate_list "B_o" B_o_list)
			(populate_list "S_o" S_o_list)

			(set_tile "L_o" L_o_selection)
			(set_tile "B_o" B_o_selection)
			(set_tile "S_o" S_o_selection)

			(action_tile "L_o" "(setq L_o_selection $value))")
			(action_tile "B_o" "(setq B_o_selection $value))")
			(action_tile "S_o" "(setq S_o_selection $value))")

			(setq dialog_result (start_dialog))
			(unload_dialog dcl_id)
			(cond
					(
						(= dialog_result 1)
							(princ "\nL: ")
							(princ (setq l (atof (nth (atoi L_o_selection) L_o_list ))))
							(princ "\nB: ")
							(princ (setq b (atof (nth (atoi B_o_selection) B_o_list ))))
							(princ "\nS: ")
							(princ (setq s (atof (nth (atoi S_o_selection) S_o_list ))))

							(panel s l b)
					)
					(
						t
							(princ "\nВыход")
					)
			)
		)
	)
	(princ "\nПроблема с диалогом")
)
(princ)

;-------------------------------------------------------------------------------------------------

  );end defun panel_uch

[Alxndr1697]

Сообщение от koMon без изяществ)

Да уж... Ничего знакомого))) Есть в чем поразбираться.
Спасибо!

----- добавлено через ~22 мин. -----
Функцию t (строка 114), вообще, не могу в справочнике найти

[koMon]

Это не функция, это булевая константа истины) true

[Alxndr1697]

Еще вопрос. Зачем здесь (princ (setq l (atof (nth (atoi L_o_selection) L_o_list )))) функция princ ? Ведь, и без нее выводится число, которого, вроде, достаточно.

[koMon]

Эммм, здесь 6 принков, которые выводят в консоль последовательно значения l, b, s. По-другому их в консоль не вывести. Но это так, посмотреть. Можно все эти принки убрать.

[Alxndr1697]

koMon, благодарствую! Благодаря вашей функции, нашел ошибки в своей и она работает, даже в моем варианте)))

----- добавлено через ~10 ч. -----

Вопрос: Как сделать, чтобы после неверного ввода осуществлялся не выход, а возврат в диалоговое окно, для последующего верного ввода?

Код:

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

(if (<= H_z 0)
  (progn (alert (strcat " Высота цоколя не может быть меньше, или равной 0"))
  (exit)))

После замены exit на c:shkaf_otd_sup - программа работает некорректно. (об остальных вариантах молчу)))

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

Код:

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

(if (<= H_z 0)
  (progn (alert (strcat " Высота цоколя не может быть меньше, или равной 0"))
  (exit) (c:shkaf_otd_sup)))

[koMon]

Сообщение от Alxndr1697 Как сделать, чтобы после неверного ввода осуществлялся не выход, а возврат в диалоговое окно, для последующего верного ввода?

если речь идёт о компоненте диалога :edit_box, то проверять правильность введённых данных нужно на выходе из компонента/подтверждении введённых данных в компоненте, то есть должна быть функция проверки введённых данных по результату которой осуществится выход или не выход из компонента, причём это не должно влиять на выход их диалога.

[Alxndr1697]

Сообщение от koMon если речь идёт о компоненте диалога :edit_box,

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

Сообщение от koMon то есть должна быть функция проверки введённых данных по результату которой осуществится выход или не выход из компонента, причём это не должно влиять на выход их диалога

А это не оно?

Код:

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

(if (< H 200)
  (progn (alert (strcat " Высота шкафа не может быть меньше чем 200 мм"))
  (exit)))

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

Код:

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

dialog_shkaf: dialog {label = "Шкафон отдельный с двумя фасадами";
                                               :spacer{height=1;}
:column {:row {:boxed_column {label = "Параметры шкафа :";
                                               

//:radio_row {label = "Тип шкафа :";
//                           key = "Tip_s";
//            :radio_button {label = "Отдельно стоящий";
//                           key = "Otd";
//                           value = "1";}
//            :radio_button {label = "Встроенный";
//                           key = "Vst";
//                           value = "0";}
//                           }//end radio_row
                                                :spacer{height=1;}
:row {:boxed_column {label = "Размеры шкафа :";
                                                :spacer{height=1;}
             :edit_box {label = "Высота :";
                          key = "eb_H";
                            value = "2000";
                              edit_width = 8;}
             :edit_box {label = "Длина (ширина) :";
                          key = "eb_L";
                            value = "1000";
                              edit_width = 8;}
             :edit_box {label = "Глубина (без учета фасада):";
                          key = "eb_B";
                            value = "600";
                              edit_width = 8;}
             :edit_box {label = "Высота цоколя :";
                          key = "eb_Hz";
                            value = "50";
                              edit_width = 8;}
                     }//end column размеры шкафа

      :boxed_column {label = "Толщина материала для :";
                                                 :spacer{height=1;}
             :popup_list {label = "Корпуса :";
                            key = "S_ko";
                              width = "8";
                                list = "16";}
             :popup_list {label = "Фасада :";
                            key = "S_fo";
                              width = "8";
                                list = "16";}
             :popup_list {label = "Заднего полика :";
                            key = "S_po";
                              width = "8";
                                list = "6";}

                      }//end column материал

       :boxed_column {label = "Зазоры фасада :";
                                                :spacer{height=1;}
             :edit_box {label = "Зазор между фасадами :";
                          key = "o_Z";
                            value = "3";
                              edit_width = 8;}
             :edit_box {label = "Отступ от корпуса вперед :";
                          key = "o_Vp";
                            value = "2";
                              edit_width = 8;}
             :edit_box {label = "Отступ сверху :";
                          key = "o_V";
                            value = "1.5";
                              edit_width = 8;}
             :edit_box {label = "Отступ снизу :";
                          key = "o_N";
                            value = "1.5";
                              edit_width = 8;}
             :edit_box {label = "Отступ слева :";
                          key = "o_L";
                            value = "1.5";
                              edit_width = 8;}
             :edit_box {label = "Отступ справа :";
                          key = "o_R";
                            value = "1.5";
                              edit_width = 8;}
             :edit_box {label = "Четверть заднего полика :";
                          key = "o_Cht";
                            value = "13";
                              edit_width = 8;}                                                             
                     }//end column зазоры

                  }//end row boxed_column габариты шкафа 
                           
                 }//end boxed_column параметры шкафа
           }//end row

                                                  :spacer{height=1;}
:boxed_row {label = "";
             ok_cancel;}

}//end column
}//end dialog

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

Код:

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

(DEFUN c:shkaf_otd_sup (/ dcl_id nub H L B H_z Z Cht o_vp o_v o_n o_l o_r S_k S_f S_p o_k 0_f o_p)

;------------------------Функция shkaf------------------------------------------
(defun shkaf (H L B H_z Z Cht o_vp o_v o_n o_l o_r S_k S_f S_p  / P_0 S_k S_f S_p o_Z osm o_Cht o_Vp o_V o_N o_L o_R
	          L_b P_b V_h F_d Z_l Z-p Z-p1 Z-p2 Z-p3 Z-p4 
		  x_01 x_11 x_02 x_12 x_03 x_13 x_04 x_14 x05 x_15 x_16 x_07 x_17 x_08 x_18 x_09 x_19
		  y_01 y_11 y_02 y_12 y_03 y_13 y_04 y_14 y05 y_15 y_16 y_07 y_17 y_08 y_18 y_09 y_19
		  z_01 z_11 z_02 z_12 z_03 z_13 z_04 z_14 z05 z_15 z_16 z_07 z_17 z_08 z_18 z_09 z_19
		  P_01 P_11 P_02 P_12 P_03 P_13 P_04 P_14 P_05 P_15 P_06 P_16 P_07 P_17 P_08 P_18 P_09 P_19)
  
;;;(setq
;;;      H (getint "\ Высота шкафа :")
;;;      L (getint "\ Длина (ширина) шкафа :")
;;;      B (getint "\ Глубина шкафа (БЕЗ учета фасада):")
;;;      H_z 50   ;Высота цоколя
;;;   S_k 16   ;толщина материала для корпуса
;;;   S_f 18   ;толщина материала для фасада
;;;   S_p 7    ;толщина материала для заднего полика
;;;      Cht 13   ;Четверть полика
;;;      Z  3.0   ;зазор между фасадами
;;;   P_0 (getpoint "\n Укажите базовую точку для построения шкафа <по умолчанию (0,0,0)>")
;;;	 (if (null P_0) (setq P_0 (quote (0 0 0))))
;;;)
 (if (null (setq P_0 (getpoint "\n Укажите базовую точку для построения шкафа <по умолчанию (0,0,0)>")))
     (setq P_0 (list 0 0 0))
 )

(if (< H 200)
  (progn (alert (strcat " Высота шкафа не может быть меньше чем 200 мм"))
  (exit)))
(if (< L 200)
  (progn (alert (strcat " Длина шкафа не может быть меньше чем 200 мм"))
  (exit)))
(if (< B 100)
  (progn (alert (strcat " Глубина шкафа не может быть меньше чем 100 мм"))
  (exit)))
(if (>= Cht S_k)
  (progn (alert (strcat " Четверть не может быть больше, или равна толщине материала корпуса"))
  ((exit))))
(if (<= H_z 0)
  (progn (alert (strcat " Высота цоколя не может быть меньше, или равной 0"))
  (exit)))
  
  (setq osm (getvar "osmode"));запоминание привязок
  (setvar "osmode" 0)
;;;(command "_ortho" "_off")
;;;(command "_osnap" "_off")
  (command "_UCS" "_o" P_0)   ;установка пск в точку вставки шкафа
  
(setq x_01 0	       ;левая боковина
      y_01 0
      z_01 0)
(setq x_11 (+ x_01 S_k)
      y_11 (+ y_01 B)
      z_11 (+ z_01 H)
      x_02 (+ x_01 L)  ;правая боковина
      y_02 y_01
      z_02 z_01
      x_12 (- x_02 S_k)
      y_12 y_11
      z_12 z_11
      x_03 x_11        ;низ
      y_03 y_01
      z_03 (+ z_01 H_z) 
      x_13 (- x_02 S_k)
      Y_13 y_12
      z_13 (+ z_03 S_k)
      x_04 x_12        ;верх
      y_04 y_01
      z_04 z_11
      x_14 x_11
      y_14 y_11
      z_14 (- z_04 S_k)

      x_05 (+ x_01 o_l)    ;фасад и отступы от корпуса по периметру(слева)
      y_05 (- y_01 o_vp)   ;отступ фасада от корпуса вперед
      z_05 (+ z_01 o_n H_z);(снизу)
      x_15 (- x_02 o_r)    ;(справа)
      y_15 (- y_05 S_f)
      z_15 (- z_12 o_v)    ;(сверху)

;;;      x_06 x_03        ;цоколь
;;;      y_06 y_03
;;;      z_06 z_03
      x_16 (- x_02 S_k)
      y_16 (+ y_02 S_k)
      z_16 z_02

      x_07 (+ x_13 Cht)    ;задний полик
      y_07 (- y_13 S_p)
      z_07 (- z_13 Cht)
      x_17 (- x_14 Cht)
      y_17 y_14
      z_17 (+ z_14 Cht)

      x_08 x_04           ;вертикальная стойка
      y_08 y_04
      z_08 (- z_04 S_k)
      x_18 (- x_13 S_k)
      y_18 (- y_13 S_p)
      z_18 z_13

      x_09 x_03           ;полка
      y_09 y_03
      z_09 (+ z_03 S_k)
      x_19 x_13
      y_19 (- y_13 S_p)
      z_19 (+ z_13 S_k)
      )
(setq P_01 (list x_01 y_01 z_01)
      P_11 (list x_11 y_11 z_11)
      P_02 (list x_02 y_02 z_02)
      P_12 (list x_12 y_12 z_12)
      P_03 (list x_03 y_03 z_03)
      P_13 (list x_13 y_13 z_13)
      P_04 (list x_04 y_04 z_04)
      P_14 (list x_14 y_14 z_14)
      P_05 (list x_05 y_05 z_05)
      P_15 (list x_15 y_15 z_15)
;;;      P_06 (list x_06 y_06 z_06)
      P_16 (list x_16 y_16 z_16)
      P_07 (list x_07 y_07 z_07)
      P_17 (list x_17 y_17 z_17)
      P_08 (list x_08 y_08 z_08)
      P_18 (list x_18 y_18 z_18)
      P_09 (list x_09 y_09 z_09)
      P_19 (list x_19 y_19 z_19)
      )

(command "_box" P_01 P_11);левая боковина
  (setq L_b (entlast))
(command "_box" P_02 P_12);правая боковина
  (setq P_b (entlast))
(command "_box" P_03 P_13);низ
  (setq N_z (entlast))
(command "_box" P_04 P_14);верх
  (setq V_h (entlast))

(command "_box" P_05 P_15);фасад
  (setq F_d (entlast))
    (command "_box" (list  (- x_05 (/ Z 2)) y_05 z_05) (list (+ x_05 (/ Z 2)) (- y_05 S_f) z_15))
       (setq Z_r (entlast))                                                                           ;черчение и запоминание тела-зазора
          (command "_move" Z_r "" (list x_05 y_05 z_05) (list (+ x_05 (/ (- x_15 x_05) 2)) y_05 z_05));перемещение в центр фасада
             (command "_subtract" F_d "" Z_r "")                                                      ; вычитание зазора из фасада
                (command "_solidedit" "_body" "_separate" (entlast) "" "")                            ;разъединение получившегося тела

(command "_box" P_03 P_16);цоколь
  (setq Z_l (entlast))
     (command "_copy" Z_l "" P_03 (list x_03 (+ y_03 (- B S_k)) z_03)"");копирование заднего цоколя

(command "_box" P_08 P_18);вертикальная стойка
(command "_box" P_09 P_19);полка

(command "_box" P_07 P_17);задний полик
  (setq Z_p (entlast)) 
(command "_copy" Z_p "" P_01 "_a" 5 "" P_01 "");создание 5 копий заднего полика и запоминание
    (setq Z_p1 (entnext Z_p))
       (setq Z_p2 (entnext Z_p1))
          (setq Z_p3 (entnext Z_p2))
             (setq Z_p4 (entnext Z_p3))

     (command "_subtract" L_b "" Z_p1 "") ;вычитание полика из деталей шкафа (изготовление четверти)
        (command "_subtract" P_b "" Z_p2 "")
           (command "_subtract" V_h "" Z_p3 "")
              (command "_subtract" N_Z "" Z_p4 "")

   (command "_UCS" "_w");возврат в мск
;;;(command "_UCS" "_p");возврат пск
;;;(command "_vscurrent" "_X-ray" "")

   (setvar "osmode" osm);возврат привязок
   (command "_zoom" "_all")

(princ)
  );end defun

;-----------------------------------функция raz_shkaf--------------------------------------------

(defun raz_shkaf (/ )
    (setq H (atof (get_tile "eb_H")));считывание и преобразование из строкового в число и сохранение
      (setq L (atof (get_tile "eb_L")))
        (setq B (atof (get_tile "eb_B")))
          (setq H_z (atof (get_tile "eb_Hz")))
             (setq Z (atof (get_tile "o_Z")))
    (setq Cht (atof (get_tile "o_Cht")))
      (setq o_vp (atof (get_tile "o_Vp")))
        (setq o_v (atof (get_tile "o_V")))
          (setq o_n (atof (get_tile "o_N")))
            (setq o_l (atof (get_tile "o_L")))
              (setq o_r (atof (get_tile "o_R")))

  (setq numStr_k (get_tile "S_ko"))
    (if (= numStr_k "") (setq S_k nil)
       (setq S_k (atof (nth (atoi numStr_k) o_k)))
    )
  (setq numStr_f (get_tile "S_fo"))
    (if (= numStr_f "") (setq S_f nil)
       (setq S_f (atof (nth (atoi numStr_f) o_f)))
    )
  (setq numStr_p (get_tile "S_po"))
    (if (= numStr_p "") (setq S_p nil)
       (setq S_p (atof (nth (atoi numStr_p) o_p)))
    )  
(princ)
  );end defun


    ;----------------функция замены выпадающего списка окна диалога iz_mat----------------

  (defun iz_mat (/ );временные переменные не добавляем они используются за пределами этой функции
     (setq o_k (list "16" "8" "9" "10" "11" "12" "13" "17" "18" "19" "22" "23" "25" "26"))
        (start_list "S_ko")
          (mapcar 'add_list o_k)
              (end_list)
     (setq o_f (list "16" "8" "9" "10" "11" "12" "13" "17" "18" "19" "22" "23" "25" "26"))
        (start_list "S_fo")
          (mapcar 'add_list o_f)
             (end_list)
     (setq o_p (list "6" "3" "4" "8" "10" "12" "16" "18"))
        (start_list "S_po")
           (mapcar 'add_list o_p)
              (end_list)
(princ)
    ) 

  ;-------------------------------------------Диалоговое окно----------------------------------------

(setq dcl_id (load_dialog "D:/MyLISP/001_SHKAF/dialog_shkaf.DCL"));загрузка диалога и запоминание под номером
  (if (not (new_dialog "dialog_shkaf" dcl_id)) (exit));проверка, если не загружен, - выход

  (iz_mat);функция изменения списка в диалоговом окне

  (action_tile "accept" "(raz_shkaf) (done_dialog 1)"); ок закрыть диалог под номером 1
        (action_tile "cancel" "(done dialog 0)"); отмена закрыть диалог под номером 0
           (setq ddi (start_dialog));ф считывает значение, с которым было закрыто диалоговое окно и сохраняет в переменной ddi
              (unload_dialog dcl_id);выгрузка файла диалога после закрытия окна

(if (= ddi 1) (shkaf H L B H_z Z Cht o_vp o_v o_n o_l o_r S_k S_f S_p ))
(princ)
         );end defun shkaf_otd

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

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

Сообщение от Alxndr1697 А это не оно?

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

1. Нет меток начала / окончания отмены.
2. Все команды вываливаются в ком.строку со всеми вытекающими.
3. Не учитывается вариант возможного переопределения команд (подробнее, если охота - https://autolisp.ru/2010/03/04/localization/ )
4. Нет контроля - удалось построить примитив или нет.
5. В сегодняшних реалиях, как мне кажется, лучше вместо command использовать command-s. Ну или по крайней мере проверять возможность использования command-s

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

[Alxndr1697]

1. Это удобство, или ошибка? И это делается при помощи вла? До него я еще не дошел.
2. Других вариантов пока не знаю.
3. Читаю все, что вы предлагаете, правда, не все понятно пока.
4. Какая это функция, дайте направление.
5. Спасибо, буду изучать.

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

Представляете, - мне уже тоже))) но, как могу, так могу.

[Сергей812]

Сообщение от Alxndr1697 но, как могу, так могу.

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

Сообщение от Alxndr1697 H L B H_z Z Cht o_vp o_v o_n o_l o_r S_k S_f S_p

~15 аргументами вызовет определенное офигевание удивление)

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

Offtop:

Сообщение от Alxndr1697 1. Это удобство, или ошибка?

https://autolisp.ru/2009/09/20/howto_undo/

Сообщение от Alxndr1697 Других вариантов пока не знаю.

Системная переменная nomutt (как минимум), если без команд ну вообще никуда и никак.

Сообщение от Alxndr1697 Какая это функция, дайте направление.

Это не функция (по крайней мере штатная). А так-то можно нарисовать нечто типа:

Код:

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

 (setq lastent (entlast))
(command-s "_.box" param1 param2)
(if (not (equal lastent (entlast)))
  (alert "Построение не удалось")
  )

Сообщение от Alxndr1697 Представляете, - мне уже тоже))) но, как могу, так могу.

В ООП для этого используются классы (уж простите меня корифеи ООП, пишу как умею), а в лиспе кто мешает использовать списки точечных пар? Быстро, дешево, сердито
Сголашусь с Сергеем:

Сообщение от Сергей812 может разбивать на подфункции?

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

Но это все так, размышления на тему. Мои слова не стоит воспринимать уж сильно всерьез

[Alxndr1697]

Сообщение от Сергей812 может разбивать на подфункции?

Может. Дайте, пожалуйста, пример.
Почитав начало темы, я, видимо, сделал неправильный вывод.

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

Сообщение от Сергей812 и в более современных языках программирования с удобной средой разработки

Посоветуйте учебник, видеокурс, или что-нибудь, где можно этому научиться.

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

Alxndr1697, сугубо ИМХО.
Если какой-то код длиннее 3..5 строк с оооочень незначительными изменениями (ну, например, имена используемых переменных) копипастится хотя бы раз - его надо в отдельную функцию выносить. Т.н. принцип DRY: Don't Repeat Yourself (никогда не повторяй за собой).
Числа в именах переменных есть зло, если только у тебя не стоит задача максимально запутать код.
Если в переменной, к примеру, хранятся координаты точки, то и называть ее надо максимально информативно. К примеру, base_point / top_left_point и т.д. ВО VLIDE Ctrl+Shift+Пробел помогут в наборе таких длинных имен.
Ну и так далее.

Сообщение от Alxndr1697 Посоветуйте учебник, видеокурс, или что-нибудь, где можно этому научиться.

C#, к примеру. Видео на youtube - ищи Дмитрия Загорулькина (напрямую по ACAD), Сергея Камянецкого (C#), Сергей Немчинский (он, конечно, больше по Java, но методику написания кода очень хорошо разобрал в свое время, мне это сильно помогло).

Ну и так далее.

[Alxndr1697]

Спасибо!Вечером все посмотрю, убег на работу.

[Сергей812]

Сообщение от Alxndr1697 Посоветуйте учебник, видеокурс, или что-нибудь, где можно этому научиться.

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

[Alxndr1697]

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

Сергей, поймите правильно, справкой и ресурсом я пользуюсь и справочник "бумажный" раздобыл. Но там найти можно что-то конкретное, а, например, как разбить функцию на подфункции, или как убрать лишние аргументы справка не объяснит. Хотя, возможно, я не умею искать. Лучшей формой обучения считаю практические занятия, потому и пошел таким путем.

[Сергей812]

Сообщение от Alxndr1697 а, например, как разбить функцию на подфункции, или как убрать лишние аргументы справка не объяснит

немного не так. В лиспе вообще нет никаких средств разделения кода, в объектно-ориентированном программировании ООП (куда входит и тот же C#) у вас будет написан класс типа CreateCabinet, имеющий конструктор с 3-5 базовыми параметрами. А если нужно задавать какие то дополнительные условия, отличающиеся от значений по умолчанию - в классе делаете свойства. И задаете по необходимости эти свойства после создания самого объекта класса. Т.е. не надо будет задавать все 15 аргументов каждый раз. А можно вместо свойств сделать перегруженные конструкторы с разным количеством или типами аргументов и вызывать именно требуемый конструктор.

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

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

Сообщение от Кулик Алексей aka kpblc Любая функция / модуль должна работать только с теми данными, которые ей "прилетают" и не затрагивать глобальные переменные. Не надо делать т.н. "GodObject" (божественные объекты) с массой ответственности. Если такое появляется - это отличный шанс выстрелить себе в ногу в самый непредсказуемый момент.

p.s. *методы = функции и процедуры

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

Ну, при желании и в лиспе можно "перегрузку" организовать

[Сергей812]

Сообщение от Кулик Алексей aka kpblc Ну, при желании и в лиспе можно "перегрузку" организовать

имхо, это больше похоже на функцию с переменным количеством параметров типа object) В том же VB/VBA есть встроенный механизм ParamArray, в C# - params, в лиспе приходится эмулировать списком.

[koMon]

Alxndr1697, это какой-то мебельный шкаф что ли?

[Alxndr1697]

Сообщение от koMon Alxndr1697, это какой-то мебельный шкаф что ли?

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

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

Сообщение от Кулик Алексей aka kpblc C#, к примеру. Видео на youtube - ищи Дмитрия Загорулькина (напрямую по ACAD)

Нашел
Отчего-то я решил, что ЛИСП, - это азбука, не изучив которую, дальше нет смысла идти.

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

Сейчас пробую что-то ковырять в C#, весьма увлекательно. Правда, вопросы в 99% случаев не касаются ACAD'a

[Сергей812]

Сообщение от Alxndr1697 что ЛИСП, - это азбука, не изучив которую, дальше нет смысла идти.

лисп - это лишь средство взаимодействия с базой данных чертежа и акадом в целом. Причем со своим синтаксисом и очень нишевой применимостью.

Если есть эксель, то можно попробовать перерисовывать через COM - интерфейс. Заодно в самом экселе делать расчеты и хранить вспомогательные данные на листах. Но через COM не все доступно.

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

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

[Сергей812]

Offtop:

Сообщение от Кулик Алексей aka kpblc мне кажется, советовать VBA, да еще и с ранним связыванием... Я бы не стал двигаться по этому пути, честно.

ну это лишь один из вариантов, учитывая что VBA для мс офиса встроенный родной язык) А после отладки убирается ссылка на библиотеку акада и раннее связывание быстро переделывается на позднее. Но согласен - лучше, конечно, работать "изнутри" акада, а не через COM-прокладку со своими глюками.

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Если какой-то код длиннее 3..5 строк с оооочень незначительными изменениями (ну, например, имена используемых переменных) копипастится хотя бы раз - его надо в отдельную функцию выносить. Т.н. принцип DRY: Don't Repeat Yourself (никогда не повторяй за собой).

Я правильно понял, что если, например, у меня "большой" дефан_шкаф, то его надо разбить на дефан_корпус, дефан_фасад, дефан_полик и т.д.?

Извините, пожалуйста, но у меня осталось желание "допилить" свой шкаф в лиспе)))

[ShaggyDoc]

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

Конечно. Еще лучше разбить на функции-"доски", из которых можно собирать что угодно.

А также сделать надежные функции ввода данных, потому что штатные "get=xxx" не защищены от действий пользователя. Нажмет ESC и вся программа рухнет.

Т.е. надо сформировать библиотеку функций - каждая из которых короткая, с минимумом аргументов.

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

Стоит подумать - а нужен ли вообще здесь диалог на DCL. Это ведь реликт давних времен, когда ничего лучшего не было. Разрабатывать такие диалоги не так уж и сложно, но очень муторно.

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

[Alxndr1697]

Сообщение от ShaggyDoc Еще лучше разбить на функции-"доски", из которых можно собирать что угодно.

Идею понял. Думаю, по такому принципу "Базис-Мебельщик" и работает.

Сообщение от ShaggyDoc А также сделать надежные функции ввода данных, потому что штатные "get=xxx" не защищены от действий пользователя. Нажмет ESC и вся программа рухнет. Т.е. надо сформировать библиотеку функций - каждая из которых короткая, с минимумом аргументов. А уже с использованием библиотеки делать конечные команды-функции для конкретных шкафов-диванов, и вообще всяких "из досок". Каждая из них будет очень короткой, надежной и легко читаемой.

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

Сообщение от ShaggyDoc В этих "шкафах" немного данных для ввода

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

[koMon]

Сообщение от Alxndr1697 Извините, пожалуйста, но у меня осталось желание "допилить" свой шкаф в лиспе)))

Это правильное решение)

[Сергей812]

Сообщение от Alxndr1697 Был бы признателен за какой-то реальный пример. Простенькую программу с парой "досок", в остальном постараюсь разобраться.

изучайте монументальный труд, там приведены листинги того - о чем говорит ShaggyDoc)

[Alxndr1697]

Сообщение от Сергей812 изучайте монументальный труд, там приведены листинги того - о чем говорит ShaggyDoc)

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

[Vladimir_Sergeevich]

Сообщение от Alxndr1697 и понимаю, что ничего не понимаю

Я бы сказал, что сей труд весьма полезен когда уже научился кодить хоть что то. "САПР на базе..." неплохо вправляет мозги на тему систематизации в разработке кода.
А если говорить о повседневной шпаргалке, то скорее подойдет "AutoLisp и VisualLisp в среде Autocad" за авторством Полещука. Хотя при некоторой сноровке эту книгу заменит справка автокада, тем более что творение Полещука слегка устарело морально, акад все таки развивается помаленьку.

[Alxndr1697]

Сообщение от Vladimir_Sergeevich А если говорить о повседневной шпаргалке, то скорее подойдет "AutoLisp и VisualLisp в среде Autocad" за авторством Полещука

Имеется. Настольная книга, так сказать)))
Хочу еще найти Хювенен, Э.; Серрянен, Й. Мир Лиспа, пока безуспешно.

[Сергей812]

Сообщение от Alxndr1697 Приобрел книгу (для учебы предпочитаю бумажные варианты), "читаю" уже на 200 странице и понимаю, что ничего не понимаю. Все таки, эта книга далеко не для новичков... Я, конечно, дочитаю до конца, но, на изучение, к сожалению, это мало похоже. Спасибо.

Просто ShaggyDoc является одним из авторов этой книги, и когда он пишет про организацию кода на лиспе - в этой книге можно найти практические примеры того, что он говорит.

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

Сообщение от Alxndr1697 Хочу еще найти Хювенен, Э.; Серрянен, Й. Мир Лиспа, пока безуспешно.

зачем? CommonLisp и AutoLisp - это разные вещи.

[Alxndr1697]

Сообщение от Сергей812 зачем? CommonLisp и AutoLisp - это разные вещи.

Уже нашел и понял) В начале темы, к ней несколько раз отсылали, вот и решил.

Переменной L_sh надо присвоить значение 270, если расстояние больше 273 и меньше 303. Что я здесь пишу неправильно?

Код:

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

  (setq	L_sh (if (and (>= (- (cadr P_B) (cadr P_0)) 273)
		      (<= (- (cadr P_B) (cadr P_0)) 303)
		  )
	              (= L_sh 270)
	      )
   )

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

Код:

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

  (if (and (>= (- (cadr P_B) (cadr P_0)) 273)
		      (<= (- (cadr P_B) (cadr P_0)) 303)
		  )
	              (= L_sh 270)
   )

Примерно так, ЯТД.

[Alxndr1697]

Не, не работает. Пачиму?

----- добавлено через ~3 мин. -----
Вообще, по неправильному пути пошел, наверное, т.к. условий будет девять. Думаю, через cond надо решать.

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

Сообщение от Alxndr1697 если расстояние больше 273 и меньше 303

А если это условие не соблюдается? Что тогда делать?
P.S. Ползать по всей теме и разыскивать, в каком коде и в каком месте у тебя нестыковка - мне лениво и некогда.

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

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] (if (and (>= (- (cadr P_B) (cadr P_0)) 273) (<= (- (cadr P_B) (cadr P_0)) 303) ) (= L_sh 270) ) Примерно так, ЯТД.

Тьфу, блин, не так!

Код:

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

  (if (and (>= (- (cadr P_B) (cadr P_0)) 273)
		      (<= (- (cadr P_B) (cadr P_0)) 303)
		  )
	              (setq L_sh 270)
   )

[koMon]

Код:

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

 (if (< 273 (distance p_0 p_b) 303) (setq l_sh 270))

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

М-да, C#-подход уже накладывает свои ходы

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc А если это условие не соблюдается? Что тогда делать?

Это будет дальше следующим вопросом

Сообщение от Кулик Алексей aka kpblc Тьфу, блин, не так!

Оно самое! Вот, догадывался, что с дублированием setq, что-то не так.

koMon Вообще, - супер! Не знал, что < работает "на две стороны".

А как будет, если по условию, >=273 и <303?

Так?

Код:

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

(if (and (>= (distance P_0 P_B) 273) (< (distance P_0 P_B) 303)) (setq L_sh 270))

[koMon]

Alxndr1697,
не работает на две стороны, сравниваемых величин может быть больше трёх. последовательно проверяются пары от символа сравнения до первого nil.
я бы сделал так:

Код:

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

 
(setq l_sh 'out_of_range) 
(if (<= 273 (setq dist_0_b (distance p_0 p_b)) 303) 
	(if (/= 303 dist_0_p) 
			(setq l_sh 270)
	)
)

[ShaggyDoc]

Сообщение от koMon сравниваемых величин может быть больше трёх. последовательно проверяются пары от символа сравнения до первого nil.

Лучше всего делать через cond

Код:

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

 (setq x
  (cond
    ((a > b) 100)
    ((a <= b) 200)
    ;; Сколько угодно проверок
    (T  nil) ;; вернет NIL если ни одно условие не соблюдается
  )
)

[koMon]

чем именно лучше?)
эмм и потом... тут x должен сравниваться с a и b, а не а и b между собой... еяпп

[ShaggyDoc]

Сообщение от koMon чем именно лучше?) эмм и потом... тут x должен сравниваться с a и b, а не а и b между собой... еяпп

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

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

[koMon]

для понятия нахождения числа в диапазоне из двух других чисел cond ваще не вариант имхо) потому что заменяется простым if с проверкой and на граничность, что соответствует поставленному практическому вопросу, а не теории многочисленности вариантов.

[Alxndr1697]

Извините, что не появлялся, уведомления почему-то не приходят, вот и думал , что тут тишина.
Вопрос, как и полагал, решил через cond:

Код:

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

  (cond
    ((< (distance P_0 P_B) 273)
       (progn (alert (strcat "Извините, направляющих, меньше 270мм, - нет. \n"
			     "Необходимо увеличить глубину ниши для ящиков."))
          (exit))
     )
    ((and (>= (distance P_0 P_B) 273) (< (distance P_0 P_B) 303)) (setq L_sh 260));длина ящика
    ((and (>= (distance P_0 P_B) 303) (< (distance P_0 P_B) 353)) (setq L_sh 290))
    ((and (>= (distance P_0 P_B) 353) (< (distance P_0 P_B) 403)) (setq L_sh 340))
    ((and (>= (distance P_0 P_B) 403) (< (distance P_0 P_B) 453)) (setq L_sh 390))
    ((and (>= (distance P_0 P_B) 453) (< (distance P_0 P_B) 503)) (setq L_sh 440))
    ((and (>= (distance P_0 P_B) 503) (< (distance P_0 P_B) 553)) (setq L_sh 490))
    ((and (>= (distance P_0 P_B) 553) (< (distance P_0 P_B) 603)) (setq L_sh 540))
    ((and (>= (distance P_0 P_B) 603) (< (distance P_0 P_B) 653)) (setq L_sh 590))
    ((>= (distance P_0 P_B) 653) (setq L_sh 640))
   );end cond

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

Что-то у меня с if не складывается)
Что тут неправильно?

Код:

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

  (setq P_0 (getpoint "\nУкажите левую нижнюю точку бокса <Отмена> :"))
  (setq P_L (getpoint "\nУкажите правую нижнюю точку бокса <Отмена> :"));ось x
  (if (eq (cadr P_L) (cadr P_0))
	(progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XYZ"))
	  (exit))
   )

----- добавлено через ~14 мин. -----
пс. Решено. Замена eq на /=

[Сергей812]

1. Зачем каждый раз вычислять (distance P_0 P_B) ? Не вижу, чтобы в данном коде переменные P_0 P_B менялись - чтобы была необходимость актуализации дистанции.
2. Здесь как раз напрашивается сделать функцию, куда передаются аргументы P_0 P_B, а возвращается длина направляющей. Либо -1, если менее 273 - а уже в вызывающей основной функции либо продолжение работы, либо alert. И так везде - где есть строго определенный законченный функционал, выносите в отдельную функцию, а в основном коде будет лишь одна строчка вызова этой функции. Читаемость кода будет гораздо лучше, и отладка проще.

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

[Alxndr1697]

Сообщение от Сергей812 1. Зачем каждый раз вычислять (distance P_0 P_B) ? Не вижу, чтобы в данном коде переменные P_0 P_B менялись - чтобы была необходимость актуализации дистанции. 2. Здесь как раз напрашивается сделать функцию, куда передаются аргументы P_0 P_B, а возвращается длина направляющей. Либо -1, если менее 273 - а уже в вызывающей основной функции либо продолжение работы, либо alert. И так везде - где есть строго определенный законченный функционал, выносите в отдельную функцию, а в основном коде будет лишь одна строчка вызова этой функции. Читаемость кода будет гораздо лучше, и отладка проще.

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

----- добавлено через ~5 мин. -----
Еще вопрос. Эту дистанцию можно было записать в переменную и уже, легче бы читалось. Сознательно пошел на этот шаг, чтобы уменьшить количество переменных. Это правильно, или нет?

[Сергей812]

Сообщение от Alxndr1697 Сознательно пошел на этот шаг, чтобы уменьшить количество переменных. Это правильно, или нет?

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

Сообщение от Alxndr1697 Буду признателен, если кто-нибудь напишет эту функцию ( без вла) и как ее потом вызывать, чтоб разобраться.

Элементарно

Код:

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

 (defun CalcSizeDepthBox ( aP_0 aP_B / lDist lRes)
   (setq lDist (distance aP_0 aP_B))
   И тут ваш код: вместо (distance P_0 P_B) - переменная lDist, вместо setq L_sh  - setq lRes.
)

в лиспе функция возвращает последнее вычисленное или присвоенное значение, поэтому на выходе будет значение lRes - хотя в явном виде его не возвращаем, как в других языках программирования.

Ну а вызов - вызов же той же distance не вызывает затруднения, а ваша функция ничем не отличается для кода.

[Alxndr1697]

Сергей812 Благодарю!
Но, немного не пойму, зачем нужна функция?
Если просто назначить переменную (setq Dist (distance P_0 P_B)) и заменить все (distance P_0 P_B) на Dist, будет неправильно?

Пока нет возможности проверить...

[Сергей812]

Сообщение от Alxndr1697 Но, немного не пойму, зачем нужна функция?

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

[Alxndr1697]

Надо построить массив, один столбец, три объекта, дистанция, например 653.
Написал вот так:

Код:

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

(command-s "_.arrayrect" Fas_one "" "_Columns" "1" "_Rows" "3" "_Distance between rows" "653" "" "")

Не работает.
Подскажите, как надо правильно.

[Сергей812]

как минимум

Сообщение от Alxndr1697 "_Distance between rows"

[Alxndr1697]

Сообщение от Сергей812 как минимум

Так это я знаю)
Делая в окне программы, я ввожу "интервал межу строками", а тут надо по другому. Как?
Есть где-нибудь справочник (не справка автокада) со всеми командами, опциями команд и их последовательностью? Не всегда все так очевидно, как делаешь через окно автокада (командную строку).

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

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

[koMon]

Сообщение от Alxndr1697 Подскажите, как надо правильно.

Код:

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

 (command-s "_.arrayrect" Fas_one "" "_col" 1 1 "_r" 3 653 "" "")

[Сергей812]

ArrayRectangular

[Alxndr1697]

koMon Благодарствую, все работает.
Что означает вторая единица?

Код:

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

"_col" 1 1

[koMon]

Количество столбцов, расстояние между столбцами. Можно заменить на "" яд.

[Alxndr1697]

Сообщение от koMon Можно заменить на "" яд.

Проверил, - можно.

[Browning Zed]

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

Код:

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

 (while (vl-cmdf "_.-insert" "ИМЯ_БЛОКА" "_S" 1.0 "_R" 0.0 "\\"))

и попадаю в "вечный" цикл, без возможности выхода по эскейпу, энтеру или пробелу. Как можно решить проблему?

[Сергей812]

ну так vl-cmdf

Always returns T.

с 2015 акада)

Вариант от Алексея

[Browning Zed]

Спасибо за решение.

[Alxndr1697]

Требуется помощь. Функции по отдельности работают, а вот в "кучу" собрать не могу. Причиной остановки указывает последнюю строчку (выделил красным) . Полагаю, что-то не так с переменными. Честно признаюсь, эта тема (аргументы, переменные, что где прописывать) мне непонятна, если кто может, - объясните, пожалуйста.

Код:

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

dialog_fasad_sup: dialog {label = "Фасад ящика (горизонтальный)";
:spacer{height=1;}
:column {label = "Точки ввода :";
:spacer{height=1;}
:image {key = "sld"; width  = 15; aspect_ratio = 1.8; color= 4;}
        }//end column точки ввода
:spacer{height=1;}
:boxed_column {label = "Параметры фасада :";
:spacer{height=1;}
:radio_row {key = "Tip_f"; label = "Тип фасада :";
                           
            :radio_button {key = "o_nkl"; label = "Накладной"; value = "1";}
            :radio_button {key = "o_vkl"; label = "Вкладной"; value = "0";}
            }//end radio_row
                                                :spacer{height=1;}
:row {:boxed_column {:boxed_column {label = "Количество фасадов :";
:spacer{height=1;}
             :edit_box {key = "o_Col_vo";         label = "Количество :";               value = "1";   edit_width = 4;}
               }//end column количество
:spacer{height=2;}
:boxed_column {label = "Толщина материала :";
             :edit_box {key = "o_B_mat_fas";      label = "Фасада :";                   value = "16";   edit_width = 4;}
             :edit_box {key = "o_B_mat_corp";     label = "Корпуса :";                  value = "16";   edit_width = 4;}
               }//end column толщина материала
               }
:spacer{height=1;}             
:boxed_column {label = "Зазоры фасада :";
//:spacer{height=1;}
             :edit_box {key = "o_Z_r";            label = "Зазор между фасадами :";     value = "3";   edit_width = 4;}
             :edit_box {key = "o_otst_up_front";  label = "Отступ от корпуса вперед :"; value = "0";   edit_width = 4;}
             :edit_box {key = "o_otst_top";       label = "Отступ сверху :";            value = "1.5"; edit_width = 4;}
             :edit_box {key = "o_otst_bottom";    label = "Отступ снизу :";             value = "1.5"; edit_width = 4;}
             :edit_box {key = "o_otst_left";      label = "Отступ слева :";             value = "1.5"; edit_width = 4;}
             :edit_box {key = "o_otst_right";     label = "Отступ справа :";            value = "1.5"; edit_width = 4;}
               }//end column зазоры
               }//end row
}//end параметры фасада

:spacer{height=1;}
:boxed_row {label = "";
             ok_cancel;}

       
                         }//end dialog

Код:

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

(DEFUN c:Fasad_sup (/ H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right
		    le edata le2 Vibor)

;***********************************функция fasad_n***************************************

(defun fasad_n ( H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right /
	      oldosm oldlay P_0 P_L P_H H_box L_box B_mat_corp B_mat_fas Z_r otst_top otst_bottom otst_left otst_right
	      H_fas_one L_fas H_fas_N Col_vo P_0_fas Fas_one)

  (command-s "._UNDO" "_be")
  (defun *error*(msg) 
  (princ msg) 
 )
(command-s "_.UCS" "_w")

  (setq P_0 (getpoint "\nУкажите левую внутреннюю нижнюю точку бокса <Отмена> :"))
  (setq P_L (getpoint "\nУкажите правую внутреннюю нижнюю точку бокса <Отмена> :"));ось x
    (if (/= (cadr P_L) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
  (setq P_H (getpoint "\nУкажите левую внутренюю верхнюю точку бокса <Отмена> :"));ось z
    (if (/= (cadr P_H) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
  (setq H_box (distance P_0 P_H));высота бокса
  (setq L_box (distance P_0 P_L));длина (ширина) бокса

  (setq oldosm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq oldlay (getvar "clayer"))
    (if (null (tblsearch "layer" "ФАСАД"))
      (command-s "_.-LAYER" "_N" "ФАСАД" "")
     )
      (command-s "_.-layer" "_make" "ФАСАД" "_color" "3" "" "")

  (setq H_fas_one (- (- (+ H_box (* 2 B_mat_corp)) otst_top) otst_bottom))  
  (setq L_fas (- (- (+ L_box (* 2 B_mat_corp)) otst_left) otst_right))
  (setq H_fas_N (/ (- H_fas_one (* Z_r (1- Col_vo))) Col_vo))
  (setq P_0_fas (list (+ (- (car P_0) B_mat_corp) otst_left) (- (cadr P_0) otst_up_front) (+ (- (caddr P_0) B_mat_corp) otst_bottom)))

	(command-s "_.box" P_0_fas (list (+ (car P_0_fas) L_fas) (- (- (cadr P_0_fas) B_mat_fas) otst_up_front) (+ (caddr P_0_fas) H_fas_N)))
	   (setq Fas_N (entlast))
              (if (not (equal Fas_N (entlast))) (alert "Построение не удалось"))
                 (regapp "AVCNames")
                    (setq le (entget (entlast)))
                       (setq edata (list (list -3 (list "AVCNames" (cons 1000 "Фасад")))))
                          (setq le2 (append le edata))
                             (entmod le2)
  (command-s "_.ucs" "x" 90)
  (command-s "_.arrayrect" Fas_N "" "_col" 1 1 "_r" Col_vo (+ H_fas_N Z_r) "" "")

  (command-s "_.UCS" "_w")

(setvar "osmode" oldosm)
   (setvar "clayer" oldlay)
   (command-s "._UNDO" "_end")
  (princ)
   );end defun fasad

;***********************************функция fasad_v***************************************

(defun fasad_v ( H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right /
	      oldosm oldlay P_0 P_L P_H H_box L_box B_mat_corp B_mat_fas Z_r otst_top otst_bottom otst_left otst_right
	      H_fas_one L_fas H_fas_N Col_vo P_0_fas Fas_one)

  (command-s "._UNDO" "_be")
  (defun *error*(msg) 
  (princ msg) 
 )
(command-s "_.UCS" "_w")

  (setq P_0 (getpoint "\nУкажите левую внутреннюю нижнюю точку бокса <Отмена> :"))
  (setq P_L (getpoint "\nУкажите правую внутреннюю нижнюю точку бокса <Отмена> :"));ось x
    (if (/= (cadr P_L) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
  (setq P_H (getpoint "\nУкажите левую верхнюю внутренюю точку бокса <Отмена> :"));ось z
    (if (/= (cadr P_H) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
  (setq H_box (distance P_0 P_H))
  (setq L_box (distance P_0 P_L))

  (setq oldosm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq oldlay (getvar "clayer"))
    (if (null (tblsearch "layer" "ФАСАД"))
      (command-s "_.-LAYER" "_N" "ФАСАД" "")
     )
      (command-s "_.-layer" "_make" "ФАСАД" "_color" "3" "" "")

  (setq H_fas_one (- (- H_box otst_top) otst_bottom))  
  (setq L_fas (- (- L_box otst_left) otst_right))
  (setq H_fas_N (/ (- H_fas_one (* Z_r (1- Col_vo))) Col_vo))
  (setq P_0_fas (list (+ (car P_0) otst_left) (- (+ (cadr P_0) B_mat_fas) otst_up_front) (+ (caddr P_0) otst_bottom)))

	(command-s "_.box" P_0_fas (list (+ (car P_0_fas) L_fas) (- (cadr P_0_fas) B_mat_fas) (+ (caddr P_0_fas) H_fas_N)))
	   (setq Fas_N (entlast))
              (if (not (equal Fas_N (entlast))) (alert "Построение не удалось"))
                 (regapp "AVCNames")
                    (setq le (entget (entlast)))
                       (setq edata (list (list -3 (list "AVCNames" (cons 1000 "Фасад")))))
                          (setq le2 (append le edata))
                             (entmod le2)
  (command-s "_.ucs" "x" 90)
  (command-s "_.arrayrect" Fas_N "" "_col" 1 1 "_r" Col_vo (+ H_fas_N Z_r) "" "")

  (command-s "_.UCS" "_w")

  (setvar "osmode" oldosm)
  (setvar "clayer" oldlay)
  (command-s "._UNDO" "_end")
  (princ)
   );end defun fasad

;**************************функция raz_fasad*****************************************************

 (defun raz_fasad (/ )
   (setq Col_vo (atof (get_tile "o_Col_vo")))
   (setq B_mat_fas (atof (get_tile "o_B_mat_fas")))
   (setq B_mat_corp (atof (get_tile "o_B_mat_corp")))
   (setq Z_r (atof (get_tile "o_Z_r")))
   (setq otst_up_front (atof (get_tile "o_otst_up_front")))
   (setq otst_top (atof (get_tile "o_otst_top")))
   (setq otst_bottom (atof (get_tile "o_otst_bottom")))
   (setq otst_left (atof (get_tile "o_otst_left")))
   (setq otst_right (atof (get_tile "o_otst_right")))

   (setq Vibor (get_tile "Tip_f"))

   );end raz_fasad

;****************************************************************************

  (if (= Vibor "o_nkl")
    (fasad_n)
      (princ)
   )
    (if (= Vibor "o_vkl")
    (fasad_v)
      (princ)
   )
;********************************Функция Slide******************************

  (defun slide (/ dx dy)
    (setq dx (dimx_tile "sld")
	  dy (dimy_tile "sld")
     )
    (start_image "sld")
    (slide_image -1  -1  (1+ dx) (1+ dy) "2" )
    (end_image)
   );end slide

;*********************************Диалоговое окно*************************************

(setq dcl_id (load_dialog "D:/MyLISP/002_FASAD/dialog_fasad_sup.DCL"))
  (if (not (new_dialog "dialog_fasad_sup" dcl_id)) (exit))

     (slide)

       (action_tile "accept" "(raz_fasad) (slide) (done_dialog 1)")
         (action_tile "cancel" "(done dialog 0)")
           (setq ddi (start_dialog))
             (unload_dialog dcl_id)

(if (= ddi 1) (Fasad_sup H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right Vibor))
(princ)

   );end defun fasad_sup

[Browning Zed]

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

Попробую по-простому объяснить синтаксис функций в AutoLISP, надеюсь гуру программирования не будут меня больно бить ногами.

Выглядит он так:
(defun foo ( a b / c d ) < тело функции > )

Разберем по порядку каждый элемент:
defun – начало определения функции. Любая функция или команда, определяемая пользователем, обязательно начинается со слова defun.

foo – имя функции. Обрати внимание, что если имя функции начинается на c:, тогда AutoCAD определяет эту функцию как команду. Таким образом, если имя функции будет foo она будет определена непосредственно как функция, но, если имя будет c:foo, она будет определена как команда, это важно!

Теперь разберемся со скобками, идущими после имени функции. Элементы внутри скобок могут содержать параметры функции и локальные переменные. Все зависит от варианта написания того, что содержится в скобках. Рассмотрим каждый из них:
Вариант 1.
(defun foo ( a b / c d ) < тело функции > )
В данном случае, функция содержит как параметры функции, так и локальные переменные.
Элементы, которые идут до слеша – a b, это параметры функции.
Элементы, расположенные после слеша – c d, это локальные переменные.
Вариант 2.
(defun foo ( a b ) < тело функции > ) или то же самое (defun foo ( a b / ) < тело функции > )
Функция содержит только параметры функции.
Вариант 3.
(defun foo ( / c d ) < тело функции > )
Функция содержит только локальные переменные.
Вариант 4.
(defun foo () < тело функции > ) или то же самое (defun foo nil < тело функции > )
Функция не имеет ни параметров функции, ни локальных переменных.

И теперь важный момент – если ты определяешь функцию как команду, то бишь вместо foo пишешь c:foo, то такая функция не должна содержать параметров функции, это будет являться ошибкой.

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

Код:

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

(defun MakeCircle ( color ) (entmake (list '(0 . "CIRCLE") (cons 62 color) '(10 4.0 4.0 0.0) '(40 . 1.0))))

Пока не будем подробно вникать в списки сущностей, но обратим внимание на то, что параметр color, является цветом создаваемого круга, и присутствует в двух местах: в начале – в качестве входящего значения, а после повторяется снова – где значение непосредственно задействуется.
Вызов функции с параметром, осуществляется следующим образом: (имя_функции параметр_функции)
Подобным образом, попробуем вызвать нашу функцию с применением разных значений в качестве параметра функции color:
(MakeCircle 1)
- создан круг красного цвета
(MakeCircle 3)
- создан круг зеленого цвета
(MakeCircle 5)
- создан круг синего цвета
и т.д.

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

Теперь разберем, что из себя представляют локальные переменные. Начать нужно с того, что сами переменные могут быть двух типов: локальные и глобальные. Локальные переменные могут быть активны только в функции, в которой они были определены, и после завершения этой функции вычищаются из памяти компьютера. Глобальные же переменные всегда находятся в памяти.
В AutoLISP переменные могут быть установлены с помощью двух функций setq и set. Таким образом, все значения, заданные с помощью этих функций, будут являться переменными.

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

Код:

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

(defun c:Hello ( / var )  (setq var "Здравствуй, мир!") (princ))

Затем, запустим команду Hello, а после введем в командную строку (princ var), и командная строка вернет nil, что значит переменной var не существует в памяти компьютера.
Теперь определим ту же команду, но переменную var оставим глобальной:

Код:

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

(defun c:Hello nil (setq var "Здравствуй, мир!") (princ))

Запускаем команду Hello, а после, также введем в командную строку (princ var). Но теперь командная строка вместо nil вернет "Здравствуй, мир!". То есть, в памяти компьютера хранится переменная, которая содержит строковое значение "Здравствуй, мир!".

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


Думаю, синтаксис функций в общих словах я объяснил. И теперь исходя из изложенного проверь свой код:
То, что ты выделил красным, это вызов некой функции Fasad_sup с кучей аргументов (параметров функции), и эта функция ранее не была определена! В начале ты определяешь команду c:Fasad_sup, а не функцию.
И, забегая вперед, скажу: функция запускаемая внутри функции, которая носит с ней одно и то же имя, называется рекурсивной, и применяется в специфических случаях. Это явно не тот случай.

[Сергей812]

терминологическое уточнение

Сообщение от Browning Zed Локальные переменные могут быть активны только в функции,

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

[Browning Zed]

Сообщение от Сергей812 терминологическое уточнение не активные - а у переменных есть области видимости. И для лиспа всего два варианта - локальная видимость в пределах функции или глобальная для всего кода лиспа. Причем чтобы создать переменную с глобальной видимостью - в лиспе достаточно просто забыть указать переменную в теле функции или ошибиться с написанием идентификатора переменной в коде.

Да, спасибо за уточнение.
От себя также добавлю, что по теме "область видимости в AutoLISP" есть замечательная статья на сайте Алексея Кулика.

[Alxndr1697]

Browning Zed, спасибо, очень доходчиво.


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

Сообщение от Browning Zed Составив такую функцию, можно впоследствии запускать ее определив только нужное значение, а не дублировать одни и те же строки кода

Наконец-то применю)))

Насчет имен, у меня, вроде, разные везде. Или, это просто предупреждение

[Alxndr1697]

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

Код:

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

(DEFUN c:Fasad_sup (/ H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right
		    le edata le2 Part_name)

;*********************************Функция re_name****************************************

(defun re_name (Part_name / le edata le2 )
(regapp "AVCNames")
(setq le (entget (entlast)))
(setq edata (list (list -3 (list "AVCNames" (cons 1000 Part_name)))));формирование подсписка расширенных данных и включение в список
(setq le2 (append le edata));присоединение расширенных данных к примитиву
(entmod le2)
(entget (entlast) '("AVCNames"))
 );end re_name

;***********************************функция fasad***************************************

(defun fasad (H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right /
	      oldosm oldlay P_0 P_L P_H H_box L_box B_mat_corp B_mat_fas Z_r otst_top otst_bottom otst_left otst_right
	      H_fas_one L_fas H_fas_N Col_vo P_0_fas Fas_one Vibor)

  (command-s "._UNDO" "_be");начало группы для отмены (Begin).
  (defun *error*(msg) 
  (princ msg) 
 )
(command-s "_.UCS" "_w")

  (setq P_0 (getpoint "\nУкажите левую внутреннюю нижнюю точку бокса <Отмена> :"))
  (setq P_L (getpoint "\nУкажите правую внутреннюю нижнюю точку бокса <Отмена> :"));ось x
    (if (/= (cadr P_L) (cadr P_0))
       (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
  (setq P_H (getpoint "\nУкажите левую внутреннюю верхнюю точку бокса <Отмена> :"));ось z
    (if (/= (cadr P_H) (cadr P_0))
       (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
   (setq H_box (distance P_0 P_H))
   (setq L_box (distance P_0 P_L))

  (setq oldosm (getvar "osmode"))
  (setvar "osmode" 0)
  (setq oldlay (getvar "clayer"))
    (if (null (tblsearch "layer" "ФАСАД"))
       (command-s "_.-LAYER" "_N" "ФАСАД" "")
     )
       (command-s "_.-layer" "_make" "ФАСАД" "_color" "3" "" "")

;**************************fasad_n*****************************************
   
 (if (= Vibor "o_nkl")
   (progn
      (setq H_fas_one (- (- (+ H_box (* 2 B_mat_corp)) otst_top) otst_bottom))  
      (setq L_fas (- (- (+ L_box (* 2 B_mat_corp)) otst_left) otst_right))
      (setq H_fas_N (/ (- H_fas_one (* Z_r (1- Col_vo))) Col_vo))
      (setq P_0_fas (list (+ (- (car P_0) B_mat_corp) otst_left) (- (cadr P_0) otst_up_front) (+ (- (caddr P_0) B_mat_corp) otst_bottom)))

	(command-s "_.box" P_0_fas (list (+ (car P_0_fas) L_fas) (- (- (cadr P_0_fas) B_mat_fas) otst_up_front) (+ (caddr P_0_fas) H_fas_N)))
	(setq Fas_N (entlast))
        (if (not (equal Fas_N (entlast))) (alert "Построение не удалось"))
        (re_name "Фасад")
        (princ)
    )
 )
;***************************fasad_v****************************************

(if (= Vibor "o_vkl")
  (progn
     (setq H_fas_one (- (- H_box otst_top) otst_bottom))  
     (setq L_fas (- (- L_box otst_left) otst_right))
     (setq H_fas_N (/ (- H_fas_one (* Z_r (1- Col_vo))) Col_vo))
     (setq P_0_fas (list (+ (car P_0) otst_left) (- (+ (cadr P_0) B_mat_fas) otst_up_front) (+ (caddr P_0) otst_bottom)))

	(command-s "_.box" P_0_fas (list (+ (car P_0_fas) L_fas) (- (cadr P_0_fas) B_mat_fas) (+ (caddr P_0_fas) H_fas_N)))
	(setq Fas_N (entlast))
        (if (not (equal Fas_N (entlast))) (alert "Построение не удалось"))
        (re_name "Фасад")
        (princ)
   )
 )
;**************************************************************************

  (command-s "_.ucs" "x" 90)
  (command-s "_.arrayrect" Fas_N "" "_col" 1 1 "_r" Col_vo (+ H_fas_N Z_r) "" "")

  (command-s "_.UCS" "_w")
  (setvar "osmode" oldosm)
  (setvar "clayer" oldlay)
  (command-s "._UNDO" "_end")
  (princ)
   );end defun fasad

;**************************функция raz_fasad*******************************

 (defun raz_fasad (/ )

   (setq Vibor (get_tile "Tip_f"))

   (setq Col_vo (atof (get_tile "o_Col_vo")))
   (setq B_mat_fas (atof (get_tile "o_B_mat_fas")))
   (setq B_mat_corp (atof (get_tile "o_B_mat_corp")))
   (setq Z_r (atof (get_tile "o_Z_r")))
   (setq otst_up_front (atof (get_tile "o_otst_up_front")))
   (setq otst_top (atof (get_tile "o_otst_top")))
   (setq otst_bottom (atof (get_tile "o_otst_bottom")))
   (setq otst_left (atof (get_tile "o_otst_left")))
   (setq otst_right (atof (get_tile "o_otst_right")))

   

   );end raz_fasad

;***************************Функция Slide**********************************

  (defun slide (/ dx dy)
    (setq dx (dimx_tile "sld")
	  dy (dimy_tile "sld"))
    (start_image "sld")
    (slide_image -1  -1  (1+ dx) (1+ dy) "2" )
    (end_image)
   );end slide

;************************Диалоговое окно**********************************

(setq dcl_id (load_dialog "D:/MyLISP/002_FASAD/dialog_fasad_sup.DCL"))
  (if (not (new_dialog "dialog_fasad_sup" dcl_id)) (exit))

   (action_tile "accept" "(raz_fasad) (slide) (done_dialog 1)")
   (action_tile "cancel" "(done dialog 0)")
   (setq ddi (start_dialog))
   (unload_dialog dcl_id)

(if (= ddi 1) (fasad H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right))
(princ)

   );end defun fasad_sup

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

Какое сообщение об ошибке?
Offtop: Сугубо ИМХО: код следует переработать полностью. Начиная с переименования функций и их локализации и документирования, заканчивая общим принципом. Могу, если хочется, снять видосик, почему этот код не подлежит отладке.

[Alxndr1697]

Текстового сообщения нет, просто выделение.

Сообщение от Кулик Алексей aka kpblc Могу, если хочется, снять видосик, почему этот код не подлежит отладке.

Конечно хочется, не то слово!

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

Вот, его-то, я никак не поймаю, видимо.

[Сергей812]

в посте №4193 дали ссылку, как запихивать функции внутрь других функций) вот и наблюдаем внутри функции-команды кашу из других функций

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

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

Дисклеймер: будет много ссылок на мой сайтик.

Представленный код невозможно протестировать. В принципе невозможно.
Причина номер раз - это использование диалога (которого, естественно, у меня нет). Я понимаю, что можно покопаться по форуму и найти тот самый dcl. Но как-то подобное не комильфо - не проще ли создавать диалог "на лету"?
Причина номер два - именования функций и переменных. Функция re_name (к примеру), судя по названию, должна там что-то переименовывать. А делает она совсем другое.
Причина номер три - это видимость функций и переменных. Все внутренние функции объявлены как глобальные. Отличный шанс выстрелить себе в ногу
Далее. Мое искреннее убеждение состоит в том, что любая (подчеркиваю - любая!), даже локальная, функция должна работать только с теми данными, которые в нее прилетели и не лезть во внешние переменные. Та же raz_fasad (кстати, по имени можно решить заранее - что оно делает?) у меня была бы переписана примерно так:

Код:

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

 (defun _kpblc-list-add-or-subst (lst key value)
                                ;|
  *    Производит замену или дополнение элемента списка новым
  *    Параметры вызова:
    lst     ; обрабатываемый список
    key     ; ключ
    value   ; устанавливаемое значение
  |;
  (if (not value)
    (vl-remove-if (function (lambda (x) (= (car x) key))) lst)
    (if (cdr (assoc key lst))
      (subst (cons key value) (assoc key lst) lst)
      (cons (cons key value) (vl-remove-if (function (lambda (x) (= (car x) key))) lst))
    ) ;_ end of if
  ) ;_ end of if
) ;_ end of defun

(defun raz_fasad (key value ref-list)
                 ;|
  *    Обработка диалога
  *    Параметры вызова:
    key      ; имя контрола в диалоге
    value    ; установленное значение контрола
    ref-list ; список с данными, передавать по ссылке
  |;
  (cond
    ((= key "Tip_f")
     (set ref-list (_kpblc-list-add-or-subst (eval ref-list) (strcase key t) value))
    )
    (t
     (set ref-list (_kpblc-list-add-or-subst (eval ref-list) (strcase key t) (atof value)))
    )
  ) ;_ end of cond
) ;_ end of defun

И в таком случае вызов диалога становится немного другим (при условии, конечно, что dcl в принципе существует):

Код:

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

 (setq dcl_lst '(("tip_f" . "")
                ("o_col_vo" . 0.)
                ("o_b_mat_fas" . 0.)
                ("o_b_mat_corp" . 0.)
                ("o_z_r" . 0.)
                ("o_otst_up_front" . 0.)
                ("o_otst_top" . 0.)
                ("o_otst_bottom" . 0.)
                ("o_otst_left" . 0.)
                ("o_otst_right" . 0.)
               )
) ;_ end of setq
(if (setq dcl_file (findfile "D:/MyLISP/002_FASAD/dialog_fasad_sup.DCL"))
  (progn
    (setq dcl_id (load_dialog dcl_file))
    (if (not (new_dialog "dialog_fasad_sup" dcl_id "(raz-fasad $key $value 'dcl_lst)"))
      (exit)
    ) ;_ end of if
  ) ;_ end of progn
) ;_ end of if

Естественно, что в таком случае action_tile для accept становится тоже другим. Примерно так:

Код:

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

 (action_tile "accept" "(done_dialog 1)")

Следом - переименование функций. Локальные функции я обычно называю по принципу fun_<И тут название>. Тот же raz_fasad станет как fun_dcl-callback, re_name - fun_addxdata. И т.д.

Дальше - я бы постарался максимально отказаться от использования командных методов. Так, например

Код:

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

 (if (null (tblsearch "layer" "ФАСАД"))
  (command-s "_.-LAYER" "_N" "ФАСАД" "")
) ;_ end of if
(command-s "_.-layer" "_make" "ФАСАД" "_color" "3" "" "")

Стало бы

Код:

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

 (setq layer (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) "Фасад"))
(vla-put-color layer 3)
(vla-put-lock layer :vlax-false)
(vl-catch-all-apply (function (lambda () (vla-put-freeze layer :vlax-false))))
(setvar "clayer" (vla-get-name layer))

А

Код:

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

 (command-s "_.box"

я бы заменил на

Код:

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

 (vla-addbox 

с соответствующими параметрами.

На предмет переопределения глобального обработчика *error* я уже когда-то высказывался. Кстати, у тебя там не возвращаются обратно системные переменные. И метка окончания отмены не ставится, что может привести к неприятным последствиям.

Ну и по поводу запроса точек и прочего

Сорян, накидали работы. Пока заканчиваю.

[Сергей812]

По поводу наименования функций - чтобы не запутаться, можно придерживаться псевдоиерархии:

Fasad_%Тип фасада%_Create - создание фасада
Fasad_%Тип фасада%_Create_%Fun01%
Fasad_%Тип фасада%_Create_%Fun02% - это подфункции создания отдельных частей фасада данного типа
Fasad_%Тип фасада%_Create_%Fun03%

и не надо их куда-то прятать, уже по идентификатору функции видно - где она должна вызываться. И что функция Fasad_%Тип фасада%_Create не может (не должна, точнее) вызываться внутри Fasad_%Тип фасада%_Create_%Fun01%. И данные передаются в эти подфункции через аргументы.

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

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Причина номер раз - это использование диалога (которого, естественно, у меня нет). Я понимаю, что можно покопаться по форуму и найти тот самый dcl. Но как-то подобное не комильфо - не проще ли создавать диалог "на лету"?

Зачем по форуму) На этой странице, 4190.
"На лету", - отличный вариант! Но,- VLA...

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

Она, в моем случае, в расширенных данных добавляет имя созданному объекту. Согласен, add_name было бы лучше.

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

Про глобальность функций не знал. Поищу инфу.

Сообщение от Кулик Алексей aka kpblc Далее. Мое искреннее убеждение состоит в том, что любая (подчеркиваю - любая!), даже локальная, функция должна работать только с теми данными, которые в нее прилетели и не лезть во внешние переменные. Та же raz_fasad (кстати, по имени можно решить заранее - что оно делает?) у меня была бы переписана примерно так:

Что значит, лезть во внешние переменные?
Raz_fasad считывает содержимое из диалогового окна, вроде как размеры фасада. Такие уж у меня ассоциации. Хотя, в окне, назвал это параметрами))

А вот дальше, то самое Но, о котором писал выше. Мне жутко неудобно, что вы потратили на меня столько времени, но, в VLA я не понимаю, от слова совсем(((
По поводу запроса точек, идею понял, попробую применить.

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

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

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

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

Сообщение от Alxndr1697 Зачем по форуму) На этой странице, 4190.

Ага, только одно "но" - это callback. Которого особо не видать

Сообщение от Alxndr1697 "На лету", - отличный вариант! Но,- VLA...

Какое vla-? Тупо получение каталога временных файлов, создание файла, запись в него и далее по тексту.

Сообщение от Alxndr1697 Про глобальность функций не знал. Поищу инфу.

Вроде бы в ссылках было.

Сообщение от Alxndr1697 Что значит, лезть во внешние переменные? Raz_fasad считывает содержимое из диалогового окна, вроде как размеры фасада. Такие уж у меня ассоциации. Хотя, в окне, назвал это параметрами))

Я, как мне казалось, привел вариант "как стоило бы переделать". Но, вспоминая о том, что все это всего лишь личное мнение...

Сообщение от Alxndr1697 вся программа в комментариях

Советую поискать на youtube видосики от Сергея Немчинского. Он, хотя и джавист, но вещи озвучивает очень серьезные и важные. В том числе и про правило 20/80, про чтение кода, про аналитику кода и все вот это вот.

[Сергей812]

Сообщение от Alxndr1697 Что значит, лезть во внешние переменные?

defun Имя_функции ( аргументы или параметры / локальные переменные)

1. Аргументы могут дублироваться (по имени) произвольное количество раз в разных функциях, но при этом конфликта не будет - так как область видимости аргумента: только внутри функции.
2. Локальные переменные - аналогично.

Сообщение от Alxndr1697 но, в VLA я не понимаю, от слова совсем(((

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

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Кстати, у тебя там не возвращаются обратно системные переменные. И метка окончания отмены не ставится, что может привести к неприятным последствиям.

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

Код:

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

  (setvar "osmode" oldosm)
  (setvar "clayer" oldlay)
  (command-s "._UNDO" "_end")

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

Сообщение от Сергей812 defun Имя_функции ( аргументы или параметры / локальные переменные) 1. Аргументы могут дублироваться (по имени) произвольное количество раз в разных функциях, но при этом конфликта не будет - так как область видимости аргумента: только внутри функции. 2. Локальные переменные - аналогично.

Да, это Browning Zed мне доходчиво объяснил.
Внешние переменные, - это которые в DCL?

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

"Внешние переменные" - это то, что по отношению к какой-то функции не прилетевшее в нее. Пример callback-функции я привел.

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Советую поискать на youtube видосики от Сергея Немчинского. Он, хотя и джавист, но вещи озвучивает очень серьезные и важные. В том числе и про правило 20/80, про чтение кода, про аналитику кода и все вот это вот.

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

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

Сообщение от Alxndr1697 При наличии времени, - час утром и час вечером на занятия, просмотреть более двух сотен видео... Я не собираюсь становиться Программистом. Мне хотелось бы написать (самому) несколько программ, которые облегчат мне работу сегодня и, возможно, обеспечат мне ее в будущем.

Я когда-то тоже так думал У тебя есть два варианта: либо сделать по-нормальному, либо сделать "на отцепись", чтобы хоть как-то работало. Второй вариант плох тем, что через пару-тройку месяцев, когда тебе придется возвращаться в код и пытаться его доработать/улучшить/изменить, тебе будет проще все переписать заново. Ну да дело твое.
Касаемо ошибки: проверяй, какие значения тебе прилетают. Точки останова в помощь ))

[Сергей812]

Offtop:

Сообщение от Alxndr1697 Я не собираюсь становиться Программистом.

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

[Alxndr1697]

Код:

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

(defun insert_fasad (H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right /
	             oldosm oldlay P_0 P_L P_H H_box L_box B_mat_corp B_mat_fas Z_r otst_top otst_bottom otst_left otst_right
	             H_fas_one L_fas H_fas_N Col_vo P_0_fas Fas_one Vibor)

  (command-s "._UNDO" "_be");начало группы для отмены (Begin).
  (defun *error*(msg) 
  (princ msg) 
 )
(command-s "_.UCS" "_w");пск в мск

  (setq P_0 (getpoint "\nУкажите левую внутреннюю нижнюю точку бокса <Отмена> :"))
  (setq P_L (getpoint "\nУкажите правую внутреннюю нижнюю точку бокса <Отмена> :"));ось x
    (if (/= (cadr P_L) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
  (setq P_H (getpoint "\nУкажите левую внутренюю верхнюю точку бокса <Отмена> :")) ;ось z
    (if (/= (cadr P_H) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
   (setq H_box (distance P_0 P_H));высота бокса
   (setq L_box (distance P_0 P_L));длина (ширина) бокса

  (setq oldosm (getvar "osmode")) ;запоминание привязок
  (setvar "osmode" 0)
  (setq oldlay (getvar "clayer"))           ;запоминание текущего слоя
    (if (null (tblsearch "layer" "ФАСАД"))  ;проверка наличия слоя "Фасад"
      (command-s "_.-layer" "_n" "ФАСАД" "");создание нового слоя
     )
      (command-s "_.-layer" "_make" "ФАСАД" "_color" "3" "" "")

  (fasad_naklad)
  (fasad_vklad)

  (if (= Vibor "o_nkl") (fasad_naklad))
  (if (= Vibor "o_vkl") (fasad_vklad))

  (command-s "_.ucs" "x" 90)
  (command-s "_.arrayrect" Fas_N "" "_col" 1 1 "_r" Col_vo (+ H_fas_N Z_r) "" "")

  (command-s "_.UCS" "_w");пск в мск
  

  (setvar "osmode" oldosm)   ;возврат привязок
  (setvar "clayer" oldlay)   ;возврат текущего слоя
  (command-s "._UNDO" "_end");окончание группы для отмены.
  (princ)
   );end defun insert_fasad

Здравствуйте.
С синими строками работают оба варианта (строятся вкладные и накладные фасады).
Как правильно написать условие, чтобы выполнялся один вариант, в зависимости от (= Vibor "o_nkl"), или (= Vibor "o_vkl")?
Мой, красный, конечно же, не работает.

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

См.в сторону cond

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc См.в сторону cond

Вот так, тоже не работает.

Код:

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

  (cond (= Vibor "o_nakl") (fasad_naklad)
	(= Vibor "o_vkl") (fasad_vklad)
    );end cond

----- добавлено через ~6 мин. -----
При прописывании условия, стоки (синие (пост 4209)), убирать, или они должны оставаться?

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

Неправильно.

Код:

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

   (cond ((= Vibor "o_nakl") (fasad_naklad))
	((= Vibor "o_vkl") (fasad_vklad))
    );end cond

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Неправильно.

Точно. Спасибо.
Но, все равно, не работает.
Отдельно (fasad_naklad), - работает. Отдельно (fasad_vklad), - работает.
Вместе и с (cond), - строит оба варианта, только у накладного, почему-то не срабатывает команда "массив"

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

Не хочу вникать в логику, но я бы подумал на предмет заменить

Код:

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

(fasad_naklad)
  (fasad_vklad)

  (if (= Vibor "o_nkl") (fasad_naklad))
  (if (= Vibor "o_vkl") (fasad_vklad))

на

Код:

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

 (cond ((= Vibor "o_nkl") (fasad_naklad))
  ((= Vibor "o_vkl") (fasad_vklad)))

[Alxndr1697]

Так, тоже пробовал:

[koMon]

Очевидно, что надо посмотреть, что находится в переменных H_fas_N, Z_r на момент выполнения команды array в проблемной сумме, яд.

[Alxndr1697]

Сообщение от koMon Очевидно, что надо посмотреть, что находится в переменных H_fas_N, Z_r на момент выполнения команды array в проблемной сумме, яд.

Удивительно, но и в рабочем варианте и в нерабочем, одно и то же.

----- добавлено через ~5 мин. -----
А вот Vibor, почему-то, - nil. Может тут собака зарыта?

----- добавлено через ~8 мин. -----
При включении обеих функций Vibor работает корректно. Мой мозг отказывается что-то понимать

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

Сообщение от Alxndr1697 Так, тоже пробовал:

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

[Alxndr1697]

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

Диалоговое окно:

Код:

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

dialog_fasad_sup: dialog {label = "Фасад ящика (горизонтальный)";
:spacer{height=1;}
:column {label = "Точки ввода :";
:spacer{height=1;}
:image {key = "sld"; width  = 15; aspect_ratio = 1.8; color= 4;}
        }//end column точки ввода
:spacer{height=1;}
:boxed_column {label = "Параметры фасада :";
:spacer{height=1;}
:radio_row {key = "Tip_f"; label = "Тип фасада :";
                           
            :radio_button {key = "o_nkl"; label = "Накладной"; value = "1";}
            :radio_button {key = "o_vkl"; label = "Вкладной"; value = "0";}
            }//end radio_row
                                                :spacer{height=1;}
:row {:boxed_column {:boxed_column {label = "Количество фасадов :";
:spacer{height=1;}
             :edit_box {key = "o_Col_vo";         label = "Количество :";               value = "1";   edit_width = 4;}
               }//end column количество
:spacer{height=2;}
:boxed_column {label = "Толщина материала :";
             :edit_box {key = "o_B_mat_fas";      label = "Фасада :";                   value = "16";   edit_width = 4;}
             :edit_box {key = "o_B_mat_corp";     label = "Корпуса :";                  value = "16";   edit_width = 4;}
               }//end column толщина материала
               }
:spacer{height=1;}             
:boxed_column {label = "Зазоры фасада :";
//:spacer{height=1;}
             :edit_box {key = "o_Z_r";            label = "Зазор между фасадами :";     value = "3";   edit_width = 4;}
             :edit_box {key = "o_otst_up_front";  label = "Отступ от корпуса вперед :"; value = "0";   edit_width = 4;}
             :edit_box {key = "o_otst_top";       label = "Отступ сверху :";            value = "1.5"; edit_width = 4;}
             :edit_box {key = "o_otst_bottom";    label = "Отступ снизу :";             value = "1.5"; edit_width = 4;}
             :edit_box {key = "o_otst_left";      label = "Отступ слева :";             value = "1.5"; edit_width = 4;}
             :edit_box {key = "o_otst_right";     label = "Отступ справа :";            value = "1.5"; edit_width = 4;}
               }//end column зазоры
               }//end row
}//end параметры фасада

:spacer{height=1;}
:boxed_row {label = "";
             ok_cancel;}

       
                         }//end dialog

Программа:

Код:

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

;***************************Функция add_name*********************************

(defun add_name (Part_name / le edata le2 )
(regapp "AVCNames")                                                  ;регистрация приложения ""AVCNames""
(setq le (entget (entlast)))                                         ;получение списка данных последнего примитива
(setq edata (list (list -3 (list "AVCNames" (cons 1000 Part_name)))));формирование подсписка расширенных данных и включение в список
(setq le2 (append le edata))                                         ;присоединение расширенных данных к примитиву
(entmod le2)                                                         ;обновление примитива
(entget (entlast) '("AVCNames"))                                     ;проверка данных примитива
 );end add_name

;**************************функция param_fasad*******************************

 (defun param_fasad (/ )

   (setq Vibor (get_tile "Tip_f"))
   
   (setq Col_vo (atof (get_tile "o_Col_vo")));считывание и преобразование из строкового в число и сохранение
   (setq B_mat_fas (atof (get_tile "o_B_mat_fas")))
   (setq B_mat_corp (atof (get_tile "o_B_mat_corp")))
   (setq Z_r (atof (get_tile "o_Z_r")))
   (setq otst_up_front (atof (get_tile "o_otst_up_front")))
   (setq otst_top (atof (get_tile "o_otst_top")))
   (setq otst_bottom (atof (get_tile "o_otst_bottom")))
   (setq otst_left (atof (get_tile "o_otst_left")))
   (setq otst_right (atof (get_tile "o_otst_right")))
   );end param_fasad

;**************************функция insert_fasad*****************************

(defun insert_fasad (H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right /
	             oldosm oldlay P_0 P_L P_H H_fas_N H_fas_one L_fas P_0_fas Fas_one Vibor)
	             

  (command-s "._UNDO" "_be");начало группы для отмены (Begin).
  (defun *error*(msg) 
  (princ msg) 
 )
(command-s "_.UCS" "_w");пск в мск

  (setq P_0 (getpoint "\nУкажите левую внутреннюю нижнюю точку бокса <Отмена> :"))
  (setq P_L (getpoint "\nУкажите правую внутреннюю нижнюю точку бокса <Отмена> :"));ось x
    (if (/= (cadr P_L) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
  (setq P_H (getpoint "\nУкажите левую внутренюю верхнюю точку бокса <Отмена> :")) ;ось z
    (if (/= (cadr P_H) (cadr P_0))
      (progn (alert (strcat "Неверная точка. Точка должна лежать в плоскости XZ"))
       (exit))
     )
   (setq H_box (distance P_0 P_H));высота бокса
   (setq L_box (distance P_0 P_L));длина (ширина) бокса

  (setq oldosm (getvar "osmode")) ;запоминание привязок
  (setvar "osmode" 0)
  (setq oldlay (getvar "clayer"))           ;запоминание текущего слоя
    (if (null (tblsearch "layer" "ФАСАД"))  ;проверка наличия слоя "Фасад"
      (command-s "_.-layer" "_n" "ФАСАД" "");создание нового слоя
     )
      (command-s "_.-layer" "_make" "ФАСАД" "_color" "3" "" "")

  (fasad_naklad)
  (fasad_vklad)

;;;  (if (= Vibor "o_nkl") (fasad_naklad))
;;;  (if (= Vibor "o_vkl") (fasad_vklad))
(cond ((= Vibor "o_nakl") (fasad_naklad))
      ((= Vibor "o_vkl") (fasad_vklad))
 );end cond


  (command-s "_.ucs" "x" 90)
  (command-s "_.arrayrect" Fas_N "" "_col" 1 1 "_r" Col_vo (+ H_fas_N Z_r) "" "")

  (command-s "_.UCS" "_w");пск в мск
  

  (setvar "osmode" oldosm)   ;возврат привязок
  (setvar "clayer" oldlay)   ;возврат текущего слоя
  (command-s "._UNDO" "_end");окончание группы для отмены.
  (princ)
   );end defun insert_fasad

;**************************функция fasad_naklad*****************************************
   
 (defun fasad_naklad ( /)
      (setq H_fas_one (- (- (+ H_box (* 2 B_mat_corp)) otst_top) otst_bottom))  
      (setq L_fas (- (- (+ L_box (* 2 B_mat_corp)) otst_left) otst_right))
      (setq H_fas_N (/ (- H_fas_one (* Z_r (1- Col_vo))) Col_vo))
      (setq P_0_fas (list (+ (- (car P_0) B_mat_corp) otst_left) (- (cadr P_0) otst_up_front) (+ (- (caddr P_0) B_mat_corp) otst_bottom)))

	(command-s "_.box" P_0_fas (list (+ (car P_0_fas) L_fas) (- (- (cadr P_0_fas) B_mat_fas) otst_up_front) (+ (caddr P_0_fas) H_fas_N)))
	(setq Fas_N (entlast))
        (if (not (equal Fas_N (entlast))) (alert "Построение не удалось"))
        (add_name "Фасад")
        (princ)
   )
;***************************функция fasad_vklad****************************************

(defun fasad_vklad ( /)
     (setq H_fas_one (- (- H_box otst_top) otst_bottom))  
     (setq L_fas (- (- L_box otst_left) otst_right))
     (setq H_fas_N (/ (- H_fas_one (* Z_r (1- Col_vo))) Col_vo))
     (setq P_0_fas (list (+ (car P_0) otst_left) (- (+ (cadr P_0) B_mat_fas) otst_up_front) (+ (caddr P_0) otst_bottom)))

       (command-s "_.box" P_0_fas (list (+ (car P_0_fas) L_fas) (- (cadr P_0_fas) B_mat_fas) (+ (caddr P_0_fas) H_fas_N)))
       (setq Fas_N (entlast))
       (if (not (equal Fas_N (entlast))) (alert "Построение не удалось"))
       (add_name "Фасад")
       (princ)
  )

;*****************************Функция Slide**********************************

  (defun slide (/ dx dy)
    (setq dx (dimx_tile "sld")
	  dy (dimy_tile "sld"))
    (start_image "sld")
    (slide_image -1  -1  (1+ dx) (1+ dy) "2" )
    (end_image)
   );end slide

;***************************Основная программа**********************************

(DEFUN c:fasad_sup (/ dcl_id ddi)
  (setq dcl_id (load_dialog "D:/MyLISP/002_FASAD/dialog_fasad_sup.DCL"));загрузка диалога и запоминание под номером
  (if (not (new_dialog "dialog_fasad_sup" dcl_id)) (exit))            ;проверка, если не загружен, - выход
  (action_tile "accept" "(param_fasad) (slide) (done_dialog 1)");ок закрыть диалог под номером 1
  (action_tile "cancel" "(done dialog 0)")                      ;отмена закрыть диалог под номером 0
  (setq ddi (start_dialog))                                     ;ф считывает значение, с которым было закрыто диалоговое окно и сохраняет в переменной ddi
  (unload_dialog dcl_id)                                        ;выгрузка файла диалога после закрытия окна

(if (= ddi 1) (insert_fasad H_box L_box Col_vo B_mat_fas B_mat_corp Z_r otst_up_front otst_top otst_bottom otst_left otst_right)
 )
(princ)

   );end defun fasad_sup

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

Сравни свой кусок кода (для начала):

Код:

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

   (fasad_naklad)
  (fasad_vklad)

;;;  (if (= Vibor "o_nkl") (fasad_naklad))
;;;  (if (= Vibor "o_vkl") (fasad_vklad))
  (cond ((= vibor "o_nakl") (fasad_naklad))
        ((= vibor "o_vkl") (fasad_vklad))
  )       ;end cond

и то, что я тебе говорил.

Сообщение от Кулик Алексей aka kpblc Не хочу вникать в логику, но я бы подумал на предмет заменить Код: [Выделить все] (fasad_naklad) (fasad_vklad) (if (= Vibor "o_nkl") (fasad_naklad)) (if (= Vibor "o_vkl") (fasad_vklad)) на Код: [Выделить все] (cond ((= Vibor "o_nkl") (fasad_naklad)) ((= Vibor "o_vkl") (fasad_vklad)))

И что в диалоге делает image, когда он там нафиг не нужен? Судя по коду единственное место, где он хоть какое-то получает значение - это нажатие на кнопку ОК. Учитывая, что диалог достаточно быстро закрывается, углядеть, что там поменялось (и поменялось ли) невозможно.
Код переписывать лениво.

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Сравни свой кусок кода (для начала):

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

Сообщение от Кулик Алексей aka kpblc И что в диалоге делает image, когда он там нафиг не нужен? Судя по коду единственное место, где он хоть какое-то получает значение - это нажатие на кнопку ОК. Учитывая, что диалог достаточно быстро закрывается, углядеть, что там поменялось (и поменялось ли) невозможно.

Считаю, было бы интересно в диалоговом окне иметь схему указания точек. Но, очередное "не знаю" не позволило это сделать. Конкретно,- не получается сделать слайд (задавал вопрос в профильной теме, но там тишина). Удалять не стал, оставил на потом.

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

Понимаю

----- добавлено через ~12 мин. -----
Не могу понять, почему при "некорректно" работающей программе (включены (fasad_naklad) и (fasad_vklad)), Vibor возвращает "o_nkl", или "o_vkl", как и положено, а при удалении этих строк, Vibor возвращает nil.

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

А разве vibor функция, чтобы что-то возвращать? По-моему, это все же переменная, в которой что-то хранится. Не путай теплое с мягким. Как лично у меня выглядел бы код (правда, без основной реализации построения - на это уже нет ни времени, ни сил):

Код:

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

 (vl-load-com)

(defun multibox (/ fun_facade-callback fun_conv-to-int fun_conv-to-real dcl_file dcl_handle dcl_id dcl_res dcl_lst sysvar low_left_point low_right_point
                 up_left_point
                )

  (defun _kpblc-list-add-or-subst (lst key value)
    (if (not value)
      (vl-remove-if (function (lambda (x) (= (car x) key))) lst)
      (if (cdr (assoc key lst))
        (subst (cons key value) (assoc key lst) lst)
        (cons (cons key value) (vl-remove-if (function (lambda (x) (= (car x) key))) lst))
      ) ;_ end of if
    ) ;_ end of if
  ) ;_ end of defun

  (defun fun_conv-to-int (string)
    (atoi (vl-string-trim " " string))
  ) ;_ end of defun

  (defun fun_conv-to-real (string)
    (atof (vl-string-subst "." "," (vl-string-trim " " string)))
  ) ;_ end of defun

  (defun fun_facade-callback (key value ref-list)
    (cond
      ((= key "o_nkl")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "type" "outside"))
      )
      ((= key "o_vkl")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "type" "inside"))
      )
      ((= key "o_col_vo")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "range" (fun_conv-to-int value)))
      )
      ((= key "o_b_mat_fas")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "thick_facade" (fun_conv-to-int value)))
      )
      ((= key "o_b_mat_corp")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "thick_box" (fun_conv-to-int value)))
      )
      ((= key "o_z_r")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "space_facades" (fun_conv-to-int value)))
      )
      ((= key "o_otst_up_front")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "front" (fun_conv-to-real value)))
      )
      ((= key "o_otst_top")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "top" (fun_conv-to-real value)))
      )
      ((= key "o_otst_bottom")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "bottom" (fun_conv-to-real value)))
      )
      ((= key "o_otst_left")
       (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "left" (fun_conv-to-real value)))
      )
    ) ;_ end of cond
    ((= key "o_otst_right")
      (set ref-list (_kpblc-list-add-or-subst (eval ref-list) "right" (fun_conv-to-real value)))
    )
  ) ;_ end of defun


  (setq dcl_file   (strcat (vl-string-right-trim
                             "\\"
                             (vla-get-tempfilepath (vla-get-files (vla-get-preferences (vlax-get-acad-object))))
                           ) ;_ end of VL-STRING-RIGHT-TRIM
                           "\\dlg.dcl"
                   ) ;_ end of strcat
        dcl_handle (open dcl_file "w")
  ) ;_ end of setq

  (foreach item '("dialog_fasad_sup: dialog {label = \"Фасад ящика (горизонтальный)\";" "	:spacer{height=1;}" "	:column {label = \"Точки ввода :\";"
                  "		:spacer{height=1;}" "		:image {key = \"sld\"; width  = 15; aspect_ratio = 1.8; color= 4;}" "	}" "	:spacer{height=1;}"
                  "	:boxed_column {label = \"Параметры фасада :\";" "		:spacer{height=1;}"
                  "		:radio_row {key = \"tip_f\"; label = \"Тип фасада :\";" "			:radio_button {key = \"o_nkl\"; label = \"Накладной\";}"
                  "			:radio_button {key = \"o_vkl\"; label = \"Вкладной\";}" "		}" "		:spacer{height=1;}" "		:row {"
                  "			:boxed_column {" "				:boxed_column {label = \"Количество фасадов :\";"
                  "					:spacer{height=1;}" "					:edit_box {key = \"o_col_vo\"; label = \"Количество :\"; edit_width = 4;}"
                  "				}" "				:spacer{height=2;}" "				:boxed_column {label = \"Толщина материала :\";"
                  "					:edit_box {key = \"o_b_mat_fas\"; label = \"Фасада :\"; edit_width = 4;}"
                  "					:edit_box {key = \"o_b_mat_corp\"; label = \"Корпуса :\"; edit_width = 4;}" "				}"
                  "			}" "			:spacer{height=1;}" "			:boxed_column {label = \"Зазоры фасада :\";"
                  "				:edit_box {key = \"o_z_r\"; label = \"Зазор между фасадами :\"; edit_width = 4;}"
                  "				:edit_box {key = \"o_otst_up_front\"; label = \"Отступ от корпуса вперед :\";  edit_width = 4;}"
                  "				:edit_box {key = \"o_otst_top\"; label = \"Отступ сверху :\"; edit_width = 4;}"
                  "				:edit_box {key = \"o_otst_bottom\"; label = \"Отступ снизу :\"; edit_width = 4;}"
                  "				:edit_box {key = \"o_otst_left\"; label = \"Отступ слева :\"; edit_width = 4;}"
                  "				:edit_box {key = \"o_otst_right\"; label = \"Отступ справа :\"; edit_width = 4;}" "			}"
                  "		}//end row" "	}//end параметры фасада" "	:spacer{height=1;}" "	:boxed_row {label = \"\";" "		ok_cancel;" "	}"
                  "}"
                 )
    (write-line item dcl_handle)
  ) ;_ end of foreach
  (close dcl_handle)

  (setq dcl_id (load_dialog dcl_file))
  (new_dialog "dialog_fasad_sup" dcl_id "(fun_facade-callback $key $value 'dcl_lst)")
  (action_tile "accept" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)")
  (foreach item '(("o_nkl" . "1")
                  ("o_col_vo" . "1")
                  ("o_b_mat_fas" . "16")
                  ("o_b_mat_corp" . "16")
                  ("o_z_r" . "3")
                  ("o_otst_up_front" . "0")
                  ("o_otst_top" . "1.5")
                  ("o_otst_bottom" . "1.5")
                  ("o_otst_left" . "1.5")
                  ("o_otst_right" . "1.5")
                 )
    (set_tile (car item) (cdr item))
    (fun_facade-callback (car item) (cdr item) 'dcl_lst)
  ) ;_ end of foreach

  (setq dcl_res (start_dialog))
  (unload_dialog dcl_id)
  (if (= dcl_res 1)
    (progn

      (if (and (= (type (setq low_left_point
                               (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 =
               low_left_point
          ) ;_ end of and
        (if (and (= (type (setq low_right_point
                                 (vl-catch-all-apply
                                   (function (lambda ()
                                               (getpoint low_left_point "\nУкажите правую внутреннюю нижнюю точку бокса <Отмена> :")
                                             ) ;_ end of lambda
                                   ) ;_ end of function
                                 ) ;_ end of vl-catch-all-apply
                          ) ;_ end of setq
                    ) ;_ end of type
                    'list
                 ) ;_ end of =
                 low_right_point
            ) ;_ end of and
          (if (and (= (type (setq up_left_point
                                   (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 =
                   up_left_point
              ) ;_ end of and
            (progn
              ;; Вот здесь в dcl_lst уже хранятся все необходимые данные. Теперь их можно разобрать и посмотреть, что и в каком месте строить.
              ;; Дополнительные проверки можно втыкать где угодно.
            )
            (princ "\nОтмена указания левой внутренней верхней точки бокса")
          ) ;_ end of if
          (princ "\nОтмена указания правой внутренней нижней точки бокса")
        ) ;_ end of if
        (princ "\nОтмена указания левой внутренней нижней точки бокса")
      ) ;_ end of if
    ) ;_ end of progn
    (princ "\nБыла нажата кнопка \"Отмена\"")
  ) ;_ end of if

  (princ)
) ;_ end of defun

[Alxndr1697]

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

Сообщение от Кулик Алексей aka kpblc А разве vibor функция, чтобы что-то возвращать? По-моему, это все же переменная, в которой что-то хранится.

Да, имел ввиду, что переменная принимает значение...

----- добавлено через ~2 мин. -----
Жаль конечно, что моя программа не заработает

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

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

[ShaggyDoc]

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

Исчо бы в функцию вынести

Код:

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

 (vl-catch-all-apply
                                 (function (lambda ()
                                             (getpoint "\nУкажите левую внутреннюю нижнюю точку бокса <Отмена> : ")
                                           ) 
                                 ) 
                               )

Alxndr1697, если "нет времени", то надо писать сразу правильно, структурированно. Как Алексей сделал.

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

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

Offtop:

Сообщение от ShaggyDoc Исчо бы в функцию вынести

Конечно, стоило бы. Но на практике я все время забываю это сделать

[Alxndr1697]

Подскажите, как создать группу?
В командной строке, - команда, выбор объектов, ентер.
Пишу в программе (command-s "_.group" Bok_l Bok_r N_p Fr_ass ""), - не работает.

Код:

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

(command-s "_.group" Bok_l Bok_r N_p Fr_ass "")

[Alxndr1697]

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

Код:

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

(if (> Col_vo 1)
  (progn
  (command-s "_.copy" Bok_l Bok_r N_p Front_sh Back_sh "" P_0 (list (car P_0) (cadr P_0) (+ (caddr P_0) (- (+ H_fasad Z_r) 19.5))) "");второй ящик

   (command-s "_.ucs" "x" 90)
   (command-s "_.arrayrect" (entlast) "" "_col" 1 1 "_r" (1- Col_vo) (+ H_fasad Z_r) "" "")
   (command-s "_.UCS" "_w")
  );end progn
);end if

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

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

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Создавай объекты некомандными методами

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

Сообщение от Кулик Алексей aka kpblc И насколько тебе нужен именно массив?

Другого способа не вижу.

Сообщение от Кулик Алексей aka kpblc Может, проще будет вообще все в блок засовывать сразу?

Пробовал. Все равно, надо выбирать "второй" блок и проблема (для меня) в том, что если в рисунке предполагается потом рисовать ящики с другими параметрами, вставляется этотже блок. Решения не нашел. Хотел попробовать через группу, - не получилось, да и проблема с выбором осталась бы, наверное.

----- добавлено через ~2 мин. -----
Комп еще поломался(((

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

Чего там изучать-то?

(vl-load-com)
(defun c:Example_AddBox()
;; This example creates a box in model space.
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))

;; Define the box
(setq center (vlax-3d-point 5 5 0)
boxLength 5
boxWidth 7
boxHeight 10)

;; Create the box (3DSolid) object in model space
(setq modelSpace (vla-get-ModelSpace doc))
(setq boxObj (vla-AddBox modelSpace center boxLength boxWidth boxHeight))

;; Change the viewing direction of the viewport to better see the box
(setq NewDirection (vlax-3d-point -1 -1 1))
(setq activeViewport (vla-get-ActiveViewport doc))
(vla-put-Direction activeViewport NewDirection)
(vla-put-ActiveViewport doc activeViewport)
(vla-ZoomAll acadObj)
)

По общей идеологии:

1. Создать описание анонимного блока
2. Внутрь блока добавлять создаваемые солиды, слегка переделав пример из справки
3. Вставить блок. В принципе, отдельная и очень большая тема, если не поступать "по-простому" - запросить точку вставки и в нее зашарашить вставку, без отрисовки.

Код:

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

 (defun fun_create-box-low-left-point (where low-left-point len width height / center res)
                                     ;|
  *    Создание "бокса"
  *    Параметры вызова:
    where          ; vla-указатель на владельца
    low-left-point ; левая нижняя точка в WCS
    len            ; длина ящика (oX)
    width          ; ширина ящика (oY)
    height         ; высота ящика (oZ)
  *    Возвращает vla-указатель на созданный бокс или nil
  *    Примеры вызова:
  (fun_create-box-low-left-point (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) '(0. 0. 0.) 20 40 60)
  |;
  (setq center (mapcar (function (lambda (a b) (* (+ a b) 0.5))) low-left-point (list len width height)))
  (if (vl-catch-all-error-p
        (setq res (vl-catch-all-apply
                    (function
                      (lambda ()
                        (vla-addbox where (vlax-3d-point center) len width height)
                      ) ;_ end of lambda
                    ) ;_ end of function
                  ) ;_ end of vl-catch-all-apply
        ) ;_ end of setq
      ) ;_ end of vl-catch-all-error-p
    (progn
      (princ (strcat "\nError creating box : " (vl-catch-all-error-message res)))
      nil
    ) ;_ end of progn
    res
  ) ;_ end of if
) ;_ end of defun

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Чего там изучать-то?

Легко Вам говорить)))

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

У меня, почему-то, не работает.

Сообщение от Alxndr1697 Подскажите, как выбрать второй ящик, для создания массива?

Неужели нет решения? Осталась только эта команда для завершения.

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

Сообщение от Alxndr1697 У меня, почему-то, не работает.

Че ета не работает? Пример вызова есть, функция возвращает vla-указатель на созданный бокс. vla-copy для него, vla-move для созданной копии - и вперед!

----- добавлено через 35 сек. -----
В качестве подсказки: http://www.cad.dp.ua/stats/vla_doc.php

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc vla-указатель на созданный бокс. vla-copy для него, vla-move для созданной копии - и вперед!

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

----- добавлено через 55 сек. -----

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

Полюбасу, чета не так делаю)))

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

Сообщение от Кулик Алексей aka kpblc В качестве подсказки: http://www.cad.dp.ua/stats/vla_doc.php

Добавил в закладки

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

Сообщение от Alxndr1697 Я правильно понял мысль, - создать ящик, потом необходимое количество его копий и перемещать копии в нужные места, так?

Можно и так.

Сообщение от Alxndr1697 Полюбасу, чета не так делаю)))

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

Код:

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

 (setq a (fun_create-box-low-left-point (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) '(0. 0. 0.) 20 40 10))
(vla-put-color a 1)

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Попробуй вызов,

Набираю в командной строке (fun_create-box-low-left-point), Энтер, - выкидывает в окно редактора.

----- добавлено через ~3 мин. -----
(vl-load-com) пробовал добавлять и как команду назначал. С тем же результатом.

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

Сообщение от Alxndr1697 Набираю в командной строке (fun_create-box-low-left-point), Энтер, - выкидывает в окно редактора. ----- добавлено через ~3 мин. ----- (vl-load-com) пробовал добавлять и как команду назначал. С тем же результатом.

Эммм... Вот это

Код:

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

*    Примеры вызова:
	  (fun_create-box-low-left-point (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) '(0. 0. 0.) 20 40 60)

я для кого делал?

[koMon]

Сообщение от Alxndr1697 Подскажите, как выбрать второй ящик, для создания массива?

ятд надо создать выборку объектов, которую затем можно запихнуть в массив:

Код:

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

(if (> Col_vo 1)
  (progn

  (setq entity (entlast))

  (command-s "_.copy" Bok_l Bok_r N_p Front_sh Back_sh "" P_0 (list (car P_0) (cadr P_0) (+ (caddr P_0) (- (+ H_fasad Z_r) 19.5))) "") ;второй ящик
   (command-s "_.ucs" "x" 90)

 	
 	(setq box_lower_sset (ssadd))
	(while (setq entity (entnext entity))
		(setq box_lower_sset (ssadd entity box_lower_sset))
	)

   (command-s "_.arrayrect" box_lower_sset "" "_col" 1 1 "_r" (1- Col_vo) (+ H_fasad Z_r) "" "")
   (command-s "_.UCS" "_w")
  );end progn
);end if

и касательно построения 3d боксов, почему бы не озадачиться вставкой единичных блоков боксов с масштабами по осям координат, равными исполнительным размерам составляющих и удобной точкой вставки (заранее определённого или сделанного на лету)? и пск крутить вертеть, это как-то несерьёзно)
и командные методы, тут я согласен с Алексеем, надо юзать activex!)

[Alxndr1697]

Сообщение от Кулик Алексей aka kpblc Эммм... Вот это я для кого делал?

Заработало

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

Сообщение от koMon и касательно построения 3d боксов

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

----- добавлено через ~17 мин. -----
koMon Спасибо!!! Все получилось!

[Alxndr1697]

Объясните, пожалуйста, в строке:

Код:

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

(while (setq entity (entnext entity))

вычисляется последующий примитив от переменной entity. Почему он запоминается под тем же именем? Ведь эта переменная уже используется выше.

[Сергей812]

ну так сами же написали

Сообщение от Alxndr1697 (setq entity

[Alxndr1697]

Сообщение от Сергей812 ну так сами же написали

Источник вопроса был парой постов выше (4238)

[koMon]

Сообщение от Alxndr1697 Тут, видимо произошло некоторое недопонимание.

Да нет, я именно предлагал заменить рисование 3d боксов, команда box, вставкой блоков. Правда для операций вычитание... потребуется их членить.

Сообщение от Alxndr1697 Почему он запоминается под тем же именем?

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

[Alxndr1697]

Сообщение от koMon Потому что никто не запрещает её использовать так) последовательно назначать ей следующий примитив после отрисовки второго ящика после последнего до операции отрисовки второго ящика до окончания примитивов базы. Как-то так, но сам вопрос не очень понятен.

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

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

"Имя" = "наименование переменной"?

[koMon]

Сообщение от Alxndr1697 Я попробовал изменить имя (мне так показалось логичней),- ан нет, работать перестало. Вот и получается, что имя именно должно быть неизменным, а почему, мне не понятно. Хочу понять логику, когда переменная может переопределяться в процессе работы программы, а когда нет.

заменить Entity на другое? При замене не работает? Быть такого не могёт! надо во всём красном заменить Entity на что-то другое, лучше автозаменой)

[Alxndr1697]

Прошу прощения за задержку, - умчался на работу.

Сообщение от Кулик Алексей aka kpblc "Имя" = "наименование переменной"?

Да.

Сообщение от koMon заменить Entity на другое? При замене не работает? Быть такого не могёт! надо во всём красном заменить Entity на что-то другое, лучше автозаменой)

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

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

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

[Alxndr1697]

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

Почему наименование переменной должно оставаться тем же?

[Сергей812]

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

И строка

Код:

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

 (setq box_lower_sset (ssadd entity box_lower_sset))

разве нужно пересохранять набор после добавления значения? Или просто по аналогии с созданием пустого набора

Код:

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

 (setq box_lower_sset (ssadd))

написано?

[Alxndr1697]

Сообщение от Сергей812 разве нужно пересохранять набор после добавления значения?

Можно не пересохранять.

[Alxndr1697]

Сообщение от Сергей812 если переменная больше не нужна - ее можно использовать повторно. Поскольку в лиспе динамическая типизация - то переменной можно присвоить любое другое значение.

Понял.

Для меня непонятным остается, почему, в данном примере, нельзя переименовать (создать новую) "синюю" переменную? Это я думаю, что она новая, а получается, что они все связаны. Как?

[koMon]

(setq entity(1) (entlast)) ; записываем в переменную entity последний примитив базы
; к базе добавляются примитивы...

(while (setq entity(2) (entnext entity(1))...) ; записываем в переменную entity примитив следующий за примитивом, который записан в переменную entity

(setq box_lower_sset (ssadd entity(2) box_lower_sset)) ; добавляем в набор примитив, записанный в переменную entity

entity(1) и entity(2) связаны непосредственно.
в первой итерации цикла while в entity(2) записывается примитив, который следует за примитивом, который записан в переменную entity(1) и который затем добавляется в набор box_lower_sset. итерации продолжаются до окончания примитивов в базе. то есть мы используем переменную entity для записи в неё каждого следующего примитива после маркировки последнего примитива и до добавления объектов второго ящика.
всё логично и лаконично.
но, если ну прямо, ну вот хочется поменять имя переменной в цикле while (не могу понять зачем), то придётся вводить новую переменную. хотя я опять сильно сомневаюсь в этом ли суть вопроса?) или какая суть вопроса?)

Код:

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

(if (> Col_vo 1)
  (progn
  	(setq entity (entlast))
  	(command-s "_.copy" Bok_l Bok_r N_p Front_sh Back_sh "" P_0 (list (car P_0) (cadr P_0) (+ (caddr P_0) (- (+ H_fasad Z_r) 19.5))) "") ;второй ящик
   	(command-s "_.ucs" "x" 90)
 	(setq box_lower_sset (ssadd))
	(setq another_var entity) 
	(while (setq another_var (entnext another_var))
		(setq entity another_var)
		(setq box_lower_sset (ssadd entity box_lower_sset))
	)
   (command-s "_.arrayrect" box_lower_sset "" "_col" 1 1 "_r" (1- Col_vo) (+ H_fasad Z_r) "" "")
   (command-s "_.UCS" "_w")
  );end progn
);end if

[Сергей812]

Сообщение от Alxndr1697 Это я думаю, что она новая, а получается, что они все связаны. Как?

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

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

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

[Alxndr1697]

koMon, Сергей812 Спасибо, разобрался.

Сообщение от koMon но, если ну прямо, ну вот хочется поменять имя переменной в цикле while (не могу понять зачем), то придётся вводить новую переменную. хотя я опять сильно сомневаюсь в этом ли суть вопроса?) или какая суть вопроса?)

Не-не. Переименовывал лишь для того, чтобы подтвердить, что:

Сообщение от koMon entity(1) и entity(2) связаны непосредственно.

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

Код:

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

(if (> Col_vo 1)
  (progn
  	(setq entity (entlast))
  	(command-s "_.copy" Bok_l Bok_r N_p Front_sh Back_sh "" P_0 (list (car P_0) (cadr P_0) (+ (caddr P_0) (- (+ H_fasad Z_r) 19.5))) "") ;второй ящик
   	(command-s "_.ucs" "x" 90)
 	(setq box_lower_sset (ssadd))
	(setq another_var entity) 
	(while (setq another_var (entnext another_var))

		(setq box_lower_sset (ssadd another_var box_lower_sset))
	)
   (command-s "_.arrayrect" box_lower_sset "" "_col" 1 1 "_r" (1- Col_vo) (+ H_fasad Z_r) "" "")
   (command-s "_.UCS" "_w")
  );end progn
);end if

[Сет]

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

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

(vla-put-displaylocked <vla-указатель> :vlax-true)
P.S. Здесь обучение лиспу, если что.

[koMon]

Сообщение от Сет заблокировать все видовые экраны на всех листах

Код:

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

 (vlax-for p_space (setq layout_collection (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))))
	(princ "\n==================")
	(if (/= "Model" (vla-get-name p_space))
		(progn
			(princ "\n")
			(princ (vla-get-name p_space)) 
			(princ "\n")
			(repeat (sslength (setq index 0 l_viewports (ssget "_x" (list (cons 0 "viewport")(cons 410 (vla-get-name p_space))))))
				(if (not (equal (ssname l_viewports index)
						   		(cdr (assoc 331 (entget (vlax-vla-object->ename (vla-item layout_collection (vla-get-name p_space))))))
						 )
					)
					(if (zerop (vlax-get (vlax-ename->vla-object (ssname l_viewports index)) 'displaylocked))
						(vla-put-displaylocked (vlax-ename->vla-object (ssname l_viewports index)) :vlax-true)
					)
				)
				(princ "\rViewport count: ")
				(setq index (1+ index))
				(princ (1- index))
			)
		)
	)
)
(princ)

[fomichev.147]

Добрый день. Сейчас осваиваю программирование на LISP

Хочу сделать блок при помощи activeX
Блок простой. Две отрезка под углом с сопряжением.
Знаю как создать отрезки (при помjщи метода addline), но вот метода для создания сопряжения не нашел.
Какой метод использовать что бы создать сопряжение между отрезками при помощи activeX?

[Сергей812]

применить к построенным отрезкам vl-cmdf "_FILLET", затем запихать в блок

[fomichev.147]

Сообщение от Сергей812 применить к построенным отрезкам vl-cmdf "_FILLET", затем запихать в блок

А как мне добавить созданию дугу в блок, если с линиями я пользуюсь методом "vla-adline" то вот для созданной дуги не могу найти метода

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

vla-addarc
Правда, придется вычислять вообще все

[Сергей812]

ну в данном случае хэндлы у отрезков не меняются после _Fillet, а дугу можно через entlast получить

[fomichev.147]

Вот кусок кода который хочу сделать. Упражнение просто для обучения. Блок из двух отрезков с сопряжением. ранее сделал такой же без ActiveX.

Насколько я понял дугу в блок можно запихать (по аналогии с линиями) только при помощи vla-addarc. другого пути нет?

Может есть метод что бы запихнуть в блок вместе с линиями произвольный (в моем случае уже созданную дугу) vla Объект ?

Код:

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

(vl-load-com)
  (setq acad_object (vlax-get-acad-object));указатель на программу autocad
  (setq active_document (vla-get-activedocument acad_object));указатель на актинвый документ
  (setq model_space (vla-get-modelspace active_document));указатель на пространства модели

  
  (setq p1 (getpoint "\nУкажите базову точку: "));запрос базовой точки
  (setq DL1 (getreal "\Кажите длину1 элемента"))
  (setq DL2 (getreal "\Кажите длину2 элемента"))
  (setq p2 (mapcar '+ p1 (list DL1 0)))
  (setq p3 (mapcar '+ p2 (list 0 DL2)))

  
  (setq bl_name (strcat "Г+сопр" (rtos DL1)" " (rtos DL2)));задаем имя блока
  
  (if (not(tblsearch "block" bl_name)); проверяем есть ли такой блок
    (progn

      (setq mp_blok (vla-add (vla-get-blocks active_document)(vlax-3d-point p1) bl_name))

      (vla-addline blk1 (vlax-3d-point p1) (vlax-3d-point p2))
      (setq nl1 (entlast))
      (vla-addline mp_blok (vlax-3d-point p2) (vlax-3d-point p3))
      (setq nl2 (entlast))
      (vl-cmdf "_fillet" nl1 nl2 "")
      (setq s (vlax-ename->vla-object(entlast)));и вот дальше не знаю как 
               
      );end progn
    );end if

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

Команда не сработает. Я бы добавлял примитивы в пространство модели, делал над ними соответствующие операции, а потом уже указатели на отрезки + entlast (полученный в результате _.fillet) загонял в блок. Это (как мне кажется) будет одним из самых простых способов.

[fomichev.147]

Сообщение от Кулик Алексей aka kpblc Команда не сработает. Я бы добавлял примитивы в пространство модели, делал над ними соответствующие операции, а потом уже указатели на отрезки + entlast (полученный в результате _.fillet) загонял в блок. Это (как мне кажется) будет одним из самых простых способов.

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

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

vla-copyobjects в помощь А потом уже и vla-insertblock
Командные методы создания блока не могу порекомендовать.

----- добавлено через ~22 мин. -----
Хотя, посмотрев на исходный код, можно использовать нечто типа

Код:

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

 (vl-load-com)
(defun t1 (/ base_point len_hor len_ver radius adoc blk_name blk_def)
  (if (and (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    (function (lambda () (setq base_point (getpoint "\nБазовая точка <Отмена> : "))))
                  ) ;_ end of vl-catch-all-apply
                ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
           (not
             (vl-catch-all-error-p
               (vl-catch-all-apply
                 (function
                   (lambda () (setq len_hor (getdist base_point "\nУкажите длину по горизонтали <Отмена> : ")))
                 ) ;_ end of function
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
           (not
             (vl-catch-all-error-p
               (vl-catch-all-apply
                 (function (lambda () (setq len_ver (getdist base_point "\nУкажите длину по вертикали <Отмена> : ")))
                 ) ;_ end of function
               ) ;_ end of vl-catch-all-apply
             ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
           (not (vl-catch-all-error-p
                  (vl-catch-all-apply
                    (function (lambda () (setq radius (getreal "\nВведите радиус скругления <Отмена> : "))))
                  ) ;_ end of vl-catch-all-apply
                ) ;_ end of vl-catch-all-error-p
           ) ;_ end of not
      ) ;_ end of and
    (progn
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (setq blk_name (strcat "Г+сопр " (itoa (fix len_hor)) "х" (itoa (fix len_ver))))
      (if (not (tblobjname "block" blk_name))
        (progn
          (setq blk_def (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) blk_name))
          (vla-addline blk_def (vlax-3d-point (list radius 0.)) (vlax-3d-point (list len_hor 0.)))
          (vla-addline blk_def (vlax-3d-point (list 0. radius)) (vlax-3d-point (list 0. len_ver)))
          (vla-addarc
            blk_def
            (vlax-3d-point (list radius radius 0.))
            radius
            pi
            (* 1.5 pi)
          ) ;_ end of vla-AddArc
        ) ;_ end of progn
      ) ;_ end of if
      (vla-insertblock
        (vla-get-modelspace adoc)
        (vlax-3d-point base_point)
        blk_name
        1.
        1.
        1.
        0.
      ) ;_ end of vla-InsertBlock

      (vla-endundomark adoc)
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun

Естественно, использовать это в боевом режиме нельзя: не отслеживания состояния слоев, нет нормализации состава блока и теде. Но в качестве старта, может, и покатит.

----- добавлено через ~23 мин. -----
Offtop: Код особо не тестировал и не проверял. Так, в тепличных условиях...

[fomichev.147]

Кулик Алексей aka kpblc, Спасибо Вам, за помощь. Буду разбираться.

[alex8888]

Уважаемые Гуру, накидал код на скорую руку по печати выборочного фрагмента чертежа по заданным параметрам посредством программы приПринтер. Интересует вопрос, почему так долго выполняется программа? Это где то мой косяк или тут сложности "железного" плана - типа связь с сервером, настройка печати? Возможно ли как то найти причину тормоза?

Тут сам код.
Offtop: Он изобилует комментариями, я для себя каждый шаг прописал. Как показала практика, код забывается быстрее чем хотелось бы, а когда нужно сделать или изменить быстро, то долго заново вникать в каждую строку. Потому что программировать приходится "раз в сто лет". А тут еще и обновление на новый автокад сделали (этакий подарок мне на 15-летие усердной службы на фирме - за что барину огромный поклон )

Код:

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

(vl-load-com)
(defun c:PP(/ acadObj doc aclay
	    pointTemp1 pointTemp2
	    pt1 pt2 )
  
    ;; Печать в припринтер при помощи выбора нижней левой и верхней правой точек
    (setq acadObj (vlax-get-acad-object))
    (setq doc (vla-get-ActiveDocument acadObj))
    (setq aclay (vla-get-ActiveLayout doc))

    ;Получаем первую точку рамки
    (setq pt1 (vlax-variant-value
	      (vla-GetPoint (vla-get-Utility doc)
	      nil
	      "Click the lower-left of the window to plot.")))
    ;; Приводим массив к 2д виду, удаляем Z-координату
    (setq pointTemp1 (vlax-make-safearray vlax-vbDouble '(0 . 1)))
    (vlax-safearray-put-element pointTemp1 0 (vlax-safearray-get-element pt1 0))
    (vlax-safearray-put-element pointTemp1 1 (vlax-safearray-get-element pt1 1))

    ;Получаем вторую точку рамки
    (setq pt2 (vlax-variant-value
		(vla-GetCorner (vla-get-Utility doc)
		pt1
		"Click the upper-right of the window to plot.")))
    ;;Приводим массив к 2д виду, удаляем Z-координату
    (setq pointTemp2 (vlax-make-safearray vlax-vbDouble '(0 . 1)))
    (vlax-safearray-put-element pointTemp2 0 (vlax-safearray-get-element pt2 0))
    (vlax-safearray-put-element pointTemp2 1 (vlax-safearray-get-element pt2 1))

    ;Устанавливаем рамки окошка области печати
    (vla-SetWindowToPlot aclay pointTemp1 pointTemp2);размеры области печати
    ;; Read back window information
    (vla-GetWindowToPlot (vla-get-ActiveLayout doc) 'pt1 'pt2)

    (setq pt1 (vlax-safearray->list pt1)
	         pt2 (vlax-safearray->list pt2))

    ;;Обновляем текущую плот-информацию
    (vla-RefreshPlotDeviceInfo aclay)
  
    ;Настройка печати
    (vla-put-ConfigName aclay "priPrinter.pc3");Имя принтера
    (vla-put-CanonicalMediaName aclay "A4");Формат
    (vla-put-CenterPlot aclay :vlax-true);смещение от начала (центрировать)
    (vla-put-PlotRotation aclay ac270degrees) ;ориентация чертежа
    (vla-put-StandardScale aclay acVpScaleToFit);масштаб печати - вписать
    (vla-put-StyleSheet aclay "monochrome.ctb") ;настройка стиля печати
    (vla-put-PlotType aclay acWindow) ;область печати - рамка  

    ;Отправляем на печать
    (vla-Regen doc acActiveViewport) ;регенерация текущего пространства 
    (vla-PlotToDevice (vla-get-Plot doc));непосредственно печать
); def PP

----- добавлено через ~7 мин. -----
Оказалось все намного проще - нужно было сбросить системную переменную Backgroundplot в ноль. Увы, не догадался сразу.

[nikkomp]

Здраствуйте в проектной организации у наших компьютерщиков я вытянул вот этот код

Код:

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (defun C:CR( / l basepoint ss)
  (princ "\n*** COPY & ROTATE ***")
(SETVAR "CMDECHO" 1)
(setq l (entlast))
(command "_SELECT" "_auto" pause)
(setq basepoint (getpoint "\n Укажи базовую точку:"))
(command "_COPY" "_Prev" "" basepoint pause)
(setq ss (ssadd))
(while (/= l nil)
 (setq l (entnext l))
 (if (/= l nil) (ssadd l ss))
)
(command "_rotate" ss "" pause pause)
);def

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:RTT( / l basepoint ss)
  (princ "\n*** ROTATE without DELETE ***")
  (SETVAR "CMDECHO" 1)
  (setq l (entlast))
  (command "_SELECT" "_auto" pause)
  (setq basepoint (getpoint "\n Укажи базовую точку:"))
  (command "_COPY" "_Prev" "" basepoint basepoint)
  (setq ss (ssadd))
  (while (/= l nil)
   (setq l (entnext l))
   (if (/= l nil) (ssadd l ss))
  )
 (command "_rotate" ss "" basepoint pause)
 (command "_redraw")
);def

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:Mvrt( / l basepoint)
(princ "\n*** MOVE & ROTATE ***")
(SETVAR "CMDECHO" 1)
(setq l (entlast))
(command "_SELECT" pause)
(setq basepoint (getpoint "\n Укажи базовую точку:"))
(command "_MOVE" "_Prev" "" basepoint pause)
(command "_rotate" "_Prev" "" pause pause)
);def
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

пересмотрев кучу литературы что была доступна в интернете я поднапрягся и усовершенствовал под себя

Код:

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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    (defun C:CR( / l basepoint1 basepoint2 basepoint3 ss)
  (princ "\n*** COPY & ROTATE ***")
(setq old_ORTHOMODE (getvar "ORTHOMODE"))
(SETVAR "ORTHOMODE" 0)
(SETVAR "CMDECHO" 1)
(setq l (entlast))
(command "_SELECT" "_auto" pause)
(setq basepoint1 (getpoint "\n Укажи базовую точку копирования:"))
(setq basepoint2 (getpoint "\n Укажи конечную точку перемещения = базовую точку поворота"))
(command "_COPY" "_Prev" "" basepoint1 basepoint2)
(setq ss (ssadd))
(while (/= l nil)
 (setq l (entnext l))
 (if (/= l nil) (ssadd l ss))
)
 (setq basepoint3  (getpoint "\n Укажи сначала опорный угол:а потом поворот:"))
 (command "_rotate" ss ""  basepoint2 "Опорный"  basepoint2 basepoint3 pause)
(setvar "ORTHOMODE" old_ORTHOMODE)
);def

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:RTT( / l basepoint1 basepoint2 ss)
  (princ "\n*** ROTATE without DELETE ***")
  (setq old_ORTHOMODE (getvar "ORTHOMODE"))
  (SETVAR "ORTHOMODE" 0)
  (SETVAR "CMDECHO" 1)
  (setq l (entlast))
  (command "_SELECT" "_auto" pause)
  (setq basepoint1 (getpoint "\n Укажи базовую точку копирования = базовую точку поворота:"))
  (setq basepoint2 (getpoint "\n Укажи сначала опорный угол:а потом поворот:"))
  (command "_COPY" "_Prev" "" basepoint1  basepoint1)
  (setq ss (ssadd))
  (while (/= l nil)
   (setq l (entnext l))
   (if (/= l nil) (ssadd l ss))
  )
 (command "_rotate" ss ""  basepoint1 "Опорный"  basepoint1 basepoint2 pause)
 (command "_redraw")
 (setvar "ORTHOMODE" old_ORTHOMODE)
);def

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun C:Mvrt( / l basepoint1 basepoint2 basepoint3 ss)
(princ "\n*** MOVE & ROTATE ***")
(setq old_ORTHOMODE (getvar "ORTHOMODE"))
(SETVAR "ORTHOMODE" 0)
(SETVAR "CMDECHO" 1)
(setq l (entlast))
(command "_SELECT" pause)
(setq basepoint1 (getpoint "\n Укажи базовую точку перемещения:"))
(setq basepoint2 (getpoint "\n Укажи конечную точку перемещения = базовую точку поворота"))
(command "_MOVE" "_Prev" "" basepoint1 basepoint2)
 (setq basepoint3 (getpoint "\n Укажи сначала опорный угол:а потом поворот:"))
(command "_rotate" "_Prev" "" basepoint2 "Опорный"  basepoint2 basepoint3 pause)
(setvar "ORTHOMODE" old_ORTHOMODE)
);def
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

все устраивает но не понятно почему при выполнении первой по очереди команды не отображается предварительный просмотр объектов (DRAGMODE), завершается все отлично.

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

Сообщение от nikkomp не отображается предварительный просмотр объектов (DRAGMODE)

А должен?
Offtop: И чем не устраивает почти штатный _.mocoro ?

[nikkomp]

Ну так можно сделать чтобы срабатывало?

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

Никак. Ты при всех операциях уже указываешь все необходимые точки.
P.S. И ты себе такие грабли подготовил - пальчики оближешь! Поменяй ради приколу copymode, посмотри, как оно работать будет.

[Sege]

Подскажите пожалуйста такую ситуацию.

Делаю определенную замену текста в примитиве MLEADER: группа (304 . "заменяемый текст") посредством SUBST
После выполнения entmode меняется цвет значения текста в MLEADER на значение "по слою", несмотря на то, что внутри MLEADER текст имеет свой цвет (знаю что не правильно, но так получилось)

Код:

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

 
(setq new (cons 304 "новый текст"))
(setq old (assoc 304 nabor))
(setq nabor (subst new old nabor))
(entmod nabor)

С примитивом MTEXT такого не происходит, несмотря на внутреннее форматирование: группа (1 . "заменяемый текст") -> просто меняется текст без "обнуления" его внутреннего форматирования цветом

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

Значит, меняется не только эта группа. Ну или их несколько.
А кто мешает работать через ActiveX?

----- добавлено через ~9 мин. -----
Кстати, приведи пример такой выноски - что-то мне не удалось сделать цвет только текста отличным от цвета мультивыноски.

[Sege]

Сообщение от Кулик Алексей aka kpblc Значит, меняется не только эта группа. Ну или их несколько. А кто мешает работать через ActiveX? ----- добавлено через ~9 мин. ----- Кстати, приведи пример такой выноски - что-то мне не удалось сделать цвет только текста отличным от цвета мультивыноски.

Пример во вложении

UDP:
кажется понимаю в чем дело: в тексте мультивыноски в группе 304 уже сидит внутреннее форматирование цветом (304 . "{\\C4;СТАРЫЙ ТЕКСТ}")
а SUBSTом мы тупо меняем на новое значение без учета знаков внутреннего форматирования, т.е. получается уже конструкция (304 . "НОВЫЙ ТЕКСТ")

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

Так у тебя там принудительное форматирование выставлено!

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

Код:

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

 (setq mleader (vlax-ename->vla-object (car (entsel))))
(vla-get-TextString mleader) ;"{\\C1;1}"

[Sege]

Сообщение от Кулик Алексей aka kpblc Так у тебя там принудительное форматирование выставлено! ----- добавлено через ~2 мин. ----- Код: [Выделить все] (setq mleader (vlax-ename->vla-object (car (entsel)))) (vla-get-TextString mleader) ;"{\\C1;1}"

Да, Алексей, это я уже увидел Т.е. тогда достаточно произвести обновление значения текста с сохранением внутреннего форматирования )

[Jek30]

Я вообще не разбираюсь в лиспах.
Есть лисп для быстрой печати, который я нашел по адресу (https://forum.dwg.ru/showthread.php?...FB%E1%EE%F0%F3).
Вот фрагмент этого лиспа:↓↓↓

Код:

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

 (command "_.plot"
             "_Yes"
             "model" ; Имя листа или [?] <Модель>: 
             "HP CLJ 5550N PCL 6 A4.pc3" ;Имя устройства вывода 
             "A4" ;Формат листа бумаги
             "Millimeters" ;Единицы измерения размеров листа
             "portrait" ;Ориентация чертежа 
             "_No" ;Перевернуть чертеж?
             "_Window" ;Печатаемая область
             xy1 ;Первая точка окна 
             xy2 ;Вторая точка окна 
             "_fit" ;[Вписать]
             "_center" ;Смещение от начала (x,y) или [Центрировать]
             "_yes" ;Учитывать стили печати?
             "monochrome.ctb" ;Имя таблицы стилей печати
             "_yes" ;Учитывать веса линий?
             "As displayed" ;Режим вывода раскрашенных ВЭ
             "_No" ;Запись чертежа в файл
             "_yes" ;Сохранить изменения параметров листа
             "_yes" ;Перейти к печати
    ) ;_ end of command

Растолкуйте пожалуйста каждую строчку, а именно, на что можно изменить данные в строчках чтобы изменились параметры печати и лисп работал?
Например я знаю некоторые строчки:
"A4" ;Формат листа бумаги ***меняем на "А3"-получаем формат А3
или
"portrait" ;Ориентация чертежа ***меняем на "Landscape"- ориентация чертежа меняется на альбомную.
ну и еще парочку строк знаю, а остальные нет.
К примеру если я не хочу чтоб вписывалось, или хочу чтоб печать работала в пространстве листов и так далее, то на что надо заменить эти остальные строки, и какие варианты есть?
Благодарю!☺

[Composter]

странно , а зачем печатать из пространства листа какой то кусок?
вы можете вбить (command "_.plot") и смотреть что вам выводит и какие варианты дает автокад, в некоторыхпараметрах можно ввести "?" чтобы посмотреть все варианты
Соответвествно чтобы не из модели печатать нужно в 3 строке где сейчас "model" , нужно указать имя листа из которого печатать. обычно имя текущего листа можно получить через (getvar "CTAB") но тут он не работает.
тоже самое если не хотите вписывать то в строке "_fit" нужно указать свое значение.

[Jek30]

Сообщение от Composter странно , а зачем печатать из пространства листа какой то кусок? вы можете вбить (command "_.plot") и смотреть что вам выводит и какие варианты дает автокад, в некоторыхпараметрах можно ввести "?" чтобы посмотреть все варианты Соответвествно чтобы не из модели печатать нужно в 3 строке где сейчас "model" , нужно указать имя листа из которого печатать. обычно имя текущего листа можно получить через (getvar "CTAB") но тут он не работает. тоже самое если не хотите вписывать то в строке "_fit" нужно указать свое значение.

Это не кусок, а быстрая печать формата А4 или какого захочешь, если выставишь в коде лиспа (просто лисп включил, указал нужный чертеж, и он тут же распечатался)

я со всеми моментами разобрался в том числе и с "_fit", авот как его заставить чтоб этот лисп работал в пространстве Листов??

[Composter]

Так если у вас лист сформирован через публикацию "_PUBLISH" печатаешь любой лист , через page setup можно выставить любой другой формат. Зачем изобретать велосипед?
вместо "_fit" нужно указать масштаб например вот так "1:1".

[Jek30]

Сообщение от Composter Так если у вас лист сформирован через публикацию "_PUBLISH" печатаешь любой лист , через page setup можно выставить любой другой формат. Зачем изобретать велосипед

Потому-что на новом велосипеде достаточно нажать только одну кнопочку и нужный чертеж распечатался, нежели капашиться в page setup. А публикация это не удобно, в плане того что там на каждый чертеж нужно создавать отдельный лист, а у меня все эти чертежи в одном пространстве Лист1. (так легче их сравнивать между собой, чем бегать по вкладкам Листов). А работаю я в Листе, потомучто там у меня видовые экраны.

Сообщение от Composter вместо "_fit" нужно указать масштаб например вот так "1:1".

Спасибо! но я так и сделал и в остальных переменных тоже разобрался. Только вот осталась одна строчка.
вот эта↓
"model" ; Имя листа или [?] <Модель>:
В модели он шикарно работает, но как сделать так чтоб он работал и в листах?
Что конкретно прописать в коде, чтоб он заработал и в пространстве Листа? (В лиспах не шарю вообще) ☺

[Composter]

а у меня все эти чертежи в одном пространстве Лист1
Рука-лицо. Зачем тогда вобще вам пространство листа тогда?
Есть куча вариантов когда нижимаешь 1 кнопку и формируются все листы с нужными размерами листов https://forum.dwg.ru/showthread.php?t=104517

Что конкретно прописать в коде, чтоб он заработал и в пространстве Листа?
Нужно указать имя листа

[Jek30]

Сообщение от Composter Рука-лицо. Зачем тогда вобще вам пространство листа тогда?

Если бы не видовые экраны, то я бы пользовался только моделью.

Сообщение от Composter Есть куча вариантов когда нижимаешь 1 кнопку и формируются все листы с нужными размерами листов https://forum.dwg.ru/showthread.php?t=104517

Этот фрагмент лиспа как раз таки из той темы, плюс еще двумя штуками от туда я пользуюсь. Но охото ещё коечто автоматизировать, просто я не умею☺

Сообщение от Composter Что конкретно прописать в коде, чтоб он заработал и в пространстве Листа?

Да, нужно чтобы этот лисп работол в пространстве листа с любым именем.

Сообщение от Composter Нужно указать имя листа

Я пытался туда вбить имя листа, но лисп выдавал почемуто ошибку. Поэтому к вам и обратился☺

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

Сообщение от Jek30 Да, нужно чтобы этот лисп работол в пространстве листа с любым именем.

Ну так получи активное пространство и бери его имя, делов-то

[Jek30]

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

Я в лиспах вообще не шарю. Мне бы кто-нибудь эту самую строчку прописал бы правильно!))

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

(getvar "ctab") - вот тебе и имя активной закладки (в подавляющем большинстве случаев).

[Jek30]

Сообщение от Кулик Алексей aka kpblc (getvar "ctab") - вот тебе и имя активной закладки (в подавляющем большинстве случаев).

Вот так прописал этот "гетвар" ☺ : в модели пашет, а в листах выдает ошибку↓↓↓

(defun c:aaa1 ()
<(defun GetBoundingBox (en / obj minpt maxpt)
(if (= (type en) 'ENAME)
(progn
(setq obj (vlax-ename->vla-object en))
(vla-getboundingbox obj 'minpt 'maxpt)
(list
(trans (vlax-safearray->list minpt) 0 1)
(trans (vlax-safearray->list maxpt) 0 1)
) ;_ end of list
) ;_ end of progn
) ;_endof if progn
) ;_endof defun

(princ "Выберите объект для печати")
(setq box (GetBoundingBox (car(entsel)))); список из координат минимума и максимума габаритов выбранного объекта
(setq xy1 (car box)); координаты для определения области печати, xy1 - левая нижняя, xy2 - правая верхняя
(setq xy2 (car (cdr box)))

(command "_.plot"
"_Yes"
(getvar "ctab") ; Имя листа или [?] <Модель>:
"PDFCreator.pc3" ;Имя устройства вывода
"A4" ;Формат листа бумаги
"Millimeters" ;Единицы измерения размеров листа
"portrait" ;Ориентация чертежа
"_No" ;Перевернуть чертеж?
"_Window" ;Печатаемая область
xy1 ;Первая точка окна
xy2 ;Вторая точка окна
"1:1" ;[Вписать]
"_center" ;Смещение от начала (x,y) или [Центрировать]
"_No" ;Учитывать стили печати?
"monochrome.ctb" ;Имя таблицы стилей печати
"_yes" ;Учитывать веса линий?
"As displayed" ;Режим вывода раскрашенных ВЭ
"_No" ;Запись чертежа в файл
"_No" ;Сохранить изменения параметров листа
"_yes" ;Перейти к печати
) ;_ end of command>
)

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

Ну, во-первых, в расширенном редакторе есть возможность показывать нормально форматированный код.
Во-вторых, что там перед локальным defun'ом делает символ "<"?
В-третьих, что за ошибка? И в каком месте?

----- добавлено через ~2 мин. -----
И зачем выполнять перевод точек из мировой системы в пользовательскую?

Короче, проверяй значения каждой переменной перед вызовом команды

[Composter]

Я ж уже писал что (getvar "ctab" ) не работает. Он пишет неверное имя листа.

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

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

Сообщение от Composter Я ж уже писал что (getvar "ctab" ) не работает. Он пишет неверное имя листа. Лучше не морочить голову а воспользоваться другим лиспом из той темы и оформлять отдельный лист в отдельном пространстве.

Ни разу не сталкивался. Приведи пример такого файла, где ctab возвращает неверный результат

[Composter]

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

[Jek30]

Сообщение от Кулик Алексей aka kpblc Ну, во-первых, в расширенном редакторе есть возможность показывать нормально форматированный код.

Я же говорю: "В лиспе я вообще не разбираюсь"

Сообщение от Кулик Алексей aka kpblc Во-вторых, что там перед локальным defun'ом делает символ "<"?

Это таким способом этот лисп у меня запускается с кнопки.

Сообщение от Кулик Алексей aka kpblc В-третьих, что за ошибка? И в каком месте?

Ошибка в том что лисп в пространстве листа не пашет! (а в пространстве модели работает прекрасно)
Моя логика подсказывает что нужно изменить вот эту строчку ↓↓↓, но я могу и ошибаться (это просто мое мнение)
"model" ; Имя листа или [?] <Модель>: (такая она была сначала)
(getvar "ctab") ; Имя листа или [?] <Модель>: (такая стала она теперь, но по прежнему не пашет в простр-ве листа)

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

это я ваще не понял что означает☺

Сообщение от Кулик Алексей aka kpblc Короче, проверяй значения каждой переменной перед вызовом команды

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

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

Я про переменные, а не про печать. На твоем месте я бы почитал книгу "AutoCAD язык макрокоманд и создание макросов" (есть в Download). Спойлер: тогда поймешь, что сначала надо команду пройтись "руками", последовательно отвечая на все ее запросы - и тогда появится хоть какой-то шанс на то, что макрос/программа корректно сработает.

[valerik88]

Jek30, Не разбирался в твоём коде, просто вставил последний кусок из своего рабочего кода, у меня всё заработало в листах.
Сравни свой с моим, может найдётся причина.

[Jek30]

Сообщение от Кулик Алексей aka kpblc На твоем месте я бы почитал книгу "AutoCAD язык макрокоманд и создание макросов" (есть в Download).

Да просто не охота ради пару лиспиков штудировать неизвестную мне литературу ☺

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

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

Какой у тебя лисп работает? Который ты во вложении скинул? (У меня он почему-то не пашет,попробовал значения некоторые поменять, тоже не работает)

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

Сообщение от Jek30 Да просто не охота ради пару лиспиков штудировать неизвестную мне литературу

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

[Jek30]

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

Ладно. Всё-равно спасибо! )))))

[nikkomp]

Здраствуйте, вот надыбал два lispa по копированию текста, нельзя ли их скомпоновать так чтобы, чтобы можно было копировать и вставлять текст в примитивы СПДС GraphiCS?

Код:

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

;;Text to Text Copy Color
(defun c:ttcc (/ actDoc vlaObj sObj sText curObj oldForm
        oType oldMode conFlag errFlag *error* color)
  (vl-load-com)
  (setq color 1) ;_ Text color Цвет текта nil - nothing
  ;;; Text to Text Copy
;;; Original posted Aleksandr Smirnov {Smirnoff} now known as ASMI
;;; Aleksandr Smirnov (ASMI)
;;; https://www.caduser.ru/forum/topic21894.html
;;; Modifyed V. Azarko (VVA)
;;; https://www.caduser.ru/forum/topic21894.html
;;; 22.10.2008 Add MULTILEADER
;;; 20.05.2009 Add Color
     (setq actDoc(vla-get-ActiveDocument
        (vlax-get-acad-object)))
      (vla-StartUndoMark actDoc)
  (defun TTC_Paste(pasteStr / nslLst vlaObj hitPt
                   hitRes Row Column lst ss)
    (setq errFlag nil)
  (setvar "ERRNO" 0)(initget "Switch")
    (while (progn
        (setq Lst(nentsel "\nPaste text or first point of corner or [Switch layout] <Enter-exit> >>"))
        (cond ((= Lst "Switch")
          (TTC_ls)
          (setvar "ERRNO" 0)
          (initget "Switch")
          T
          )
;;;         ((and (null Lst)
;;;          (= (getvar "errno") 7)
;;;          )
;;;          (princ "* Missing * ")
;;;          (setvar "ERRNO" 0)
;;;          (initget "Switch")
;;;          T
;;;          )
         (t nil)
         )
        )
      );_while
  (if (and (null Lst)
      (= (getvar "errno") 7)
      (setq hitPt (getcorner  (setq vlaObj (cadr(GRREAD nil 1))) "\nOther point: "))
      (setq ss (ssget "_C" vlaObj hitPt '((0 . "*TEXT"))))
      )
    (progn
    (setq Lst (mapcar '(lambda(x)(cons x '((0 0 0))))
         (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
       )
     )
    )
    (setq Lst (list Lst))
    )
(foreach nsllst Lst
    (if nsllst (progn
  (cond
    (
     (and
       (= 4(length nslLst))
       (= "DIMENSION"(cdr(assoc 0(entget(car(last nslLst))))))
       ); end and
     (setq vlaObj
      (vlax-ename->vla-object
        (cdr(assoc -1(entget(car(last nslLst)))))))
     (if
       (vl-catch-all-error-p
         (vl-catch-all-apply
       '(lambda()
          (vla-put-TextOverride vlaObj pasteStr)
          (if color (vla-put-color vlaObj color)))))
         (progn
         (princ "\n Can't paste. Object may be on locked layer. ")
         (setq errFlag T)
         ); end progn
       ); end if
     ); end condition #1
    (
     (and
       (= 4(length nslLst))
       (= "ACAD_TABLE"(cdr(assoc 0(entget(car(last nslLst))))))
       ); end and
     (setq vlaObj
      (vlax-ename->vla-object
        (cdr(assoc -1(entget(car(last nslLst))))))
     hitPt(vlax-3D-Point(trans(cadr nslLst)1 0))
     hitRes(vla-HitTest vlaObj hitPt
        (vlax-3D-Point '(0.0 0.0 1.0)) 'Row 'Column)
           ); end setq
     (if(= :vlax-true hitRes)
     (progn
         (if
     (vl-catch-all-error-p
       (vl-catch-all-apply
     '(lambda()
        (vla-SetText vlaObj Row Column pasteStr)
            ;|(if color (vla-put-color vlaObj color))|;)))
     (progn
       (princ "\n Can't paste. Object may be on locked layer. ")
       (setq errFlag T)
       ); end progn
     ); end if
         ); end progn
       ); end if
     ); end condition # 2
    (
     (and
       (= 4(length nslLst))
       (= "INSERT"(cdr(assoc 0(entget(car(last nslLst))))))
       ); end and
     (princ "\nCan't paste to block's DText or MText. Select Attribute ")
     (setq errFlag T)
     ); end condition #3
    (
     (and
       (= 2(length nslLst))
         (member(cdr(assoc 0(entget(car nslLst))))
           '("TEXT" "MTEXT" "ATTRIB" "ATTDEF" "MULTILEADER"))
       ); end and
     (setq vlaObj
      (vlax-ename->vla-object(car nslLst)))
        (if
     (vl-catch-all-error-p
       (vl-catch-all-apply '(lambda()
         (vla-put-TextString vlaObj pasteStr)
         (if color (vla-put-color vlaObj color)))))
    (progn
       (princ "\nError. Can't pase text. ")
      (setq errFlag T)
      ); end progn
     ); end if
     ); end condition #4
    (T
     (princ "\nCan't paste. Invalid object. ")
     (setq errFlag T)
     ); end condition #5
    ); end cond
             T
      ); end progn
            nil
           ); end if
  )
    ); end of TTC_Paste
    (defun TTC_MText_Clear(Mtext / Text Str)
    (setq Text "")
    (while(/= Mtext "")
      (cond
  ((wcmatch
     (strcase
       (setq Str
        (substr Mtext 1 2)))
                     "\\[\\{}`~]")
   (setq Mtext(substr Mtext 3)
         Text(strcat Text Str)
   ); end setq
  ); end condition #1
  ((wcmatch(substr Mtext 1 1) "[{}]")
    (setq Mtext
     (substr Mtext 2))
  ); end condition #2
  (
   (and
   (wcmatch
     (strcase
       (substr Mtext 1 2)) "\\P")
   (/=(substr Mtext 3 1) " ")
    ); end and
         (setq Mtext (substr Mtext 3)
               Text (strcat Text " ")
         ); end setq
   ); end condition #3
  ((wcmatch
     (strcase
       (substr Mtext 1 2)) "\\[LOP]")
    (setq Mtext(substr Mtext 3))
  ); end condition #4
  ((wcmatch
     (strcase
       (substr Mtext 1 2)) "\\[ACFHQTW]")
    (setq Mtext
     (substr Mtext
       (+ 2
          (vl-string-search ";" Mtext))))
  ); end condition #5
  ((wcmatch
     (strcase (substr Mtext 1 2)) "\\S")
    (setq Str(substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
          Text(strcat Text (vl-string-translate "#^\\" " " Str))
          Mtext(substr Mtext (+ 4 (strlen Str)))
   ); end setq
   (print Str)
  ); end condition #6
  (T
   (setq Text(strcat Text(substr Mtext 1 1))
         Mtext (substr Mtext 2)
   )
  ); end condition #7
      ); end cond
    ); end while
  Text
); end of TTC_MText_Clear
(defun ttc-layouts-list (doc)
  (or doc (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (vl-sort
    ((lambda (/ res)
       (vlax-for item (vla-get-layouts doc)
         (setq res (cons item res))
         ) ;_ end of vlax-for
       ) ;_ end of lambda
     )
    '(lambda (a b)
       (< (vla-get-taborder a) (vla-get-taborder b))
       ) ;_ end of lambda
    ) ;_ end of vl-sort
  ) ;_ end of defun
;;; RUS ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2008  DWGru Programmers Group
;;; *
;;; * _TTC-GET-USER-DCL (Кандидат)
;;; *
;;; * Запрос значения у пользователя через диалоговое окно
;;; *
;;; *
;;; * 26/01/2008 Версия 0002. Редакция Владимир Азарко (VVA)
;;;              - Выход по двойному клику, если запрещен множественный выбор (multi-nil)
;;;              - Обработка нескольких колонок
;;; * 21/01/2008 Версия 0001. Редакция Владимир Азарко (VVA)
;;; ************************************************************************
;;; EN ************************************************************************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group
;;; *
;;; * _TTC-GET-USER-DCL (Candidate)
;;; *
;;; * Inquiry of value at the user through a dialogue window
;;; *
;;; *
;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA)
;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden
;;; - Processing of several columns
;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)
(defun _TTC-GET-USER-DCL (ZAGL        INFO-LIST   MULTI
                            /           FL          RET
                            DCL_ID      MAXROW      MAX_COUNT_COL
                            COUNT_COL   I           LISTBOX_HEIGHT
                            LST         _LOC_FINISH _LOC_CLEAR
                            NCOL
                           )
;|
* ENGLISH
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without скроллинга is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Parameters of a call:
    zagl - heading of a window [String]
    info-list - the list of line values[List of String]
    multi - t - the plural choice is resolved, nil-is not present
* Returns:
The list of the chosen lines or nil - a cancelling
* the Example
(_TTC-GET-USER-DCL " Specify a variant " ' ("First " Second " " Third ") nil); _-> ("First")
(_TTC-GET-USER-DCL " Specify a variant " ' ("First " Second " " Third ") t); _-> ("First " Second ")
(_TTC-GET-USER-DCL " Specify a variant "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)
(_TTC-GET-USER-DCL " Specify a variant, using CTRL and SHIFT for a choice "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
                   
                   
;|
* RUS                  
* Запрос значения у пользователя через диалоговое окно
* Диалог формируется "налету"
* Количество строк на страницу без скроллинга задается переменной MAXROW.
* Необходимо помнить, что число MAXROW увеличивается на 3.
* Максимальное количество колонок задается переменной MAX_COUNT_COL
* Опубликована
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Параметры вызова:
    zagl - заголовок окна [String]
    info-list - список строковых значений[List of String]
    multi - t - разрешен множественный выбор, nil- нет
* Возвращает:
Список выбранных строк или nil - отмена
* Пример
(_TTC-GET-USER-DCL "Укажите вариант" '("Первый" "Второй" "Третий") nil) ;_->("Первый")
(_TTC-GET-USER-DCL "Укажите вариант" '("Первый" "Второй" "Третий") t) ;_->("Первый" "Второй")
(_TTC-GET-USER-DCL "Укажите вариант"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) nil)
(_TTC-GET-USER-DCL "Укажите вариант, используя CTRL и SHIFT для выбора"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) t)
|;
;_ ===== КОНСТАНТЫ ============
  (setq MAXROW 40) ;_макc. кол-во строк без скроллинга (К нему дальше добавится еще 3 строчки)
                   ;_  max lines without scrolling (To it 3 more lines further will be added)
  (setq MAX_COUNT_COL 5) ;_максимальное количество колонок
                         ;_ ; _ a maximum quantity of columns
;;;==================== Локальные фунцкции START==================================
;;;==================== Local functions START==================================
  (defun _LOC_FINISH ()
    (setq I   0
          RET NIL
    ) ;_ end ofsetq
    (repeat COUNT_COL
      (setq I (1+ I))
      (setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
    ) ;_ end ofrepeat
    (setq RET (reverse RET))
    (done_dialog 1)
  ) ;_ end ofdefun
  (defun _LOC_CLEAR (NOMER)
    (setq I 0)
    (repeat COUNT_COL
      (setq I (1+ I))
      (if (/= I NOMER)
        (progn
          (start_list (strcat "info" (itoa I)))
          (mapcar 'add_list (nth (1- I) LST))
          (end_list)
        ) ;_ end ofprogn
      ) ;_ end ofif
    ) ;_ end ofrepeat
  ) ;_ end ofdefun
;;;==================== Локальные фунцкции END ==================================
;;;==================== Local functions END ==================================
;;;==================== MAIN PART ===============================================
  (if (null ZAGL)
    (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
      (setq ZAGL "Выбор")
      (setq ZAGL "Select")
    ) ;_ end ofif
  ) ;_ end if
  (if (zerop (rem (length INFO-LIST) MAXROW)) ;_Целое количество столбцов
    (setq COUNT_COL (/ (length INFO-LIST) MAXROW)) ;_Его и оставляем
    (setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0)))) ;_Берем ближайшее целое
  ) ;_ end ofif
  (if (> COUNT_COL MAX_COUNT_COL)
    (setq COUNT_COL MAX_COUNT_COL)
  ) ;_Ограничиваем max количеством
  (setq LISTBOX_HEIGHT (+ 3 MAXROW)) ;_  добавляем 3 строчки для красоты и для исключения пограничного скроллинга
                                     ;_ We add 3 lines for appearance and for exception boundary scroll
  (if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
    (setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
  ) ;_ end ofif
  (setq I 0)
  (setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
  (setq RET (open FL "w")
        LST NIL
  ) ;_ end ofsetq
  (mapcar '(lambda (X) (write-line X RET))
          (append (list "dwgru_get_user : dialog { "
                        (strcat "label=\"" ZAGL "\";")
                        ": boxed_row {"
                        (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                          "label = \"Значение\";"
                          "label = \"Value\";"
                        ) ;_ end ofif
                  ) ;_ end oflist
                  (repeat COUNT_COL
                    (setq LST
                           (append
                             LST
                             (list
                               " :list_box {"
                               "alignment=top ;"
                               (if MULTI
                                 "multiple_select = true ;"
                                 "multiple_select = false ;"
                               ) ;_ end ofif
                               "width=31 ;"
                               (strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
                               "is_tab_stop = false ;"
                               (strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
                             ) ;_ end oflist
                           ) ;_ end ofappend
                    ) ;_ end ofsetq
                  ) ;_ end ofrepeat
                  (list
                    "}"
                    ":row{"
                    "ok_cancel_err;}}"
                  ) ;_ end oflist
          ) ;_ end of list
  ) ;_ end of mapcar
  (setq RET (close RET))
  (if (and (null (minusp (setq DCL_ID (load_dialog FL))))
           (new_dialog "dwgru_get_user" DCL_ID)
      ) ;_ end and
    (progn
      (setq LST INFO-LIST)
      ((lambda (/ RET1 BUF ITM)
         (repeat (1- COUNT_COL)
           (setq I '-1)
           (while (and (setq ITM (car LST))
                       (< (setq I (1+ I)) MAXROW)
                  ) ;_ end ofand
             (setq BUF (cons ITM BUF)
                   LST (cdr LST)
             ) ;_ end ofsetq
           ) ;_ end ofwhile
           (setq RET1 (cons (reverse BUF) RET1)
                 BUF  NIL
           ) ;_ end ofsetq
         ) ;_ end ofrepeat
         (setq RET RET1)
       ) ;_ end oflambda
      )
      (if LST
        (setq RET (cons LST RET))
      ) ;_ end ofif
      (setq LST (reverse RET))
      (setq I 0)
      (mapcar '(lambda (THIS_LIST)
                 (if (<= (setq I (1+ I)) COUNT_COL)
                   (progn
                     (start_list (strcat "info" (itoa I)))
                     (mapcar 'add_list THIS_LIST)
                     (end_list)
                   ) ;_ end ofprogn
                 ) ;_ end ofif
               ) ;_ end oflambda
              LST
      ) ;_ end ofmapcar
      (set_tile "info1" "0")
      (setq I 0
            NCOL 1
      ) ;_ end ofsetq
      (repeat COUNT_COL
        (action_tile
          (strcat "info" (itoa (setq I (1+ I))))
          (strcat "(progn (setq Ncol "
                  (itoa I)
                  ")(if (not multi)(_loc_clear Ncol))"
                  "(if (and (not multi)(= $reason 4))(_loc_finish)))"
          ) ;_ end ofstrcat
        ) ;_ end ofaction_tile
      ) ;_ end ofrepeat
      (action_tile "cancel" "(done_dialog 0)")
      (action_tile "accept" "(_loc_finish)")
      (if MULTI
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Используйте CTRL и SHIFT для выбора"
                    "Use CTRL and SHIFT for a choicet"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Можно выбирать двойным щелчком"
                    "It is possible to choose double click"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
      ) ;_ end ofif
      (if (zerop (start_dialog))
        (setq RET NIL)
        (progn
          (setq
            RET (apply
                  'append
                  (mapcar
                    '(lambda (ITM)
                       (setq THIS_LIST (nth (1- (car ITM)) LST))
                       (mapcar
                         (function (lambda (NUM) (nth NUM THIS_LIST)))
                         (read (strcat "(" (cdr ITM) ")"))
                       ) ;_ end ofmapcar
                     ) ;_ end oflambda
                    RET
                  ) ;_ end ofmapcar
                ) ;_ end ofapply
          ) ;_ end ofsetq
        ) ;_ end ofprogn
      ) ;_ end if
      (unload_dialog DCL_ID)
    ) ;_ end of progn
  ) ;_ end of if
  (vl-file-delete FL)
  RET
) ;_ end of defun
(defun TTC_ls ( / ret)
  (and
    (setq
      ret
       (car (_TTC-GET-USER-DCL
              "Select layout"
              (mapcar 'vla-get-name (ttc-layouts-list nil))
              nil
              ) ;_ end of _TTC-GET-USER-DCL
            ) ;_ end of car
      ) ;_ end of setq
    (setvar "CTAB" ret)
    ) ;_ end of and
  (princ)
  ) ;_ end of defun
  (defun TTC_Copy (/ sObj sText tType actDoc)
(setvar "ERRNO" 0)(initget "Switch")
   (if
    (and
    (or
    (while (progn
        (setq sObj(nentsel "\nCopy text [Switch layout]... "))
        (cond ((= Lst "Switch")
          (TTC_ls)
          (setvar "ERRNO" 0)
          (initget "Switch")
          T
          )
         ((and (null Lst)
          (= (getvar "errno") 7)
          )
          (princ "* Missing * ")
          (setvar "ERRNO" 0)
          (initget "Switch")
          T
          )
         (t nil)
         )
        )
      ) T)
;;;      (or
;;;      (while (= (setq sObj(nentsel "\nCopy text [Switch layout]... ")) "Switch")
;;;   (TTC_ls)
;;;   (initget "Switch")
;;;   )
;;;         t)
     (setq sObj(car sObj))
     (member(setq tType(cdr(assoc 0(entget sObj))))
      '("TEXT" "MTEXT" "ATTRIB" "ATTDEF" "MULTILEADER"))
     ); end and
    (progn
      (setq actDoc(vla-get-ActiveDocument(vlax-get-Acad-object))
       sText(vla-get-TextString(vlax-ename->vla-object sObj))
      ); end setq
      ;;; (if(= tType "MTEXT")(setq sText(TTC_MText_Clear sText))); end if
      (setq sText(TTC_MText_Clear sText))
      ); end progn
    ); end if
    sText
    ); end of TTC_Copy
  (defun CCT_Str_Echo(paseStr / comStr)
    (if(< 20(strlen paseStr))
      (setq comStr
       (strcat
         (substr paseStr 1 17)"..."))
      (setq comStr paseStr)
      ); end if
    (princ
      (strcat "\nText = \"" comStr "\""))
    (princ)
    ); end of CCT_Str_Echo
    (defun *error*(msg)
    (vla-EndUndoMark
      (vla-get-ActiveDocument
        (vlax-get-acad-object)))
    (princ "\nQuit TTC")
    (princ)
    ); end of *error*
    (if(not ttc:Mode)(setq ttc:Mode "Multiple"))
    (initget "Multiple Pair-wise")
    (setq oldMode ttc:Mode
    ttc:Mode
     (getkword
       (strcat "\nSpecify mode [Multiple/Pair-wise] <" ttc:Mode ">: "))
    conFlag T
    paseStr ""
     ); end setq
    (if(null ttc:Mode)(setq ttc:Mode oldMode))
    (if(= ttc:Mode "Multiple")
      (progn
  (if(and(setq paseStr(TTC_Copy))conFlag)
    (progn
    (CCT_Str_Echo paseStr)
    (while(setq conFlag(TTC_Paste paseStr))T
      ); end while
    ); end progn
    ); end if
  ); end progn
      (progn
  (while
    (and conFlag paseStr)
    (setq paseStr(TTC_Copy))
    (if(and paseStr conFlag)
      (progn
    (CCT_Str_Echo paseStr)
    (setq errFlag T)
    (while errFlag
    (setq conFlag(TTC_Paste paseStr))
         );end while
       ); end progn
      ); end if
    ); end while
  ); end progn
      ); end if
   (vla-EndUndoMark actDoc)
   (princ "\nQuit TTC")
  (princ)

и вот

Код:

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

(defun c:ttc (/ *error* vlaObj sObj sText curObj oType oldMode conFlag errFlag) ;*error* actDoc
;;;     (vl-load-com)
;;;     (setq actDoc (vla-get-activedocument
;;;		       (vlax-get-acad-object)
;;;		  ) ;_ vla-get-ActiveDocument
;;;     ) ;_ setq

  (defun *error* (msg)
     (vla-endundomark
	  (vla-get-activedocument
	       (vlax-get-acad-object)
	  ) ;_ vla-get-ActiveDocument
     ) ;_ vla-EndUndoMark
     (princ "\nQuit TTC")
     (princ)
) ;_ defun
  
     (vla-startundomark adoc)
;;;***********************************
;;;     выбор режима

;;;     (if (not ttc:Mode)
;;;	  (setq ttc:Mode "Multiple")
;;;     ) ;_ if
     (initget "Multiple Pair-wise")
     (setq
;;;	  oldMode  ttc:Mode
;;;	   ttc:Mode
;;;		    (getkword
;;;			 (strcat "\nSpecify mode [Multiple/Pair-wise] <" ttc:Mode ">: ")
;;;		    ) ;_ getkword
	  conFlag
	      t
	  paseStr ""
     )						  ; end setq
;;;     (if (null ttc:Mode)
;;;	  (setq ttc:Mode oldMode)
;;;     ) ;_ if


;;;***********************************
     (setq ttc:Mode "Multiple")			  ; предопределенный режим
;;;***********************************

     (setq t_offer "\nВыберите исходный текст... >")

     (if (= ttc:Mode "Multiple")
	  (progn
	       (if (and (setq paseStr (TTC_Copy t_offer)) conFlag)
		    (progn
			 (CCT_Str_Echo paseStr)
			 (while	(setq conFlag (TTC_Paste paseStr "\nКуда вставлять текст? >"))
			      t
			 )			  ; end while
		    )				  ; end progn
	       )				  ; end if
	  )					  ; end progn
	  (progn
	       (while
		    (and conFlag paseStr)
			(setq paseStr (TTC_Copy t_offer))
			(if (and paseStr conFlag)
			     (progn
				  (CCT_Str_Echo paseStr)
				  (setq errFlag t)
				  (while errFlag
				       (setq conFlag (TTC_Paste paseStr "\nКуда вставлять текст? >"))
				  )		  ;end while
			     )			  ; end progn
			)			  ; end if
	       )				  ; end while
	  )					  ; end progn
     )						  ; end if
     (vla-endundomark adoc)
     (princ "\nQuit TTC")
     (princ)
)						  ; end c:ttc



(defun TTC_Copy (offer / sObj sText tType i)                                   ; возвращает строку, работает с текстом, таблицами, мтекстом и пр.    sObj sText tType actDoc
                                                            ; offer - приглашение для выбора объекта
  (setq sObj  (entget (car (nentsel offer)))
        tType (cdr (assoc 0 sObj))
  ) ;_ setq
  (if sObj
    (cond
;;;---------------------------------------------------------------------------------------------------------------------
      ((member tType '("TEXT" "MTEXT"))                     ;текст, мтекст
       (setq sText (cdr (assoc 1 sObj)))
       (if (= tType "MTEXT")
         (setq sText (TTC_MText_Clear sText))
       ) ;_ if
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((or (= tType "spdsNotePosition")                     ;позиционная выноска
           (= tType "spdsNoteComb")                         ;гребенчатая выноска
           (= tType "spdsNoteChain")                        ;цепная выноска
           (= tType "spdsLinearMark")                       ;маркировка линейных конструкций
       ) ;_ or
       (setq i 0)
       (repeat (length sObj)
         (if (= (cdr (nth i sObj)) "String1")
           (progn
             (setq sText (cdr (nth (1+ i) sObj)))
           ) ;_ progn
         ) ;_ if
         (setq i (1+ i))
       ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((or
         (= tType "spdsLevelMark")                          ;отметка уровня
         (= tType "spdsPlaneLevelMark")                     ;отметка уровня на плане
         (= tType "spdsNodeMark")                           ;обозначение узла
       ) ;_ or
       (setq i 0)
       (repeat (length sObj)
         (if (= (cdr (nth i sObj)) "Text")
           (progn
             (setq sText (cdr (nth (1+ i) sObj)))
           ) ;_ progn
         ) ;_ if
         (setq i (1+ i))
       ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((= tType "spdsNoteKnot")                             ;узловая выноска 
       (setq sText (cdr (assoc 300 sObj)))
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((= tType "spdsConstructionLine")                     ;строительная ось
       (setq i 0)
       (repeat (length sObj)
         (if (= (cdr (nth i sObj)) "Axis name")
           (progn
             (setq sText (cdr (nth (1+ i) sObj)))
           ) ;_ progn
         ) ;_ if
         (setq i (1+ i))
       ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((or
         (= tType "spdsSection")                            ;разрез
         (= tType "spdsView")                               ;вид
       ) ;_ or
        (setq i 0)
        (repeat (length sObj)
          (if (= (cdr (nth i sObj)) "VSPrefix")
            (progn
              (setq sText (strcat
                            (cdr (nth (1+ i) sObj))         ;VSPrefix
                            (cdr (nth (+ 3 i) sObj))        ;VSNumber
                            (if (/= (cdr (nth (+ 5 i) sObj)) "")
                              (progn
                                (strcat
                                  "("
                                  (cdr (nth (+ 5 i) sObj))  ;SheetNumber
                                  ")"
                                ) ;_ strcat
                              ) ;_ progn
                              ""
                            ) ;_ if
                          ) ;_ strcat
              ) ;_ setq
            ) ;_ progn
          ) ;_ if
          (setq i (1+ i))
        ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((= tType "spdsNoteMultilayer")                       ;выноска для многослойных конструкций
       (setq i 0)
       (repeat (length sObj)
         (if (= (cdr (nth i sObj)) "NoteM_String0")
           (progn
             (setq sText (cdr (nth (1+ i) sObj)))
           ) ;_ progn
         ) ;_ if
         (setq i (1+ i))
       ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((= tType "spdsNoteSecant")                           ;узловая секущая выноска
       (setq i 0)
       (repeat (length sObj)
         (if (= (cdr (nth i sObj)) "NodeNumber")
           (progn
             (setq sText (strcat
                           (cdr (nth (1+ i) sObj))          ;NodeNumber

                           (if (/= (cdr (nth (+ 3 i) sObj)) "")
                             (progn
                               (strcat
                                 "("
                                 (cdr (nth (+ 3 i) sObj))   ;SheetNumber
                                 ")"
                               ) ;_ strcat
                             ) ;_ progn
                             ""
                           ) ;_ if
                         ) ;_ strcat
             ) ;_ setq
           ) ;_ progn
         ) ;_ if
         (setq i (1+ i))
       ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((= tType "spdsSquare")                               ;площадь
       (setq i 0)
       (repeat (length sObj)
         (if (= (cdr (nth i sObj)) "Text up")
           (progn
             (setq sText (cdr (nth (1+ i) sObj)))
           ) ;_ progn
         ) ;_ if
         (setq i (1+ i))
       ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
      ((= tType "spdsCLineOrient")                          ;указатель ориентации
       (setq i 0)
       (repeat (length sObj)
         (if (= (cdr (nth i sObj)) "Marker name")
           (progn
             (setq sText (cdr (nth (1+ i) sObj)))
           ) ;_ progn
         ) ;_ if
         (setq i (1+ i))
       ) ;_ repeat
      )
;;;---------------------------------------------------------------------------------------------------------------------
    ) ;_ cond
  ) ;_ if
  sText
) ;_ defun


(defun TTC_Paste (pasteStr offr / nslLst vlaObj hitPt hitRes Row Column sObj-new sObj)
  (setq errFlag nil)
;;;  (if (not offr) (setq offr "\nКуда вставлять текст? >"))
  (if (setq nslLst (nentsel offr))
    (progn (cond
             ((and (= 4 (length nslLst))                    ;размер
                   (= "DIMENSION" (cdr (assoc 0 (entget (car (last nslLst))))))
              ) ;_ and
              (setq vlaObj (vlax-ename->vla-object (cdr (assoc -1 (entget (car (last nslLst))))))
              ) ;_ setq
              (if (vl-catch-all-error-p
                    (vl-catch-all-apply
                      'vla-put-textoverride
                      (list vlaObj pasteStr)
                    ) ;_ vl-catch-all-apply
                  ) ;_ vl-catch-all-error-p
                (progn
                  (princ "\n Can't paste. Object may be on locked layer. ")
                  (setq errFlag t)
                ) ;_ progn
              ) ;_ if
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 4 (length nslLst))                    ;таблица
                   (= "ACAD_TABLE" (cdr (assoc 0 (entget (car (last nslLst))))))
              ) ;_ and
              (setq vlaObj (vlax-ename->vla-object (cdr (assoc -1 (entget (car (last nslLst))))))
                    hitPt  (vlax-3d-point (cadr nslLst))
                    hitRes (vla-hittest
                             vlaObj
                             hitPt
                             (vlax-3d-point '(0.0 0.0 1.0))
                             'Row
                             'Column
                           ) ;_ vla-HitTest
              ) ;_ setq
              (if (= :vlax-true hitRes)
                (progn
                  (if
                    (vl-catch-all-error-p
                      (vl-catch-all-apply
                        'vla-settext
                        (list vlaObj Row Column pasteStr)
                      ) ;_ vl-catch-all-apply
                    ) ;_ vl-catch-all-error-p
                     (progn
                       (princ "\n Can't paste. Object may be on locked layer. ")
                       (setq errFlag t)
                     ) ;_ progn
                  ) ;_ if
                ) ;_ progn
              ) ;_ if
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 4 (length nslLst))                    ;блок
                   (= "INSERT" (cdr (assoc 0 (entget (car (last nslLst))))))
              ) ;_ and
              (princ "\nCan't paste to block's DText or MText. ")
              (setq errFlag t)
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))                    ;текст, атрибуты
                   (member (cdr (assoc 0 (entget (car nslLst))))
                           '("TEXT" "MTEXT" "ATTRIB" "ATTDEF")
                   ) ;_ member
              ) ;_ and
              (setq vlaObj (vlax-ename->vla-object (car nslLst)))
              (if (vl-catch-all-error-p
                    (vl-catch-all-apply
                      'vla-put-textstring
                      (list vlaObj pasteStr)
                    ) ;_ vl-catch-all-apply
                  ) ;_ vl-catch-all-error-p
                (progn
                  (princ "\nError. Can't paste text. ")
                  (setq errFlag t)
                ) ;_ progn
              ) ;_ if
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))
                   (member (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst))))))
                           '("spdsNotePosition"             ;позиционная выноска
                             "spdsNoteComb"                 ;гребенчатая выноска
                             "spdsNoteChain"                ;цепная выноска
                             "spdsLinearMark"               ;маркировка линейных конструкций
                            )
                   ) ;_ member
              ) ;_ and
              (setq i 0)
              (repeat (length sObj)
                (if (= (cdr (nth i sObj)) "String1")
                  (progn
                    (setq sObj (subst (cons 300 pasteStr) (nth (1+ i) sObj) sObj))
                    (entmod sObj)                           ;изменяем примитив
                  ) ;_ progn
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))
                   (member (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst))))))
                           '("spdsLevelMark"                ;отметка уровня
                             "spdsPlaneLevelMark"           ;отметка уровня на плане
                             "spdsNodeMark"                 ;обозначение узла
                            )
                   ) ;_ member
              ) ;_ and
              (setq i 0)
              (repeat (length sObj)
                (if (= (cdr (nth i sObj)) "Text")
                  (progn
                    (setq sObj (subst (cons 300 pasteStr) (nth (1+ i) sObj) sObj))
                    (entmod sObj)                           ;изменяем примитив
                  ) ;_ progn
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))                    ;узловая выноска
                   (= (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst)))))) "spdsNoteKnot")
              ) ;_ and
              (setq numb pasteStr                           ;номер узла
                    list-num ""                             ;номер листа
              ) ;_ setq
              (if (setq addr-start (vl-string-search "(" pasteStr))
                (if (setq addr-end (vl-string-search ")" pasteStr))
                  (setq numb     (substr pasteStr 1 addr-start)
                        list-num (substr pasteStr (+ addr-start 2) (- addr-end addr-start 1))
                  ) ;_ setq
                ) ;_ if 
              ) ;_ if
              (setq i 0)
              (repeat (length sObj)
                (setq sObj-new (append sObj-new (list (nth i sObj))))
                (if (= (cdr (nth i sObj)) "NodeNumber")
                  (setq sObj-new (append sObj-new (list (cons 300 numb)))
                        sObj-new (append sObj-new (list (cons 301 "SheetNumber")))
                        sObj-new (append sObj-new (list (cons 300 list-num)))
                        i        (+ i 3)
                  ) ;_ setq
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
              (entmod (vl-remove-if 'null sObj-new))        ;изменяем примитив
             )
;;;---------------------------------------------------------------------------------------------------------------------
;;; 		   ((and (= 2 (length nslLst))              ;строительная ось
;;;                         (= (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst)))))) "spdsConstructionLine")
;;;                    ) ;_ and
;;;                     (setq i 10)
;;;                     (repeat (length sObj)
;;;                       (cond
;;;                         ((= (type (cdr (nth i sObj))) 'STR)
;;;                          (if (wcmatch (cdr (nth i sObj)) "Строительная ось *")
;;;                            (setq sObj (subst (cons 300 (strcat "Строительная ось " pasteStr)) (nth i sObj) sObj))
;;;                          ) ;_ if
;;;                         )
;;;                         ((= (cdr (nth i sObj)) "Axis name")
;;;                          (setq sObj (subst (cons 300 pasteStr) (nth (1+ i) sObj) sObj))
;;;                         )
;;;                       ) ;_ cond
;;;                       (setq i (1+ i))
;;;                     ) ;_ repeat
;;;                     (entmod sObj)                          ;изменяем примитив
;;;                   )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))
                   (member (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst))))))
                           '("spdsSection"                  ;разрез
                             "spdsView"                     ;вид
                            )
                   ) ;_ member
              ) ;_ and
              (setq numb pasteStr                           ;номер узла
                    list-num ""                             ;номер листа
              ) ;_ setq
              (if (setq addr-start (vl-string-search "(" pasteStr))
                (if (setq addr-end (vl-string-search ")" pasteStr))
                  (setq numb     (substr pasteStr 1 addr-start)
                        list-num (substr pasteStr (+ addr-start 2) (- addr-end addr-start 1))
                  ) ;_ setq
                ) ;_ if 
              ) ;_ if
              (setq i 0)
              (repeat (length sObj)
                (setq sObj-new (append sObj-new (list (nth i sObj))))
                (if (= (cdr (nth i sObj)) "VSNumber")
                  (setq sObj-new (append sObj-new (list (cons 300 numb)))
                        sObj-new (append sObj-new (list (cons 301 "SheetNumber")))
                        sObj-new (append sObj-new (list (cons 300 list-num)))
                        i        (+ i 3)
                  ) ;_ setq
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
              (entmod (vl-remove-if 'null sObj-new))        ;изменяем примитив
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))                    ;выноска для многослойных конструкций
                   (= (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst)))))) "spdsNoteMultilayer")
              ) ;_ and
              (setq i 0)
              (repeat (length sObj)
                (if (= (cdr (nth i sObj)) "NoteM_String0")
                  (progn
                    (setq sObj (subst (cons 300 pasteStr) (nth (1+ i) sObj) sObj))
                    (entmod sObj)                           ;изменяем примитив
                  ) ;_ progn
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))                    ;узловая секущая выноска
                   (= (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst)))))) "spdsNoteSecant")
              ) ;_ and
              (setq numb pasteStr                           ;номер узла
                    list-num ""                             ;номер листа
              ) ;_ setq
              (if (setq addr-start (vl-string-search "(" pasteStr))
                (if (setq addr-end (vl-string-search ")" pasteStr))
                  (setq numb     (substr pasteStr 1 addr-start)
                        list-num (substr pasteStr (+ addr-start 2) (- addr-end addr-start 1))
                  ) ;_ setq
                ) ;_ if 
              ) ;_ if
              (setq i 0)
              (repeat (length sObj)
                (setq sObj-new (append sObj-new (list (nth i sObj))))
                (if (= (cdr (nth i sObj)) "NodeNumber")
                  (setq sObj-new (append sObj-new (list (cons 300 numb)))
                        sObj-new (append sObj-new (list (cons 301 "SheetNumber")))
                        sObj-new (append sObj-new (list (cons 300 list-num)))
                        i        (+ i 3)
                  ) ;_ setq
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
              (entmod (vl-remove-if 'null sObj-new))        ;изменяем примитив
             )
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))                   ;площадь
                   (= (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst)))))) "spdsSquare")
              ) ;_ and
              (setq i 0)
              (repeat (length sObj)
                (if (= (cdr (nth i sObj)) "Text up")
                  (progn
                    (setq sObj (subst (cons 300 pasteStr) (nth (1+ i) sObj) sObj))
                    (entmod sObj)                           ;изменяем примитив
                  ) ;_ progn
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
             )             
;;;---------------------------------------------------------------------------------------------------------------------
             ((and (= 2 (length nslLst))                   ;указатель ориентации
                   (= (cdr (assoc 0 (setq sObj (entget (setq ename (car nslLst)))))) "spdsCLineOrient")
              ) ;_ and
              (setq i 0)
              (repeat (length sObj)
                (if (= (cdr (nth i sObj)) "Marker name")
                  (progn
                    (setq sObj (subst (cons 300 pasteStr) (nth (1+ i) sObj) sObj))
                    (entmod sObj)                           ;изменяем примитив
                  ) ;_ progn
                ) ;_ if
                (setq i (1+ i))
              ) ;_ repeat
             ) 
;;;---------------------------------------------------------------------------------------------------------------------
             (t
              (princ "\nCan't paste. Invalid object. ")
              (setq errFlag t)
             )                                              
           )                                                ; end cond
           t
    )                                                       ; end progn
    nil
  )                                                         ; end if
;;;  (princ)
) ;_ defun



(defun CCT_Str_Echo (paseStr / comStr)
     (if (< 20 (strlen paseStr))
	  (setq	comStr
		    (strcat
			 (substr paseStr 1 17)
			 "..."
		    ) ;_ strcat
	  ) ;_ setq
	  (setq comStr paseStr)
     )						  ; end if
     (princ
	  (strcat "\nText = \"" comStr "\"")
     ) ;_ princ
     (princ)
)						  ; end of CCT_Str_Echo





(defun TTC_MText_Clear (Mtext / Text Str)
     (setq Text "")
     (while (/= Mtext "")
	  (cond
	       ((wcmatch
		     (strcase
			  (setq	Str
				    (substr Mtext 1 2)
			  ) ;_ setq
		     ) ;_ strcase
		     "\\[\\{}`~]"
		) ;_ wcmatch
		(setq Mtext (substr Mtext 3)
		      Text  (strcat Text Str)
		)				  ; end setq
	       )				  ; end condition #1
	       ((wcmatch (substr Mtext 1 1) "[{}]")
		(setq Mtext
			  (substr Mtext 2)
		) ;_ setq
	       )				  ; end condition #2
	       ((wcmatch
		     (strcase
			  (substr Mtext 1 2)
		     ) ;_ strcase
		     "\\[LOP]"
		) ;_ wcmatch
		(setq Mtext (substr Mtext 3))
	       )				  ; end condition #3
	       ((wcmatch
		     (strcase
			  (substr Mtext 1 2)
		     ) ;_ strcase
		     "\\[ACFHQTW]"
		) ;_ wcmatch
		(setq Mtext
			  (substr Mtext
				  (+ 2
				     (vl-string-search ";" Mtext)
				  ) ;_ +
			  ) ;_ substr
		) ;_ setq
	       )				  ; end condition #4
	       ((wcmatch
		     (strcase (substr Mtext 1 2))
		     "\\S"
		) ;_ wcmatch
		(setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
		      Text  (strcat Text (vl-string-translate "#^\\" " " Str))
		      Mtext (substr Mtext (+ 4 (strlen Str)))
		)				  ; end setq
;;;		(print Str)
	       )				  ; end condition #5
	       (t
		(setq Text  (strcat Text (substr Mtext 1 1))
		      Mtext (substr Mtext 2)
		) ;_ setq
	       )				  ; end condition #6
	  )					  ; end cond
     )						  ; end while
     Text
) ;_ defun

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

[МишаИнженер]

Команда получается из функции добавлением в начало функции символов "C:" (по русски можно сказать что это намек, что данная функция это команда)
После символа "/" указываются "внутренние переменные функции, которые впрочем можно не описывать. Поэтому функцию FHS можно упростить:

Код:

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

 
;Собирает имена всех шаблонов штриховки, используемых в текущем чертеже, включая те, которые используются только внутри блоков
(defun FHS ();FindHatchStyle Поиск Стиля Штриховки
  (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for obj block
      (if (and
		  (eq (vla-get-objectname obj) "AcDbHatch")
		  (not (member (setq h (vla-get-PatternName obj)) l))
	   )
	   (setq l (cons h l))
      );_end if
    )
  )
  (acad_strlsort l)
)

Непонятно только как строка (setq l (cons h l)) создает список который потом сортируется в строке (acad_strlsort l)
И в итоге программа ничего не выдает на выходе

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

Сообщение от МишаИнженер Команда получается из функции добавлением в начало функции символов "C:" (по русски можно сказать что это намек, что данная функция это команда)

Читаешь правильно. А вот как вызывать одно и другое - вот тут разница известна?

Сообщение от МишаИнженер Непонятно только как строка (setq l (cons h l)) создает список который потом сортируется в строке (acad_strlsort l)

В любом учебнике по лиспу это расписано. Да и в справке, кстати, тоже.

Сообщение от МишаИнженер И в итоге программа ничего не выдает на выходе

Значит в текущем файле не найдены штриховки.

[name02]

Сообщение от МишаИнженер Неизвестная команда FHS. Почему так происходит?

Конструкция defun определяет функцию, в данном примере это функция FHS. Чтобы вызвать функцию, загруженную в автокад надо набрать в командной строке (FHS).
Если имя функции начинается с C: (например C:FHS) - то автокад уже воспринимает эту функцию как свою внутреннюю команду, и для вызова ее достаточно набрать все что написано после C: - т.е. просто FHS или же все название функции в круглых скобках (C:FHS).

Сообщение от Кулик Алексей aka kpblc Еще раз повторю - либо чтение литературы

[МишаИнженер]

Понятно, добавил C: и после fhs функция выдала список штриховок. Вызов (fhs) не знал. Спасибо буду знать!
Не понимаю как несколько раз вызванная строка (setq l (cons h l)) создает список? Почему она каждый раз дополняет список, а не записывает его заново?
Модифицировал функцию:

Код:

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

 
(defun C:SetProp ()
	(while (setq el (car (entsel "\n Выбери объект:")))
	;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
	;команды которые должны выполняться в цикле пока не будет пустой ввод
	  (setq dan (entget el));получает список с характеристиками примитива
	  (setq name0 (assoc 0 dan)) ;получаем имя объекта
	  (setq name (cdr name0))
	  (princ (strcat " " name))
;;;	  (alert (strcat "Был выбран " name))
	  (princ (strcat (chr 10) "========================================================="))
	  (princ (strcat (chr 10) "Был выбран " name))
	  (setq cLayer0 (assoc 8 dan)) ;получаем имя объекта
	  (setq cLayer (cdr cLayer0))
	  (setq cLWeight0 (assoc 370 dan)) ;получаем текущий вес линии
	  (setq cLWeight (cdr cLWeight0))
	  (setq cLType0 (assoc 6 dan)) ;получаем текущий тип линии
	  (setq cLType (cdr cLType0))  
	  (setq cLTypeScale0 (assoc 48 dan)) ;получаем текущий масштаб типа линии
	  (setq cLTypeScale (cdr cLTypeScale0))
	  (setq cColor0 (assoc 62 dan)) ;получаем текущий цвет
	  (setq cColor (cdr cColor0))
	  (setq cThick0 (assoc 39 dan)) ;получаем текующую толщину
	  (setq cThick (cdr cThick0))
	  
	;Назначим текущим слой выбранного объекта (setvar "clayer" <имя слоя>)
	  (setvar "clayer" cLayer)
	  (princ (strcat (chr 10) "Был назначен текущий слой " (chr 34) cLayer (chr 34)))
	;Назначим текущий вес линий
	  (cond ((eq cLWeight nil)
			(setvar "CELWEIGHT" -1)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cLWeight -2)
			(setvar "CELWEIGHT" -2)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоБлоку" (chr 34)))
			)
		((eq cLWeight -3)
			(setvar "CELWEIGHT" -3)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоУмолчанию" (chr 34)))
			)
		(t 
			(setvar "CELWEIGHT" cLWeight)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) (rtos (/ cLWeight 100.0)) (chr 34)))
		)
	   )
	;Назначим текущий тип линии
	  (cond ((eq cLType nil)
			(setvar "CELTYPE" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) "ПоСлою" (chr 34)))
			)
		(t 
			(setvar "CELTYPE" cLType)
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) cLType (chr 34)))
		)
	   )
	;Назначим текущий масштаб типа линии
	  (cond ((eq cLTypeScale nil)
			(setvar "CELTSCALE" 1)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) "1" (chr 34)))
			)
		(t 
			(setvar "CELTSCALE" cLTypeScale)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) (rtos cLTypeScale) (chr 34)))
		)
	   )
	;Назначим ткущий цвет чертежа
	  (cond ((eq cColor nil)
			(setvar "CECOLOR" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cColor 0)
			(setvar "CECOLOR" "ByBlock")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоБлоку" (chr 34)))
			)
		(t 
			(setvar "CECOLOR" (rtos cColor))
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) (rtos cColor) (chr 34)))
		)
	   )
	;Назначаем текущую толщину
	  (cond ((eq cThick nil)
			(setvar "THICKNESS" 0)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) "0" (chr 34)))
			)
		(t 
			(setvar "THICKNESS" cThick)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) (rtos cThick) (chr 34)))
		)
	   )
	;Назначим особые свойства для сложных объектов
	  (setq TypeObj (strcase name)) 
	  (cond 
		((eq TypeObj "ACAD_TABLE");Назначим текущий стиль таблиц
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CTABLESTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль таблиц " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MTEXT");Назначим текущий стиль текста
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "TEXTSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль текста " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MULTILEADER");Назначим текущий стиль мультивыносок
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLEADERSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультивыносок " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MLINE");Назначим текущий стиль мультилинии
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLSTYLE" StyleName);CMLSCALE CMLJUST
			(princ (strcat (chr 10) "Был назначен текущий стиль мультилиний " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "DIMENSION");Назначим текущий стиль размеров
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(command "_-dimstyle" "_r" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль размеров " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "HATCH");Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(setq HatchCol (FHS))
		 	(if (t (member StyleName HatchCol))
				(progn
					(setvar "HPNAME" StyleName)
					(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
				)
			)
		)
	  )
	)
)

(defun FHS ();FindHatchStyle Поиск Стиля Штриховки
;Собирает имена всех шаблонов штриховки, используемых в текущем чертеже, включая те, которые используются только внутри блоков
  (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for obj block
      (if (and
		  (eq (vla-get-objectname obj) "AcDbHatch")
		  (not (member (setq h (vla-get-PatternName obj)) l))
	   )
	   (setq l (cons h l))
      );_end if
    )
  )
  (acad_strlsort l)
)

Почему при выделении штриховки появляется ошибка: ; ошибка: неверная функция: T
Причем StyleName это "список символов", а HatchCol это список названий штриховок.
Что там надо исправить?

[Сергей812]

Offtop: интересно, когда ТС "узнает" - что в лиспе отладчик тоже есть...

[name02]

Ты бы хоть писал где ошибка происходит, в какой строке...
Если про 121 - то ошибка в (t (member StyleName HatchCol)) - lisp ищет функцию именем t. А тебе похоже нужно сравнение с истиной.
И предвкушая будущее - не надо писать конструкт вида (if (= t (member StyleName HatchCol)) или (if (not (null (member StyleName HatchCol)))) - можно просто (if (member StyleName HatchCol)

(setq l (cons h l)) - присваивает переменной l значение пары, в которую записывает имеющееся значение переменной l

Сообщение от Кулик Алексей aka kpblc В любом учебнике по лиспу это расписано. Да и в справке, кстати, тоже.

[МишаИнженер]

Я назначаю точку останова в AutoLisp, программа останавливается, я проверяю значения переменных, но потом все зависает. Приходится все останавливать и запускать все заново.
Насчет команды member мне кажется надо создать список из 1 аргумента. Но как это сделать?

[Сергей812]

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

[МишаИнженер]

Сообщение от name02 А тебе похоже нужно сравнение с истиной.

Да надо сравнение с истиной

Сообщение от name02 (setq l (cons h l)) - присваивает переменной l значение пары, в которую записывает имеющееся значение переменной l

тогда должно получатся (("знач1" "знач2 "знач3"))))
а получается ("знач1" "знач2" "знач3")
Непонятно!

[trir]

штриховки не в чертеже, а автокаде

[===AAA===]

Вообще говоря, если второй элемент не атом, т.е. если /b/ - список,
то (cons a b) просто добавляет первый элемент /а/ в начало списка.

И, как правило, в этом функционале (cons … ) и используют.

[name02]

https://help.autodesk.com/view/ACD/2...E-F070F0A7CB2B
добавь в закладки!

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

Offtop: Мне интересно, насколько у народа хватит терпения объяснять, что справку все же не стоит игнорировать...

[МишаИнженер]

Сообщение от ===AAA=== (cons a b) просто добавляет первый элемент /а/ в начало списка

Интересная идея и функция вроде подходит. Спасибо!
Исправил код

Код:

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

 
		((eq TypeObj "HATCH");Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(setq HatchCol (FHS))
		 	(if (t (member (cons StyleName FindSN) HatchCol))
				(progn
					(setvar "HPNAME" StyleName)
					(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
				)
			)
		)

Но все равно появляется ошибка: ; ошибка: неверная функция: T
Не могу найти справку на функцию Т. Как правильно её использовать и что это за функция (это функция из функций сравнения)?

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

Это что за бред зеленой лошади?

Код:

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

if (t (member (cons StyleName FindSN) HatchCol))

[Сергей812]

Offtop: это просто лисп ТС "не зашел".. или его сразу "воспринимаешь", или опыт с "обычными" языками программирования вступает в постоянный конфликт с подходом к программированию в лиспе. Учитывая явное нежелание ТС хоть как-то систематизировать знания - это, похоже, надолго)

[МишаИнженер]

Сообщение от Кулик Алексей aka kpblc if (t (member (cons StyleName FindSN) HatchCol))

Если функция member возвратит номер позиции (не nil) значит это значение при конвертировании в булевский тип должно быть ИСТИНА, а функция T сравнивает аргумент с истиной. Если аргумент ИСТИНА, тогда функция T должна вернуть значение ИСТИНА.
Но почему функция Т не хочет выполняться?

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

Для ради приколу посмотри в справке примеры использования if в лиспе. В VBA ты тоже пишешь:
If value=1 Then True
Else False
End If
?

----- добавлено через ~2 мин. -----
Пара недель ненапряжного чтения и пара десятков собствнных экспериментов (только нормальных, а не простого копипастинга кода без малейшего понимания что куда и зачем) будут значительно более эффективны. Offtop: Но ТС, как тот комсомолец, без трудностей не может, похоже.

[===AAA===]

Это он "хвостик" от (cond …) в (if … ) запихнуть попытался, похоже...

[Сергей812]

Т - это вроде логическая константа, а не функция. А if воспринимает nil как ложь - это вам любая справка скажет, если туда заглянете)

----- добавлено через ~2 мин. -----
Offtop: люди в свое время изучали языки программирования методом тыка, конечно.. но это уже лет этак 20+ неактуально в связи с появлением инета)

[МишаИнженер]

Вот в таком виде получается доступ к командам если искомая штриховка находится в списке штриховок чертежа:

Код:

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

 
(defun C:SetProp ()
	(while (setq el (car (entsel "\n Выбери объект:")))
	;entsel выдает имя объекта и все остальное, car - Извлекает первый элемент из списка: имя объекта
	;команды которые должны выполняться в цикле пока не будет пустой ввод
	  (setq dan (entget el));получает список с характеристиками примитива
	  (setq name0 (assoc 0 dan)) ;получаем имя объекта
	  (setq name (cdr name0))
	  (princ (strcat " " name))
;;;	  (alert (strcat "Был выбран " name))
	  (princ (strcat (chr 10) "========================================================="))
	  (princ (strcat (chr 10) "Был выбран " name))
	  (setq cLayer0 (assoc 8 dan)) ;получаем имя объекта
	  (setq cLayer (cdr cLayer0))
	  (setq cLWeight0 (assoc 370 dan)) ;получаем текущий вес линии
	  (setq cLWeight (cdr cLWeight0))
	  (setq cLType0 (assoc 6 dan)) ;получаем текущий тип линии
	  (setq cLType (cdr cLType0))  
	  (setq cLTypeScale0 (assoc 48 dan)) ;получаем текущий масштаб типа линии
	  (setq cLTypeScale (cdr cLTypeScale0))
	  (setq cColor0 (assoc 62 dan)) ;получаем текущий цвет
	  (setq cColor (cdr cColor0))
	  (setq cThick0 (assoc 39 dan)) ;получаем текующую толщину
	  (setq cThick (cdr cThick0))
	  
	;Назначим текущим слой выбранного объекта (setvar "clayer" <имя слоя>)
	  (setvar "clayer" cLayer)
	  (princ (strcat (chr 10) "Был назначен текущий слой " (chr 34) cLayer (chr 34)))
	;Назначим текущий вес линий
	  (cond ((eq cLWeight nil)
			(setvar "CELWEIGHT" -1)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cLWeight -2)
			(setvar "CELWEIGHT" -2)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоБлоку" (chr 34)))
			)
		((eq cLWeight -3)
			(setvar "CELWEIGHT" -3)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) "ПоУмолчанию" (chr 34)))
			)
		(t 
			(setvar "CELWEIGHT" cLWeight)
			(princ (strcat (chr 10) "Был назначен текущий вес линий " (chr 34) (rtos (/ cLWeight 100.0)) (chr 34)))
		)
	   )
	;Назначим текущий тип линии
	  (cond ((eq cLType nil)
			(setvar "CELTYPE" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) "ПоСлою" (chr 34)))
			)
		(t 
			(setvar "CELTYPE" cLType)
			(princ (strcat (chr 10) "Был назначен текущий тип линий " (chr 34) cLType (chr 34)))
		)
	   )
	;Назначим текущий масштаб типа линии
	  (cond ((eq cLTypeScale nil)
			(setvar "CELTSCALE" 1)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) "1" (chr 34)))
			)
		(t 
			(setvar "CELTSCALE" cLTypeScale)
			(princ (strcat (chr 10) "Был назначен текущий масштаб типа линий " (chr 34) (rtos cLTypeScale) (chr 34)))
		)
	   )
	;Назначим ткущий цвет чертежа
	  (cond ((eq cColor nil)
			(setvar "CECOLOR" "ByLayer")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоСлою" (chr 34)))
			)
		((eq cColor 0)
			(setvar "CECOLOR" "ByBlock")
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) "ПоБлоку" (chr 34)))
			)
		(t 
			(setvar "CECOLOR" (rtos cColor))
			(princ (strcat (chr 10) "Был назначен текущий цвет " (chr 34) (rtos cColor) (chr 34)))
		)
	   )
	;Назначаем текущую толщину
	  (cond ((eq cThick nil)
			(setvar "THICKNESS" 0)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) "0" (chr 34)))
			)
		(t 
			(setvar "THICKNESS" cThick)
			(princ (strcat (chr 10) "Была назначена текущая толщина " (chr 34) (rtos cThick) (chr 34)))
		)
	   )
	;Назначим особые свойства для сложных объектов
	  (setq TypeObj (strcase name)) 
	  (cond 
		((eq TypeObj "ACAD_TABLE");Назначим текущий стиль таблиц
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CTABLESTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль таблиц " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MTEXT");Назначим текущий стиль текста
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "TEXTSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль текста " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MULTILEADER");Назначим текущий стиль мультивыносок
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLEADERSTYLE" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль мультивыносок " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "MLINE");Назначим текущий стиль мультилинии
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(setvar "CMLSTYLE" StyleName);CMLSCALE CMLJUST
			(princ (strcat (chr 10) "Был назначен текущий стиль мультилиний " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "DIMENSION");Назначим текущий стиль размеров
		 	(setq StyleName (vla-get-stylename (vlax-ename->vla-object el)))
			(command "_-dimstyle" "_r" StyleName)
			(princ (strcat (chr 10) "Был назначен текущий стиль размеров " (chr 34) StyleName (chr 34)))
		)
		((eq TypeObj "HATCH");Назначим текущий стиль штриховки
			(setq StyleName (cdr (assoc 2 dan)))
		 	(setq HatchCol (FHS))
		 	(if (member StyleName HatchCol)
				(progn
					(setvar "HPNAME" StyleName)
					(princ (strcat (chr 10) "Был назначен текущий стиль штриховки " (chr 34) StyleName (chr 34)))
				)
			  	(princ (strcat (chr 10) "Штриховка " (chr 34) StyleName (chr 34) " ненайдена среди штриховок АвтоКада"))
			)
		)
	  )
	)
)

(defun FHS ();FindHatchStyle Поиск Стиля Штриховки
;Собирает имена всех шаблонов штриховки, используемых в текущем чертеже, включая те, которые используются только внутри блоков
  (vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (vlax-for obj block
      (if (and
		  (eq (vla-get-objectname obj) "AcDbHatch")
		  (not (member (setq h (vla-get-PatternName obj)) l))
	   )
	   (setq l (cons h l))
      );_end if
    )
  )
  (acad_strlsort l)
)

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

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

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

[МишаИнженер]

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

Сообщение от SetQ ******dict

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

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

А почитать, подумать, проанализировать - не?

Код:

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

Dim aValue As Integer
Dim bValue As Integer
aValue =
  bValue

Последнюю строку тоже снесешь?

[Konstr_pgs]

Нужна помощь в корректировке лиспа Сумматор текста (автор Владимир Громов, корр.ZZZ, Евгений Елпанов, Вадим).
1. В лиспе есть "." и ",", но нет возможности выбрать(собственно выбор не нужен, нужна точка),
сумма вставляется с ",".
Если просто удалить "," пишет в КС: ; ошибка: слишком мало аргументов. Как можно вставку суммы
производить с разделителем "."?
2. А ещё выскакивает табличка
Сообщение AutoCad Сумма=2,18
Укажите точку вставки
Надо жать на ОК, потом указывать точку вставки, ненужные движения.
Можно убрать эту таблицу, просто указывать точку вставки суммы в чертеж.
3. Добавить возможность выбора высоты текста, или лучше по умолчанию 250. Такая странность, если
установить текущим стиль текста с заданной высотой 250, текст вставляет "0" да ещё
с поворотом 3 градуса, при этом, в окне показывается правильная сумма... Корректно работает только с высотой текста 2.5.
Подскажите, пожалуйста, в чём затык.

Код:

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

 (defun c:z-calc-text-value (/ value ent obj ss)
  (vl-load-com)
  (princ
    "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
    ) ;_ princ
  (setq ss (ssget '((0 . "TEXT,MTEXT"))))
  (if (not ss)
    (princ "Не выбраны объекты")
    (progn
      (setq
  value (rtos
    (apply
      (function +)
      (mapcar
        (function
          (lambda (a)
      (atof
        (vl-string-trim
          "%Uu {\\Ll}"
          (vl-string-subst
            "."
            ","
            (cdr (assoc 1 (entget a)))
            ) ;_ vl-string-subst
          ) ;_ vl-string-trim
        ) ;_ atof
      ) ;_ lambda
          ) ;_ function
        (vl-remove-if
          (function listp)
          (mapcar (function cadr)
            (ssnamex ss)
            ) ;_ mapcar
          ) ;_ vl-remove-if
        ) ;_ mapcar
      ) ;_ apply
    ) ;_ rtos
  ) ;_ setq
      (if (vl-string-position (ascii ".") value)
  (setq value (vl-string-right-trim ".0" value))
  ) ;_ if
      (setq value (vl-string-subst "," "." value))
      (princ (strcat "\n Сумма = " value))
      (alert (strcat "Сумма = " value "\nУкажите точку вставки "))
      (setvar "ERRNO" 0)
      (if (and ent
         (vlax-property-available-p
     (setq obj (vlax-ename->vla-object ent))
     'TextString
     ) ;_ vlax-property-available-p
         ) ;_ and
  (progn
    (vlax-put-property obj 'TextString value)
    (vlax-release-object obj)
    ) ;_ progn
  ) ;_ if
      ) ;_ progn
    ) ;_ if
  (setq pt2 (getpoint))
  (setq r (* (getvar "DIMSCALE") (getvar "DIMTXT")))
   (command "_text" pt2 r 0 value)
  (princ)
  ) ;_ defun

[skkkk]

Сообщение от Konstr_pgs 1. В лиспе есть "." и ",", но нет возможности выбрать(собственно выбор не нужен, нужна точка), сумма вставляется с ",".

Убрать в коде строчку 42

Сообщение от Konstr_pgs 2. А ещё выскакивает табличка Сообщение AutoCad Сумма=2,18 Укажите точку вставки Надо жать на ОК, потом указывать точку вставки, ненужные движения. Можно убрать эту таблицу, просто указывать точку вставки суммы в чертеж.

Убрать строчку 44.

Сообщение от Konstr_pgs 3. Добавить возможность выбора высоты текста, или лучше по умолчанию 250.

После строки 53 добавить строку:

Код:

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

(vlax-put-property obj 'Height 250)

[Konstr_pgs]

skkkk, спасибо большое, буду пробовать...
Всё работает, как хотелось! Только сумму меньше нуля выводит в виде .27 (а не 0.27) Это можно изменить?
Вот подкорректированный код

Код:

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

 (defun c:z-calc-text-value (/ value ent obj ss)
 (vl-load-com)
 (princ
   "\nВыберите текстовые объекты среди которых будет произведененна калькуляция"
   ) ;_ princ
 (setq ss (ssget '((0 . "TEXT,MTEXT"))))
 (if (not ss)
   (princ "Не выбраны объекты")
   (progn
     (setq
 value (rtos
   (apply
     (function +)
     (mapcar
       (function
         (lambda (a)
     (atof
       (vl-string-trim
         "%Uu {\\Ll}"
         (vl-string-subst
           "."
           ","
           (cdr (assoc 1 (entget a)))
           ) ;_ vl-string-subst
         ) ;_ vl-string-trim
       ) ;_ atof
     ) ;_ lambda
         ) ;_ function
       (vl-remove-if
         (function listp)
         (mapcar (function cadr)
           (ssnamex ss)
           ) ;_ mapcar
         ) ;_ vl-remove-if
       ) ;_ mapcar
     ) ;_ apply
   ) ;_ rtos
 ) ;_ setq
     (if (vl-string-position (ascii ".") value)
 (setq value (vl-string-right-trim ".0" value))
 ) ;_ if
     (princ (strcat "\n Сумма = " value))
     (setvar "ERRNO" 0)
     (if (and ent
        (vlax-property-available-p
    (setq obj (vlax-ename->vla-object ent))
    'TextString
    ) ;_ vlax-property-available-p
        ) ;_ and
 (progn
   (vlax-put-property obj 'TextString value)
  (vlax-put-property obj 'Height 250)
   (vlax-release-object obj)
   ) ;_ progn
 ) ;_ if
     ) ;_ progn
   ) ;_ if
 (setq pt2 (getpoint))
 (setq r (* (getvar "DIMSCALE") (getvar "DIMTXT")))
  (command "_text" pt2 r 0 value)
 (princ)
 ) ;_ defun

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

Сообщение от Konstr_pgs Это можно изменить?

Можно: https://autolisp.ru/2021/05/19/chto-...-te-rezultaty/

[Konstr_pgs]

Спасибо, Алексей. DIMZIN в "8" и отображается с нулем 0.25. А была DIMZIN 13 (AutoCad 2015rus), в справке нет такой цифры...

[===AAA===]

DIMZIN - битовая величина

13 = 1+4+8

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

Сообщение от ===AAA=== DIMZIN - битовая величина 13 = 1+4+8

Сомневаюсь. Значение 3 как толковать? А 12? Как 12 или как 4+8? )))

[===AAA===]

Если верить справке (в которой - надо отметить - нет упоминания о "битовости" этой переменной), то:

4
Подавляет ведущие нули в десятичных размерах (например, 0,5000 записывается как ,5000)
8
Подавляет замыкающие нули в десятичных размерах (например, 12,5000 записывается как 12,5)
12
Подавляет и ведущие, и замыкающие нули (например, 0,5000 записывается как ,5)

Тогда 12=8+4

Вот с "тройкой", действительно, кривовато как-то.

Экспериментировать надо. Но для футов и дюймов не слишком оно актуально...

Но - опять же:

Команда: DIMZIN
Новое значение DIMZIN <13>: 18
Требуется целое значение от 0 до 15.

Что это, как не "битовость"?

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

Уговорил, чертяка языкатый

[koMon]

[Konstr_pgs]

Тема решилась см. #4337

[Konstr_pgs]

Если в чертеже просуммировать 3 текста, то получается такой код поля

Код:

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

  %<\AcExpr (%<\_FldPtr 891083120>%+%<\_FldPtr 891087632>%+%<\_FldPtr 891087152>%) \f "%lu2%pr2">%

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

Код:

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

 "%<\\AcObjProp Object(%<\\_ObjId "
	          (LM:objectid (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
	                              ">%).TextString>%" " + " lst

[Konstr_pgs]

Вопрос с полями суммы решился в теме "Поле суммы нескольких текстов". Спасибо gumel & Lee Mac!

[Sege]

Коллеги! Возможно торможу, но как с помощью ssget выбрать определенные объекты (например TEXT,MTEXT), которые находятся внутри заданной окружности.
Пока вижу только такой метод:
(ssget "_W" '(x1 y1) '(x2 y2))
где x1 y1, x2 y2 - координаты рамки, описывающую окружность (т.е. надо вычислить две точки рамки-квадрата, с учетом координаты центра круга и радиуса)
Или можно проще?

[Сергей812]

все варианты ssget от Lee Mac. Есть еще ключ _WP - для непрямоугольных окон выбора.

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

Чисто теоретически можно высчитать несколько десятков точек (так сказать, аппроксимировать окружность полигоном) и выбирать уже не через _W, а через _CP (кажется, так)

[Сергей812]

_CP - это захватывает объекты, находящиеся внутри полигона полностью и частично (т.е. пересекающие его).
_WP - только те объекты, которые полностью внутри полигона.

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

[Sege]

Сообщение от Кулик Алексей aka kpblc Чисто теоретически можно высчитать несколько десятков точек (так сказать, аппроксимировать окружность полигоном) и выбирать уже не через _W, а через _CP (кажется, так)

да, поначалу думал с помощью -ConvTo2d из PL-tools получить вместо круга полилинию и уже использовать "_CP"
но все-же проще оказалось просто получить координаты 2-х точек диагоналей "квадрата описывающий круг" и использовать "_W"

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

Сообщение от Сергей812 _CP - это захватывает объекты, находящиеся внутри полигона полностью и частично (т.е. пересекающие его). _WP - только те объекты, которые полностью внутри полигона. экспериментируйте - что даст приемлемую погрешность выбора. ----- добавлено через ~2 мин. ----- в случае прямоугольного окна и _CP больше риск "подцепить" примитивы из углов вне окружности.

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

[lenivec]

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

Только не для последних версий AutoCAD

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

Не уверен, если честно.

[koMon]

очень зря) _cp точно.

[Konstr_pgs]

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

Код:

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

 ":column {label=\" Параметры текста\";" 
":row {"
":text {label= \" Слой: \"; width=20;}"
":popup_list {key=\"b1\"; is_enabled=true; label=\"\"; list=\"\"; width=30;}"
 "}"
":row {"
":text {label= \" Стиль текста: \"; width=20;}"
":popup_list {key=\"b2\"; is_enabled=true; label=\"\"; list=\"\"; width=30;}"
"}"
":edit_box {label= \" Высота текста: \"; key=\"b3\"; value=\"\"; edit_width=28; edit_limit=60;}"
":edit_box {label= \" Сжатие: \"; key=\"b4\"; value=\"\"; edit_width=28; edit_limit=60;}"

Текст с такими параметрами имеет выравнивание "середина влево"(ml), как это исправить на "середина по центру" (mc)?
Здесь нет ml (Middleleft)? Или нужен какой-то цифровой код?

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

dcl как dcl. В чем трудность пока не понимаю.
https://www.google.com/search?q=autolisp+dcl+alignment
https://www.cadtutor.net/forum/topic...gnment-column/
https://www.afralisp.net/archive/lispa/lisp49a.htm
Ну и так далее.

[Konstr_pgs]

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

В какой строке "сидит" это выравнивание в данном коде?

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

alignment где ж еще. По ссылкам проходил? Смотрел что там предлагается?

[Konstr_pgs]

здесь alignment=centered (середина влево)

Код:

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

  "}"
              "spacer_1;"
              "ok_cancel;"
           "}"                                                                                 

        "Error_Nachzn: dialog"
            "{label = \"Ошибка типа\";"
               "spacer;"
               ":text_part {label=\"Ошибка: В поле <Нач. значение> введите числовое значение\"; key=\"c1\"; alignment=centered;}"
               "spacer;"
               "ok_button;"
            "}"

а как записать середина по центру?

[koMon]

никак. нужно имхо строить многоуровневые кластеры.

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

https://www.cadtutor.net/forum/topic...alignment-dcl/ ?
Offtop: Я сейчас не занимаюсь dcl, и прилично все позабыл.

[Konstr_pgs]

Сообщение от koMon никак. нужно имхо строить многоуровневые кластеры

Всё так сложно???

[koMon]

не то чтобы сложно, но как-то очень не современно(

[Shox]

Здравствуйте.
Не могу разобраться, почему при сохранении чертежа например в C:\Folder\Чертеж.dwg
и выполнении команды "vl-directory-files" я вижу список файлов и папок в Моих документах, но если я повторно открываю этот чертеж, команда выдает список файлов и папок в C:\Folder\ как мне было нужно.
тоже самое с "findfile"

И еще вопрос. Как правильно объяснить автолиспу, что последующий код нужно выполнять только после того, как отработал скрипт на питоне "(command "_.shell" "python convert.py")". Я Сделал это через создание вспомогательного файла в директории с проектом, но что то мне подсказывает это не самый лучший вариант)

[bloodassasinv]

Добрый день, пробую изучать лисп. Хочу создать программу которая будет копировать объекты в буфер обмена с базовой точкой 0 0 0. Как не тыкаюсь-получаю ошибки(как минимум в 6 строке, дальше отладку не делал), в общем доступе найти решение не получилось, прошу помочь.

Код:

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

(defun c:copyto0 (/ ss obj newdoc objname objlist cmd)
  (setq ss (ssget))
  (if ss
    (progn
      (setq newdoc (vla-get-activedocument (vlax-get-acad-object)))
      (setq obj (vlax-invoke-method newdoc 'CopyObjects ss newdoc))
      (vlax-invoke-method newdoc 'SetVariable "UCSNAME" "0,0,0")
      (setq obj (vlax-invoke-method obj 'Explode))
      (setq objlist '())
      (foreach o obj
        (setq objname (vla-get-objectname o))
        (setq objlist (cons (strcat "\"" objname "\"") objlist))
      )
      (setq cmd (strcat "_copyclip " (apply 'strcat (reverse objlist))))
      (vlax-release-object newdoc)
      (vlax-release-object obj)
      (vl-cmd cmd)
      (princ "Selected objects copied to clipboard with 0,0,0 UCS.")
    )
    (princ "No objects selected.")
  )
  (princ)
)

[Shox]

Сообщение от bloodassasinv Хочу создать программу которая будет копировать объекты в буфер обмена с базовой точкой 0 0 0.

Если только это

Код:

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

 
(defun c:copyto0 (/ ss )
  (setq ss (ssget))
  (command "_.copybase" '(0.0 0.0 0.0) ss "")
)

[bloodassasinv]

Сообщение от Shox Если только это Код: [Выделить все] (defun c:copyto0 (/ ss ) (setq ss (ssget)) (command "_.copybase" '(0.0 0.0 0.0) ss "") )

Супер, спасибо! Сравниваю ваш код со своим.. куда-то я совсем не туда полез

[koMon]

Сообщение от Shox в C:\Folder\ как мне было нужно

(vl-directory-files "c:\\folder")

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

Сообщение от Shox (command "_.shell" "python convert.py")

Попробуй заменить command на command-s или vl-cmdf

[Shox]

Сообщение от koMon (vl-directory-files "c:\\folder")

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

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

Сообщение от Кулик Алексей aka kpblc Попробуй заменить command на command-s или vl-cmdf

Все 3 варианта рабочие (command, command-s, vl-cmdf), но только если чертеж был запущен в нужной директории, а вот если он первый раз сохранен, то рабочая папка не определяется.

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

Сообщение от Shox Помогла бы функция для определения директории в который сохранен чертеж, но я такую не нашел.

(getvar "dwgprefix")

[Sege]

Как указать команде "_.offset" чтобы она сделала подобие замкнутого контура во внутрь (т.е. без указания это мышкой) ?
т.е. если pnt - это точка ВНУТРИ замкнутого контура, то offset это выполняет:

(command "_.offset" 10 (car (entsel)) "_NONE" pnt "")

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

upd: задача решена с помощью готового лиспа

Код:

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

 
;|
OffsetInOrOut.lsp [command names:  OffIn & OffOut]
To Offset selected objects all by same User-specified distance, all either Inward
  or Outward, regardless of drawn direction.
OffIn = Offset Inward; OffOut = Offset Outward.
Works on Arcs/Circles/Ellipses/planar Splines/LW or "heavy" 2D Polylines.
  [cannot Offset 3D Polylines or non-planar Splines].  Polylines/Splines/
  Ellipses can be open/partial or closed/full.
Offsets in direction that results in entity of [in OffIn] smaller or [in OffOut]
  larger area than original.
In OffIn, detects objects too small to be Offset Inward by specified distance,
  and reports how many there were.
Can have unintended result with Polyline/Spline if self-intersecting or of other
  shape that results in more than one new entity when Offset.
Works in any UCS.
Remembers User's distance independent of regular Offset's, and offers as
  default on subsequent use; on first use, offers regular Offset's if not Through.
Kent Cooper, 1 August 2018
|;
(defun OIO ; = Offset object(s) Inward or Outward [called by OffIn & OffOut]
  (subpr / *error* doc ss nogo n ent obj oarea)
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
      (princ (strcat "\nError: " errmsg))
    ); if
    (vla-endundomark doc)
    (princ)
  ); defun - *error*
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (initget (if (and (not *OIOdist) (= (getvar 'offsetdist) -1.0)) 7 6))
    ; no Enter if no prior value and regular Offset is Through; no zero; no negative
  (setq *OIOdist ; global, to offer as default on subsequent use
    (cond
      ( (getdist ; User input
          (strcat
            "\nDistance to Offset " subpr "ward"
            (cond
              (*OIOdist (strcat " <" (rtos *OIOdist) ">")); prior OIO value
              ((/= (getvar 'offsetdist) -1.0) (strcat " <" (rtos (getvar 'offsetdist)) ">"))
                ; regular Offset's distance if not Through
              (""); no default if neither above condition
            ); cond
            ": "
          ); strcat
        ); getdist
      ); User-input condition
      (*OIOdist); User Enter with prior OIO value
      ((/= (getvar 'offsetdist) -1.0) (getvar 'offsetdist))
        ; User Enter with no OIO value but regular Offset not Through
    ); cond
    nogo 0
  ); setq
  (prompt (strcat "\nTo Offset object(s) " subpr "ward by same distance,"))
  (if (setq ss (ssget ":L" '((0 . "*POLYLINE,ARC,CIRCLE,ELLIPSE,SPLINE")))); level1
    (progn ; then
      (setq nogo 0)
      (repeat (setq n (sslength ss)); level1 then
        (if ; level2
          (and
            (not
              (member
                '(100 . "AcDb3dPolyline"); can't Offset 3DPolyline
                (entget (setq ent (ssname ss (setq n (1- n)))))
              ); member
            ); not
            (vlax-curve-isPlanar ent); nor non-planar [Spline only]
          ); and
          (progn ; level2 then -- proceed
            (setq
              obj (vlax-ename->vla-object ent)
              oarea (vla-get-Area obj)
            ); setq
            (if ; level3
              (not ; Offset succeeded [returns T if so, because:]
                (vl-catch-all-error-p ; returns T for error if inward but too small
                  (vl-catch-all-apply 'vla-offset (list obj *OIOdist))
                ); -error-p
              ); not
              (if ; level4 is level3 then -- check comparative areas:
                ((if (= subpr "In") > <) (vla-get-Area (vlax-ename->vla-object (entlast))) oarea)
                (progn ; level4 then -- went wrong way
                  (entdel (entlast))
                  (if ; level5 -- go the other way [if possible]
                    (vl-catch-all-error-p ; returns T for error if inward but too small
                      (vl-catch-all-apply 'vla-offset (list obj (- *OIOdist)))
                    ); -error-p
                    (setq nogo (1+ nogo)); then -- add to count of too-small [no else]
                  ); if level5
                ); progn
              ); if level4 [went wrong way -- no else; do nothing if it went right way]
              (if (= subpr "Out") (vla-offset obj (- *OIOdist)) (setq nogo (1+ nogo)))
                ; level3 else -- too small for inward; go other way only if OffOut
                ; if OffIn, add to count of too-small
            ); if level3 [Offset succeeded]
          ); progn [then]
        ); if level2 [valid object -- no else; can't Offset otherwise]
      ); repeat
      (if (> nogo 0)
        (prompt (strcat "\n" (itoa nogo) " objects too small to be Offset Inward.")); then
      ); if
    ); progn -- then
  ); if level1 [unlocked object(s) selected]
  (vla-endundomark doc)
  (princ)
); defun -- C:OIO

(defun C:OffIn (/ *error*)
  (OIO "In")
); defun -- C:OffIn

(defun C:OffOut (/ *error*)
  (OIO "Out")
); defun -- C:OffIn

(vl-load-com)
(prompt "\nType OffIn to Offset object(s) Inward, OffOut to Offset object(s) Outward.")

[nikkomp]

Здраствуйте, раньше в акаде 2008 и 2014 у меня работало вот это

Код:

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

(defun C:l ()
  (while (VL-CMDF "_xline" pause pause ""))
  (princ)
)

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

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

vl-cmdf в последних версиях всегда возвращает t, независимо ни от чего. Так что теперь придется делать нечто типа

Код:

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

 (defun c:qw (/ elast)
  (setq elast (entlast))
  (vl-cmdf "_.xline" pause pause "")
  (while (/= (entlast) elast)
    (setq elast (entlast))
    (vl-cmdf "_.xline" pause pause "")
  ) ;_ end of while
) ;_ end of defun

Код не проверял и не тестировал.

[nikkomp]

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

Не то же самое,выйти можно через enter, но любое действие возвращает к этой команде, а можно сделать что то подобное через команду _multiple?

[posetitel]

Сообщение от koMon ну можно и без костылей. проверки на правильность имени слоя нет. Код: [Выделить все] (defun c:pline_cb_layer () (command "._pasteclip" '(1e10 1e10)) (setq layer_mtext (entlast)) (if (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object (setq layer_mtext (entlast))))) (progn (vl-catch-all-apply 'vla-add (list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq layer_name (vla-get-textstring (vlax-ename->vla-object layer_mtext))) ) ) (setvar 'clayer layer_name) (vla-erase (vlax-ename->vla-object layer_mtext)) (command "_.pline" pause) ) (progn (vla-erase (vlax-ename->vla-object layer_mtext)) (alert "В буфере обмена не текст!") ) ) )

Скажите, почему если в этом лиспе команду заменить на кириллицу, то лисп перестает работать?
Т.е. "pline_cb_layer" заменить например на "слойкаб" лисп не запускается, пишет неизвестная команда

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

Свой вариант кода покажи. И "C:" должна остаться на английском, если что.

[posetitel]

Код:

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

(defun c:вап ()
	(command "._pasteclip" '(1e10 1e10))
	(setq layer_mtext (entlast))
	(if (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object (setq layer_mtext (entlast)))))
			(progn
				(vl-catch-all-apply 'vla-add (list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) 
												   (setq layer_name (vla-get-textstring (vlax-ename->vla-object layer_mtext)))
											 )
				)
				(setvar 'clayer layer_name)
				(vla-erase (vlax-ename->vla-object layer_mtext))
				(command "_.pline" pause)
			)
			(progn
				(vla-erase (vlax-ename->vla-object layer_mtext))
				(alert "В буфере обмена не текст!")
			)
	)
)

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

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

Я проверил - все срабатывает нормально. Может, кодировка lsp-файла не ANSI?

[posetitel]

Сообщение от Кулик Алексей aka kpblc Я проверил - все срабатывает нормально. Может, кодировка lsp-файла не ANSI?

Offtop: Хм...
Создал файл txt, в нем по умолчанию кодировка ANSI, скопировал прям из своего сообщения код, сохранил, расширение поменял на lsp, подгрузил в автокад и все равно не работает.
Покрутил-повертел кодировку, реально в ней видимо была проблема. Спасибо.

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

Короче, файл приложи

[Kavalergrad]

Пожалуйста, проконсультируйте меня. Встретил следущее выражениеdefun asd (lays_1 lays_2 att k / ).
Я так понимаю, что это определение функции asd. defun - это оператор определения функции, а asd - сама функция,
lays_1 lays_2 att k - это переменные. А вот для чего в конце стоит косая черта, что она означает, для чего служит и когда применяется?
И почему именно в конце поставлена? Или это ошибка и косая черта должна стоять в начале, перед переменными?

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

После обычно указываются имена локальных функций и переменных

[Jek30]

Вопрос про наборы в лиспе:
Есть строчка в одном лиспе: (setq s11 (ssname s1 i))
Я так пологаю что она отвечает за извлечение примитивов из набора s1 по порядковому номеру.
А как сделать так чтобы эти примитивы извлекались из набора не по порядковому номеру их создания, а в порядке расположения их в координатном пространстве. (то есть например по столбцам, сначала по оси "Y" по убыванию, далее если имеются еще столбцы с этими примитивами, то извлечение передвигается по оси "Х" по возрастанию и примитивы опять извлекаются по оси "Y" по убыванию и так далее, пока примитивы из набора не закончатся).
Подскажите пожалуйста, как это осуществить?

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

Так а какая разниц? Сначала получи, потом сортируй как тебе надо.

[Jek30]

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

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

[posetitel]

Сообщение от koMon ну можно и без костылей. проверки на правильность имени слоя нет. Код: [Выделить все] (defun c:pline_cb_layer () (command "._pasteclip" '(1e10 1e10)) (setq layer_mtext (entlast)) (if (= "AcDbMText" (vla-get-objectname (vlax-ename->vla-object (setq layer_mtext (entlast))))) (progn (vl-catch-all-apply 'vla-add (list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq layer_name (vla-get-textstring (vlax-ename->vla-object layer_mtext))) ) ) (setvar 'clayer layer_name) (vla-erase (vlax-ename->vla-object layer_mtext)) (command "_.pline" pause) ) (progn (vla-erase (vlax-ename->vla-object layer_mtext)) (alert "В буфере обмена не текст!") ) ) )

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

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

posetitel, тут как бы обучение, а не просьбы модифицировать коды.

[name02]

posetitel, для получения текста из ячейки используй nentsel.
А для создания слоя уже на форуме было - https://forum.dwg.ru/showthread.php?t=80531

[koMon]

Сообщение от name02 для получения текста из ячейки используй nentsel.

очень и очень сомнительно

[name02]

Сообщение от koMon очень и очень сомнительно

А почему? Вроде там есть группа с текстом

[koMon]

Offtop:
we all have learned a better something
in every possible mistake

posetitel,
ну это конечно не подправить

Код:

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

 
;*****************************************************************************************************************************

(defun set_layer (layer_name / added_layer)
	(if (vl-catch-all-error-p
			(setq added_layer
		       	(vl-catch-all-apply
			   	 'vla-item
			   		(list (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
			   			layer_name
			   		)
	   			)
			)
		)
		(setq added_layer
				(vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
					     layer_name
				)
		)
		(if (minusp (vlax-get added_layer 'freeze))
				(vla-put-freeze added_layer :vlax-false)
				(if (minusp (vlax-get added_layer 'lock))
					(vla-put-lock added_layer :vlax-false)
				)
		)
	)
	(vla-put-activelayer (vla-get-activedocument (vlax-get-acad-object)) added_layer)
)

;*****************************************************************************************************************************

(defun get_cell_value (_prompt / cell_picked table_selected_object row_number column_number checking_vector result table_sset)
	(setq checking_vector (vlax-3d-point (getvar 'viewdir)))
	(while (null cell_picked)
		(setq picked_point (vl-catch-all-apply 'getpoint (list (strcat "\n" _prompt ": "))))
		(cond
			(
				(vl-catch-all-error-p picked_point)
					(setq cell_picked t
					      result 'cancel
					)
			)
			(
				(null picked_point)
			)
			(
				t
					(setq table_sset (ssget "_f" (list
									  					(list (car picked_point) (- (cadr (getvar 'viewctr)) (/ (getvar 'viewsize) 2.0)))
									  					(list (car picked_point) (+ (cadr (getvar 'viewctr)) (/ (getvar 'viewsize) 2.0)))
								 				 )
								 				'((0 . "ACAD_TABLE"))
									 )
					)
					(cond
						(
							(null table_sset)
						)
						(
							(< 1 (sslength table_sset))
						)
						(
							(and
								(= :vlax-true (vla-hittest (setq table_selected_object (vlax-ename->vla-object (ssname table_sset 0)))
														   (vlax-3d-point picked_point) checking_vector 'row_number 'column_number
											  )
								)
								(or
									(= :vlax-true (vla-get-titlesuppressed table_selected_object))
									(and
										 (= :vlax-false (vla-get-titlesuppressed table_selected_object))
										 (not (zerop row_number))
									)
								)
							)
								(setq cell_picked t
								      result (list (vlax-variant-value (vla-getcellvalue table_selected_object row_number column_number))
												   table_selected_object
												   row_number
												   column_number
											 )
								)
						)
						(
							t
						)
					)
			)
		)
	)
	result
)

;*****************************************************************************************************************************

(defun c:make_cell_layer_pline (/ done cell_data)
	(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
	(if (and
			 (setq cell_data (get_cell_value "Выберите ячейку таблицы с текстом"))
			 (= 'str (type (car cell_data)))
			 (snvalid (car cell_data))
		)
			(progn
				(set_layer (car cell_data))
				(vl-catch-all-apply 'vla-deletecellcontent (cdr cell_data)) 
				(command "_pline" pause)
			)
			(princ "\nНеверное имя слоя или отмена команды.")
	)
	(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)

;*****************************************************************************************************************************

[Browning Zed]

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

Код:

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

 (defun CollectItemSeq ( num lst / seq lst)
	(setq seq nil)
	(repeat num (setq seq (cons (car lst) seq) lst (cdr lst)))
	(reverse seq)
)

И вот теперь, решил создать аналогичную вышеуказанной функции рекурсию, и споткнулся:

Код:

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

 (defun CollectItemSeq ( num lst / seq)
	(if (> 0 num)
		(reverse seq)
		(progn
			(setq seq (cons (car lst) seq))
			(CollectItemSeq (1- num) (cdr lst))
		)
	)
)

I'm so stupid. ЧЯДНТ?

[koMon]

Browning Zed,

можно так

Код:

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

 
(defun CollectItemSeq (num lst / seq)
  	(if (> num 0)
		(setq seq (cons (car lst) (CollectItemSeq (setq num (1- num)) (setq lst (cdr lst)))))
	)
  	seq
)

[Browning Zed]

koMon, круто, спасибо. Теперь все встало на свои места.

Сразу не допер, что (cons (car нужно применять не к списку, а к рекурсии возвращающей список.
С твоего позволения, немного модифицировал твой код, убрав из него ненужные setq, так как аргументы входящие в функцию рекурсивно, сами меняют свое значение при каждом новом вызове функции (разумеется, если изменение значения аргумента прописано в теле функции).
Итого, получилось:

Код:

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

 (defun CollectItemSeq (num lst / seq)
  	(if (> num 0)
		(setq seq (cons (car lst) (CollectItemSeq (1- num) (cdr lst))))
	)
  	seq
)

Еще раз, спасибо коммандеру koMon'у.

[===AAA===]

Маленькое примечание.

Рекурсию при обработке списков нужно использовать очень
осторожно - можно натолкнуться на "переполнение стека".
Если список очень большой. Такие ошибки очень трудно
потом отлавливать. Я, например, в принципе отказался
от неё при обработке списков непредсказуемой длины.

foreach - "наше всё" :-)

[Browning Zed]

===AAA===
Безусловно, такая проблема существует. Но на практике, со stack overflow пока не сталкивался, возможно по причине того, что рекурсивные функции использую не так часто.
При этом, неоднократно сталкивался с мнением, что LISP, это как раз тот язык, из всех прочих языков, где рекурсивные алгоритмы перебора списков (коллекций, последовательностей) смотрятся органичнее всего.
Да и foreach, далеко не панацея. Так же, как панацеей могут не оказаться mapcar, или все семейство vl- функций относящихся к обработке списков.
То есть, решить задачу с помощью foreach, наверное, можно любую, но иногда куда как проще (а также понятней, и логичней), к примеру, взять и использовать цикл while, пролистывая в его теле список при помощи cdr, и одновременно совершая кучу других действий. Ну, или воспользоваться рекурсивным алгоритмом.

[===AAA===]

Дык одно дело сам LISP, другое - его реализация на конкретной программно-аппаратной платформе.
Я однажды столкнулся. Правда - давно. И памяти в компах с тех пор изрядно добавилось и версия
Автокада поменялась. Однако с тех пор - ну её нафиг, эту рекурсию...
Как элемент непредсказуемости.

[SetQ]

Промежуточное решение с помощью Функции "рекурсивирования" или рекурсивной lambda:

Код:

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

 (defun recurs (p f x);создает рекурсивный список до выполнения условия p функции f с начальным аргументом х
  (if (p x)
      (cons x nil)
      (cons x (recurs p f (f x)))))
(setq  lst '(1 2 3 4 5 6) num 3)
(reverse (last (recurs (lambda (x) (>= num (length x))) cdr (reverse lst))))

[Andrey55]

Здравствуйте. Тема изъезженная, понимаю. Необходимо создать LISP для импорта координат точек в AutoCAD и последующего построения точек по ним (с точками совсем не скоро). Исходник координат в Excel, перевожу в txt с разделением табуляцией.
Пока дошел вот до этого с выводом координат в командную строку (для наглядности, чтобы я понимал что КАД вообще этот файл видит и читает):

Код:

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

(defun c:FF ()
(setq 	f1 (open "d:\\lisp\\coor.txt" "r")
	a (read-line f1)
	b (read-line f1)
	c (read-line f1)
	d (read-line f1)
	e (read-line f1)
	f (read-line f1)
	)
  	        (close f1)
(print (strcat "" a ""))
(print (strcat "" b ""))
(print (strcat "" c ""))
(print (strcat "" d ""))
(print (strcat "" e ""))
(print (strcat "" f ""))
(print)
)

В комадную строку выводит текст вида:
"1254.65\t654.26\t6589.21"
"206646.26\t5486.15\t164.25"
"15.2664\t201.16\t023.254"
"154.10\t2168.489\t456.15"
"18.20\t45632.15\t2031.22"
"1648.25\t20.15\t254.16"
Условных 6 точек просто пока для эксперимента. Теперь цель заставить автокад понять что от нуля до первой табуляции это Х, от первой табуляции это Y, и последнее соотвественно Z. Вроде как должно решаться strlen и ascii, но в справочниках пишут "функция возвращает длину строковой константы...", если кто может разжевать как это понять и что есть константа в моем примере?

Предупреждая вопросы - осваиваю это дело по учебе, интересно, но нифига не понятно, поэтому использовать чужой "импорт XYZ" не могу.

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

Все что сейчас напишу - сугубо личное мнение.
Первое и самое главное - имена. Имена функций, переменных и т.д. Когда код даже на 10 строк, понять, что в переменной q хранится, может быть затруднительно.
Далее. LISP - язык списков, и этим желательно пользоваться. Соответственно чтение файла можно сделать так:

Код:

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

 (setq file   "d:\\lisp\\coor.txt"
      handle (open file "r")
)
(while (setq str (read-line handle)) 
  (setq res (cons str res))
)
(close handle)
(setq res (reverse res))

В переменной res будет содержимое файла списком, независимо от длины файла. К примеру:

Код:

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

 '("1254.65\t654.26\t6589.21"
 "206646.26\t5486.15\t164.25"
 "15.2664\t201.16\t023.254" 
 "154.10\t2168.489\t456.15"
 "18.20\t45632.15\t2031.22" 
 "1648.25\t20.15\t254.16"
)

Теперь надо каждую строку разбить по символу табуляции на список (например, https://forum.dwg.ru/showthread.php?t=63867). Но, поскольку lambda вряд ли сразу "зайдут", исходный код можно переделать:

Код:

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

 (defun str-str-lst (str pat / i)  ;Evgeny Elpanov
  (cond 
    ((= str "") nil)
    ((setq i (vl-string-search pat str))
     (cons (substr str 1 i) 
           (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
     ) ;_  cons
    )
    (t (list str))
  ) ;_  cond
) ;_  defun

(setq file   "d:\\lisp\\coor.txt"
      handle (open file "r")
)
(while (setq str (read-line handle)) 
  (setq res (cons (str-str-lst str "\t") res))
)
(close handle)
(setq res (reverse res))

В res теперь будет нечто типа

Код:

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

 '(("1254.65" "654.26" "6589.21") 
  ("206646.26" "5486.15" "164.25")
  ("15.2664" "201.16" "023.254)(154.10" "2168.489" "456.15")
  ("18.20" "45632.15" "2031.22")
  ("1648.25" "20.15" "254.16")
)

Преобразовать строку в число - функция atof. Чтобы "было все и сразу":

Код:

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

 (defun str-str-lst (str pat / i)  ;Evgeny Elpanov
  (cond 
    ((= str "") nil)
    ((setq i (vl-string-search pat str))
     (cons (substr str 1 i) 
           (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
     ) ;_  cons
    )
    (t (list str))
  ) ;_  cond
) ;_  defun

(setq file   "d:\\lisp\\coor.txt"
      handle (open file "r")
)
(while (setq str (read-line handle)) 
  (setq res (cons (mapcar (function atof) (str-str-lst str "\t")) res))
)
(close handle)
(setq res (reverse res))

Теперь в res будет нечто типа:

Код:

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

 '((1254.65 654.26 6589.21) 
  (206646.26 5486.15 164.25)
  (15.2664 201.16 023.254)
  (154.10 2168.489 456.15)
  (18.20 45632.15 2031.22)
  (1648.25 20.15 254.16)
)

И теперь можно делать точки - хоть командными методами, хоть как.

[koMon]

Сообщение от Andrey55 Теперь цель заставить автокад понять что от нуля до первой табуляции это Х,

(print (read (strcat "(" a ")"))) -> (1254.65 654.26 6589.21), то есть (list x y z)

[Andrey55]

Сообщение от Кулик Алексей aka kpblc И теперь можно делать точки - хоть командными методами, хоть как.

Спасибо
Выдает ошибку - слишком много аргументов. Остальные лиспы отключил, проблема не ушла.

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

Сообщение от koMon (print (read (strcat "(" a ")"))) -> (1254.65 654.26 6589.21), то есть (list x y z)

Код:

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

(print (read (strcat "(" a ")"))) (list x y z)

Такого вида?
В командную строку выводит как вы и написали 3 значения в скобках, тут ок. Оно благодаря этому кусочку кода теперь понимает, что x=1254.65 y=654.26 z=6589.21? Подозреваю что нет.

[koMon]

Сообщение от Andrey55 Оно благодаря этому кусочку кода теперь понимает, что x=1254.65 y=654.26 z=6589.21?

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

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

Код:

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

 
(defun c:FF (/ f1 point point_list)
	(setq f1 (open "d:\\lisp\\coor.txt" "r"))
	(while (setq point (read-line f1))
		(setq point_list (append point_list (list (read (strcat "(" point ")")))))
	)
	(print point_list)
  	(close f1)
)

1-я точка из списка -> (nth 0 point_list)
координата X 1-й точки (car (nth 0 point_list))
координата Y 1-й точки (cadr (nth 0 point_list))
координата Z 1-й точки (caddr (nth 0 point_list))
и т.д.

[1958]

Сообщение от Кулик Алексей aka kpblc (setq res (cons (mapcar (functino atof) (str-str-lst str "" "")) res))

functino - это function ?
И всё-равно не работает. А очень интересно!

[Browning Zed]

Сообщение от Andrey55 Оно благодаря этому кусочку кода теперь понимает, что x=1254.65 y=654.26 z=6589.21? Подозреваю что нет.

Обратите внимание, оба представленных решения по преобразованию координат: от Кулик Алексей aka kpblc, и от koMon на выходе дают вам список координат: три цифры заключенные в скобки.
Список - это основная структура данных в LISP, и если вы планируете начать изучать программирование вам потребуется понять как устроен список, как он формируется и как его обрабатывать.
Чтобы передать программе сведения о том, что в списке у вас какие-то данные нужно обратиться к элементам списка. Это осуществляется через определенные функции, например: car, cadr, nth, last.

Но в данном случае, у вас список координат, а это значит, что вы вообще можете не указывать какая цифра является той или иной координатой.
Вы просто передаете этот список соответствующей функции, которая без ваших дополнительных подсказок понимает что первый элемент списка это x, второй y, а третий z.
Например, функция создания точки:

Код:

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

 (entmakex (list (cons 0 "POINT") (cons 10 '(1254.65 654.26 6589.21))))

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

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

Исправил опечатки. Offtop: Странно как-то код из VSCode копируется - то так, то этак.

[1958]

Алексей! А как подправить лисп, чтобы он выдавал результат такого типа:
(("1" 4255443.36 12245413.22 623.56 "ладно") ("2" 4255426.09 12245409.77 626.62 "низ")...

Код:

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

 (defun str-str-lst (str pat / i) ;Evgeny Elpanov
 (cond ((= str "") nil)
       ((setq i (vl-string-search pat str))
        (cons (substr str 1 i) (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)) ;_  cons
       )
       (t (list str))
 ) ;_  cond
) ;_  defun
(defun c:22 (/)
 (setq res nil)
 (setq file (getfiled "Выбор файла :" (getvar 'dwgprefix) "csv" 16)
       handle (open file "r")
 )
 (while (setq str (read-line handle))
;;;  (setq res (cons (mapcar (function atof) (str-str-lst str ";")) res))
    (setq res (cons (str-str-lst str ";") res))
 )
 (close handle)
 (setq res (reverse res))
)

Данные читаются из файла с расширением *.csv

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

Да в принципе точно так же - только разделителем для str-str-lst будет не "\t", а ";"

[1958]

Сообщение от Кулик Алексей aka kpblc только разделителем для str-str-lst будет не "\t", а ";"

Это применил. Вопрос в другом - как можно составить список, в котором будут данные такого типа: ("1" 4255443.36 12245413.22 623.56 "ладно") ? Т.е. читается строка из файла (четыре элемента) и записывается в список (символ число число символ). Сейчас у меня получается ("1" "4255443.36" "12245413.22" "623.56" "ладно") - все символьные значения. В принципе, потом после извлечения, можно применить atof для второго и третьего элементов.

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

(setq str ' ("1" "4255443.36" "12245413.22" "623.56" "ладно"))
(setq res (list (car str) (atof (cadr str)) (atof (caddr str)) (atof (cadddr str)) (last str)))

Примерно так, пишу на коленке

[1958]

Спасибо, Алексей!
У меня получилось вот так:

Код:

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

 (defun str-str-lst (str pat / i) ;Evgeny Elpanov
 (cond ((= str "") nil)
       ((setq i (vl-string-search pat str))
        (cons (substr str 1 i) (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)) ;_  cons
       )
       (t (list str))
 )
)
(defun c:22 (/)
 (setq res nil)
 (setq file   (getfiled "Âûáîð ôàéëà :" (getvar 'dwgprefix) "csv" 16)
       handle (open file "r")
 )
 (while (setq str (read-line handle))
  (setq str (str-str-lst str ";"))
  (setq res (cons (list (car str)
                        (atof (cadr str))
                        (atof (caddr str))
                        (atof (cadddr str))
                        (last str)
                  )
                  res
            )
  )
 )
 (close handle)
 (setq res (reverse res))
)

[Andrey55]

Сообщение от koMon именно понимает. если сохранить этот список в переменную или составить список из таких точек, то можно обращаться к индивидуальным точкам такого списка. ----- добавлено через ~15 мин. ----- Код: [Выделить все] (defun c:FF (/ f1 point point_list) (setq f1 (open "d:\\lisp\\coor.txt" "r")) (while (setq point (read-line f1)) (setq point_list (append point_list (list (read (strcat "(" point ")"))))) ) (print point_list) (close f1) ) 1-я точка из списка -> (nth 0 point_list) координата X 1-й точки (car (nth 0 point_list)) координата Y 1-й точки (cadr (nth 0 point_list)) координата Z 1-й точки (caddr (nth 0 point_list)) и т.д.

setq f1 - мы присваиваем имя переменной f1 - нашему файлу
steq point (read-line f1) - создаем переменную point, в которую cчитывает все что есть в переменной f1 (то есть в файле). Почему он считывает все строки, а не только первую?

Код:

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

 (setq point_list (append point_list (list (read (strcat "(" point ")")))))

Зачем использована команда append? Как я понимаю работает, как объединение списков (append <список1> [<список2> … <списокN>])
list - создаем список из данных переменной point
strcat (сцепляет данные в 1 строку? так бы они были в виде списка), а read - считывает данные из этой строки? Если просто использовать (list point) - cписок не создаст?

Код:

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

   (defun c:FF (/ f1 point point_list x1 y1 z1)
	(setq f1 (open "d:\\lisp\\coor.txt" "r"))
	(while (setq point (read-line f1))
		(setq point_list (append point_list (list (read (strcat "(" point ")")))))
	)
	(print point_list)
        (setq x1 (car (nth 0 point_list)) y1 (cadr (nth 0 point_list)) z1 (caddr (nth 0 point_list)))
        (setq x2 (car (nth 1 point_list)) y2 (cadr (nth 1 point_list)) z2 (caddr (nth 1 point_list)))
        (print y1) (print y2)
        (entmakex (cons 0 "POINT") (cons 10 '(x1 y1 z1)))
        (close f1)
)

Добавил переменные x1 y1 z1 (понимаю, что как-то делается проще, но пока процесс понимаю только так) и модифицировал строчку предложенную Browning Zed - не работает.
entmakex - создание примитива, понятно.
list - не понимаю зачем тут? У нас уже есть один список, созданный ранее. Они как между собой? Конфликтуют, объединяются?
cons 0 "POINT" - выбор типа примитива, мы указываем point-точка.
cons 10 '(x1 y1 z1) - указываем координаты начальной точки. Почему-то не работает? Зачем перед скобками ' - апостроф?

На команды (print y1) (print y2) не обращайте внимания, это я для себя визуализировал правильно ли я понял логику списка, гду nth0, где nth1, где car, cadr

[Browning Zed]

Andrey55,
Продолжим обучение

Сообщение от Andrey55 steq point (read-line f1) - создаем переменную point, в которую cчитывает все что есть в переменной f1 (то есть в файле). Почему он считывает все строки, а не только первую?

(read-line f1) считывает только одну строку в файле (open "d:\\lisp\\coor.txt" "r") и помещает значение этой строки в переменную point. И если файл не закрыт (а он у нас пока не закрыт, т.е. статус файла "open"), в данном случае каждый новый вызов (read-line f1) будет считывать следующую строку.
Обрати внимание, что полностью данное выражение в коде указано так:
(while (setq point (read-line f1))
while - это цикл,
(setq point (read-line f1)) это условие при прохождении которого цикл будет выполняться.
Фактически, (read-line f1) может вернуть либо значение строки, либо значение nil (логический ноль, false), в том случае, если будет попытка прочесть значение в файле идущее после последней строки. И в тот момент когда переменной point будет присвоено значение nil произойдет выход из цикла, потому что цикл while работает ровно до того момента, пока условие выполения цикла будет true. Соответственно, по-простому, выражение (while (setq point (read-line f1)) можно сформулировать так: "до тех пор, пока в файле читается строка цикл продолжится, но если строку прочитать не удалось цикл прекратится. То есть, первый вызов (read-line f1) в цикле считает первую строку, второй вторую строку и т.д. И в тот момент когда очередной вызов (read-line f1) дойдет до конца файла и попытается прочитать строку еще раз, а читать будет нечего так так последняя строка уже прочитана, то переменной point будет присвоено значение nil и будет осуществлен выход из цикла.

Теперь рассмотрим что еще происходит в цикле. Каждый раз когда будет прочитана очередная строка, будет также выполнено следующее действие:
(setq point_list (append point_list (list (read (strcat "(" point ")")))))

Так как выражения в LISP выполняются справа на лево, рассмотрим их в этом порядке:

1. (read (strcat "(" point ")")) Объединение полученной строки с символами открывающей и закрывающей скобки, после чего следует буквальное прочтение строки функцией read, в результате чего строка трансформируется в список. Для новичка звучит, наверное, немного запутано, но это один из своеобразных трюков LISP. Пользуясь терминологией языков со статической типизацией, условно можно сказать, что данная операция - это неявное приведение типа. Отмечу также, что выражение (read (strcat "(" point ")")) можно использовать ТОЛЬКО если в качестве разделителя между значением координат в текстовом файле используются пробелы, но если разделитель будет любым другим, например запятой, такой код не будет работать. В этом случае нужно будет преобразовать строку в список в соответствии с указанным разделителем. Для этого, ты можешь воспользоваться соответствующей функцией из кода Кулик Алексей aka kpblc, либо аналогичной функцией от Lee Mac'a.
2. (list (read (strcat "(" point ")"))) Полученный в первом выражении список мы помещаем внутрь еще одного списка. Предположим, в результате первого выражения мы получили список '(15.7 35.9 12.2), в таком случае выражение (list '(11.8 22.8 33.8)) вернет нам '((11.8 22.8 33.8)). Обрати внимание, количество скобочек удвоилось, сформировался, так называемый, список списков, то есть ранее полученный список был помещен внутрь нового списка.
3. (setq point_list (append point_list (list (read (strcat "(" point ")"))))) Так как значение переменной до ее инициализации всегда nil (логический ноль, false), то в данном случае при чтении первой строки мы, фактически, получим выражение (append nil '((11.8 22.8 33.8))), в результате чего переменной point_list будет присвоен все тот же список '((11.8 22.8 33.8)) (значения координат могут быть любые, я привожу эти цифры лишь в качестве примера). Самое интересное будет происходить при чтении второй и последующей строк: так как значение переменной point_list теперь не nil, а список '((11.8 22.8 33.8)), а в результате чтения второй строки был получен еще один список, предположим, такой '((55.8 66.8 77.8)), тогда после выполнения выражения (append '((11.8 22.8 33.8)) '((55.8 66.8 77.8))) переменной point_list будет присвоен список '((11.8 22.8 33.8) (55.8 66.8 77.8)). Соответственно, при каждой новой прочтенной в файле строке, внутрь некого общего списка будет добавляться список координат полученный из прочтенной строки. Таким образом, если строк в файле всего три, в итоге будет получено примерно следующее '((11.8 22.8 33.8) (55.8 66.8 77.8) (13.8 14.8 15.8)). То есть количество вложенных списков будет равно количеству строк.


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

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

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

Код:

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

 (defun c:FF (/ f1 point point_list)
	(setq f1 (open "d:\\lisp\\coor.txt" "r"))
	(while (setq point (read-line f1))
		(entmakex (cons 0 "POINT") (cons 10 (read (strcat "(" point ")"))))
	)
  	(close f1)
)

Но второй вариант будет работать ТОЛЬКО если в строках файла приведены значения координат формата "координата_X координата_Y координата_Z". А если в строках содержится какая-либо другая информация, либо порядок координат иной, например формата: "имя_точки, координата_Y, координата_X, координата_Z, какое-то значение", тогда в код необходимо будет вносить изменения.

На счет апострофа - это тема более сложная, и пока, как новичку можно этот вопрос оставить. Вместо такого представления списка '(11.8 22.8 33.8), ты можешь использовать (list 11.8 22.8 33.8). Результат выражения будет аналогичным. Апостроф, если вкратце, позволяет прочитать выражение буквально, без применения функции, что в теории может улучшить производительность, так как мы не затрачиваем ресурсы на вычисление функции (что, впрочем, не относится к лямбде, а только к списку), но апостроф не может быть применим к переменным внутри списка, а только к непосредственным значениям. В общем, пока оставь эту тему и используй функцию list.

[koMon]

Browning Zed, 👍

[Andrey55]

Фактически, (read-line f1) может вернуть либо значение строки

Вам бы учебники писать. Я из этой цитаты наконец-то понял, что значит возвращает Мы ему команду/запрос, а он нам возвращает действие/ответ? Сколько литературы и справочников посмотрел, никак не мог понять.
Логику работы while и read понял, c nil тоже все ясно.

3. (setq point_list (append point_list (list (read (strcat "(" point ")")))))

Долго вчитывался в данный пункт, но все таки понял, как этот трюк с append работает. Мы каждую строку заключаем в скобки, считываем и формируем list. Это все проделывается для формирования надсписка понятного программе, где каждый подсписок (новая строка в исходном файле) будет для нее отдельной точкой (XYZ)? Это прям очень круто.
Если рассмотреть этот кусок (опять добавил свои корявки):

Код:

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

 (while (setq point (read-line f1))
		(setq point_list (append point_list (list (read (strcat "(" point ")")))))
	)
	(print point_list)
         (print point)

Переменную point он не выводит на печать, пишет nil. Т.е. ее обязательно надо загнать в список командой list и сформировать список point_list, иначе он нас не понимает.

Все таки при команде read формируется список вида (11.8 22.8 33.8 55.8 66.8 77.8 13.8 14.8 15.8)? Или командой read он просто считывает, а дальше мы со считанной информацией работаем - либо присваиваем переменную считанной информации, либо формируем список командой list?

Код:

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

 (cons 10 (read (strcat "(" point ")"))

Как я понимаю, если не задавать доп.условия, то по команде cons 10 функция автоматически понимает что в скобках за ней идут X Y Z (через пробел) по порядку? Т.е. даже не надо присваивать переменные, как я делал x1 y1 z1, x2 y2 z2 итд.

Код не работает, пишет "слишком много аргументов". Думал дело в том, что в txt стоит табуляция вместо пробела, но замена ничего не решила.

[koMon]

Сообщение от Andrey55 "слишком много аргументов"

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

Код:

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

 
(defun c:FF (/ f1 point)
	(setq f1 (open "d:\\lisp\\coor.txt" "r"))
	(while (setq point (read-line f1))
		(entmake (list '(0 . "point") (cons 10 (read (strcat "(" point ")")))))
	)
  	(close f1)
)

функция read возвращает первый список или первый атом из прочитанной строки.

но всё же правильнее сначала прочитать данные, закрыть файл, а потом выводить данные, например в точки.

Код:

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

 
(defun c:FF (/ f1 point point_list)
	(setq f1 (open "d:\\lisp\\coor.txt" "r"))
	(while (setq point (read-line f1))
		(setq point_list (append point_list (list (read (strcat "(" point ")")))))
	)
  	(close f1)
	(foreach point point_list
		(entmake (list '(0 . "point") (cons 10 point)))
	)
	(princ)
)

[Andrey55]

Код:

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

  
	(foreach point point_list
		(entmake (list '(0 . "point") (cons 10 point)))

Вот это читаем справа на лево. Задаем команду cons 10 point - программа берет данные из списка point - понятно, далее указываем тип примитива 0 . "point" - почему между 0 и "point" точка, и почему перед 0 не прописали опять cons?
И поправьте если не прав, командой list мы далее создаем список графических примитивов - точек? Я думал list создает только списки чисел, которые висят в памяти.
Далее, как я понимаю foreach. Мы создаем точки entmake для каждой записи, которая встретится в списках point и point_list? Но при этом ранее мы координаты точек cons 10 point брали из списка point?
И вот тут вопрос, почему мы берем оба списка point и point_list? Ведь у нас должно случиться задвоение/наложение точек при выводе графики?
Список point у нас вида (11.23 45.78 2388.34 3737.122 22.34 11.33), а список point_list ((11.23 45.78 2388.34) (3737.122 22.34 11.33))

С функцией foreach попробовал разобраться еще

Код:

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

         (foreach n '(point point_list) (print n))
        (print point_list)

Почему 1-я строка возвращает просто надписи
POINT
POINT_LIST
А вторая строка возвращает, как и положено список координат ((1254.65 654.26 6589.21) (206646.0 5486.15 164.25)....
Ведь они тождествены по сути?

[koMon]

Сообщение от Andrey55 Задаем команду cons 10 point

функция cons добавляет элемент в начало списка point.

Сообщение от Andrey55 почему между 0 и "point" точка

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

Сообщение от Andrey55 почему перед 0 не прописали опять cons

потому что точечная пара (0 . "point") это константа, которую проще процитировать арострОфом, нежели создавать из переменных/констант

Сообщение от Andrey55 Я думал list создает только списки чисел

LISP акроним для LIST Processing и в нём всё списки, см. на скобочки) списки могут объёдинять всё что угодно.

Сообщение от Andrey55 как я понимаю foreach. Мы создаем точки entmake для каждой записи, которая встретится в списках point и point_list

foreach применяет выражения для каждого члена списка по динамически созданной переменной, в данном случае point. то есть берётся каждая координата из прочитанных в список point_list из текстового файла координат, и для создания примитива точка создается ассоциативный список (см. выше) для выполнения функции entmake, которая создаёт и добавляет в базу данных черетежа примитив точка для каждой координаты списка point_list.

Сообщение от Andrey55 Но при этом ранее мы координаты точек cons 10 point брали из списка point?

ну, ранее было так, теперь так)

Сообщение от Andrey55 Список point у нас вида (11.23 45.78 2388.34 3737.122 22.34 11.33), а список point_list ((11.23 45.78 2388.34) (3737.122 22.34 11.33))

в переменную point мы по очереди помещаем координаты каждой прочитанной точки из текстового файла, список point_list содержит все прочитанные точки по порядку их нахождения в текстовом файле, то есть это список, который состоит из списков.

Сообщение от Andrey55 Почему 1-я строка возвращает просто надписи

функция quote или сокращённый её вариант (') цитирует ровно то, к чему она применяется '(point point_list) вернёт список символов POINT и POINT_LIST, это видно по их верхнему регистру. можно проверить функцией type.

Сообщение от Andrey55 А вторая строка возвращает, как и положено список координат

функция print выводит в консоль содержимое списка point_list.

Сообщение от Andrey55 Ведь они тождествены по сути?

ни разу. переменной n foreach присваивается каждый из двух символов списка сивмолов '(point point_list). (setq n_list '(point point_list))->(POINT POINT_LIST) см. выше.

[Andrey55]

Продолжаем движение. Решил маленько улучшить:

Код:

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

  
(defun c:GG (/ f1 point point_list)
  (setq f1 (open (getfiled "Select file with coordinates" "d:/lisp/" "lsp;txt;doc;dwg" 8) "r"))
		(while (setq point (read-line f1))
		(setq point_list (append point_list (list (read (strcat "(" point ")")))))
	)
  	(close f1)
	(foreach point point_list
		(entmake (list '(0 . "point") (cons 10 point)))
	)
        (alert "Points imported successfully.")
	(princ)
)

Осваиваем команду getfiled. Как прописано в коде выше, позволяет выбрать файл и импортирует точки (для меня чудо какое-то что оно работает). Но если в списке расширений "lsp;txt;doc;dwg" я переношу lsp в конец списка, т.к. мне надо чтобы приоритетное для выбора было все же txt, то оно перестает работать "неверный тип аргумента: FILE nil". Почему так?
Команду alert добавил, тоже работает.
Сейчас буду пробовать прикрутить построение 3Dполилинии по этим точкам.

[koMon]

Сообщение от Andrey55 Почему так?

Flag 8 (bit 3) If this bit is set and bit 0 is not set, getfiled performs a library search for the file name entered. If it finds the file and its directory in the library search path, it strips the path and returns only the file name. (It does not strip the path name if it finds that a file of the same name is in a different directory.) If this bit is not set, getfiled returns the entire file name, including the path name. Set this bit if you use the dialog box to open an existing file whose name you want to save in the drawing (or other database).

открыть файл только по его имени конечно можно...

(getfiled "Select file with coordinates" "d:/lisp/" "txt;doc;dwg;lsp" 2)

[Sege]

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

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

Проверяй vla-get-visible, к примеру.

[Sege]

Сообщение от Кулик Алексей aka kpblc Проверяй vla-get-visible, к примеру.

Код:

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

 
(setq obj (vlax-ename->vla-object (car (entsel))))
(setq temp (vla-GetAttributes obj))
(setq att_list (vlax-safearray->list (vlax-variant-value temp)))

а дальше как?

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

(setq att (vl-remove-if (function (lambda(x) (equal (vla-get-visible x) :vlax-false))) att_list)

Примерно так

[Sege]

Сообщение от Кулик Алексей aka kpblc (setq att (vl-remove-if (function (lambda(x) (equal (vla-get-visible x) :vlax-false))) att_list) Примерно так

!att_list
(#<VLA-OBJECT IAcadAttributeReference 0000014b6fa1a188> #<VLA-OBJECT IAcadAttributeReference 0000014b6fa1a2a8> #<VLA-OBJECT IAcadAttributeReference 0000014b6fa1a3c8>)

!att
выводит такое же значение
(#<VLA-OBJECT IAcadAttributeReference 0000014b6fa1a188> #<VLA-OBJECT IAcadAttributeReference 0000014b6fa1a2a8> #<VLA-OBJECT IAcadAttributeReference 0000014b6fa1a3c8>)

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

Блочок бы глянуть.

[Sege]

Сообщение от Кулик Алексей aka kpblc Блочок бы глянуть.

блок.dwg
вот

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

Кхм... В свойствах показывается далеко не один атрибут. Так что для начала надо понять, что значит "видимый".

[koMon]

Сообщение от Кулик Алексей aka kpblc (setq att (vl-remove-if (function (lambda(x) (equal (vla-get-invisible x) :vlax-true))) att_list)

Код:

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

 
(vla-get-tagstring (car (vl-remove-if '(lambda (attribute) (minusp (vlax-get attribute 'invisible))) (vlax-invoke (vlax-ename->vla-object (car (entsel "\nВыберите блок с атрибутами: "))) 'getattributes))))

[Sege]

Сообщение от koMon Код: [Выделить все] (vla-get-tagstring (car (vl-remove-if '(lambda (attribute) (minusp (vlax-get attribute 'invisible))) (vlax-invoke (vlax-ename->vla-object (car (entsel "\nВыберите блок с атрибутами: "))) 'getattributes))))

Получил (#<VLA-OBJECT IAcadAttributeReference 0000014b6c843c58>)
А как из этого получить имя атрибута?
UPD: получил, спасибо!

[Sege]

Что-то под конец рабочей недели немного туплю.

Есть список типа
(("1" . "aa") ("2" . "bb") ("3" . "cc"))

Как его преобразовать в список ("1" "2" "3")?

[SetQ]

Сообщение от Sege Есть список типа (("1" . "aa") ("2" . "bb") ("3" . "cc")) Как его преобразовать в список ("1" "2" "3")?

Код:

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

 (mapcar car '(("1" . "aa") ("2" . "bb") ("3" . "cc")))

[koMon]

Код:

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

 'car

[SetQ]

Сообщение от koMon 'car

Правда, нужен апостроф в автокаде, а в VeLisp и без апострофа работает.

[Alex_mur]

Подскажите пожалуйста, как можно объединить два списка в один

есть список1 ("номер 1" "номер 2" "номер 3")
есть список2 ("a" "b" "c")

Как объединить эти два списка в один в следующей формате (("номер 1" "a") ("номер 2" "b") ("номер 3" "c"))

Делаю так:
(mapcar 'cons список1 список2)
но на выходе получается
(("номер 1" . "a") ("номер 2". "b") ("номер 3" . "c"))

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

Код:

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

 (setq lst1 '("num1" "num2" "num3")
      lst2 '("a" "b" "c")
      lst3 '("d" "e")
      ) ;_ end of setq
(mapcar (function list) lst1 lst2) ; '(("num1" "a") ("num2" "b") ("num3" "c"))

(mapcar (function list) lst1 lst3) ; '(("num1" "d") ("num2" "e"))

[Alex_mur]

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] (setq lst1 '("num1" "num2" "num3") lst2 '("a" "b" "c") lst3 '("d" "e") ) ;_ end of setq (mapcar (function list) lst1 lst2) ; '(("num1" "a") ("num2" "b") ("num3" "c")) (mapcar (function list) lst1 lst3) ; '(("num1" "d") ("num2" "e"))

Алексей, спасибо!

[posetitel]

Товарищи, извините за детский вопрос, но как мне запустить нижние два лиспа?
Хэлп по запуску лиспов читал, но он не помог, т.к. в первом лиспе нет "defun", а во втором лиспе непонятно, как вводить исходные данные.
первый лисп переименовывает слои, содержащие буквы ХХХ на буквы SSS

Код:

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

 (vl-load-com)
(vlax-for lay (vla-get-Layers(vla-get-activedocument (vlax-get-acad-object)))
  (setq layname (vla-get-name lay))
  (if (and (snvalid layname)
           (= (substr layname 1 3) "XXX")
           )
    (vla-put-name lay (setq layname (strcat "SSS" (substr layname 4))))
    )
  )

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

Код:

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

 (defun rename-layers (source       dest         /            adoc
                      *error*      name         err_lst
                      _dwgru-string-parser
                      )
  ;|
*    Переименование слоев активного документа
*    Параметры вызова:
    source    Начальное значение "подстроки". Регистр неважен
    dest    Новое значение "подстроки".
*    Не допускается использование символов маски (?, *, [] и т.п.). Корректность
* нового имени не проверяется впрямую.
|;
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun
  (defun _dwgru-string-parser (string separator / i)
                              ;|
*    Функция разбора строки. Возвращает список либо точечную пару.
*    Параметры вызова:
*    string        разбираемая строка
*    separator    символ, используемый в качестве разделителя частей
*    Примеры вызова:
(_dwgru-string-parser "1;2;3;4;5;6" ";")    ;'(1 2 3 4 5 6)
*    За основу взяты уроки Евгения Елпанова по рекурсиям
|;
    (cond
      ((= string "") nil)
      ((setq i (vl-string-search (strcase separator) (strcase string)))
       (cons (substr string 1 i)
             (_dwgru-string-parser
               (substr string (+ (strlen separator) 1 i))
               separator
               ) ;_ end of _kpblc-string-parser
             ) ;_ end of cons
       )
      (t (list string))
      ) ;_ end of cond
    ) ;_ end of defun
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for item (vla-get-layers adoc)
    (if (wcmatch (strcase (setq name (vla-get-name item)))
                 (strcat "*" (strcase source) "*")
                 ) ;_ end of wcmatch
      (if
        (vl-catch-all-error-p
          (vl-catch-all-apply
            (function
              (lambda ()
                (vla-put-name
                  item
                  ((lambda (/ res lst count)
                     (setq res ""
                           count -1
                           ) ;_ end of setq
                     (repeat
                       (1- (length (setq lst (_dwgru-string-parser name source)))
                           ) ;_ end of 1-
                        (setq res
                               (strcat res (nth (setq count (1+ count)) lst) dest)
                              ) ;_ end of setq
                        ) ;_ end of repeat
                     (strcat res (last lst))
                     ) ;_ end of lambda
                   )
                  ) ;_ end of vla-put-name
                ) ;_ end of lambda
              ) ;_ end of function
            ) ;_ end of vl-catch-all-apply
          ) ;_ end of vl-catch-all-error-p
         (setq err_lst (cons name err_lst))
         ) ;_ end of if
      ) ;_ end of if
    ) ;_ end of vlax-for
  (if err_lst
    (princ (strcat "Для следующих слоев не удалось установить новые имена : "
                   (apply 'strcat (mapcar '(lambda (x) (strcat x "\n")) err_lst))
                   ) ;_ end of strcat
           ) ;_ end of princ
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

[Сергей812]

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

[posetitel]

Ок, с первым, видимо, не все просто.
Второй то можно же как-то запустить.
У меня на чертеже есть слой "1_слой", я хочу переименовать 1_слой на 2_слой
Я ввожу (rename-layers), в надежде на окно запроса аргумента, акад пишет "ошибка: слишком мало аргументов", пытаюсь ввести аргументы (rename-layers 1 2), пишет "неверный тип аргумента: stringp 1", пытаюсь переписать через скобки (rename-layers (1 2)), опять "ошибка: неверная функция: 1".
Как задать аргументы у этой функции?

[Сергей812]

подозреваю, что там хочет все-таки строки увидеть в аргументах (rename-layers "1" "2")

[SetQ]

Сообщение от Сергей812 первый не лисп, а выдранный откуда то кусок кода на лиспе.

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

[gumel]

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

Макрос на кнопку сочинил такой: ^C^C_polyline;end;\per;\end;\;
Макрос работает, но надо сделать командой

Не могу придумать как сделать на лиспе тож самое.. (command "_polyline" "_end") - закрывает чертеж

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

Попробуй
(vl-cmdf "_.polyline" "_end" pause "_per" pause "_end" pause "")
С какого перепугу у тебя чертеж закрывается - тайна лично для меня

[gumel]

Сообщение от Кулик Алексей aka kpblc Попробуй (vl-cmdf "_.polyline" "_end" pause "_per" pause "_end" pause "") С какого перепугу у тебя чертеж закрывается - тайна лично для меня

Слушайте, я не знаю, может я что не так пишу..
Вот код полностью:

Код:

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

 
(princ "POLYLINE с объектной привязкой END-PER-END. Для запуска - EPE")

(defun C:EPE ()
  (vl-cmdf "_.polyline" "_end" pause "_per" pause "_end" pause "")
)

Закрывает текущий документ, спрашивая в командной строке, сохранить ли изменения?

....

Код не менял. Теперь вообще непонятно что происходит:

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

Да не должен чертеж-то закрываться, вот в чем прикол.

[Фёдор Сумкин`]

А если _end заменить на _endpoint?

[gumel]

Сообщение от Фёдор Сумкин` А если _end заменить на _endpoint?

Теперь у меня polyline сломался

Command: EPE
_.polyline Unknown command "POLYLINE". Press F1 for help.
Command: _endpoint Unknown command "ENDPOINT". Press F1 for help.

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

ТЬфу, блин! Не _.polyline, а _.pline !!

[gumel]

Сообщение от Кулик Алексей aka kpblc ТЬфу, блин! Не _.polyline, а _.pline !!

Спасибо!

[koMon]

Сообщение от Кулик Алексей aka kpblc С какого перепугу у тебя чертеж закрывается

видимо с этого

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

Да уже разобрались )))

[Ingpro]

Пытаюсь в коде изменить высоту текста на 2.5 и радиус на 3, но что-то делаю не так... Подскажите, как исправить

Код:

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

 (defun c:rcl (/ selset ent ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0) ;_ Восстанавливаем NOMUTT, Что плохого в NOMUTT?
    (princ msg)
  ) ;_ end of defun
  (vl-load-com)
  (princ "\nВыберите Mтексты: ")
  (setq selset (ssget '((0 . "MTEXT"))))
  (if selset
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
      (setq ed (entget ent))
      (setq ed (subst (cons 41 0) (assoc 41 ed) ed))
      (setq ed (subst (cons 71 5) (assoc 71 ed) ed))
      (setq ed (subst (cons 40 250.) (assoc 40 ed) ed))
      (entmod ed)
      (entmakex	(list
		  '(0 . "CIRCLE")
		  (assoc 10 ed)
		  '(40 . 300.)
		  '(6 . "Continuous")
		  '(62 . 256)
		  '(8 . "Osi")
		) ;_ end of list
      ) ;_ end of entmake
    ) ;_ end of foreach
    (princ)
  ) ;_ end of if
) ;_ end of defun

Заменяю в строке

Код:

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

 (setq ed (subst (cons 40 250.) (assoc 40 ed) ed))

Код:

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

 (setq ed (subst (cons 40 2.5.) (assoc 40 ed) ed))

И в строке

Код:

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

 '(40 . 300.)

Код:

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

 '(40 . 3.)

После запуска пишет "неверная DXF-группа: (40)"

[name02]

Сообщение от Ingpro Код: [Выделить все] 1 (setq ed (subst (cons 40 2.5.) (assoc 40 ed) ed))

У тебя написано 2.5. , а надо 2.5

[Ingpro]

Сообщение от name02 У тебя написано 2.5. , а надо 2.5

name02, спасибо, получилось, а после 250 стоит точка (250.)...

[Ingpro]

Код:

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

 '(8 . "Osi")

Цвет или слой круга как правильно поменять в коде?
Круги создаются слоем "Osi" с цветом 7, поменять, например, на цвет 74...

[name02]

Сообщение от Ingpro а после 250 стоит точка (250.)

Точка после 250 в данном случае не ошибка. LISP воспринимает 250. как число типа REAL (т.е. числа с десятичными разрядами), а 250 (без точки) - как целое число типа INTEGER

Цвет или слой круга как правильно поменять в коде? Круги создаются слоем "Osi" с цветом 7, поменять, например, на цвет 74...

В строке 21 пишешь соответсвенно '(62 . 74) - эта группа определяет цвет круга, а в строке 22 - '(8 . "имя_СУЩЕСТВУЮЩЕГО_слоя")

Возвращаясь к предыдущим твоим сообщениям:
Вот именно в группе 62 для определения цвета должно быть число 74, а не 74. - номер цвета должен быть целочисленными (тип INTEGER), в противном случае LISP выдаст ошибку

[koMon]

Сообщение от name02 а в строке 22 - '(8 . "имя_СУЩЕСТВУЮЩЕГО_слоя")

entmake по фиг существует слой или нет. если нет, то он создастся.

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

Сообщение от name02 а в строке 22 - '(8 . "имя_СУЩЕСТВУЮЩЕГО_слоя")

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

[Ingpro]

Сообщение от name02 В строке 21 пишешь соответсвенно '(62 . 74) - эта группа определяет цвет круга

name02, спасибо за помощь с заменой цвета и подробные пояснения про 250 с точкой...

[gnuvse]

Добрый день.

Как я мог бы получить из vla объекта мультивыноски данные о координатах указателья выноски(стрелка скажем), можете подсказать?

А то дамп не дает этой информации

Код:

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

 
(vlax-dump-object vla-obj)

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

Код:

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

 
(defun closest m-lead (vla-pl set-of-vla-mleads /) 
	(setq mlead-find nil)
	(setq closer-pt (vlax-curve-getClosestPointTo vla-pl POINT-MLEADER?))
	(setq closest-pt (vlax-curve-getClosestPointTo vla-pl POINT-MLEADER?))
	
	(foreach mlead set-of-vla-mleads
		
		; ближайшая точка на линии к точке выноски
		(if (> closer-pt closest-pt)
 			(setq closest-pt closer-pt)                       
			(setq mlead-find mlead)
		)
		
	)
	mlead-find
)

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

Сообщение от gnuvse Как я мог бы получить из vla объекта мультивыноски данные о координатах указателья выноски(стрелка скажем), можете подсказать?

Варианта два. Первый - преобразовать в ename и смотреть там. Второй (пишу насухую, без проверки):
(vlax-safearray->list (vlax-varant-value (vla-getleaderlinevertices multileader-object 0)))
0 - индекс выноски, с которой работаешь.

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Варианта два. Первый - преобразовать в ename и смотреть там. Второй (пишу насухую, без проверки): (vlax-safearray->list (vlax-varant-value (vla-getleaderlinevertices multileader-object 0))) 0 - индекс выноски, с которой работаешь.

Я думаю, что мне пока первого варианта хватит, правильно я понимаю, что мне потом нужно назад в vla объект преобразовать мои координаты, но как?
vlax-curve-getClosestPointTo vla-pl вторым аргументом принимает как раз точку.

Спасибо

----- добавлено через ~52 мин. -----
В продолжении https://forum.dwg.ru/showpost.php?p=...postcount=4454

При отладке кода, у меня ругается лисп при вызове vlax-curve-getClosestPointTo, ошибка - unable to get ObjectID: nil, я так понимаю, что моя координата coordinate-mlead не является WSC, как я мог бы преобразоватьее в WSC?
Гугл оперативно не дал ответ, а старая тема с CADUSER ничего не дала, кроме нерабочих ссылок.
Поиск по dwg.ru безрезультатно
Поиск по доку лиспа не помогло тоже, ничего не нашел по WSC, OSC

Код:

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

 
(setq closer-pt (vlax-curve-getClosestPointTo vla-pl coordinate-mlead))

Сама по себе coordinate-mlead обычная (x, y, z) z = 0.0

[gnuvse]

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

на входе vla полилинии и набор выносок

Код:

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

 (defun closest-mlead (vla-pl set-of-vla-mleads /) ; return closest mlead 
    (setq mlead-found nil)
    (setq key-coordinate-mlead 49)
    
 
    (setq closest-pt '(-99999.0 -99999.0 -99999.0))
    (setq L 0.0)
    (foreach mlead set-of-vla-mleads
        (setq ent-mlead (vlax-vla-object->ename mlead))
        (setq coordinate-mlead (cdr (nth key-coordinate-mlead (entget ent-mlead))))
        (setq closer-pt (vlax-curve-getClosestPointTo vla-pl coordinate-mlead))
        
        (if (< L (vlax-curve-getDistAtPoint vla-pl closer-pt))
            (progn
                (setq L (vlax-curve-getDistAtPoint vla-pl closer-pt))
                (setq mlead-found mlead)
            )
        )
        ; ближайшая точка на линии к точке выноски
        ; (if (and (> (car closer-pt) (car closest-pt))
                 ; (> (cadr closer-pt) (cadr closest-pt))
            ; )
            ; (progn 
                ; (setq closest-pt closer-pt)
                ; (setq mlead-found mlead)
            ; )
        ; )
    )
        mlead-found
)

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

У мультивыносок гарантированно по одному "хвосту" или могут быть варианты?

[gnuvse]

Сообщение от Кулик Алексей aka kpblc У мультивыносок гарантированно по одному "хвосту" или могут быть варианты?

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

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

Сам отфильтруешь лишнее:

Код:

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

 (defun _kpblc-eval-closest-mleader (vla-polyline vla-mleader-list)
  (vl-sort (mapcar
             (function
               (lambda (x / pt closest)
                 (setq pt      (vlax-safearray->list
                                 (vlax-variant-value
                                   (vla-getleaderlinevertices x 0)
                                 ) ;_ end of vlax-variant-value
                               ) ;_ end of vlax-safearray->list
                       pt      (list (car pt) (cadr pt) (caddr pt))
                       closest (vlax-curve-getclosestpointto vla-polyline pt)
                 ) ;_ end of setq
                 (setq x (list (cons "obj" x)
                               (cons "pt" pt)
                               (cons "closest" closest)
                               (cons "dist" (distance pt closest))
                         ) ;_ end of list
                 ) ;_ end of setq
               ) ;_ end of lambda
             ) ;_ end of function
             vla-mleader-list
           ) ;_ end of mapcar
           (function (lambda (a b)
                       (< (cdr (assoc "dist" a)) (cdr (assoc "dist" b)))
                     ) ;_ end of LAMBDA
           ) ;_ end of function
  ) ;_ end of vl-sort
) ;_ end of defun

----- добавлено через ~1 мин. -----
"obj" - указатель на мультивыноску
"pt" - начальная точка первого хвоста
"closest" - ближайшая точка на полилинии
"dist" - расстояние до полилинии

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Сам отфильтруешь лишнее: Код: [Выделить все] (defun _kpblc-eval-closest-mleader (vla-polyline vla-mleader-list) (vl-sort (mapcar (function (lambda (x / pt closest) (setq pt (vlax-safearray->list (vlax-variant-value (vla-getleaderlinevertices x 0) ) ;_ end of vlax-variant-value ) ;_ end of vlax-safearray->list pt (list (car pt) (cadr pt) (caddr pt)) closest (vlax-curve-getclosestpointto vla-polyline pt) ) ;_ end of setq (setq x (list (cons "obj" x) (cons "pt" pt) (cons "closest" closest) (cons "dist" (distance pt closest)) ) ;_ end of list ) ;_ end of setq ) ;_ end of lambda ) ;_ end of function vla-mleader-list ) ;_ end of mapcar (function (lambda (a b) (< (cdr (assoc "dist" a)) (cdr (assoc "dist" b))) ) ;_ end of LAMBDA ) ;_ end of function ) ;_ end of vl-sort ) ;_ end of defun ----- добавлено через ~1 мин. ----- "obj" - указатель на мультивыноску "pt" - начальная точка первого хвоста "closest" - ближайшая точка на полилинии "dist" - расстояние до полилинии

АА, я все-таки правильно копал, пойду разбираться. Спасибо большое.


UPD.
Только я немного не понял, я получил массив структур данных, где выноски отсартированы по дистанции.
А мне нужно было на выходе функции получить нужную выноску к передаваемой vla-pl и все

PS> Код крутой у тебя

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

Так забирай car от результата и делай с ним чего хотишь, делов-то ) Это будет выноска, расстояние от полилинии до хвоста которой минимально. Берешь (cdr (assoc "obj" value)) - вот тебе указатель на выноску. Ну и теде.

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Так забирай car от результата и делай с ним чего хотишь, делов-то ) Это будет выноска, расстояние от полилинии до хвоста которой минимально. Берешь (cdr (assoc "obj" value)) - вот тебе указатель на выноску. Ну и теде.

Так зачем мне каждый раз такую структуру данных городить, если мне нужна одна выноска и выйти из цикла, получается, что если у меня будет 300 линий, то каждый раз мне нужно будет 300 выносок собрать, 90к раз =)
Я понимаю, что для быстрого процессора это фигня, но все равно, хачем лишние телодвижения

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

Самые близкие элементы по итогу имеют дистанцию 0, но мне немного непонятно, почему "(setq coordinate-mlead (cdr (nth key-coordinate-mlead (entget ent-mlead))))", вот это дает одинаковую координату с мультивыноской

Код:

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

 
	(setq LX 0.0)
	(setq mlead-found-flag nil)
	(setq elem 0)
	(while (not mlead-found-flag)
		(setq mlead (nth elem set-of-vla-mleads))
		(setq ent-mlead (vlax-vla-object->ename mlead))
		(setq coordinate-mlead (cdr (nth key-coordinate-mlead (entget ent-mlead))))
		(setq closer-pt (vlax-curve-getClosestPointTo vla-pl coordinate-mlead))

		
		(if (= LX (distance closer-pt coordinate-mlead))
			(progn
				(setq mlead-found-flag T)
				(setq mlead-found mlead)
			)
		)
		
		(setq elem (1+ elem))
	)

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

Ну, откуда и с какого перепугу ты берешь key-coordinate-mlead, я без понятия. И там в ename-представлении, ЕМНИП, не все настолько просто и однозначно, обычный (cdr (assoc ...)) может дать неправильные результаты. Кажется, там надо нечто типа
(cdr(assoc 10 (member '(0 . "{MLEADER_LINE") (entget (vlax-vla-object->ename vla-mleader-object))))) или что-то наподобие. Скажу честно, сейчас совсем в другой задаче, и ковыряться не могу.
Касаемо

Сообщение от gnuvse если мне нужна одна выноска

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

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Ну, откуда и с какого перепугу ты берешь key-coordinate-mlead, я без понятия. И там в ename-представлении, ЕМНИП, не все настолько просто и однозначно, обычный (cdr (assoc ...)) может дать неправильные результаты. Кажется, там надо нечто типа (cdr(assoc 10 (member '(0 . "{MLEADER_LINE") (entget (vlax-vla-object->ename vla-mleader-object))))) или что-то наподобие. Скажу честно, сейчас совсем в другой задаче, и ковыряться не могу. Касаемо что будет, если выноска попадает на пересечение двух и более полилиний? А сделать обработку сразу на список полилиний и список выносок не сложно, достаточо просто будет проходить (к примеру) по всем полилиниям, подставляя для сравнения постоянно уменьшающийся список выносок. Вариантов, конечно, масса, и мой гарантированно не является самым идеальным

А, я не стал весь код кидать key-coordinate-mlead = 49, это элемент списка где координата выноски, сегодня вручную ковырял все это дело, выяснял. Извиняюсь

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

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

Сообщение от gnuvse А, я не стал весь код кидать key-coordinate-mlead = 49, это элемент списка где координата выноски

Щщас тебе! Я возьму и в мультивыноску своих данных напихаю, и код пойдет глубоко и далеко. Вот тебе варианты получения начальных точек хвостов, сколько бы их ни было:

Код:

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

 (defun fun_get-startpoint-mleader-ename (mleader-ename / elist)
  (setq elist (member '(304 . "LEADER_LINE{") (entget mleader-ename))
        elist (reverse elist)
        elist (member '(301 . "}") elist)
        elist (reverse elist)
  ) ;_ end of setq
  (mapcar (function cdr)
          (vl-remove-if-not
            (function
              (lambda (x)
                (= (car x) 10)
              ) ;_ end of LAMBDA
            ) ;_ end of function
            elist
          ) ;_ end of vl-remove-if-not
  ) ;_ end of mapcar
) ;_ end of defun

(defun fun_get-startpoint-mleader-vla (mleader-vla / res point)
  (foreach item (vlax-safearray->list (vlax-variant-value (vla-getleaderlineindexes mleader-vla 0)))
    (setq point (vlax-safearray->list (vlax-variant-value (vla-getleaderlinevertices mleader-vla item)))
          point (list (car point) (cadr point) (caddr point))
          res   (cons point res)
    ) ;_ end of setq
  ) ;_ end of foreach
  (reverse res)
) ;_ end of defun

Сообщение от gnuvse слишком сложновато все это разом охватить

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

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Щщас тебе! Я возьму и в мультивыноску своих данных напихаю, и код пойдет глубоко и далеко. Вот тебе варианты получения начальных точек хвостов, сколько бы их ни было: Код: [Выделить все] (defun fun_get-startpoint-mleader-ename (mleader-ename / elist) (setq elist (member '(304 . "LEADER_LINE{") (entget mleader-ename)) elist (reverse elist) elist (member '(301 . "}") elist) elist (reverse elist) ) ;_ end of setq (mapcar (function cdr) (vl-remove-if-not (function (lambda (x) (= (car x) 10) ) ;_ end of LAMBDA ) ;_ end of function elist ) ;_ end of vl-remove-if-not ) ;_ end of mapcar ) ;_ end of defun (defun fun_get-startpoint-mleader-vla (mleader-vla / res point) (foreach item (vlax-safearray->list (vlax-variant-value (vla-getleaderlineindexes mleader-vla 0))) (setq point (vlax-safearray->list (vlax-variant-value (vla-getleaderlinevertices mleader-vla item))) point (list (car point) (cadr point) (caddr point)) res (cons point res) ) ;_ end of setq ) ;_ end of foreach (reverse res) ) ;_ end of defun Да там вроде ничего особо сложного. Саму идею понял или стоит объяснить? Спрашиваю без сарказма, просто из меня учитель как из слона балерина.

Спасибо, а зачем мне начальные точки всех хвостов? =)

Да, если честно я код понял, прогнал его, потестировал. Круто ты оперируешь функциональным программироанием, но при этом массивы во все поля, как-то необычно.
Кажется что ты еще тот любитель common lisp'a =)

но я продублирую, может поправишь:

Код:

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

  (defun _kpblc-eval-closest-mleader (vla-polyline vla-mleader-list)
; запускаем функцию сортировки)
  (vl-sort (mapcar
; Выполнить функцию ниже для каждого элемента списка vla-mleader-list
             (function ; оптимизация
               (lambda (x / pt closest) ;анонимная функция
                 (setq pt      (vlax-safearray->list ; делаем из него список
                                 (vlax-variant-value; вытаскиеваем этот массив
                                   (vla-getleaderlinevertices x 0) ; получаем массив координат мультивыноски, их тут два
                                 ) ;_ end of vlax-variant-value
                               ) ;_ end of vlax-safearray->list
                       pt      (list (car pt) (cadr pt) (caddr pt)) ; получаем координаты выноски
                       closest (vlax-curve-getclosestpointto vla-polyline pt) ; находим ближайшую координату
                 ) ;_ end of setq ; создаем структуру с заданными данными
                 (setq x (list (cons "obj" x)
                               (cons "pt" pt)
                               (cons "closest" closest) ; ближайшая полилиния
                               (cons "dist" (distance pt closest))
                         ) ;_ end of list
                 ) ;_ end of setq
               ) ;_ end of lambda
             ) ;_ end of function
             vla-mleader-list
           ) ;_ end of mapcar
; сортируем по данной функции, каждый последующий с предыдущим, по признаку дистанции из нашей структуры
           (function (lambda (a b)
                       (< (cdr (assoc "dist" a)) (cdr (assoc "dist" b)))
                     ) ;_ end of LAMBDA
           ) ;_ end of function
  ) ;_ end of vl-sort
) ;_ end of defun

Для моей простой задачи такое универсальное решение рановато, учитывая, что я тут с точками не могу разобраться, как-то непривычно что-ли. Поэтому хочется пока все упрощать.
Тут загвоздка в том, что мне непонятно, почему мой код работает, и почему ближайшая выноска дает 0.0 дистанцию, а не 0.1 или 2.0, как буд-то какая-то фунция вычисляет от моей выноски до места касания с полилинией

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

Пфффф... Попробую по шагам

Код:

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

   (defun _kpblc-eval-closest-mleader (vla-polyline vla-mleader-list)
; запускаем функцию сортировки)
  (vl-sort (mapcar
; Выполнить функцию ниже для каждого элемента списка vla-mleader-list
             (function ; оптимизация
               (lambda (x / pt closest) ;анонимная функция [+]
                 (setq pt      (vlax-safearray->list ; делаем из него список [+]
                                 (vlax-variant-value; вытаскиеваем этот массив
                                   (vla-getleaderlinevertices x 0) ; получаем массив координат мультивыноски, их тут два [kpblc: или больше]
                                 ) ;_ end of vlax-variant-value
                               ) ;_ end of vlax-safearray->list
                       pt      (list (car pt) (cadr pt) (caddr pt)) ; получаем координаты выноски [kpblc: на самом деле из списка выбираются первые три значения и засовываются в список]
                       closest (vlax-curve-getclosestpointto vla-polyline pt) ; находим ближайшую координату [kpblc: почти. Только не координату, а точку на полилинии, ближайшую к вычисленной чуть раньше]
                 ) ;_ end of setq ; создаем структуру с заданными данными
                 (setq x (list (cons "obj" x)
                               (cons "pt" pt)
                               (cons "closest" closest) ; ближайшая полилиния [kpblc: не полилиния, а ближайшая точка на полилинии]
                               (cons "dist" (distance pt closest)) ; [kpblc: дистанция от хвоста выноски до ближайшей точки. Понадобится потом для фильтрации и сортировки]
                         ) ;_ end of list
                 ) ;_ end of setq
               ) ;_ end of lambda
             ) ;_ end of function
             vla-mleader-list
           ) ;_ end of mapcar
; сортируем по данной функции, каждый последующий с предыдущим, по признаку дистанции из нашей структуры
           (function (lambda (a b) [kpblc: функция сортировки]
                       (< (cdr (assoc "dist" a)) (cdr (assoc "dist" b))) [kpblc: сортируем по параметру "dist"]
                     ) ;_ end of LAMBDA
           ) ;_ end of function
  ) ;_ end of vl-sort
) ;_ end of defun

Смотри, в mapcar вместо указателей на выноски формируется список из списков, внутри которых будет и начальная точка хвоста, и указатель на выноску, и расстояние - короче, все, чего душе захочется. mapcar вернет обновленный список, который через vl-sort уже сортируется. А вот уже через функцию сортировки мы сравниваем вычисленный ранее dist от хвоста до ближайшей точки на полилинии между двумя бывшими выносками. Чем это расстояние меньше, тем ближе к началу списка будет элемент. Соответственно самый первый будет обладать минимальным расстоянием от своего хвоста до полилинии. Его и можно брать и делать с ним (или с полилинией) уже все что угодно.
Offtop: ПыСы До пн я вряд ли буду в адеквате, других задач накидали мама не балуй.

[gnuvse]

Алексей, можешь подсказать, а как ты нашел метод vla-getleaderlinevertices, если не погуглить напрямую, то нет этого метода в Leader, как такие вещи вообще стоит искать?

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

Дык ета... (vlax-dump-object objec t)
Прикол именно в последнем параметре - он показывает еще и методы, доступные для объекта. Ну или VBA-справку надо раскуривать.

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Дык ета... (vlax-dump-object objec t) Прикол именно в последнем параметре - он показывает еще и методы, доступные для объекта. Ну или VBA-справку надо раскуривать.

А что за последний параметр, у меня на выноску вот такое показывает, ничего похожего на координаты или название leader line vertices

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

Ты эту строку в консоли VLIDE выполни )))

Код:

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

 _$ (setq obj (vlax-ename->vla-object (car (entsel "\nSelect mleader : "))))
#<VLA-OBJECT IAcadMLeader 00000203fc3bf758>
_$ (vlax-dump-Object obj t)
; IAcadMLeader: AutoCAD Multi-Leader Interface
; Property values:
;   Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff688c7d990>
;   ArrowheadBlock = ""
;   ArrowheadSize = 4.0
;   ArrowheadType = 0
;   BlockConnectionType = 0
;   BlockScale = 1.0
;   ContentBlockName = ""
;   ContentBlockType = 6
;   ContentType = 2
;   Document (RO) = #<VLA-OBJECT IAcadDocument 00000203fbc9c2e8>
;   DogLegged = -1
;   DoglegLength = 8.0
;   EntityTransparency = "ByLayer"
;   Handle (RO) = "295"
;   HasExtensionDictionary (RO) = 0
;   Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 00000203fbe5c368>
;   LandingGap = 2.0
;   Layer = "0"
;   LeaderCount (RO) = 1
;   LeaderLineColor = #<VLA-OBJECT IAcadAcCmColor 00000203fbeff390>
;   LeaderLinetype = "ByBlock"
;   LeaderLineWeight = -2
;   LeaderType = 1
;   Linetype = "ByLayer"
;   LinetypeScale = 1.0
;   Lineweight = -1
;   Material = "ByLayer"
;   ObjectID (RO) = 42
;   ObjectName (RO) = "AcDbMLeader"
;   OwnerID (RO) = 43
;   PlotStyleName = "ByLayer"
;   ScaleFactor = 1.0
;   StyleName = "Standard"
;   TextAttachmentDirection = 0
;   TextBackgroundFill = 0
;   TextBottomAttachmentType = 0
;   TextDirection = 5
;   TextFrameDisplay = 0
;   TextHeight = 4.0
;   TextJustify = 1
;   TextLeftAttachmentType = 1
;   TextLineSpacingDistance = 6.66667
;   TextLineSpacingFactor = 1.0
;   TextLineSpacingStyle = 1
;   TextRightAttachmentType = 1
;   TextRotation = 0.0
;   TextString = "qwerfgd"
;   TextStyleName = "Standard"
;   TextTopAttachmentType = 0
;   TextWidth = 0.0
;   TrueColor = #<VLA-OBJECT IAcadAcCmColor 00000203f0dcff60>
;   Visible = -1
; Methods supported:
;   AddLeader ()
;   AddLeaderLine (2)
;   AddLeaderLineEx (1)
;   ArrayPolar (3)
;   ArrayRectangular (6)
;   Copy ()
;   Delete ()
;   GetBlockAttributeValue (1)
;   GetBoundingBox (2)
;   GetDoglegDirection (1)
;   GetExtensionDictionary ()
;   GetLeaderIndex (1)
;   GetLeaderLineIndexes (1)
;   GetLeaderLineVertices (1)
;   GetVertexCount (1)
;   GetXData (3)
;   Highlight (1)
;   IntersectWith (2)
;   Mirror (2)
;   Mirror3D (3)
;   Move (2)
;   RemoveLeader (1)
;   RemoveLeaderLine (1)
;   Rotate (2)
;   Rotate3D (3)
;   ScaleEntity (2)
;   SetBlockAttributeValue (2)
;   SetDoglegDirection (2)
;   SetLeaderLineVertices (2)
;   SetXData (2)
;   TransformBy (1)
;   Update ()
T
_$ 

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Ты эту строку в консоли VLIDE выполни ))) Код: [Выделить все] _$ (setq obj (vlax-ename->vla-object (car (entsel "\nSelect mleader : ")))) #<VLA-OBJECT IAcadMLeader 00000203fc3bf758> _$ (vlax-dump-Object obj t) ; IAcadMLeader: AutoCAD Multi-Leader Interface ; Property values: ; Application (RO) = #<VLA-OBJECT IAcadApplication 00007ff688c7d990> ; ArrowheadBlock = "" ; ArrowheadSize = 4.0 ; ArrowheadType = 0 ; BlockConnectionType = 0 ; BlockScale = 1.0 ; ContentBlockName = "" ; ContentBlockType = 6 ; ContentType = 2 ; Document (RO) = #<VLA-OBJECT IAcadDocument 00000203fbc9c2e8> ; DogLegged = -1 ; DoglegLength = 8.0 ; EntityTransparency = "ByLayer" ; Handle (RO) = "295" ; HasExtensionDictionary (RO) = 0 ; Hyperlinks (RO) = #<VLA-OBJECT IAcadHyperlinks 00000203fbe5c368> ; LandingGap = 2.0 ; Layer = "0" ; LeaderCount (RO) = 1 ; LeaderLineColor = #<VLA-OBJECT IAcadAcCmColor 00000203fbeff390> ; LeaderLinetype = "ByBlock" ; LeaderLineWeight = -2 ; LeaderType = 1 ; Linetype = "ByLayer" ; LinetypeScale = 1.0 ; Lineweight = -1 ; Material = "ByLayer" ; ObjectID (RO) = 42 ; ObjectName (RO) = "AcDbMLeader" ; OwnerID (RO) = 43 ; PlotStyleName = "ByLayer" ; ScaleFactor = 1.0 ; StyleName = "Standard" ; TextAttachmentDirection = 0 ; TextBackgroundFill = 0 ; TextBottomAttachmentType = 0 ; TextDirection = 5 ; TextFrameDisplay = 0 ; TextHeight = 4.0 ; TextJustify = 1 ; TextLeftAttachmentType = 1 ; TextLineSpacingDistance = 6.66667 ; TextLineSpacingFactor = 1.0 ; TextLineSpacingStyle = 1 ; TextRightAttachmentType = 1 ; TextRotation = 0.0 ; TextString = "qwerfgd" ; TextStyleName = "Standard" ; TextTopAttachmentType = 0 ; TextWidth = 0.0 ; TrueColor = #<VLA-OBJECT IAcadAcCmColor 00000203f0dcff60> ; Visible = -1 ; Methods supported: ; AddLeader () ; AddLeaderLine (2) ; AddLeaderLineEx (1) ; ArrayPolar (3) ; ArrayRectangular (6) ; Copy () ; Delete () ; GetBlockAttributeValue (1) ; GetBoundingBox (2) ; GetDoglegDirection (1) ; GetExtensionDictionary () ; GetLeaderIndex (1) ; GetLeaderLineIndexes (1) ; GetLeaderLineVertices (1) ; GetVertexCount (1) ; GetXData (3) ; Highlight (1) ; IntersectWith (2) ; Mirror (2) ; Mirror3D (3) ; Move (2) ; RemoveLeader (1) ; RemoveLeaderLine (1) ; Rotate (2) ; Rotate3D (3) ; ScaleEntity (2) ; SetBlockAttributeValue (2) ; SetDoglegDirection (2) ; SetLeaderLineVertices (2) ; SetXData (2) ; TransformBy (1) ; Update () T _$

Ого, спасибо. Не разгадал твой ребус с красной t

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

Ну на крайняк действительно поставь VBA-енаблер и справку под него )) Тож пользительная штука.

[koMon]

gnuvse,
найди в своей языковой папке в "C:\Program Files\Common Files\Autodesk Shared\" справочник по ActiveX "acadauto.chm" и будет тебе счастье.

[gnuvse]

Сообщение от koMon gnuvse, найди в своей языковой папке в "C:\Program Files\Common Files\Autodesk Shared\" справочник по ActiveX "acadauto.chm" и будет тебе счастье.

Спасибо.

Но я вчера пока искал метод для выноски, уже нашел эту доку онлайн

[koMon]

[gnuvse]

Сообщение от koMon Вложение 259689

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

[gnuvse]

Доброго дня.

У меня накопилось несколько вопросов и просьб, можете помочь?
Буду признателен.

1. Есть ли встроенная функция по декодированию списка-списков в список?
А то я сам накодировал вот такую программу, просто чертим pline по вставленным блокам. Сама функция list-of-lists-pt->list делает то, что я описал. А как ее переписать в стиле lisp?

Код:

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

 
; Предварительно считаем, что в наборе правильные данные
; собираем список всех точек из списка-списков точек. Было ((x y z)...(xn yn zn)) -> (x y z ... xn yn zn)
(defun list-of-lists-pt->list (vla-set-of-bl / ret-list)
	(setq list-of-lists-pt nil)
	(foreach vla-bl vla-set-of-bl
		(setq pt-bl (vlax-get vla-bl "insertionpoint"))
		(foreach c pt-bl
			(setq list-of-lists-pt (cons c list-of-lists-pt))
		)
	)
	(setq ret-list (reverse list-of-lists-pt))
	;return
	ret-list
)
; инициализация и заполнение массива 
(defun list-pt->safearray (list-pt)
	(setq len-list-pt (- (length list-pt) 1))
	(setq points (vlax-make-safearray vlax-vbDouble (cons '0 len-list-pt)))
	; return last eval
	(vlax-safearray-fill points list-pt)
)


(defun main()
	(setq acadObj (vlax-get-acad-object))
        (setq doc (vla-get-ActiveDocument acadObj))
	(setq modelSpace (vla-get-ModelSpace doc))

	(setq layer-bl "0")
	(setq eff-list-bl "test")
	
	
	(print "Select set of data")
	(setq list-of-vlas-bl (get-vlas-from-set-data layer-bl "INSERT")) ; (get-vlas-from-set-data layer-bl "INSERT") - самописная функция, просто делает ввод по нужным объектам и преобразовывает в vla весь набор
	(setq points (list-pt->safearray (list-of-lists-pt->list list-of-vlas-bl)))
	
	(vla-AddPolyline modelSpace points)
	

)

(main)

2. Как обработать такой случай работы моей программы выше(см. вложение)?
Какие я тут вижу проблемы:
а. Это определение этого места, то есть на пути от одной точки до другой стоит некое препятствие, может можно какой-то тестовый луч перед построением отправлять?
б. После локализации места нужно нам найти точку, и добавить ее для построения линии, то есть это должно осуществляться до вызова list-pt->safearray, чтобы потом передать правильную длину для vla-make-safearray
По-возможности, попробуйте мне описать словами, чтобы код я сам попробовал написать.



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

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

Код:

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

 ; собираем список всех точек из списка-списков точек. Было ((x y z)...(xn yn zn)) -> (x y z ... xn yn zn)
	(defun list-of-lists-pt->list (point-list)
    (apply (function append) point-list))

И вторую я бы написал примерно так:

Код:

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

 (defun list-pt->safearray (list-pt) 
  (vlax-vlax-safearray-fill 
    (vlax-make-safearray 
      vlax-vbDouble
      (cons 0 (1- (length list-pt)))
      list-pt
    )
  )
)

[koMon]

Сообщение от gnuvse просто чертим pline по вставленным блокам

добавляем полилинию по точкам вставки выбранных блоков?

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

Сообщение от gnuvse 1. Есть ли встроенная функция по декодированию списка-списков в список?

(apply 'append '((1 2 3) (4 5 6) (7 8 9)))-> '(1 2 3 4 5 6 7 8 9)

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Код: [Выделить все] ; собираем список всех точек из списка-списков точек. Было ((x y z)...(xn yn zn)) -> (x y z ... xn yn zn) (defun list-of-lists-pt->list (point-list) (apply (function append) point-list)) И вторую я бы написал примерно так: Код: [Выделить все] (defun list-pt->safearray (list-pt) (vlax-vlax-safearray-fill (vlax-make-safearray vlax-vbDouble (cons 0 (1- (length list-pt))) list-pt ) ) )

Какой же это изящный чит с append.
Переписал свою функцию для получения cписка точек из vla-list-bl в духе Lisp

Код:

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

 
(defun get-list-of-lists-pts (vla-set-of-bl)
	(setq list-of-lists-pt 
		(mapcar
			(function 
				(lambda (vla-bl) 
					(vlax-get vla-bl "insertionpoint")
				)
			)
			vla-set-of-bl
		)
	)
	list-of-lists-pt
)

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

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

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

Сообщение от koMon добавляем полилинию по точкам вставки выбранных блоков? ----- добавлено через ~2 мин. ----- (apply 'append '((1 2 3) (4 5 6) (7 8 9)))-> '(1 2 3 4 5 6 7 8 9)

Да, все верно.
Спасибо за append, мне Леха подсказал уже, классная штука

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

Сообщение от gnuvse Это определение этого места, то есть на пути от одной точки до другой стоит некое препятствие, может можно какой-то тестовый луч перед построением отправлять?

Чисто теоретически (если не привлекать тяжелую артиллерию в виде R-Tree, про которое несколько раз упоминал trir), то можно попытаться пройтись по всем примитивам и получить от них BoundingBox. Строим пары точек будущей полилинии и смотрим, пересекает ли каждый из этих "виртуальных" отрезков прямоугольник примитива (ну или, в некоторых случаях, сам примитив) - см. inters. Логика так себе, согласен - может, кто и подскажет более приемлемый способ для лиспа.
Чего еще хотелось бы добавить. Точки вставки у тебя будут трехмерные, а координаты в полилинию надо передавать двумерные. Вариантов немного - либо каждую координату принудительно приводить к двумерному виду, либо создавать полилинию через entmake / entmakex. Второй вариант будет работать только в текущем документе, учти.

[gnuvse]

Сообщение от Кулик Алексей aka kpblc Чисто теоретически (если не привлекать тяжелую артиллерию в виде R-Tree, про которое несколько раз упоминал trir), то можно попытаться пройтись по всем примитивам и получить от них BoundingBox. Строим пары точек будущей полилинии и смотрим, пересекает ли каждый из этих "виртуальных" отрезков прямоугольник примитива (ну или, в некоторых случаях, сам примитив) - см. inters. Логика так себе, согласен - может, кто и подскажет более приемлемый способ для лиспа. Чего еще хотелось бы добавить. Точки вставки у тебя будут трехмерные, а координаты в полилинию надо передавать двумерные. Вариантов немного - либо каждую координату принудительно приводить к двумерному виду, либо создавать полилинию через entmake / entmakex. Второй вариант будет работать только в текущем документе, учти.

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

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

[koMon]

gnuvse,
добавить 2d-полилинию по точкам вставки выбранных блоков

Код:

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

 
(setq raw_vertices_list (apply 'append 
							   (mapcar '(lambda (ename) (cdr (assoc 10 (entget ename)))) 
										(vl-remove-if 'listp 
											(mapcar 'cadr (ssnamex (ssget '((0 . "insert")))))
										)
							   )
						)
)
(vla-addpolyline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
 				 (vlax-safearray-fill 
				 	(vlax-make-safearray vlax-vbdouble (cons 1 (length raw_vertices_list))) 
					raw_vertices_list
				 )
)

[gnuvse]

Сообщение от koMon gnuvse, добавить 2d-полилинию по точкам вставки выбранных блоков Код: [Выделить все] (setq raw_vertices_list (apply 'append (mapcar '(lambda (ename) (cdr (assoc 10 (entget ename)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "insert"))))) ) ) ) ) (vla-addpolyline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object)))) (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 1 (length raw_vertices_list))) raw_vertices_list ) )

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

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

Сообщение от gnuvse А можешь подсказать какие из твоих исходников я мог бы начать изучать?

Не-а... У меня нормальных исходников-то практически нет. Могу посоветовать "САПР на базе" (в глубинах форума где-то скан есть). Можно сказать библия разработчика под кад ))

[koMon]

Сообщение от gnuvse какие исходники поизучать

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

[Сергей812]

ну и быть моральным готовым к тому - что в один прекрасный момент "упретесь" в то же быстродействие лиспа, когда уже будет готов определенный объем программы)

[gnuvse]

Сообщение от Сергей812 ну и быть моральным готовым к тому - что в один прекрасный момент "упретесь" в то же быстродействие лиспа, когда уже будет готов определенный объем программы)

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

----- добавлено через 46 сек. -----

Сообщение от koMon изучать лисп по исходникам - дело неблагодарное) лучше смотреть что может делать лисп, activex и применять эти знания к решению своих задач.

А, тут дело в том, чтобы смотреть в комплексе и на код и Doc, потому что читать тоже полезно.

[40in]

Добрый день!
Имеется такой кусок программы:

Код:

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

 (setq obj nil)
(while (or (= obj nil)
	   (/= (cdr (assoc 0 (entget obj))) "TEXT")
;;;	   (/= (cdr (assoc 0 (entget obj))) "MULTILEADER")
       )
  (setq obj (car (entsel)))
)

По двум условиям все работает, но если включить третье условие то ничего не работает. Что не так?

[koMon]

40in,

Код:

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

 
(setq obj nil)
(while (or (null obj)
	   	   (and
		   		(/= (cdr (assoc 0 (entget obj))) "TEXT")
	   	   		(/= (cdr (assoc 0 (entget obj))) "MULTILEADER")
		   )
       )
  	   (setq obj (car (entsel)))
)

[40in]

Спасибо большое! Ну не програмер я...)))))

[posetitel]

Товарищи, подскажите, возможно ли в принципе на лисп реализовать вот такую хотелку.
1) Есть в чертеже несколько поллиний, каждая полилиния в своем слое (например слой1, слой2, слой3). Я хочу секущей рамкой выбрать определенные полилинии, например, выбрал полилинию, находящуюся в слой1, и полилинию, находящуюся в слой3, и запомнить выбор в какую-нибудь переменную (тут вроде все выполнимо).
2) Далее необходимо во вторую переменную из заранее заготовленного экселя подгрузить таблицу соответствия величины диаметра названию всех слоев с полилиниями на чертеже.
Ну т.е. в экселе в первом столбце названия слоев, а во втором столбце величина диаметра, получается слой1=10, слой2=20, слой3=30.
3) Далее внутри лиспа выполнить функцию, аналогичную функции экселя ВПР, т.е. соотнести слои из переменной 1 и слои в переменной 2, и в случае совпадения имен создать переменную 3, в которой будут уже не названия слоев, а числа соответствующие диаметрам каждого слоя (в примере получается 2 числа: 10 и 30).
4) Ну и самое простое - начертить кружочки с диаметрами из переменной 3.
Теоретически, наверное, это реализуемо, если сначала выгрузить переменную 1 из действия 1) в эксель, уже в экселе с функцией ВПР обработать результат, там же сформировать команду черчения окружностей и потом просто скопировать готовую команду черчения окружностей в командную строку, но хотелось миновать задействования экселя в процессе работы лиспа.

Смущают пункты 2 и 3, на VBA я сопоставление и выборку сделать смогу, а вот можно ли так на лиспе?

[Сергей812]

имхо, вместо экселя загружать из текстового файла в список точечные пары {имя слоя . диаметр}, и потом искать в этом списке по имени слоя. Т.е. в текстовом файле идет построчно имя слоя и на следующей строке сопоставленный слою диаметр. И тогда сформировать список примерно таким кодом:

Код:

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

 (setq lF (open "%FileName%" "r"))
   (while (and lKey lD)
      (setq lKey (read-line lF))
      (setq lD (read-line lF))
      (if (and lKey lD) (setq lLst (append lLst (List (cons lKey lD)))))
   )
   (close lF)

и на выходе в переменной lLst будет список пар типа (("Name1" . 10) ("Name2" . 20) ("Name3" . 30)).

Ну а получить потом из списка диаметр

Код:

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

 (setq lD (cdr (assoc %Имя слоя%  lLst)))

естественно, это все надо "обвесить" проверками на получение не NIL значения и обработчиками ошибок.

[posetitel]

В лиспе совсем-совсем новичок, сижу с рекомендуемой всем новичкам в этой теме талмудом на 1000 страниц и пытаюсь разобрать код, но все равно идет трудновато. Направьте в нужное русло, тем более тема соответствующая.
В общих чертах смысл первого кода ясен: пока в текстовом документе есть строчки, в переменную lLst слепляются точечные пары. Но хочу детально вникнуть, что делает каждая функция и тут затык получается.
Непонятно выражение (while (and lKey lD). Ну т.е. я представляю, как оно обычно работает, но вот как конкретно в этом коде не догоняю.
Переменные lKey lD, если их не объявить перед функцией while, сразу выдадут nil и цикл должен прерваться. В чем я заблуждаюсь в своих рассуждениях?
Еще уточняющий вопрос: функция read-line автоматически перескакивает на следующую строчку? Т.е. выражения
(setq lKey (read-line lF))
(setq lD (read-line lF))
сами читают строчки по очереди, не надо добавлять что-то вроде next read-line или read-line = read-line+1 ?
Ну и самый важный вопрос от новичка: а как у вас получаются цветные слова? Как можно писать и обкатывать код на лиспе? А то я по старинке в блокноте пишу, потом пока загружу в автокад, пока напишу команду на выполнение...

[Сергей812]

Сообщение от posetitel функция read-line автоматически перескакивает на следующую строчку

да, т.е. она "проглатывает" символы конца текущей строки и указатель файла (это уже не к лиспу, а к самой операционной системе относится) стоит на начале следующей строки. А если файл закончился, то вернет nil. Ну для красоты перед вторым вызовом (setq lD (read-line lF)) можно было бы сперва проверить lKey <> nil - чтобы не пытаться читать завершенный файл еще раз.

Сообщение от posetitel (while (and lKey lD)

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

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

[posetitel]

Сообщение от Сергей812 если были успешно считаны обе связанные строки - в цикле пытаемся считать следующую пару значений. То же условие в строке 5 - если конец файла (или "накосячили" в файле и непарное количество значений), то просто не будет добавлено в список. Еще могут быть пустые строки в файле - тоже по хорошему их надо пропускать.

я к тому, не надо ли переписать вот так:
(setq lKey (read-line lF))
(setq lD (read-line lF))
(while (and lKey lD)
(if (and lKey lD) (setq lLst (append lLst (List (cons lKey lD)))))
(setq lKey (read-line lF))
(setq lD (read-line lF))
)
чтобы перед циклом сначала были заданы переменные, которые уже считали по строчке из текстового файла.

[Сергей812]

кстати да, не заметил логической ошибки, спасибо) Можно просто перед циклом вставить

Код:

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

 (setq lKey "" lD 1)

чтобы начальные значения не nil были и цикл хоть раз бы отработал.

[posetitel]

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

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

VLIDE либо VS Code с расширением AutoLISP (ИМХО)

[Сергей812]

Сообщение от posetitel А как код можно быстро тестировать и писать с цветовым выделением переменных, функций, чтобы нагляднее было?

ну я в Notepad++ писал сейчас, там подсветка синтаксиса лиспа есть. А тестировать - autolisp внутренний язык приложения, поэтому без акада его (код) и не протестируешь в работе. Так что встроенный редактор акада и там сразу fixedsys (вроде) шрифт поставить - чтобы кириллица нормально отображалась.

[Alxndr1697]

Упс)

[posetitel]

Товарищи, подскажите еще где смотреть описание команд, их параметры и очередность ввода, чтобы можно было написать в лиспе или в командной строке? В справочнике команд автокада приводится только общее описание, без описания, как пользоваться командой через командную строку.
Т.е., например, я взял из другого лиспа команду (command "_mleader" p1 p1 str) и пытаюсь разобраться как она работает. Интуитивно понятно, что p1 - это переменная координаты точки вставки стрелки, она в лиспе задается в другом месте, вторая p1 по идее должна быть переменная координаты вставки текста выноски, но они почему-то одинаковые, хотя по факту при выполнении лиспа все же в итоге запрашиваются на экране, ну а str - это содержание мультивыноски.
Так вот если я попытаюсь ввести в команду в строчку вот так "_mleader 10.5 20.6 Текст", то автокад вообще выдаст ошибку, он не понимает мои координаты 10.5 и 20.6, а просит указать их на экране и вместо "текст" ждет ввода совсем других параметров команды mleader, таких как что указывать вначале положение стрелки выноски или положение текста выноски или вообще выбрать опции.

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

Самое простое - пытаться выполнять команды напрямую в ACAD. Помня о том, что точки, к примеру, задаются не

Код:

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

10.5 20.6

а как

Код:

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

10.5,20.6

Правда, там могут быть нюансы Особенно касаемо мультивыноски: https://autolisp.ru/2015/01/21/mleader_create_order/

[posetitel]

Сообщение от Кулик Алексей aka kpblc Самое простое - пытаться выполнять команды напрямую в ACAD. Помня о том, что точки, к примеру, задаются не Код: [Выделить все] 10.5 20.6 а как Код: [Выделить все] 10.5,20.6 Правда, там могут быть нюансы Особенно касаемо мультивыноски: https://autolisp.ru/2015/01/21/mleader_create_order/

Через запятую получилось ввести координаты начала стрелки и начала текста, т.е. вводил "_mleader 10,5 20,6 Текст" (без кавычек), тогда стрелка в точке (10,5), текст выноски начинается в точке (20,6), разделение координат начала стрелки и начала текста пробелом. Но вот слово "Текст" в выноску поместить не удается ни через кавычки, ни через пробел, автокад ждет выбора параметра построения, о котором как раз идет речь по ссылке.
Ну и в общем случае, не для мультивыноски, а для построения других примитивов где посмотреть очередность и синтаксис параметров?

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

Ну, сначала-то было написано

Сообщение от posetitel _mleader 10.5 20.6 Текст

а не

Сообщение от posetitel _mleader 10,5 20,6 Текст

И я бы, если честно, не создавал бы командными методами мультивыноски, многострочные тексты, таблицы и до дури других типов примитивов, особенно если заранее известны все параметры. В Download есть книга В.Света "Язык макрокоманд", советую скачать и почитать - там про командные методы много всякого рассказано. В глубинах форума есть "САПР на базе AutoCAD - как это делается": мощнейший талмуд, больше 1000 страниц, практически библия для разработки под ACAD. Хорошо прочищает мозги, если ее осилить хотя бы наполовину ))

[posetitel]

Обе книги нашел, монументальные, ничего не скажешь, надо прям вчитываться. Сходу пробежался, то что хотел не обнаружил.
Мне казалось должен быть простой список команд с синтаксисом написания, ну если возвращаться к мультивыноске, то что-то вроде:
_mleader <arg1> <arg2> <arg3>,
где <arg1> - координата первой точки, <arg2> - координата второй точки, <arg3> - содержание.
Ну как обычно описывают функции, так и для команд должно быть что-то похожее.

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

Сообщение от posetitel для команд должно быть что-то похожее

Подобный подход работает далеко не для каждой команды, к сожалению.

[Сергей812]

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

А чтобы был удобный вызов - пишутся на базе существующего языка программирования свои функции (классов в лиспе нет), и после отладки собираются в библиотеки для повторного использования. Собственно, книга <САПР на базе AutoCAD - как это делается> об этом всем и рассказывает. Другое дело, что писать сейчас САПР на лиспе - это очень на любителя, имхо)

[posetitel]

тогда может есть список с описанием для команд, для которых доступно такое описание?

[Alxndr1697]

Сообщение от posetitel тогда может есть список с описанием для команд, для которых доступно такое описание?

Если найдешь ответ на этот вопрос, - поделись, пожалуйста.

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

Сообщение от posetitel тогда может есть список с описанием для команд, для которых доступно такое описание?

F1 ?

[posetitel]

Подскажите простую вещь, самому допереть не получается.
Есть команда _SPDSNET_ExportACAD, которая должна взрывать все объекты spds extension (Autodesk SPDS)
В составе лиспа, который в том числе должен вызывать и эту команду, у меня код выглядит так:
(command "команда1")
(command "_SPDSNET_ExportACAD" )
(command "команда2")
и все бы ничего, но после вызова _SPDSNET_ExportACAD вылетает диалоговое окно с просьбой подтвердить действия (Все объекты безвозвратно расчленятся. Вы уверены? и кнопки ОК и Cancel).
Как в тексте лиспа прописать автоматическое подтверждение?

[Alxndr1697]

Двойные кавычки ("") имитируют нажатие Enter.

[posetitel]

да, я пытался через двойные кавычки, т.е. писал (command "_SPDSNET_ExportACAD" ""), но скорее всего после запуска команды и выскакивания меню лисп ставится на паузу и ждет действия от пользователя, т.е. даже двойные кавычки ждут, пока я не нажму кнопку в меню.
т.е не получается через двойные кавычки.

[Alxndr1697]

Сообщение от posetitel да, я пытался через двойные кавычки, т.е. писал (command "_SPDSNET_ExportACAD" ""), но скорее всего после запуска команды и выскакивания меню лисп ставится на паузу и ждет действие от пользователя, т.е. даже двойные кавычки ждут, пока я не нажму кнопку в меню. т.е не получается через двойные кавычки.

А ещё раз нажать Enter? ("" "")

[posetitel]

не помогает.
вот выкопировка из кода
(command "_SPDSNET_ExportACAD" "" "")
все равно требует подтверждения с мыши или клавиатуры

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

Интересно, а эта команда имеет вариант недиалогового режима? Что будет, если перед именем команды поставить минус?

[posetitel]

написал (command "-_SPDSNET_ExportACAD" "" "")
вот что в командой строке получилось
Команда: -_SPDSNET_ExportACAD Неизвестная команда "-_SPDSNET_EXPORTACAD". Для вызова справки нажмите F1

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

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

[posetitel]

Хорошо, со всплывающим окном подтверждения придется мириться.
А можно ли как прописать условие проверки, выполнима ли команда _SPDSNET_ExportACAD? Т.е. чтобы если команда не найдена (модуль СПДС не установлен на машине), лисп продолжал выполнять следующие команды по списку, а не прерывался с ошибкой?

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

vl-catch-all-apply - ИМХО самое простое

[Alxndr1697]

Сообщение от posetitel Есть команда _SPDSNET_ExportACAD, которая должна взрывать все объекты spds extension (Autodesk SPDS)

А заменить на (command-s "_.Explode" "_all" ""), например?

Параметр "_All", возможно, неверный. У меня взрывает только первый объект, а должен, вроде как, все

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

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

[Alxndr1697]

Дык, я подумал, что такая задача и стоИт...

Понял, надо фильтр на "все объекты spds extension (Autodesk SPDS)"

[posetitel]

Да, хотел взрывать штатными средствами, раз есть такая опция, да и spds extension - очень специфические объекты, и лучше делать все так, как у них предусмотрел разработчик, иначе косяки вылезают в неожиданных местах.
Подскажите, как работает vl-catch-all-apply, какой у нее принцип?
Ну т.е. эта функция похожа на оператор если: если ошибка делай то, если нет ошибки делай это?
Т.е. после проверяемого условия мне нужно будет два раза написать продолжение кода, чтобы он выполнялся и при возникновении ошибки и без возникновения ошибки?

[name02]

Сообщение от posetitel Подскажите, как работает vl-catch-all-apply, какой у нее принцип?

Читай справку vl-catch-all-apply и vl-catch-all-error-p

[SetQ]

Сообщение от posetitel Хорошо, со всплывающим окном подтверждения придется мириться.

Можно довольно просто сделать, чтобы 'Ok' в окне нажимался сам (окно будет всплывать и тут же закрываться).

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

Сообщение от SetQ Можно довольно просто сделать, чтобы 'Ok' в окне нажимался сам (окно будет всплывать и тут же закрываться).

Это как?

[Сергей812]

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

найти окно, затем хэндл кнопки и послать ей (кнопке) сообщение BM_CLICK - чистое WinApi, которое вроде из лиспа тоже можно вызывать.

[posetitel]

Сообщение от posetitel Да, хотел взрывать штатными средствами, раз есть такая опция, да и spds extension - очень специфические объекты, и лучше делать все так, как у них предусмотрел разработчик, иначе косяки вылезают в неожиданных местах. Подскажите, как работает vl-catch-all-apply, какой у нее принцип? Ну т.е. эта функция похожа на оператор если: если ошибка делай то, если нет ошибки делай это? Т.е. после проверяемого условия мне нужно будет два раза написать продолжение кода, чтобы он выполнялся и при возникновении ошибки и без возникновения ошибки?

Запилил лисп по советам форумчан и все работало, спасибо откликнувшимся, но традиционно косяки вылезли откуда не ждали, а именно в долбаном СПДСе от автодеска, он очень криво сам взрывает свои же объекты. Тамошний форум закрыт (только чтение), сами понимаете из-за чего. Теперь придется искать другие способы.

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

Сносить SPDS Extension и дальше ExplodeAllProxy от А.Н.Ривилиса )

[posetitel]

а есть лисп, чтобы автоматизировать процесс:
снес спдс - применил ExplodeAllProxy от А.Н.Ривилиса - установил спдс
а?

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

Учитывая, что SPDS Extension надо сносить средствами винды, насколько я помню?

----- добавлено через ~2 мин. -----
Ну а на старт каждого документа поставить нечто типа
(if (= (getvar "demandload") 3)
(alert "Сначала demandload в 2, а потом и поговорим")
(progn
(if explodeproxyinentity (vl-cmdf "_.explodeallproxy" "_.removeallproxy" "_n"))

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

[posetitel]

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

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

Ну, подобное я себе ставить как бы не собираюсь.

[posetitel]

подскажите еще по другой теме:
в коде присвоил переменной имя файла
(setq с_dwg (strcat(getvar "DWGPREFIX")(getvar "DWGNAME")))
далее по этой переменной пытаюсь закрыть файл
(vla-Close с_dwg :vlax-true)
акад пишет ошибку: неверный тип аргумента: VLA-OBJECT "C:\\Users\\....имяфайла.dwg".
в чем может быть дело? У Полещука функция vla-Close не описывается, хотя в примерах есть, например, на странице 402.

добавлю, может это важно, что предварительно открываю другой документ

т.е. код выглядит так:
(setq с_dwg (strcat(getvar "DWGPREFIX")(getvar "DWGNAME")))
(vla-activate(vla-open (vla-get-documents (vlax-get-acad-object))(findfile o_dwg) :vlax-false))
(vla-Close с_dwg :vlax-true)

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

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

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

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

----- добавлено через ~2 мин. -----
ПыСы для работы с нетекущим документов настоятельно рекомендую использовать менее варварские способы. Например, ObjectDBX (ну или вообще поднимать отдельный экземпляр ACAD'а и работать с ним)

[posetitel]

Напоминаю идею: получить переменные с именем открываемого (o_dwg) файла и закрываемого (с1_dwg), а потом открыть открываемый и закрыть закрываемый соответственно.
Код был примерно такой
(setq с1_dwg (strcat(getvar "DWGNAME")))
(setq с2_dwg (vla-Item (vla-get-documents (vlax-get-acad-object)) с1_dwg))
(vla-activate(vla-open (vla-get-documents (vlax-get-acad-object))(findfile o_dwg) :vlax-false))
(vla-Close с2_dwg :vlax-true )

нужный файл открылся, но закрыть первый не смог, получил ошибку "Ошибка Automation. Чертеж занят."
Скорее всего это из-за попытки закрыть документ из которого выполняется лисп, несмотря на то, что я уже открыл другой чертеж.
Ну и вообще моя идея изначально плохая, как пишут выше.

[===AAA===]

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

[posetitel]

обработать единичную связку из двух файлов.

[===AAA===]

Вариант переключиться на это время в SDI=0 не подойдёт?

[posetitel]

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

[===AAA===]

с SDI=0 - никаких проблем

[posetitel]

сейчас проверил, SDI=0 стоит по умолчанию, т.е. не помогло

[===AAA===]

Сорри, SDI=1 нужно.

[posetitel]

тоже не помогло, попробовал и с 1

[===AAA===]

Просто открывай новый чертёж. Старый сам закроется.

----- добавлено через 54 сек. -----
Только старый сохраняй предварительно, чтобы Автокад вопросов не задавал.

[posetitel]

отличный совет ))
я целый день разбираюсь, как это реализовать средствами лиспа

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

Я не очень понимаю глубинного смысла этой затеи, но как алгоритм:
- получить и запомнить "где-то снаружи" текущее значение SDI
- Если SDI = 0, то пройтись по всей коллекции документов и позакрывать их
- SDI в 0
- сохранить файл
- в ком.строку послать нечто типа (vl-cmdf "_.close" "open" NewFileName.dwg) или каким-то другим способом попытаться открыть NewFileName.dwg
- восстановить SDI из "где-то снаружи".

[SetQ]

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

Добавить реактор, который на команду SPDSNET_EXPORTACAD будет создавать файл flag.txt.

Код:

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

 (SetQ *fn* "C:\\temp\\flag.log")

(DeFun f0 (a b / f)
  (SetQ f (Open *fn* "w"))
  (Write-Line (Car b) f)
  (Close f)
)

(DeFun f1 (a b)
  (vl-file-delete *fn*)
)

(vlr-command-reactor nil '((:vlr-commandWillStart . f0)))
(vlr-command-reactor nil '((:vlr-commandEnded . f1)))
(vlr-command-reactor nil '((:vlr-commandCancelled . f1)))
(vlr-command-reactor nil '((:vlr-commandFailed . f1)))

(Eval (f1 0 0))

И одновременно работает какой-нибудь планировщик, например nnCron с таким заданием:

Код:

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

#( SPDSok
WatchFile: "C:\temp\flag.log"
Action:
SEND-KEYS: "{ENTER}"
FILE-DELETE: "C:\temp\flag.log"
)#

[Сергей812]

Сообщение от SetQ И одновременно работает какой-нибудь планировщик, например nnCron с таким заданием:

имхо, все-таки надо проверять текущее активное модальное окно - а не посылать наугад.

[SetQ]

Или совсем просто - по F5 nnCron "отправляет с клавиватуры" команду и два раза нажимает Ентер:

Код:

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

#( spds
WatchHotKey: "{0x74}"
Action:
SEND-KEYS: "SPDSNET_EXPORTACAD{ENTER}"
PAUSE: 500
SEND-KEYS: "{ENTER}"
)#

Можно в каком-нибуд AutoHotkey то же самое задать.

[MironovMA]

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

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

По-моему, что-то типа vla-vbaload

[Red Nova]

Добродо времени суток, други. Ответите блудному автору на вопросик?
Имею список наименований объектов. Там есть как блоки (в основном динамические) так и другие объекты (линии, размеры и т.п.)
Что-то типа вот этого:

Код:

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

'(<Entity name: 142f8fbea20> <Entity name: 142f8fbee70> <Entity name: 142f8fbb960>)

Можно ли удалить из списка все что не есть блок?

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

Можно, а в чем проблема?
(vl-remove-if-not '(lambda(x)(=(cdr(assoc 0 (entget x)))"INSERT")) <Твой список>)

[Sege]

Нужно проверить цвет ячейки таблицы (например что она красная)

(setq obj (vlax-ename->vla-object (car (entsel))))
(setq clr (vla-GetCellContentColor obj 1 1))

получаю значение ячейки 1,1 в виде
#<VLA-OBJECT IAcadAcCmColor 000001da1a25e950>

что дальше делать с полученным значением clr для его проверки (цвет равен красным)

[Red Nova]

Сообщение от Кулик Алексей aka kpblc Можно, а в чем проблема? (vl-remove-if-not '(lambda(x)(=(cdr(assoc 0 (entget x)))"INSERT")) <Твой список>)

Спасибо, маэстро. Проблема во мне

[koMon]

Сообщение от Sege что дальше делать с полученным значением clr для его проверки (цвет равен красным)

(= 1 (vla-get-colorindex clr))

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

Sege, попробуй взять дамп clr.

[Red Nova]

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

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

Во-первых, ты получаешь указатель на вхождение блока или на его описание? Если на вхождение, то через OwnerId (или 330-ю группу) получить "владельца" можно. Если на описание - то никак: блок может быть вставлен куда угодно. Или вообще не вставлен.

[Red Nova]

Спасибо, получилось. Речь шла о вхождении блока.

[40in]

Есть файл с кучей динамических блоков. В свойствах все блоки имеют одно имя, но по ENTGET получаю разные значения имени блока (assoc 2 ) Вот собственно и вопрос: как добраться до истинного имени блока?

[name02]

Код:

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

 (setq ent (car (entsel "\n Select a Dynamic block :")))
(vla-get-Effectivename (vlax-ename->vla-object ent))

или более универсальный вариант от kpblC https://forums.augi.com/showthread.p...l=1#post610063

Или тут - на VLisp или чистом лиспе https://lee-mac.com/effectivename.html

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

Через ActiveX: vla-get-effectivename

[Сергей812]

Сообщение от 40in Вот собственно и вопрос: как добраться до истинного имени блока?

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

[40in]

Всем спасибо!!! Вы мне очень помогли!

[1958]

Код:

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

  (initget "Нет Замечания Принято Брак Чужое")
 (setq reply (getkword "Проверка: [Нет/Замечания/Принято/Брак/Чужое]: "))
 (setq answ (cond ((= reply "Нет") 0)
                  ((= reply "Замечания") 1)
                  ((= reply "Принято") 2)
                  ((= reply "Брак") 3)
                  ((= reply "Чужое") 4)
                  (t nil)
            )
 )

Дома и на работе установлен AC2024. По вышеприведенному коду отображение диалога на работе и дома отличается. Я так понимаю, что это зависит от какой-то системной переменной. Какой? Или в чем-то другом причина?

[SetQ]

Сообщение от 1958 Я так понимаю, что это зависит от какой-то системной переменной. Какой? Или в чем-то другом причина?

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

[1958]

Сообщение от SetQ скорее, какая-то неисправность в автокаде.

Ерунда эта появилась из-за авто переноса пользовательских настроек при установке AC2024. Я, в основном, работаю в AC2007. Пришлось возвращать настройки по умолчанию, а потом вручную настраивать автокад род себя и всё заработало нормально.

[Сет]

Как организовать выбор объекта по условию? Есть простая функция entsel, но она выбирает любой тип объекта. А мне бы хотелось, чтобы выбирался только объект, удовлетворяющий некоторым условиям. Ну например, это должно быть вхождение блока с именем "абв". То есть если пользователь на запрос программы "Выберите объект" кликает на любой другой объект - ничего не должно происходить. И только если пользователь кликнул на вхождение блока с именем "абв" - продолжилось бы выполнение лисп-программы.

[Сергей812]

цикл по факту выбора правильного объекта - вроде встроенной фильтрации типа выбираемого объекта в лиспе нет, в отличие от того же .Net

[Сет]

Сообщение от Сергей812 цикл по факту выбора правильного объекта - вроде встроенной фильтрации типа выбираемого объекта в лиспе нет, в отличие от того же .Net

В функции ssget фильтрация есть. Получается такой функционал работает только для наборов, а для одиночного объекта нужно что-то изобретать?

[Сергей812]

Сообщение от Сет нужно что-то изобретать?

в лиспе приходится постоянно что-то изобретать, как и в том же VBA - языки остановились в своем развитии *-цать лет назад.. Хотя для сравнения в том же .Net можно задать искомый тип примитива, но проверку на

Сообщение от Сет блока с именем "абв"

надо будет делать отдельно в коде. Т.е. только частично код сокращается по сравнению с лиспом в данном случае.

[megabeton]

Кликнул по объекту entsel'ом, посмотрел что это через entget, если удовлетворило условие, продолжил выполнение кода, если нет, выполнил новый entsel (через while)

----- добавлено через ~1 мин. -----
Встроенной фильтрации в entsel'е нет

[Сет]

Сообщение от megabeton Кликнул по объекту entsel'ом, посмотрел что это через entget, если удовлетворило условие, продолжил выполнение кода, если нет, выполнил новый entsel (через while)

Примерно так и собирался поступить, но подумал может есть какой-то фильтр выбора по типу ssget.

[megabeton]

(while
(= "АБВ" (cdr (assoc 2 (entget (setq obj (car (entsel)))))))
(что то делаем с obj)
...
)

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

Т.е. конструкция типа (ssget "_+.:S:L:E" '((0 . "INSERT")(2 . "АБВ")) не катит в принципе? )
Сейчас не у акада, проверить корректность синтаксиса не могу.

[Сергей812]

Сообщение от Сет но подумал может есть какой-то фильтр выбора по типу ssget.

делаете отдельный файл с функциями выбора примитивов и нужными фильтрациями. И эти функции возвращают значение или nil в случае отказа пользователя от выбора. Код будет гораздо читабельный основной.

Кстати, отказ пользователя от выбора в entsel вроде через генерацию ошибки идет - т.е. и это нужно тоже обработать.

----- добавлено через ~6 мин. -----
прикольно, только возвращает набор и не работает с динблоками, и отказ пользователя все равно обрабатывать надо

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

Сообщение от Сергей812 прикольно, только возвращает набор и не работает с динблоками, и отказ пользователя все равно обрабатывать надо

Ессно ) Вариантов решения чуть больше чем сопутствующих вопросов )))

[Сергей812]

слепил функцию на .Net: выбирает блок ABC (может быть и динамическим) - возвращает либо вставку блока, либо null при отказе пользователя от выбора

Код:

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

 
private BlockReference GetBlockWithName(string aName)
        {
            if (string.IsNullOrEmpty(aName)) throw new ArgumentException("Не задано имя блока!");
            Document lDoc = Application.DocumentManager.MdiActiveDocument;
            Database lDb = lDoc.Database;
            Editor lEd = lDoc.Editor;
            PromptEntityOptions lPEO = new PromptEntityOptions("\nВыберите блок:");
            lPEO.SetRejectMessage("\nНужно выбирать блок");
            lPEO.AddAllowedClass(typeof(BlockReference), false);
            BlockReference lOutput = null;
            do
            {
                PromptEntityResult lPER = lEd.GetEntity(lPEO);
                if (lPER.Status != PromptStatus.OK) break;
                using (Transaction lTr = lDb.TransactionManager.StartTransaction())
                {
                    BlockReference lBR = lTr.GetObject(lPER.ObjectId, OpenMode.ForRead) as BlockReference;
                    string lName = (lTr.GetObject(lBR.IsDynamicBlock ? 
                        lBR.DynamicBlockTableRecord : lBR.BlockTableRecord, OpenMode.ForRead) as BlockTableRecord).Name;
                    lOutput = lName.Equals(aName) ? lBR : null;
                    if (lOutput == null) lEd.WriteMessage("\nНадо выбирать блок с именем [ {0} ]!\n", aName);
                    lTr.Commit();
                }
            } while (lOutput == null);
            return lOutput;
        }

если кто сделает на лиспе аналог, выложите, плиз - сравнить по объему кода

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

Сообщение от Сергей812 слепил функцию на .Net: выбирает блок ABC (может быть и динамическим) - возвращает либо вставку блока, либо null при отказе пользователя от выбора Код: [Выделить все] private BlockReference GetBlockWithName(string aName) { if (string.IsNullOrEmpty(aName)) throw new ArgumentException("Не задано имя блока!"); Document lDoc = Application.DocumentManager.MdiActiveDocument; Database lDb = lDoc.Database; Editor lEd = lDoc.Editor; PromptEntityOptions lPEO = new PromptEntityOptions("\nВыберите блок:"); lPEO.SetRejectMessage("\nНужно выбирать блок"); lPEO.AddAllowedClass(typeof(BlockReference), false); BlockReference lOutput = null; do { PromptEntityResult lPER = lEd.GetEntity(lPEO); if (lPER.Status != PromptStatus.OK) break; using (Transaction lTr = lDb.TransactionManager.StartTransaction()) { BlockReference lBR = lTr.GetObject(lPER.ObjectId, OpenMode.ForRead) as BlockReference; string lName = (lTr.GetObject(lBR.IsDynamicBlock ? lBR.DynamicBlockTableRecord : lBR.BlockTableRecord, OpenMode.ForRead) as BlockTableRecord).Name; lOutput = lName.Equals(aName) ? lBR : null; if (lOutput == null) lEd.WriteMessage("\nНадо выбирать блок с именем [ {0} ]!\n", aName); lTr.Commit(); } } while (lOutput == null); return lOutput; } если кто сделает на лиспе аналог, выложите, плиз - сравнить по объему кода

Код:

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

 (vl-load-com)

(defun _select-block-with-name (name / ent ref_name)
  ;; name - имя блока. nil -> "*"
  ;; Возвращает vla-указатель на вхождение или nil
  (if (and (= (type (setq ent (vl-catch-all-apply
                                (function
                                  (lambda ()
                                    (car (entsel (strcat "\nSelect block with name \"" name "\" <Cancel> : ")))
                                  )
                                )
                              )
                    )
              )
              'ename
           )
           (= (cdr (assoc 0 (entget ent))) "INSERT")
           (setq name (cond ((name) (strcase name))
                            (t "*")
                      )
           )
           (setq ent (vlax-ename->vla-object ent))
           (setq ref_name (cond ((vlax-property-available-p ent 'effectivename)  (vla-get-effectivename ent))
                                ((vlax-property-available-p ent 'name) (vla-get-name))
                          )
           )
           (wcmatch (strcase ref_name) name)
      )
    ent
  )
)

----- добавлено через 44 сек. -----
Как один из оооочень многих вариантов

----- добавлено через ~1 мин. -----
P.S. Код не проверял, некогда

[Сергей812]

в принципе, сравнимы объемы кода - в лиспе скрытые транзакции, работа по умолчанию с активным документом - код покомпактнее немного.

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

У тебя выбор закольцован, у меня - нет

[Сергей812]

Сообщение от Кулик Алексей aka kpblc У тебя выбор закольцован, у меня - нет

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

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

Угу. Код писал на бегу так что сорян

[skkkk]

Сообщение от Сергей812 если кто сделает на лиспе аналог, выложите, плиз - сравнить по объему кода

У меня вот, что вышло

Код:

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

 (defun sel_block_by_name (blcname / blc)
(vl-load-com)
	(while 
		(or 
			(null blc)
			(/= (cdr (assoc 0 (entget blc))) "INSERT")
			(and
				(/= (cdr (assoc 2 (entget blc))) blcname)
				(/= (vla-get-EffectiveName (vlax-ename->vla-object blc)) blcname)
			)
		)
		(setq blc (car (entsel (strcat "\nУкажите блок с именем " blcname " <Отмена>"))))
		(if (= (getvar "ERRNO") 52)
			(progn 
				(setq blc T)
				(princ "\nОтменено")
				(princ)
			)
			(princ)
		)
	)
	blc
)

----- добавлено через 49 сек. -----
Вызывать так:

Код:

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

(SEL_BLOCK_BY_NAME "ABC")

[koMon]

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

[skkkk]

Сообщение от koMon переменная blc всегда будет иметь начальное значение nil при вызове функции

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

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

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

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

Ессно - ибо область видимости

[Сергей812]

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

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

[skkkk]

Сообщение от Кулик Алексей aka kpblc Ессно - ибо область видимости

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

[Сет]

Сделал программку, которая подключает расширенные данные к объекту. Вроде бы код рабочий и она в 95% случаев работает так, как и ожидалось, но иногда расширенные данные по какой-то причине к объекту не подключаются. Не смог понять закономерность ошибки, чтобы понять что ее вызывает. Программка, конечно, получилась не самая простая, да и я не специалист по лиспу, так что есть вероятность, что просто я где-то начудил в коде, но возникает мысля, что с самими расширенными данными что-то не то. Подскажите, есть ли какая-то особенность расширенных данных, что они не всегда присоединяются к объекту? Или если такое происходит, то дело 100% в моем коде? Код не выкладываю, он довольно громоздкий, сложновато наверное будет в нем сходу понять в чем дело.

[Сергей812]

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

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

Сообщение от skkkk Проверил сейчас - даже если глобально существует, то внутрь функции она не "попадает"

а как обратиться к глобальной переменной, если в функции объявлена локальная с тем же именем?

[===AAA===]

Сообщение от Сергей812 а как обратиться к глобальной переменной, если в функции объявлена локальная с тем же именем?

Обозначить её в качестве параметра функции?

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

Сообщение от Сет Сделал программку, которая подключает расширенные данные к объекту. Вроде бы код рабочий и она в 95% случаев работает так, как и ожидалось, но иногда расширенные данные по какой-то причине к объекту не подключаются. Не смог понять закономерность ошибки, чтобы понять что ее вызывает. Программка, конечно, получилась не самая простая, да и я не специалист по лиспу, так что есть вероятность, что просто я где-то начудил в коде, но возникает мысля, что с самими расширенными данными что-то не то. Подскажите, есть ли какая-то особенность расширенных данных, что они не всегда присоединяются к объекту? Или если такое происходит, то дело 100% в моем коде? Код не выкладываю, он довольно громоздкий, сложновато наверное будет в нем сходу понять в чем дело.

Ограничение на объем расширенных данных не превышено случайно?

[Сергей812]

Сообщение от ===AAA=== Обозначить её в качестве параметра функции?

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

Просто как написали выше

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

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

[Сет]

Сообщение от Кулик Алексей aka kpblc Ограничение на объем расширенных данных не превышено случайно?

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

Еще есть сомнение в том, что я регистрирую довольно много приложений для расширенных данных (regapp). Их всего порядка 30-ти разных. При этом часто происходит повторная регистрация одного и того же приложения, я перед этим не проверяю зарегистрировано ли оно уже до того. Как я понял в такой проверке нет особой нужды. Но может все таки это неправильно?

Все же выложу функцию, где происходит добавление расширенных данных. Она на самом деле работает в связке с другими функциями, но может кто-то при беглом просмотре найдет здесь явный косяк из-за чего иногда расширенные данные не присоединяются к объекту. Вообще программа предназначена для добавления строк спецификации. Строка спецификации - это блок с атрибутами, которые я програмно заполняю на основе чтения данных из внешнего файла. А кроме атрибутов добавляю и расширенные данные, где содержится различная техническая информация, которая нужна мне для взаимодействия с внешним exe-приложением, с помощью которого я, собственно, и формирую строку спецификации. Код где-то может выглядить несуразным, но как я и говорил - не являюсь спецом по лиспу, где-то что-то в интернете нарыл из нужных мне функций и применил в своей программе как умел.

Код:

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

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Настройка атрибутов блока и запись расширенных данных ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cs_make_specification_string (file v_block old_name_offset old_note_offset / attributes attribute name name_width is_product ind element_type le le2 edata)
(setq attributes (vlax-variant-value (vla-GetAttributes v_block)))
(setq is_product (cs_read_ini_value file "Data" "IsProduct"))
(setq element_type (cs_read_ini_value file "Data" "Type"))
(if (= is_product "0") (setq ind 0) (setq ind 1))
; заполнение атрибутов блока, общее для всех типов строки спецификации
(setq name (cs_read_ini_value file "SpecRow" "Name")) 
(setq name_width (atoi (cs_read_ini_value file "Data" "NameWidth")))
(setq attribute (vlax-safearray-get-element attributes (- 2 ind)))
(vla-Move attribute (vlax-3D-point '(0 0 0)) (vlax-3D-point (list 0 (- (atoi (cs_read_ini_value file "Data" "NameOffset")) old_name_offset) 0)))
(cs_compress_text name attribute name_width) 
(if (= is_product "0")
    (progn
	(setq attribute (vlax-safearray-get-element attributes 6))
	(vla-Move attribute (vlax-3D-point '(0 0 0)) (vlax-3D-point (list 0 (- (atoi (cs_read_ini_value file "Data" "NoteOffset")) old_note_offset) 0)))
;;;	(princ (strcat "\nсмещаю примечание на " (itoa (- (atoi (cs_read_ini_value file "Data" "NoteOffset")) old_note_offset))))
    ) ; progn
) ; if
(vla-put-TextString (vlax-safearray-get-element attributes 0) (cs_read_ini_value file "SpecRow" "Pos"))                  ; позиция
(if (= is_product "0") ; обычная строка спецификации
    (progn 
        (vla-put-TextString (vlax-safearray-get-element attributes 1) (cs_read_ini_value file "SpecRow" "Designation"))  ; обозначение
        (vla-put-TextString (vlax-safearray-get-element attributes 6) (cs_read_ini_value file "SpecRow" "Note"))         ; примечание
    ) ; progn
) ; if
(vla-put-TextString (vlax-safearray-get-element attributes (- 3 ind)) (cs_read_ini_value file "SpecRow" "MP"))           ; м.п.
(vla-put-TextString (vlax-safearray-get-element attributes (- 4 ind)) (cs_read_ini_value file "SpecRow" "Quantity"))     ; количество
(vla-put-TextString (vlax-safearray-get-element attributes (- 5 ind)) (cs_read_ini_value file "SpecRow" "Weight"))       ; масса    
(cond
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Прокат ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Prokat")
;;;	(princ "\nзаполняю расширенные данные") 
	(regapp "cs_IsProduct") 
        (regapp "cs_Type")
	(regapp "cs_DesignationText")
	(regapp "cs_TypeText")
	(regapp "cs_MarkaText")
	(regapp "cs_SteelMarkaText")
	(regapp "cs_Length")
	(regapp "cs_NameGOST")
	(regapp "cs_Marka")
	(regapp "cs_SteelGOST")
	(regapp "cs_SteelMarka")
	(regapp "cs_SteelCategory")
	(regapp "cs_DesignationMark")
	(regapp "cs_QuantityMark")
	(regapp "cs_WeightMark")
	(regapp "cs_MPMark")
	(regapp "cs_NameOffset") 
	(regapp "cs_NoteOffset") 
	(setq le (entget (vlax-vla-object->ename v_block)))
	(setq edata (list (list -3
		(list "cs_IsProduct" (cons 1000 (cs_read_ini_value file "Data" "IsProduct")))		
		(list "cs_Type" (cons 1000 (cs_read_ini_value file "Data" "Type")))
		(list "cs_DesignationText" (cons 1000 (cs_read_ini_value file "Data" "DesignationText")))
		(list "cs_TypeText" (cons 1000 (cs_read_ini_value file "Data" "TypeText")))
		(list "cs_MarkaText" (cons 1000 (cs_read_ini_value file "Data" "MarkaText")))
		(list "cs_SteelMarkaText" (cons 1000 (cs_read_ini_value file "Data" "SteelMarkaText")))	
		(list "cs_Length" (cons 1000 (cs_read_ini_value file "Data" "Length")))	
		(list "cs_NameGOST" (cons 1000 (cs_read_ini_value file "Data" "NameGOST")))
		(list "cs_Marka" (cons 1000 (cs_read_ini_value file "Data" "Marka")))
		(list "cs_SteelGOST" (cons 1000 (cs_read_ini_value file "Data" "SteelGOST")))
		(list "cs_SteelMarka" (cons 1000 (cs_read_ini_value file "Data" "SteelMarka")))	
		(list "cs_SteelCategory" (cons 1000 (cs_read_ini_value file "Data" "SteelCategory")))
		(list "cs_DesignationMark" (cons 1000 (cs_read_ini_value file "Data" "DesignationMark")))
		(list "cs_QuantityMark" (cons 1000 (cs_read_ini_value file "Data" "QuantityMark")))
		(list "cs_WeightMark" (cons 1000 (cs_read_ini_value file "Data" "WeightMark")))	
		(list "cs_MPMark" (cons 1000 (cs_read_ini_value file "Data" "MPMark")))	
		(list "cs_NameOffset" (cons 1000 (cs_read_ini_value file "Data" "NameOffset")))	
		(list "cs_NoteOffset" (cons 1000 (cs_read_ini_value file "Data" "NoteOffset")))									
	))) ; setq
	(setq le2 (append le edata))
	(entmod le2)
	) ; прокат
	
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Лист ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "List")
	(regapp "cs_IsProduct") 
        (regapp "cs_Type")
	(regapp "cs_DesignationText")
	(regapp "cs_TypeText")
	(regapp "cs_MarkaText")
	(regapp "cs_SteelMarkaText")
	(regapp "cs_SteelGOST")
	(regapp "cs_SteelMarka")
	(regapp "cs_SteelCategory")
	(regapp "cs_Thickness")
	(regapp "cs_Width")
	(regapp "cs_Length")
	(regapp "cs_DesignationMark")
	(regapp "cs_NameOffset") 
	(regapp "cs_NoteOffset") 
	(setq le (entget (vlax-vla-object->ename v_block)))
	(setq edata (list (list -3
		(list "cs_IsProduct" (cons 1000 (cs_read_ini_value file "Data" "IsProduct")))		
		(list "cs_Type" (cons 1000 (cs_read_ini_value file "Data" "Type")))
		(list "cs_DesignationText" (cons 1000 (cs_read_ini_value file "Data" "DesignationText")))
		(list "cs_TypeText" (cons 1000 (cs_read_ini_value file "Data" "TypeText")))
		(list "cs_MarkaText" (cons 1000 (cs_read_ini_value file "Data" "MarkaText")))
		(list "cs_SteelMarkaText" (cons 1000 (cs_read_ini_value file "Data" "SteelMarkaText")))	
		(list "cs_SteelGOST" (cons 1000 (cs_read_ini_value file "Data" "SteelGOST")))
		(list "cs_SteelMarka" (cons 1000 (cs_read_ini_value file "Data" "SteelMarka")))	
		(list "cs_SteelCategory" (cons 1000 (cs_read_ini_value file "Data" "SteelCategory")))
		(list "cs_Thickness" (cons 1000 (cs_read_ini_value file "Data" "Thickness")))	
		(list "cs_Width" (cons 1000 (cs_read_ini_value file "Data" "Width")))	
		(list "cs_Length" (cons 1000 (cs_read_ini_value file "Data" "Length")))	
		(list "cs_DesignationMark" (cons 1000 (cs_read_ini_value file "Data" "DesignationMark")))
		(list "cs_NameOffset" (cons 1000 (cs_read_ini_value file "Data" "NameOffset")))	
		(list "cs_NoteOffset" (cons 1000 (cs_read_ini_value file "Data" "NoteOffset")))									
	))) ; setq
	(setq le2 (append le edata))
	(entmod le2)
	) ; лист

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Дерево ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Wood")	
	(regapp "cs_IsProduct") 
        (regapp "cs_Type")
	(regapp "cs_DesignationText")
	(regapp "cs_TypeText")
	(regapp "cs_MarkaText")
	(regapp "cs_Length")
	(regapp "cs_WoodSort")
	(regapp "cs_WoodPoroda")
	(regapp "cs_Thickness")
	(regapp "cs_Width")
	(regapp "cs_DesignationMark")
	(regapp "cs_ByGOSTMark")
	(regapp "cs_MPMark")
	(regapp "cs_NameOffset")  
	(regapp "cs_NoteOffset") 
	(setq le (entget (vlax-vla-object->ename v_block)))
	(setq edata (list (list -3
		(list "cs_IsProduct" (cons 1000 (cs_read_ini_value file "Data" "IsProduct")))		
		(list "cs_Type" (cons 1000 (cs_read_ini_value file "Data" "Type")))
		(list "cs_DesignationText" (cons 1000 (cs_read_ini_value file "Data" "DesignationText")))
		(list "cs_TypeText" (cons 1000 (cs_read_ini_value file "Data" "TypeText")))
		(list "cs_MarkaText" (cons 1000 (cs_read_ini_value file "Data" "MarkaText")))
		(list "cs_Length" (cons 1000 (cs_read_ini_value file "Data" "Length")))	
		(list "cs_WoodSort" (cons 1000 (cs_read_ini_value file "Data" "WoodSort")))
		(list "cs_WoodPoroda" (cons 1000 (cs_read_ini_value file "Data" "WoodPoroda")))	
		(list "cs_Thickness" (cons 1000 (cs_read_ini_value file "Data" "Thickness")))	
		(list "cs_Width" (cons 1000 (cs_read_ini_value file "Data" "Width")))	
		(list "cs_DesignationMark" (cons 1000 (cs_read_ini_value file "Data" "DesignationMark")))
		(list "cs_ByGOSTMark" (cons 1000 (cs_read_ini_value file "Data" "ByGOSTMark")))
		(list "cs_MPMark" (cons 1000 (cs_read_ini_value file "Data" "MPMark")))	
		(list "cs_NameOffset" (cons 1000 (cs_read_ini_value file "Data" "NameOffset")))	
		(list "cs_NoteOffset" (cons 1000 (cs_read_ini_value file "Data" "NoteOffset")))									
	))) ; setq
	(setq le2 (append le edata))
	(entmod le2)
	) ; дерево
	
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Арматура ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "Arm")	
	(regapp "cs_IsProduct") 
        (regapp "cs_Type")
	(regapp "cs_DesignationText")
	(regapp "cs_Length")
	(regapp "cs_SteelMarka")
	(regapp "cs_Diameter")
	(regapp "cs_DesignationMark")
	(regapp "cs_ByGOSTMark")
	(regapp "cs_MPMark")
	(regapp "cs_NameOffset")  
	(regapp "cs_NoteOffset") 
	(setq le (entget (vlax-vla-object->ename v_block)))
	(setq edata (list (list -3
		(list "cs_IsProduct" (cons 1000 (cs_read_ini_value file "Data" "IsProduct")))		
		(list "cs_Type" (cons 1000 (cs_read_ini_value file "Data" "Type")))
		(list "cs_DesignationText" (cons 1000 (cs_read_ini_value file "Data" "DesignationText")))
		(list "cs_Length" (cons 1000 (cs_read_ini_value file "Data" "Length")))	
		(list "cs_SteelMarka" (cons 1000 (cs_read_ini_value file "Data" "SteelMarka")))
		(list "cs_Diameter" (cons 1000 (cs_read_ini_value file "Data" "Diameter")))
		(list "cs_DesignationMark" (cons 1000 (cs_read_ini_value file "Data" "DesignationMark")))
		(list "cs_ByGOSTMark" (cons 1000 (cs_read_ini_value file "Data" "ByGOSTMark")))
		(list "cs_MPMark" (cons 1000 (cs_read_ini_value file "Data" "MPMark")))	
		(list "cs_NameOffset" (cons 1000 (cs_read_ini_value file "Data" "NameOffset")))		
		(list "cs_NoteOffset" (cons 1000 (cs_read_ini_value file "Data" "NoteOffset")))									
	))) ; setq
	(setq le2 (append le edata))
	(entmod le2)
	) ; арматура
	
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Простой Текст ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "SimpleText")	
	(regapp "cs_IsProduct") 
        (regapp "cs_Type")
	(regapp "cs_NameOffset")  
	(regapp "cs_NoteOffset") 
	(setq le (entget (vlax-vla-object->ename v_block)))
	(setq edata (list (list -3
		(list "cs_IsProduct" (cons 1000 (cs_read_ini_value file "Data" "IsProduct")))		
		(list "cs_Type" (cons 1000 (cs_read_ini_value file "Data" "Type")))
		(list "cs_NameOffset" (cons 1000 (cs_read_ini_value file "Data" "NameOffset")))		
		(list "cs_NoteOffset" (cons 1000 (cs_read_ini_value file "Data" "NoteOffset")))									
	))) ; setq
	(setq le2 (append le edata))
	(entmod le2)
	) ; простой текст
	
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; строка спецификации Дробный Текст ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	((= element_type "FractionText")
	(princ "\nзаполняю расширенные данные") 	
	(regapp "cs_IsProduct") 
        (regapp "cs_Type")
        (regapp "cs_BeforeText")
        (regapp "cs_UpText")
        (regapp "cs_DownText")
        (regapp "cs_AfterText")
	(regapp "cs_NameOffset")  
	(regapp "cs_NoteOffset") 
	(setq le (entget (vlax-vla-object->ename v_block)))
	(setq edata (list (list -3
		(list "cs_IsProduct" (cons 1000 (cs_read_ini_value file "Data" "IsProduct")))		
		(list "cs_Type" (cons 1000 (cs_read_ini_value file "Data" "Type")))		
		(list "cs_BeforeText" (cons 1000 (cs_read_ini_value file "Data" "BeforeText")))		
		(list "cs_UpText" (cons 1000 (cs_read_ini_value file "Data" "UpText")))		
		(list "cs_DownText" (cons 1000 (cs_read_ini_value file "Data" "DownText")))		
		(list "cs_AfterText" (cons 1000 (cs_read_ini_value file "Data" "AfterText")))
		(list "cs_NameOffset" (cons 1000 (cs_read_ini_value file "Data" "NameOffset")))		
		(list "cs_NoteOffset" (cons 1000 (cs_read_ini_value file "Data" "NoteOffset")))									
	))) ; setq
	(setq le2 (append le edata))
	(entmod le2)
	) ; дробный текст
	
) ; cond
(princ)  
) ; defun

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

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

Я бы делал. А ограничение 16 кб это ж на все приложения, которые ты пытаешься на примитив засунуть. ЕМНИП, там еще и имена приложений участвуют в этом объеме.

[Сет]

Сообщение от Кулик Алексей aka kpblc Я бы делал.

А для чего? Повторная регистрация ведь не дублирует приложение, там вроде просто возвращается nil и все.

Сообщение от Кулик Алексей aka kpblc А ограничение 16 кб это ж на все приложения, которые ты пытаешься на примитив засунуть.

У меня не больше 1 кб объем расширенных данных на объект получается.

[Сергей812]

Сообщение от Сет регистрирую довольно много приложений для расширенных данных (regapp). Их всего порядка 30-ти разных.

ограничений особых нет на количество зарегистрированных приложений

Миллион приложений команда зарегистрировала без ошибок. Правда, при попытке посмотреть данные по базе, AutoCAD завис намертво. При 10000 приложений удалось посмотреть данные в базе: Вывод: ограничений на количество зарегистрированных приложений нет. Но большое их количество сильно затормаживает работу с чертежом.

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

[Сет]

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

[koMon]

Сообщение от Сет Как организовать выбор объекта по условию?

ну и до кучи

Код:

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

 
(defun inselect (insert_name / insert_ename it_is)
	(while (not it_is) 
			   	(and (setq insert_ename (vl-catch-all-apply 'entsel (list (strcat "\nВыберите блок с именем \"" insert_name "\": "))))
					 (null (setq it_is (vl-catch-all-error-p insert_ename)))
					 (setq insert_ename (car insert_ename))
			   		 (= "INSERT" (cdr (assoc 0 (entget insert_ename))))
					 (setq it_is (= (strcase insert_name) (strcase (vla-get-effectivename (vlax-ename->vla-object insert_ename)))))
			   	)
	)
	(if (vl-catch-all-error-p insert_ename) nil insert_ename) 
)

[Сергей812]

Offtop:

Сообщение от koMon ну и до кучи

добавьте, пожалуйста, что это относится к предыдущей подтеме выбора блока по имени - а то как-то неожиданно код появляется среди расширенных данных)

[koMon]

Сообщение от Сергей812 Offtop: добавьте, пожалуйста, что это относится к предыдущей подтеме выбора блока по имени - а то как-то неожиданно код появляется среди расширенных данных)

я же процитировал не расширенные данные.

[Сет]

Сообщение от skkkk У меня вот, что вышло Код: [Выделить все] (defun sel_block_by_name (blcname / blc) (vl-load-com) (while (or (null blc) (/= (cdr (assoc 0 (entget blc))) "INSERT") (and (/= (cdr (assoc 2 (entget blc))) blcname) (/= (vla-get-EffectiveName (vlax-ename->vla-object blc)) blcname) ) ) (setq blc (car (entsel (strcat "\nУкажите блок с именем " blcname " <Отмена>")))) (if (= (getvar "ERRNO") 52) (progn (setq blc T) (princ "\nОтменено") (princ) ) (princ) ) ) blc ) ----- добавлено через 49 сек. ----- Вызывать так: Код: [Выделить все] (SEL_BLOCK_BY_NAME "ABC")

Попробовал применить вашу функцию, немного ее модернизировав. Переменную blcname перевел в локальные и первым делом присваиваю ей имя блока "СпецСтр3". Функция завершается с ошибкой:

Команда: SEL_BLOCK_BY_NAME Укажите блок с именем СпецСтр3 <Отмена> Отменено; ошибка: неверный тип аргумента: lentityp T

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

Так надо модифицированный код предоставлять ИМХО

[Сет]

Сообщение от Кулик Алексей aka kpblc Так надо модифицированный код предоставлять ИМХО

Посчитал что ничего существенного не поменял.

Код:

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

 (defun c:sel_block_by_name (/ blcname blc)
    (setq blcname "ÑïåöÑòð3")
	(while 
		(or 
			(null blc)
			(/= (cdr (assoc 0 (entget blc))) "INSERT")
			(and
				(/= (cdr (assoc 2 (entget blc))) blcname)
				(/= (vla-get-EffectiveName (vlax-ename->vla-object blc)) blcname)
			)
		)
		(setq blc (car (entsel (strcat "\nÓêàæèòå áëîê ñ èìåíåì " blcname " <Îòìåíà>"))))
		(if (= (getvar "ERRNO") 52)
			(progn 
				(setq blc T)
				(princ "\nÎòìåíåíî")
				(princ)
			)
			(princ)
		)
	)
	blc
)  

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

[Сергей812]

Сообщение от Сет Кракозябры на самом деле у меня в редакторе в виде нормальных букв. Это сюда почему-то так копируются.

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

----- добавлено через ~24 мин. -----
а так пользуйтесь отладкой - пытаетесь в условии цикла запросить у логического значения T (в переменной blc) информацию через entget - тут даже лисп удивился)

----- добавлено через ~50 мин. -----
а происходит это по причине, написанной в справке

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

[Сет]

Вот так модифицировал, вроде работает. Я здесь перед циклом определяю переменную blc и удалил еще в условии цикла проверку blc на nil, а также присваивание blc=true, если ERRNO=52.

Код:

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

 (defun c:sel_block_by_name (/ blcname blc)
    (setq blcname "СпецСтр3")
    (setq blc (car (entsel (strcat "\nУкажите блок с именем " blcname " <Отмена>"))))
	(while 
		(or 
			(/= (cdr (assoc 0 (entget blc))) "INSERT")
			(and
				(/= (cdr (assoc 2 (entget blc))) blcname)
				(/= (vla-get-EffectiveName (vlax-ename->vla-object blc)) blcname)
			)
		)
		(setq blc (car (entsel (strcat "\nУкажите блок с именем " blcname " <Отмена>"))))
		(if (= (getvar "ERRNO") 52)
			(progn 
				(princ "\nОтменено")
				(princ)
			)
			(princ)
		)
	)
	blc
)

Кстати, не совсем понимаю зачем нужна эта проверка ERRNO? И еще не понимаю, для чего в запросе на выбор объекта писать <Отмена>?

[Сергей812]

Сообщение от Сет И еще не понимаю, для чего в запросе на выбор объекта писать <Отмена>?

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

Код:

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

 (if (= (getvar "ERRNO") 52)

отлавливает эту реакцию пользователя и выводит сообщение об этом. А если при выборе пользователь промахнется мимо объекта, например - то ERRNO вернет значение 7

----- добавлено через ~2 мин. -----
правда это не поможет, если пользователь нажмет Esc - для этого надо использовать функции лиспа vl-catch-all-*, как выше и показывали в примерах.

[Сет]

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

В данном случае по нажатию ввода - ошибка. Но в любом случае <Отмена> - это же просто строка, а не какое-то ключевое слово, переменная или функция. Она же в сущности не работает. Или это просто такой стиль оформления запроса?

[Сергей812]

Сообщение от Сет В данном случае по нажатию ввода - ошибка.

так трассировкой пройдите по коду и увидите - почему

Сообщение от Сет Или это просто такой стиль оформления запроса?

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

[Сет]

Сообщение от Сергей812 так трассировкой пройдите по коду и увидите - почему

Я плоховато освоился и в лиспе, и в редакторе, толком не знаю как эту трассировку делать. Лисп время от времени нужен для кое-каких мелких программ для себя.

[Сергей812]

Сообщение от Сет толком не знаю как эту трассировку делать

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

[Сет]

А можно ли в этой строчке делать сравнение имени блока по маске?

Код:

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

 (/= (cdr (assoc 2 (entget blc))) blcname)

Например если blcname="спецстр*" - чтобы функция возвращала nil для всех блоков, имя которых начинается на "спецстр".

[Сергей812]

имя блока - это всего лишь строка, поэтому ее можно сравнивать любыми доступными методами. С масками вроде функция wcmatch работает, или как-то похожая по названию

[1958]

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

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

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

[1958]

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

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

[1958]

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

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

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

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

[1958]

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

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

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

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

[Ingpro]

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

Код:

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

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

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

Код:

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

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

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

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

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

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

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

Код:

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

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

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

    (setq *error* olderr)
    (princ)
  )

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

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

[skkkk]

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

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

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

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

[Ingpro]

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

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

Код:

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

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

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

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

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

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

[Ingpro]

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

Тогда так?:

Код:

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

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

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

    (setq *error* olderr)
    (princ)
  )

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

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

[skkkk]

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

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

[Ingpro]

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

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

Код:

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

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

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

Код:

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

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

[===AAA===]

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

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

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

Код:

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

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

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

[Ingpro]

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

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

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

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

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

[Ingpro]

А можно изменить код, чтобы поменять регистр на нижний? Или добавить возможность выбора регистра...
Команда tcase (Uppercase и Lowercase) в кодах не используется? А что вместо неё?

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

А поискать справку по strcase - нихьть?
https://www.progesoft.com/products/p...ctions/strcase
https://www.lee-mac.com/textcasefunctions.html
И тому подобное

[Ingpro]

Сообщение от Кулик Алексей aka kpblc А поискать справку по strcase - нихьть?

хьть, спасибо!

[skkkk]

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

Ну в описании локальной функции *error* надо просто прописать строчку с возвращением запомненной в начале кода системной переменной. Эта функция запустится в случае ошибки и сделает всё, что в ней прописано.

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

Да, именно так.

Сообщение от Кулик Алексей aka kpblc Уже проще через vl-catch-* работать, если припрет.

Удобное это семейство, но ведь тоже на каждое "узкое место" их ненапасёшься.
Расскажи, пожалуйста, Алексей, как часто и в принципе - в каких местах рекомендуешь вставлять vl-catch-*? Интерактивный ввод? Вычисления, в которых изначально возможны ошибки? Так ведь можно прийти к тому, что чуть ли не каждую строку станет надо обернуть в это вээлкэтч)

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

Ну, лично у меня нет однозначных рекомендаций. В текущих реалиях обычно ставлю когда у пользователя что-то запрашиваю (эта ж зараза в любой момент может Esc нажать), ну и основную команду тоже оборачиваю. Так-то у vl-catch-* есть ограничение - не больше, кажется, 9 уровней вложенности. Так что приходится изгаляться
P.S. Если с этими обертками переборщить, то скорость работы кода может кратно упасть.

[skkkk]

Сообщение от Кулик Алексей aka kpblc Ну, лично у меня нет однозначных рекомендаций.

Ну как это - "нет"?

Сообщение от Кулик Алексей aka kpblc В текущих реалиях обычно ставлю когда у пользователя что-то запрашиваю

Я ж и говорю: "Интерактивный ввод", подразумевая, что это зараза)
А вот почему-то до сих пор не догадался основную функцию в неё обернуть вместо *error*)
Надо будет попробовать это сделать

[Сет]

Подскажите, как программно настроить межстрочный интервал мультитекста в мультивыноске? В моем примере он установлен автоматически и равен 416,67 и выноска отображается криво (слева). Если его поменять хотя бы на 417 - выноска становится нормальная (справа)



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

Сообщение от Сет Подскажите, как программно настроить межстрочный интервал мультитекста в мультивыноске? В моем примере он установлен автоматически и равен 416,67 и выноска отображается криво (слева). Если его поменять хотя бы на 417 - выноска становится нормальная (справа)

Сам уже нашел - vla-put-TextLineSpacingDistance. Однако это не помогло привести выноску в нормальный вид, она все равно выглядит как вариант слева. Причем таким образом выноска выглядит только если я в качестве содержимого устанавливаю ссылку на поле. С обычным текстом выноска отображается нормально. Эта выноска создана с помощью лиспа. Из-за чего выноска получается кривой, если ее содержимое - это ссылка на поле?

----- добавлено через ~17 мин. -----
Любое изменение межстрочного интервала в свойствах уже созданной выноски - приводит ее к нормальному виду. А вот программно почему-то отображается не так как надо. Если же выноска без ссылки на поле - программно отображается нормально.

[Сет]

Еще немного поковырялся. Выноска приходит в норму при изменении почти любых параметров мультитекста через панель свойств. А проблема кажется в том, что когда выноска формируется программно - я с помощью функции vla-GetBoundingBox определяю длину мультитекста для своих нужд. Но судя по всему в этот момент программа думает, что верхний текст - это "####" - поле до регенерации. И исходя из этого формирует мультивыноску. Но реальный текст "2" - поэтому выноска выглядит криво. Как с этой проблемой справиться? vla-regen перед vla-GetBoundingBox не помогает, это всего лишь позволяет при вставке выноски получить значение поля. Без vla-regen значение будет "####".

[Сет]

Удалось сделать выноску нормального вида применив в конце лиспа функцию vla-put-TextJustify. Не проверял, но наверное многие функции изменения параметров мультитекста дали бы такой же результат, хотя вот изменение интервала между линиями (vla-put-TextLineSpacingDistance) не сработало.

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

А vla-update не сработает?
----
Offtop: Оставлю себе на память - сообщение №40 000...

[Сет]

Сообщение от Кулик Алексей aka kpblc А vla-update не сработает?

Нет.

[Сет]

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

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

Можно ли повесить на мультивыноску с полем реактор, который будет отслеживать изменение содержимого поля? Я попробовал vlr-object-reactor с отслеживанием события :vlr-objectModified - оно не срабатывает при изменении содержимого поля после регенерации.

[===AAA===]

Попробуй после изменения стереть и обратно восстановить выноску.

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

А если попробовать выполнить обновление поля? Принудительно, программно (ну, на крайний случай - командой)?

[Сет]

Сообщение от ===AAA=== Попробуй после изменения стереть и обратно восстановить выноску.

Восстановить как? Undo? Это не срабатывает.

Вообще нужен способ, который позволяет автоматически, условно скажем "обновить" выноску с полем, после того как выполнена регенерация. Как я вижу тут бы помог реактор, который бы выявил изменение содержимого выноски и в обработчике реактора я бы, например, включил Скрытие заднего плана и тут же выключил. Такие действия через панель свойств приводят выноску в норму. Вопрос в том, какой именно реактор здесь надо использовать? Кажется удобнее всего объектный реактор, но у меня не получилось через :vlr-objectModified. Этот реактор срабатывает, если двигать вершины выноски или вручную менять ее содержимое, но при обновлении поля через регенерацию - не срабатывает.

Сообщение от Кулик Алексей aka kpblc А если попробовать выполнить обновление поля? Принудительно, программно (ну, на крайний случай - командой)?

Пробовал _updatefield - не помогает.

[===AAA===]

Восстановить как? Undo? Это не срабатывает.

Нет - (entdel ...) 2 раза.

Что-то давно у меня подобное было с "кривым отображением".
Только таким способом и выкручивался. Может быть - и здесь
поможет.

[skkkk]

Сет, может, в этой теме найдётся решение?

[Сет]

Прикрутил вот такой костыль к мультивыноскам. Создал командный реактор (cs_regen_reactor) и обработчик события :vlr-commandEnded (cs_regen). После выполнения регенерации выбираю все мультивыноски чертежа и центрирую содержимое мультитекста. Этот подход, конечно, некрасивый, но он работает - выноски с полями после регенерации выглядят нормально.

Код:

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

 (defun c:cs_create_reactor ( / )
    (setq cs_regen_reactor (vlr-command-reactor " " (list '(:vlr-commandEnded . cs_regen))))
) ; defun

(defun cs_regen (reac cname / ss n i item m)
    (if (member (car cname) (list "РЕГЕН" "REGEN" "_regen" "ВСЕРЕГЕН" "REGENALL" "_regenall"))
	(progn
	    (setq ss (ssget "_X" '((0 . "MULTILEADER"))))
	    (setq n (sslength ss))
	    (setq i 0)
	    (while (< i n)
		(setq item (ssname ss i))		
		(setq m (vlax-ename->vla-object item))
		(if (= (vla-get-ContentType m) acMTextContent) (vla-put-TextJustify m acAttachmentPointMiddleCenter))
		(setq i (1+ i))
	    ) ; while
	    (setq ss nil)	     
	) ; progn
    ) ; if
    (princ (strcat "\nКоманда " (car cname) ". Обработано " (itoa n) " мультивыносок."))
    (princ)	
) ; defun

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

Команда: _line Первая точка: Следующая точка или [оТменить]: Следующая точка или [оТменить]: ; ошибка: неверный тип аргумента: fixnump: nil

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

1. Тебе никто не помешает несколько раз зарегистрировать реактор - в текущих реалиях.
2. Кто мешает все же проверять - что болтается в наборе?
3. Не отслеживаешь заблокированные и замороженные слои.
4. ... Обрабатывать реактором вообще все - ИМХО ну так себе затея. Я бы подумал, что и как сделать, чтоб мультивыноска изначально строилась "нормально".
Опять же дамп, проверки, изменения и теде. И, может быть, все сработает на реакторе окончания команды вставки мультивыноски.
ЗЫ В реактор имя команды, насколько я помню, всегда приходит на английском языке. Могу ошибаться.

[Сет]

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

Я пока тестирую, в будущем планировал делать проверку на существование реактора.

Сообщение от Кулик Алексей aka kpblc Кто мешает все же проверять - что болтается в наборе?

Да. Подправил код, добавил некоторые проверки, наверное еще не все.

Код:

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

 (defun cs_regen (reac cname / ss n i item m)
    (if (and
	    (member (car cname) (list "РЕГЕН" "REGEN" "_regen" "ВСЕРЕГЕН" "REGENALL" "_regenall"))
	    (setq ss (ssget "_X" '((0 . "MULTILEADER"))))
	) ; and
	(progn
	    (setq n (sslength ss))
	    (setq i 0)
	     (while (< i n)
		(setq item (ssname ss i))		
		(setq m (vlax-ename->vla-object item))
		(if (= (vla-get-ContentType m) acMTextContent) (vla-put-TextJustify m acAttachmentPointMiddleCenter))
		(setq i (1+ i))
	    ) ; while
	    (setq ss nil)
	    (princ (strcat "\nКоманда " (car cname) ". Обработано " (itoa n) " мультивыносок."))
	) ; progn
    ) ; if
    (princ)	
) ; defun

Сообщение от Кулик Алексей aka kpblc Не отслеживаешь заблокированные и замороженные слои.

Пока да, надо подумать об этом тоже.

Сообщение от Кулик Алексей aka kpblc Обрабатывать реактором вообще все - ИМХО ну так себе затея. Я бы подумал, что и как сделать, чтоб мультивыноска изначально строилась "нормально".

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

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

Да, на английском. По крайней мере в моем случае. REGEN и REGENALL.

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

Я бы заменил

Код:

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

 (member (car cname) (list "РЕГЕН" "REGEN" "_regen" "ВСЕРЕГЕН" "REGENALL" "_regenall"))

на нечто типа

Код:

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

 (wcmatch (strcase (vl-string-trim "_" cname)) "REGEN*")

Написал насухую, мог ошибиться с vl-string-trim.

Сообщение от Сет Пока да, надо подумать об этом тоже.

Да че там думать - либо ssget "_.+:LX" (или как-то так), либо разблокировать слои и после обработки - восстанавливать все обратно.

[Сет]

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

[skkkk]

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

[Сет]

Сообщение от skkkk а что мешает сделать свой реген?

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

Но это тоже костыль, только чуть изящнее

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

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

Странно, у меня пока что получается нечто типа:

Код:

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

 (vl-load-com)

(defun _kpblc-ent-create-mleader (start-point end-point annostring / adoc anno leader)

  (setq adoc   (vla-get-activedocument (vlax-get-acad-object))
        leader (vla-addmleader
                 (vla-get-modelspace adoc)
                 (vlax-make-variant
                   (vlax-safearray-fill
                     (vlax-make-safearray
                       vlax-vbdouble
                       '(0 . 5)
                     )
                     (append start-point end-point)
                   )
                 )
                 0
               )
  )
  (vla-put-textstring leader annostring)
  leader
)

Начальная точка (откуда строить), конечная точка (где располагается полка), текст выноски. ВОзвращает указатель на MLeader. А потом ты уже с ним делаешь что угодно

[skkkk]

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

У меня и наоборот работает
Offtop:

Сообщение от Сет Но это тоже костыль, только чуть изящнее

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

[Сет]

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

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

Сообщение от skkkk У меня и наоборот работает

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

[skkkk]

Сообщение от Сет Это странно. Ведь текст в мультивыноске с полем сползает с полки как раз после регенерации.

Вообще, логично. У меня, помнится, не из-за полей съезжали выноски. А так, думаю, практичнее будет вместо регена применять к мультивыноскам команду _UPDATEFIELD, особенно на громоздких чертежах.

[Сет]

del

[Сет]

Сообщение от Кулик Алексей aka kpblc Да че там думать - либо ssget "_.+:LX" (или как-то так), либо разблокировать слои и после обработки - восстанавливать все обратно.

Комбинирование режимов выбора ssget не документировано. Скомбинировать режимы "_X" и "_:L" не получилось. Поэтому сделал так:

Код:

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

 
(setq ss (ssget "_X" '((0 . "MULTILEADER"))))
(sssetfirst nil ss)
(setq ss (ssget "_:L"))

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

Насчет недокументированности : https://www.lee-mac.com/ssget.html
А зачем ты вообще формируешь набор? Может, проще будет программно пройтись по пространствам модели / листов и набрать в один список все указатели на мультивыноски (заодно контролируя состояние слоя, тип аннотации и теде)?

[Сет]

Сообщение от Кулик Алексей aka kpblc Насчет недокументированности : https://www.lee-mac.com/ssget.html

У Полещука написано, что комбинации режимов недокументированы. Скомбинировать X и :L в работающую конструкцию у меня не получилось. В частности "_+.X:L" - не работает.

Сообщение от Кулик Алексей aka kpblc А зачем ты вообще формируешь набор? Может, проще будет программно пройтись по пространствам модели / листов и набрать в один список все указатели на мультивыноски (заодно контролируя состояние слоя, тип аннотации и теде)?

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

[Сет]

Можно ли использовать grread с объектной привязкой и ее отслеживанием?

Поиск в интернете дает довольно много разных решений на тему ПСЕВДО объектной привязки с функцией grread, но почему-то ни один из примеров у меня не работает как ожидается, то есть никакой объектной привязки нет. Например вот этот пример. Тут даже на демонстрационной гифке показана объектная привязка, но у меня почему-то эта функция так не работает. У меня Автокад 2022. В этой версии может уже пропали возможности, реализованные в этом примере? Обратил внимание, что все способы, которые попадались в поиске - довольно давние, около 15 лет им. В версии 2022 это уже не работает?

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

Сам по себе grread привязку не поддерживает. Решение, насколько я помню, было от Елпанова на theswamp.org, но оно настолько замороченное...
А тебе вообще зачем? Может, getpoint будет достаточно?

[Сет]

Сообщение от Кулик Алексей aka kpblc Решение, насколько я помню, было от Елпанова на theswamp.org, но оно настолько замороченное...

Попадались и его примеры - не работают.

Сообщение от Кулик Алексей aka kpblc А тебе вообще зачем? Может, getpoint будет достаточно?

Хочу программно отрисовывать будущий вид создаваемых элементов, как это реализовано в оригинальных функциях автокад. Например ту же самую мультивыноску. Стандартная мультивыноска меня не устраивает. Рисую ее через vla-AddMLeader, далее меняю разные свойства. Нужно чтобы она была визуализирована, пока я перемещаю курсор по экрану.

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

Я бы уже задумывался о применении NET и его транзитной (вроде так называется) графики. JIG, в общем.

[Сергей812]

причем это будет штатный API акада, а не ежик из костылей)

----- добавлено через ~5 мин. -----
вот один из примеров для ознакомления от Kean Walmsley.

[Сет]

Сообщение от Кулик Алексей aka kpblc Я бы уже задумывался о применении NET и его транзитной (вроде так называется) графики. JIG, в общем.

А где бы посмотреть азы по этой теме? То есть в принципе как это работает. После часа поиска в интернете - ничего путного не нашел.

----- добавлено через ~13 мин. -----
Или это имеется ввиду работа с ObjectArx? Как-то однажды попытался его освоить, но что-то не получилось с ходу написать dll, которая будет работать в среде автокад. Возможно из-за того, что писал в Embarcadero C++ Builder, хотя там рекомендуется Visual Studio, причем под разные версии ObjectArx - разные версии Visual Studio, такая "универсальность" отпугнула.

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

Дык ета... Сергей же ссылку дал - вот и вперед, с песнями ))

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

Ну да, у меня самого пока что с JIG так себе дела обстоят (

[Сергей812]

Сообщение от Сет Эта ссылка не на азы.

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

Сообщение от Сет Хочу программно отрисовывать будущий вид создаваемых элементов, как это реализовано в оригинальных функциях автокад. Например ту же самую мультивыноску. Стандартная мультивыноска меня не устраивает. Рисую ее через vla-AddMLeader, далее меняю разные свойства. Нужно чтобы она была визуализирована, пока я перемещаю курсор по экрану.

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

ну и еще одна ссылка - более подробного учебника за эти года, пожалуй, не видел. Пока еще доступно)

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

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

adn-cis.org

[Сергей812]

Сообщение от Сет Я под азами в данном случае имел ввиду этап организации взаимодействия программы со средой Автокад. То есть реализация, для начала, банальной вещи. Например такой, как вывод в командную строку автокада сообщения "Hello, World!". Этот этап описан в справке по ObjectArx. Я думал Jig - это нечто другое, но нет, это часть ObjectArx, значит азы там смотреть и нужно. Там, правда, все довольно лаконично. Русскоязычных ресурсов с более подробным разжевыванием азов не нашел в свое время.

есть открытое API, через которое можно взаимодействовать с акадом: lisp, vba, ObjectARX, .Net. Можно, конечно, писать и на нескольких видах API одновременно, но обычно выбирают все-таки один какой-то вид API - который обеспечивает нужный функционал. Лисп ваши потребности уже не обеспечивает.

[Сет]

Повесил объектный реактор на динамический блок с атрибутами. В функции-обработчике события :vlr-subObjModified планировал менять некоторые динамические параметры. Однако получаю вот такую ошибку:

Ошибка Automation. Объект был открыт для уведомления

Как выяснилось - эта ошибка возникает даже если в обработчике просто попытаться получить имя блока (vla-get-Name), вызвавшего срабатывание реактора. Получается в обработчике реактора запрещено читать и изменять свойства подобных объектов?

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

А какой именно реактор был повешен? Хотя бы тип реактора.

[Сет]

Сообщение от Кулик Алексей aka kpblc А какой именно реактор был повешен? Хотя бы тип реактора.

vlr-object-reactor

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

Для С++/ObjectARX выделил отдельную тему: https://forum.dwg.ru/showthread.php?t=171769

[koMon]

Сообщение от Сет Можно ли использовать grread с объектной привязкой и ее отслеживанием?

можно, но, например, через правый клик, если прямо вот нужно точное позиционирование.

[Сет]

Странное поведение блока с параметром видимости (круг и овал). Сделал блок, у которого два состояния видимости. На блок повесил объектный реактор, который делает много всякого и среди прочего - читает состояние видимости:

Код:

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

 (setq shape (vlax-variant-value (vla-get-value param)))

Здесь param - это ссылка на vla-объект динамический параметр, полученный через vla-getdynamicblockproperties. Реактор работает как надо, за исключением следующего визуального дефекта (см. вложение).
1. Состояние, когда блок вставлен в чертеж, все с ним пока как надо.
2. Переключена видимость с круга на овал. Здесь уже проблемка - должны были появиться ручки линейного параметра, которые видны на картинке 3. Отмечу, что в этот момент уже сработал объектный реактор.
3. Нажимаю ESC и просто выделяю блок - теперь он снова выглядит как надо.
4. Переключаю видимость на круг - и снова визуальный дефект в виде ручек линейного параметра, которые должны были отключиться, так как относятся к состоянию видимости "овал". Здесь тоже срабатывает реактор.

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

Что это за глюк такой и как можно его побороть?
Напрашивается вариант с программным выделением блока, но какое-то некрасивое решение.
Может можно как-то обновить отрисовку этого блока в конце кода функции-обработчике реактора? Update, redraw - не работают.

----- добавлено через ~30 мин. -----
Вот на что еще обратил внимание - после срабатывания реактора (п.2 и п.4) - сбрасывается выделение блока. В обычном блоке без реакторов при переключении видимости выделение не сбрасывается.

[===AAA===]

Может можно как-то обновить отрисовку этого блока в конце кода функции-обработчике реактора? Update, redraw - не работают.

(entdel ...) этого блока 2 раза тоже не помогает?

[Сет]

Сообщение от ===AAA=== (entdel ...) этого блока 2 раза тоже не помогает?

В этом случае сбрасывается выделение.

А как выделить vla объект? Что-то у меня не получается.

Код:

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

 (setq ss (vla-Add (vla-get-SelectionSets active_document) "MySelSet"))
	    (setq ssobj (vlax-make-safearray vlax-vbObject (cons 0 0)))
	    (vlax-safearray-put-element ssobjs 0 blc)
	    (vla-AddItems ss ssobjs)
	    (vla-Delete ss)

Здесь blc - ссылка на vla объект.

----- добавлено через ~8 мин. -----
Опечатка в переменных - ssobj и ssobjs. Добавил еще

Код:

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

 (vla-Highlight ss :vlax-true)

Узел выделяется, но вот "нелегальные ручки" остаются на месте

----- добавлено через ~15 мин. -----
Работает вот такая конструкция - после переключения видимости блок остается выделенным и все ручки соответствуют состоянию видимости, но решение какое-то кривое и некрасивое.

Код:

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

 (setq ent (vlax-vla-object->ename blc))
	    (entdel ent)
	    (entdel ent)
	    (setq ss (ssadd))
	    (ssadd ent ss)
	    (sssetfirst nil ss)
	    (setq ss nil)

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

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

[Сет]

Сообщение от Кулик Алексей aka kpblc У меня крепнет подозрение, что все можно сделать значительно менее геморно - но для этого надо задачу знать, ради решения которой вся эта катавасия вообще стартанула.

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

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

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

[Сет]

Сообщение от Кулик Алексей aka kpblc Если б не овал, можно было бы простой мультивыноской обойтись.

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

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

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

Сообщение от Сет Странно, что чтение параметра видимости приводит к этой проблеме.

Кажется разобрался в чем была проблема. Виновато вовсе не чтение параметра видимости, а функция vla-Update для блока после программной настройки динамических параметров. Вроде как пишут, что эта функция нужна, чтобы настроенные параметры вступили в действие и результат отобразился на экране. Но может быть это было нужно в ранних версиях Автокада (у меня Автокад 2022). Сейчас просто убрал эту функцию - и блок стал адекватно работать. И все параметры отображаются так, как я их программно настроил, и ручки у параметров правильные, и блок остается выделенным (в отличие от того, как было на скриншотах 2 и 4 выше, где у блока слетало выделение).

[Сет]

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

Если повесить на примитив объектный реактор vlr-object-reactor, который отслеживает событие копирования :vlr-copied, то в функцию-обработчик передается в списке параметров имя объекта, созданного операцией копирования. Первая интересность состоит в том, что в самой функции-обработчике с этим объектом ничего сделать нельзя, потому что он еще не существует, ему всего лишь присвоено будущее имя. Чтобы работать с этой копией - нужна глобальная переменная, в которую я помещаю имя объекта и командный реактор vlr-command-reactor, который отслеживает событие окончания выполнения команды :vlr-commandEnded. В функции-обработчике этого события скопированный объект уже существует и с ним можно делать что угодно.

Такой подход вполне работает с командой COPY. Однако объект скопировать можно еще и командой COPYCLIP и вставить командой PASTECLIP. И тут вторая интересность - после выполнения команды PASTECLIP объект, созданный копированием и от которого у нас есть только имя - все еще не существует. Соответственно в обработчике команды PASTECLIP ничего с объектом сделать нельзя. Судя по всему нужно делать еще один реактор типа vlr-acdb-reactor и там отслеживать событие добавления примитива :vlr-objectAppended и уже там делать то что надо с объектом, вставленным через буфер обмена.

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

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

Ты под именем понимаешь handle? Если да, то handent для неправильного хендла вернет nil
Для операций копирования я бы, скорее всего, использовал командные реакторы - они как-то мне ближе.

[Сет]

Сообщение от Кулик Алексей aka kpblc Ты под именем понимаешь handle?

Я имею ввиду вот это имя: <Имя объекта: 2d0b9892db0>. Оно в таком виде передано в качестве параметра в функцию-обработчик объектного реактора копирования.

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

Ну пробуй получить от него entget. nil - объекта еще нет

[Сет]

Сообщение от Кулик Алексей aka kpblc Для операций копирования я бы, скорее всего, использовал командные реакторы - они как-то мне ближе.

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

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

Сообщение от Кулик Алексей aka kpblc Ну пробуй получить от него entget. nil - объекта еще нет

Да, можно так проверять существует объект или нет.

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

Сообщение от Сет как определить какие именно объекты были скопированы

Вопрос на форуме уже поднимался, тему искать лениво (да и в отпуске я, так что звиняй ) А так - на реакторе начала команды получаешь (entlast), все что после него - получить через entnext - вот тебе и список новых объектов. Ну понятно, что переменную, в которой (entlast), придется обнулять при отмене / завершении / ошибки команды.

[Сет]

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

Только потом еще фильтровать набор надо.

Может дело вкуса, мне объектный реактор вполне удобен. Хотя и он не без недостатков. Например событие редактирования сложного объекта, например блока, состоящего из нескольких полилиний и атрибутов, срабатывает несколько раз. Он реагирует на изменение каждой вершины полилинии. И чем сложнее блок- тем больше будет срабатываний. Не придумал как прервать эту цепочку срабатываний после первой сработки. Я сейчас работаю с блоком не таким уж большим. Событие модификации срабатывает не более десятка раз. Код в обработчике совсем небольшой - поэтому меня это не сильно напрягает. Основной код в обработчике командного реактора - он вызывается всегда один раз.

К слову о прерывании цепочки срабатываний. Выключение реактора в функции-обработчике - почему-то не помогает. Других вариантов прервать цепочку не придумал.

Код:

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

 
(setq cs_node_modified_object_reactor
		(vlr-object-reactor (list blc) "cs_node_modified_object_reactor"
		    (list '(:vlr-openedForModify . cs_node_modified) '(:vlr-subObjModified . cs_node_modified)))
	    ) ; setq

(defun cs_node_modified (obj reac args / )
    (setq cs_ModifiedNode obj)
    (setq cs_NodeEventsCounter (1+ cs_NodeEventsCounter))
    (vlr-remove cs_node_modified_object_reactor) ; не прерывает цепочку!
) ; defun

Здесь:
blc - блок, на который вешаю объектный реактор,
cs_ModifiedNode - глобальная переменная, в которой содержится ссылка на измененный блок
cs_NodeEventsCounter - глобальный счетчик, подсчитывает количество раз срабатывания реактора

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

Сообщение от Сет Только потом еще фильтровать набор надо.

Вот это вообще не проблема ИМХО. vl-remove и вперед

Сообщение от Сет мне объектный реактор вполне удобен

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

Сообщение от Сет К слову о прерывании цепочки срабатываний

Я бы делал по-другому. В глобальную переменную в начале редактирования засовываешь, к примеру, 0. В конце редактирования добавляешь 1. Если общее количество <= 1, то выполнять обработку. Нет - значит нет. Это тупо как идея, без реализации.

[Сергей812]

Сообщение от Сет К слову о прерывании цепочки срабатываний. Выключение реактора в функции-обработчике - почему-то не помогает. Других вариантов прервать цепочку не придумал.

это потому что в лиспе нет idle реактора, насколько помню) Это где уж гарантировано закончилась транзакция БД, и можно отцепить обработчики изменений и сделать что-то с объектом без опасения повторного вхождения в обработчики изменений.

[Сет]

Сообщение от Кулик Алексей aka kpblc Я бы делал по-другому. В глобальную переменную в начале редактирования засовываешь, к примеру, 0. В конце редактирования добавляешь 1. Если общее количество <= 1, то выполнять обработку. Нет - значит нет. Это тупо как идея, без реализации.

Ты не совсем понял проблему. Нет возможности в какой-либо момент времени влиять на работу реактора в момент срабатывания события редактирования. Автокад помечает объект как редактируемый столько раз, сколько параметров было изменено при редактировании - и вот столько раз и вызывает функцию-обработчик. То есть вот это - "Если общее количество <= 1" - просто негде вставить. Произошло 10 изменений в блоке при редактировании - значит 10 раз вызовется функция-обработчик. Отменить ее вызов - не получается.

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

Думаешь, я просто так сказал про "топорные" подходы?

----- добавлено через ~1 мин. -----
А так - ну реально я бы смотрел в сторону MultiCAD, NET и пользовательских объектов.

[Сергей812]

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

[Сет]

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

Код:

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

 ; объектный реактор (копирование)
(setq cs_node_copied_object_reactor (vlr-object-reactor (list blc) "cs_node_copied_object_reactor" (list '(:vlr-copied . cs_node_copied))))

; реактор базы данных (добавление примитива)
(setq cs_node_acdb_reactor (vlr-acdb-reactor "cs_node_acdb_reactor" (list '(:vlr-objectAppended . cs_node_pasteclip))))

; функция-обработчик копирования
(defun cs_node_copied (obj reac args / )
    (setq cs_CopiedNodes (append cs_CopiedNodes args))
    (setq cs_NodeEventsCounter (1+ cs_NodeEventsCounter))
) ; defun

; функция-обработчик добавление примитива
(defun cs_node_pasteclip (reac args / )
    (if (and
	    (> cs_NodeEventsCounter 0)
	    (/= cs_CopiedNodes nil)
	    (/= cs_node_copied_object_reactor nil)
        ) ; and
        (progn
	    (foreach x cs_CopiedNodes
	        (vlr-owner-add cs_node_copied_object_reactor (vlax-ename->vla-object x))
	    ) ; foreach
	    (princ (strcat "\nКоличество срабатываний реактора копирования: " (itoa cs_NodeEventsCounter)
		           ". Обработано событие добавление примитива."))
	    (setq cs_CopiedNods nil)
            (setq cs_NodeEventsCounter 0)
        ) ; progn
    ) ; if
) ;defun

Создаю два реактора - объектный (отслеживает копирование) и реактор базы данных (отслеживает добавление примитива). При помещении объекта в буфер обмена (Ctrl+C) - срабатывает реактор копирования и добавляет имя будущего объекта в список cs_CopiedNodes, также инкрементируется счетчик. Затем вставляю объекты в чертеж (Ctrl+V) - срабатывает функция-обработчик cs_node_pasteclip, которая добавляет в список владельцев реактора копирования - объекты из списка cs_CopiedNodes. Проблема в том, что в этом списке оказываются вовсе не те объекты, которые будут затем вставлены в чертеж, а некие промежуточные. Ведь после Ctrl+V нужно еще указать точку вставки. После непосредственно вставки - имена добавленных объектов не соответствуют именам из списка cs_CopiedNodes. Как же здесь получить список реальных объектов после вставки из буфера?

P.S. При тестировании всего этого дела счетчик копирования у меня почему-то получает очень высокое значение - 43.

----- добавлено через ~24 мин. -----
Наверное действительно стоит добывать объекты через entlast.

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

Вот скажи, а на фига вообще объектный реактор-то?
Мне кажется, что, во-первых, не "при копировании", а "при завершении команды вставки из буфера обмена". Во-вторых, я не уверен, что твой код сработает при простом _.copy / _.mocoro.

Код:

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

 (if *vlr-cmd*
  (progn
    (vlr-remove *vlr-cmd*)
    (setq *vlr-cmd* nil)
  )
)

(if (not *vlr-cmd*)
  (progn
    (setq *vlr-cmd* (vlr-command-reactor
                      "kpblc-cmd-reactor"
                      '((:vlr-commandwillstart . _kpblc-vlr-command-start)
                        (:vlr-commandended . _kpblc-vlr-command-ended)
                        (:vlr-commandfailed . _kpblc-vlr-command-failed)
                        (:vlr-commandcancelled . _kpblc-vlr-command-cancelled)
                       )
                    )
    )
  )
)

(defun _kpblc-vlr-command-start (reactor cmd)
  (setq *kpblc-ent-last* (entlast)
        *kpblc-ent-list* nil
  )
)

(defun _kpblc-vlr-command-ended (reactor cmd / ent)
  (setq cmd (strcase (vl-string-trim "_-." (car cmd))))
  (if (member cmd '("COPY" "COPYCLIP" "MOCORO" "PASTE" "PASTECLIP"))
    (progn
      (while (setq *kpblc-ent-last* (entnext *kpblc-ent-last*))
        (setq *kpblc-ent-list* (cons *kpblc-ent-last* *kpblc-ent-list*))
      )
      ;; И тут уже обрабатываешь *kpblc-ent-list* как душе угодно
    )
  )
)

(defun _kpblc-vlr-command-failed (reactor cmd)
  (setq *kpblc-ent-last* nil
        *kpblc-ent-list* nil
  )
)

(defun _kpblc-vlr-command-cancelled (reactor cmd)
  (setq *kpblc-ent-last* nil
        *kpblc-ent-list* nil
  )
)

[Сет]

Сообщение от Кулик Алексей aka kpblc Вот скажи, а на фига вообще объектный реактор-то?

Для формирования списка копируемых объектов. Я пока не въехал вот в эту твою конструкцию, которая отвечает судя по всему за то же самое.

Код:

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

 (while (setq *kpblc-ent-last* (entnext *kpblc-ent-last*))
(setq *kpblc-ent-list* (cons *kpblc-ent-last* *kpblc-ent-list*))
      )

Что будет в твоем списке *kpblc-ent-list*, если скопировано несколько объектов одной командой COPY? Функция entnext в твоем цикле перебирает вообще ВСЕ объекты чертежа, а не только добавленные последней командой COPY. Или я не понимаю как работает команда entnext.

В моем случае объектный реактор легко формирует набор новых объектов. И проблема, которую я здесь обозначил, не в объектном реакторе, а в командном, там где я, собственно, обрабатываю команду COPY или PASTECLIP. С командой COPY нет проблем - она корректно обрабатывает мой список объектов, полученный в объектном реакторе. А вот PASTECLIP обрабатывается некорректно, потому что после окончания выполнения этой команды объекты еще не существуют - я не могу их обработать. Собственно тот же самый вопрос и к твоему коду. Обработав PASTECLIP ты оперируешь списком (*kpblc-ent-list*) реальных объектов или неких временных? Это твой реальных рабочий код или ты сейчас набросал его для пояснения своей мысли?

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

А ты проверь. А заодно и посмотри на справку по функции entnext

[Сет]

Сообщение от Кулик Алексей aka kpblc А ты проверь.

Проверил - работает.

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

Во-вторых - entnext расчленяет составные объекты и считает их отдельно. А мне нужно, чтобы блок считался за один объект. Наверняка это как-то можно сделать?

[===AAA===]

Наверное действительно стоит добывать объекты через entlast.

Тут вот ещё не забудь про один подводный камень.

"Последним" вполне может оказаться не "цельный" объект (типа отрезка),
а "составной" (типа полилинии или блока с атрибутами).

Поэтому (entnext) будет возвращать не "свежедобавленный" объект,
а подобъект от уже существующего в базе объекта.

Я в своё время делал так - добавлял в чертеж "отрезок", запоминал его
как (entlast), от него искал добавленные примитивы и затем удалял его.

Разумеется, с обвесом в виде проверок и удаления этого отрезка по ERROR.
Не слишком изящно, но это было очень давно, ещё до появления (vl-load-com) ...
И оно работало вполне себе стабильно.

[Сергей812]

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

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

[Сет]

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

Да, но почему при этом entnext работает только до первого только что добавленного примитива, а не до самого первого в базе данных чертежа?

[Сергей812]

Сообщение от Сет Да, но почему при этом entnext работает только до первого только что добавленного примитива, а не до самого первого в базе данных чертежа?

это функция просто ищет следующий по UID объект, у которого нет пометки - что он был удален. Если не задавать объект - будет искать с дефолтного значения UID, т.е. с начала БД чертежа.
---
И этот UID называется хэндлом (DXF группа 5, насколько помню).

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

Сообщение от Сет Во-вторых - entnext расчленяет составные объекты и считает их отдельно. А мне нужно, чтобы блок считался за один объект. Наверняка это как-то можно сделать?

А фильтрация на что?

[===AAA===]

Так (entnext) идёт "вперёд" по базе данных.

Вызов (entnext) без параметра - первый примитив в базе.

С параметром (entnext <имя_примитива>) - вперёд от указанного,
включая субпримитивы. Пока база данных чертежа не закончится.

[Сет]

Сообщение от Сергей812 это функция просто ищет следующий по UID объект, у которого нет пометки - что он был удален. Если не задавать объект - будет искать с дефолтного значения UID, т.е. с начала БД чертежа.

Ну вот добавили мы 5 объектов в чертеж, у них имена - 1, 2, 3, 4, 5. Затем выделяем объекты 2 и 5 - и копируем, получаем два новых объекта - 6 и 7. И запускаем команду entnext в цикле. Получили в список объекты 6 и 7, но почему (entnext 6) дает nil? Ведь есть предыдущий объект - 5 и так далее до 1.

Сообщение от Кулик Алексей aka kpblc А фильтрация на что?

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

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

Сообщение от Сет О какой фильтрации речь?

Ты специально не читаешь, да? )

Сообщение от Кулик Алексей aka kpblc vl-remove и вперед

Как пример:

Код:

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

 (vl-remove-if-not
               (function
                 (lambda (x)
                   (and (entget x)
                        (= (cdr (assoc 0 (entget x))) "INSERT")
                   )
                 )
               )
               *kpblc-ent-list*
             )

[Сергей812]

Сообщение от Сет Ну вот добавили мы 5 объектов в чертеж, у них имена - 1, 2, 3, 4, 5. Затем выделяем объекты 2 и 5 - и копируем, получаем два новых объекта - 6 и 7. И запускаем команду entnext в цикле. Получили в список объекты 6 и 7, но почему (entnext 6) дает nil? Ведь есть предыдущий объект - 5 и так далее до 1.

имхо, (entnext 6) должно дать объект с хэндлом (ака UID) = 7. А вот (entnext 7) уже вернуть nil - нет объектов с БОЛЬШИМ значением хэндла. С меньшим значением хэндла (1..5) есть, то функция то называется EntNext - с какого перепуга она вдруг должна пойти назад по БД?

[Сет]

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

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

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

Сообщение от Сергей812 имхо, (entnext 6) должно дать объект с хэндлом (ака UID) = 7. А вот (entnext 7) уже вернуть nil - нет объектов с БОЛЬШИМ значением хэндла. С меньшим значением хэндла (1..5) есть, то функция то называется EntNext - с какого перепуга она вдруг должна пойти назад по БД?

Аааа, то есть entnext идет вперед, начиная с первого добавленного? В моем мини-примере - начиная с 6? Тогда понятно, почему она прерывается. Но пока непонятно, почему она начинает работать с объекта номер 6? Согласно описанию entnext возвращает первый неудаленный примитив, это же должен быть номер 1?

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

Сообщение от Кулик Алексей aka kpblc Как пример:

Кстати, а автокад не захлебнется при копировании, если ему придется таким образом фильтровать 10 000 объектов, чтобы включить в целевой список только нужные блоки?

[Сергей812]

Сообщение от Сет Согласно описанию entnext возвращает первый неудаленный примитив, это же должен быть номер 1?

ну я не знаю, где вы смотрите описания функций) Там ясно написано - либо следующий неудаленный после указанного в аргументах примитива, либо если функция вызывается без параметров - то первый неудаленный примитив в БД. Где тут можно запутаться?

----- добавлено через ~16 мин. -----
а единственный порядок следования примитивов в БД чертежа - это их хэндлы (UID в виде 64-битных целых чисел) в порядке добавления в БД чертежа. Других явных признаков нет.

[Сет]

Сообщение от Сергей812 ну я не знаю, где вы смотрите описания функций) Там ясно написано - либо следующий неудаленный после указанного в аргументах примитива, либо если функция вызывается без параметров - то первый неудаленный примитив в БД. Где тут можно запутаться?

Да где я только не смотрю описание этой функции - и у Полещука, и в справке Автокада, и на каких-то сайтах, где есть справка по лиспу. Описание не очень понятное. Ну может я такой непонятливый. Возвращаясь к моему мини-пример и циклу из кода Алексея по формированию списка добавленных примитивов. Тот цикл находится в обработчике события по завершению выполнения команды. Завершается команда COPY - срабатывает этот обработчик. Когда команда COPY завершается - в базе уже есть все 7 объектов - 5 изначальных и 2 скопированных. В цикле идет первым делом вызов (entnext nil). Должны получить первый неудаленный примитив. В данном случае это же объект номер 7. Ну а на втором шаге цикла выполняется код (entnext 7) и если функция идет вперед по БД, то должен вернуться nil, а значит итоговый список должен состоять только из объекта номер 7, хотя мы же копированием получили и номер 6.

----- добавлено через ~3 мин. -----
Все, дошло наконец. Первый вызов не (entnext nil). Там в качестве аргумента примитив (entlast), полученный перед копированием.

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

Сообщение от Сет Кстати, а автокад не захлебнется при копировании, если ему придется таким образом фильтровать 10 000 объектов, чтобы включить в целевой список только нужные блоки?

Попробовал на 50 000 примитивов. Чувствуется лаг на несколько секунд на моем компьютере. Но он чувствуется и без фильтрации, и даже с отключенными реакторами. Так что особого влияния нет.

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

Сообщение от Сет Кстати, а автокад не захлебнется при копировании, если ему придется таким образом фильтровать 10 000 объектов, чтобы включить в целевой список только нужные блоки?

Он скорее захлебнется с объектными реакторами. И что-то мне сложно поверить, что у тебя будет несколько тысяч объектов. В конце концов, никто не мешает проверку вколотить в цикл сбора объектов.

[Сет]

Сообщение от Кулик Алексей aka kpblc Он скорее захлебнется с объектными реакторами. И что-то мне сложно поверить, что у тебя будет несколько тысяч объектов. В конце концов, никто не мешает проверку вколотить в цикл сбора объектов.

С объектными как раз должно быть проще, потому что они срабатывают при модификации конкретного объекта. А командные - при любой команде. Но в данном случае их некорректно противопоставлять, потому что хоть я думаю отказаться от объектного реактора ан копирование, но пока не вижу причин отказаться от объектного реактора на изменение. Не очень представляю как его можно убрать, оставив только командный. Я в объектном реакторе получаю глобальную ссылку на изменяемый объект, а в командном - провожу над ним различные действия.

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

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

Касаемо "глубоких" реакторов и их поведения : https://autolisp.ru/2020/02/18/acdb-reactors/ Именно из-за этих и подобных приколок я предпочитаю "топорные" методы.
Какая связь между сотнями листов, их копиями "рядом" и списками примитивов - как-то не догоняю.

[Сет]

Сообщение от Кулик Алексей aka kpblc Какая связь между сотнями листов, их копиями "рядом" и списками примитивов - как-то не догоняю.

Лист в данном случае - не автокадовская вкладка лист - а электронный эквивалент бумажного листа. Вот тут, например, 20 000 примитивов. Мне может понадобиться необходимость их скопировать в другое место пространства модели.

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

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

[Сет]

Сообщение от Кулик Алексей aka kpblc Ну хочешь - попробуй мой код, посмотри, "захлебнется" кад или нет. Подозреваю, что все сработает корректно - основная проблема будет при прорисовке, но вряд ли при обработке списка.

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

Сообщение от Кулик Алексей aka kpblc Именно из-за этих и подобных приколок я предпочитаю "топорные" методы.

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

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

Стоп. Командные реакторы у меня в реальных боевых условиях вообще слабо привязаны к объектам. Ну скопировал пользователь объект - и бог с ними, и с объектом, и с пользователем. Изменений объектов лично я предпочитаю непредсказуемо (для пользователя) не выполнять: лекарство может оказаться хуже болезни.
А необходимость "привязки" объектного реактора я бы делал примерно так:
1. В описании блока в словарь засунуть некую последовательность типа '("objreactor" . t). Решения в ынтырнетах есть
2. При открытии документа пройтись по всем описаниям блоков, найти те, у которых "надо привязывать" реактор
3. Пройтись по всем вхождениям таких блоков и прописать им объектный реактор
4. При выполнении команд копирования / вставки из буфера / внедрения стороннего файла как блока / внедрении внешней ссылки повторно выполнить п.3
---
Offtop: Хотя мне до сих пор кажется, что задачка своей сложностью выходит за рамки возможностей лиспа.

[Сет]

Можно ли ограничить выбор точки pt3 прямой, проходящей через точки pt1 и pt2?

Код:

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

 
(setq pt1 (getpoint "\nУкажите точку 1:"))
(setq pt2 (getpoint pt1 "\nУкажите точку 2:"))
(setq pt3 (getpoint pt2 "\nУкажите точку 3:"))

[Сергей812]

имхо, лучше получить проекцию от третьей точки на отрезок - чем требовать от пользователя точного попадания в определенную точку)

[Сет]

Сообщение от Сергей812 имхо, лучше получить проекцию от третьей точки на отрезок - чем требовать от пользователя точного попадания в определенную точку)

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

[Сергей812]

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

реально, может хватит издеваться над лиспом, пытаясь реализовать на нем функционал ObjectARX/NetAPI? Хотя в последних вроде такого встроенного функционала тоже нет.

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

[Сет]

Сообщение от Сергей812 реально, может хватит издеваться над лиспом, пытаясь реализовать на нем функционал ObjectARX/NetAPI? Хотя в последних вроде такого встроенного функционала тоже нет.

Ну почему издеваться? Я просто не большой спец в лиспе, вдруг есть такая возможность, о которой я пишу.

Если нет, то я эту третью точку пока думаю получать программно. Она будет на том же расстоянии от точки 2, что и указанная пользователем, но смещенная на линию 1-2. Этот вариант меня тоже устраивает, просто он чуть менее красив, чем если бы при выборе точки 3 резиновая линия изначально тянулась только по прямой 1-2.

[Сергей812]

Сообщение от Сет Ну почему издеваться?

Сообщение от Сет просто он чуть менее красив

лисп - это ЯП для реализация чистого функционала. А если начинать думать о красивом GUI - лисп слишком далеко в прошлом остановился в развитии.

[Сет]

Я тут подумал, может как вариант - повернуть систему координат по двум первым точкам и включить режим ОРТО перед выбором третьей точки.

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

1. Режим может быть отключен пользователем
2. Никто не помешает вести перпендикулярно
3. Замучаешься обратно восстанавливать UCS

[Сет]

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

Перпендикулярно чему?

Сообщение от Кулик Алексей aka kpblc Замучаешься обратно восстанавливать UCS

Почему замучаюсь? Вроде простого включения МСК будет достаточно.

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

Сообщение от Сет Перпендикулярно чему?

Меняешь UCS, ждешь, что пользователь будет вести плюс-минус около оси Ox. А он бац - и вдоль оси Oy текущей UCS

Сообщение от Сет Вроде простого включения МСК будет достаточно.

А кто сказал, что при старте кода система координат была мировой?

[Сет]

Сообщение от Кулик Алексей aka kpblc Меняешь UCS, ждешь, что пользователь будет вести плюс-минус около оси Ox. А он бац - и вдоль оси Oy текущей UCS

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

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

Так как я делаю программки чисто для себя, то можно сказать, что при старте всегда МСК. Я редко трогаю систему координат. А если затрону - ну опять же, просто надо будет иметь ввиду, что после отработки этой команды - система переключится на МСК.

----- добавлено через ~2 мин. -----
Кстати, проблему с перпендикулярным вводом частично можно уменьшить, если начало координат закинуть подальше, чтобы физически сложно было выбрать перпендикулярный режим.

[name02]

Можно сделать так:

Код:

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

 (defun c:test (/ pt0 pt1 pt2 pt3 line1)

  (setq pt1 (getpoint "\nУкажите точку 1:"))
  (setq pt2 (getpoint pt1 "\nУкажите точку 2:"))

  (command-s "_LINE" pt1 pt2 "")

  (setq line1 (entlast))

  (vl-cmdf "_lengthen" "_dy" (list line1 pt2) pause "")

  (setq pt0 (cdr (assoc 10 (entget line1))))

  (if (or (equal pt0 pt1) (equal pt0 pt2))
    (setq pt3 (cdr (assoc 11 (entget line1))))
    (setq pt3 pt0)
  ) ;_ END_OF if

) ;_ END_OF defun

[Сет]

Сообщение от name02 Можно сделать так:

Выглядит неплохо.

[NewNeo]

Доброй ночи!
Подскажите как в коде указать универсальный путь к файлу шаблона? Если ввести конструкцию %UserName% в пути напрямую, то не работает(
Дали идею:
(getenv "%appdata%")
(getenv "%userprofile%")
Но как применить в коде не знаю, мои знания в язык LISP равны нулю к сожалению(

Код:

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

 (vl-load-com)

(defun c:set-def-settings (/ acad_obj files)
  (setq acad_obj (vlax-get-acad-object)
        files    (vla-get-files (vla-get-preferences acad_obj))
  )
  (vla-put-qnewtemplatefile files "C:\\Users\\%%UserName%%\\AppData\\Local\\Autodesk\\C3D 2024\\rus\\Template\\ACAD metric.dwt")
  (vla-put-templatedwgpath files "C:\\Users\\%%UserName%%\\AppData\\Local\\Autodesk\\C3D 2024\\rus\\Template")
  (princ)
)

[name02]

У тебя неправильно написаны переменные, нужно так:
(getenv "APPDATA")
(getenv "USERPROFILE")

Если нужно только имя пользователя:
(getvar "LOGINNAME")

Для объединения строк используется оператор strcat

[Сет]

Подскажите, каким образом можно добраться до свойств массива (расстояние между строками, столбцами, количество строк, столбцов), чтобы их изменить?

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

ИМХО никак. В СОМ-модели соответствующие свойства вроде бы не проброшены, да и в ename-представлении динамический массив - всего лишь анонимный блок. Правда, со своими реакторами и словарями.

[Сет]

Сообщение от Кулик Алексей aka kpblc ИМХО никак. В СОМ-модели соответствующие свойства вроде бы не проброшены, да и в ename-представлении динамический массив - всего лишь анонимный блок. Правда, со своими реакторами и словарями.

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

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

Или расковыривать словари на примитиве - насколько я помню, там что-то мелькало.

[Сет]

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

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

Я же говорю - вскрывай словари.

[Сет]

Сообщение от Кулик Алексей aka kpblc Я же говорю - вскрывай словари.

Пока что не сталкивался с ними, абсолютно новая для меня тема. Надо изучать.

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

Ну как-то так примерно

[Сет]

А можно ли через vla-функции создать массив, который получается командой _array? Есть функция ArrayRectangular, она создает просто набор отдельных объектов, а нужно чтобы результат был в виде единого объекта.

[Сет]

Не придумал как сделать из набора примитивов обычный автокадовский массив с ручками, обернул набор в анонимный блок. Ниже реализация. Посмотрите, нет ли там каких-то явных глупостей в коде, может что-то можно сделать проще.
Функция создает объект, представляющий собой заводской сварной шов - небольшой отрезок с некоторым шагом. Геометрия пока жестко прописана в коде (длина отрезка и максимальный шаг отрезков).

Код:

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

 (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 c:asd (/ pt1 pt2 pt3 len n line blc)
    (setq pt1 (getpoint "\nПервая точка:"))
    (setq pt2 (getpoint pt1 "\nВторая точка:"))
    (setq len (distance pt1 pt2))
    (setq n 1)
    (while (> (/ len n) 130)
	(setq n (1+ n))
    ) ; while
    (setq pt3 (polar pt1 (/ pi 2) 130))
    (setq blc (vla-add (vla-get-blocks active_document) (vlax-3d-point pt1) "*U"))
    (setq line (vla-AddLine blc (vlax-3d-point pt1) (vlax-3d-point pt3)))
    (vla-ArrayRectangular line 1 (1+ n) 1 1 (/ len n) 1)
    (vla-insertblock model_space (vlax-3d-point pt1) (vla-get-name blc) 1.0 1.0 1.0 (angle pt1 pt2))
    (princ)
) ; defun

[nikkomp]

Использую вот зтот код

Код:

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

;|=============================================================================
*    проверка размеров на правильность проставления. Вручную проставленные
* размеры меняют цвет на 1, вес линии на 2.11 мм. Переназначения текста не
* выполняется
=============================================================================|;
(defun c:kpblc-dimcheck (/ *kpblc-activedoc* selset item temp_text)
  (vl-load-com)
  (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *kpblc-activedoc*)
  (setq selset (ssget '((0 . "DIMENSION"))))
  (while (and selset
	      (> (sslength selset) 0)
	      (setq item (ssname selset 0))
	      (ssdel item selset)
	      ) ;_ end of and
    (setq item (vlax-ename->vla-object item))
    (if	(and (/= (vla-get-textoverride item) "")
    (not (wcmatch (vla-get-textoverride item) "*<>*"))
	     ) ;_ end of and
      (progn
	(vla-put-color item 1)		; цвет - красный
	(vla-put-lineweight item 211)	; вес линии - 2.11
        (vla-put-TextColor item 6)      ; цвет - фиолетовый
	(setq temp_text (vla-get-textoverride item))
	(vla-put-TextOverride item (strcat "%%u" temp_text)) ; текст - подчеркнутый
	) ;_ end of progn
      ) ;_ end of if
    ) ;_ end of while
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  ) ;_ end of defun

Можно добавить команду, чтобы все эти перебитые размеры переносились в определенный, желательно новый слой?

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

Ну создай перед while свой слой, и в конце после vla-put-textoverride добавь (vla-put-layer item <Имя твоего слоя>)

[Ingpro]

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

Код:

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

 (defun c:Sel-mtxt ( )
(sssetfirst nil (ssget "_A" (list (cons 0 "*TEXT") 
(cons 1 (getstring "\nВведите строку для поиска: ")))))

Здесь нужно ввести текст в командную строку
Но мне нужно выбрать текст на экране

Код:

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

 (setq e (entsel "Please choose an object: "))

эта строка выбирает объект и выводит имя объекта и координаты
(<Имя объекта: 7ffffb0c620> (12816.6 1477.96 0.0))
(<Имя объекта: 7ffffb0c610> (11643.9 2491.88 0.0))
(<Имя объекта: 7ffffb0c630> (13407.1 1037.49 0.0))
Для мтекстов с одинаковым содержанием выводятся различные имена...
Возможно ли выбрать одинаковые мтексты как одинаковые объекты, указав на мтекст-образец?

[Сергей812]

Сообщение от Ingpro эта строка выбирает объект и выводит имя объекта и координаты (<Имя объекта: 7ffffb0c620> (12816.6 1477.96 0.0)) (<Имя объекта: 7ffffb0c610> (11643.9 2491.88 0.0)) (<Имя объекта: 7ffffb0c630> (13407.1 1037.49 0.0)) Для мтекстов с одинаковым содержанием выводятся различные имена...

если будут выводить одинаковые имена - это битая БД чертежа)

Сообщение от Ingpro Возможно ли выбрать одинаковые мтексты как одинаковые объекты, указав на мтекст-образец?

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

[Ingpro]

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

From the point of view of banal erudition, not every individual (teapot) is able to understand the trends of paradoxical explanations.

[Сергей812]

Offtop:

Сообщение от Ingpro From the point of view of banal erudition, not every individual (teapot) is able to understand the trends of paradoxical explanations.

вы когда правите текст - учитывайте, что на почту всем подписавшимся на тему приходит первичный вариант)

Мультитекст может содержать один и тот же текст, но с разными кодами форматирования. В Net это одна строчка для получения "чистого" текста, на лиспе люди тоже реализовывали - ищите.

[Ingpro]

Сообщение от Сергей812 Мультитекст может содержать один и тот же текст, но с разными кодами форматирования. В Net это одна строчка для получения "чистого" текста, на лиспе люди тоже реализовывали - ищите.

Ув. профи, которые реализовали на лиспе, поделитесь, плз...

[koMon]

без реализации, штатная функция

Код:

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

 
(getpropertyvalue (car (entsel "\nМТекст: ")) "text")

[Сергей812]

и аутодеск до сих пор игнорирует разметку верхних и нижних индексов при получении деформатированного значения)

[Ingpro]

Сообщение от koMon 1 (getpropertyvalue (car (entsel "\nМТекст: ")) "text")

Команда: (getpropertyvalue (car (entsel "\nМТекст: ")) "text")
выдает:
МТекст: "Строка текста 1.\r\nСтрока текста 2."
Как с помощью этой строки можно выделить все мтексты с таким содержанием?
Просто для сравнения, если вызвать ком. ПОЛЕ, потом - объект-мтекст, то в окне содержимое выглядит по-другому (как в свойствах мтекста).
или
Команда: _LIST
Выберите объекты: найдено: 1
MTEXT
..............................
..............................
Содержание: Строка текста 1.\PСтрока текста 2.

[koMon]

Сообщение от Сергей812 и аутодеск до сих пор игнорирует разметку верхних и нижних индексов при получении деформатированного значения)

для поиска идентичных текстов это не должно мешать.

Сообщение от Сергей812 В Net это одна строчка для получения "чистого" текста

там тоже с индексами аналогично?

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

Сообщение от Ingpro Как с помощью этой строки можно выделить все мтексты с таким содержанием?

выбрать мтексты (все или выборочно) и проверять содержимое со [под]строкой поиска, например.

[Сергей812]

Сообщение от koMon там тоже с индексами аналогично?

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

[Ingpro]

Сообщение от koMon выбрать мтексты (все или выборочно) и проверять содержимое со [под]строкой поиска, например.

А как это записать на лисп? Мне просто нужно выбрать все мтексты с одинаковым содержанием, а потом я применю лисп Replace, например, или удалю выбранные мтексты...

[koMon]

можно напр. так

Код:

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

 
(setq pattern (getpropertyvalue (car (entsel "\nОбразец МТекста для фильтрации: ")) "text")
      mtext_filtered_sset (ssadd)
)
(if (setq mtext_sset (ssget '((0 . "mtext"))))
  (sssetfirst nil
	  (foreach mtext  
		  (vl-remove-if-not '(lambda (mtext) (vl-string-search pattern (getpropertyvalue mtext "text")))
		    		     (vl-remove-if 'listp (mapcar 'cadr (ssnamex mtext_sset)))
		  )
	    	  (ssadd mtext mtext_filtered_sset)
	  )
  )
)

[Ingpro]

Сообщение от koMon можно напр. так

koMon, спасибо! это отлично работает!!!

[===AAA===]

Всем привет!

Кто знает, для nanoCAD'а 23.1 семейство функций (dumpallproperties ...) вообще не реализовано?
Может быть, просто их синтаксис изменили... А вдруг? :-)

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

А чем тебе не нравится vlac-dump-object?

[===AAA===]

Дело в том, что в функции (dumpallproperties ...) Аутодеск напихал больше
свойств, чем они доступны по (vlax-dump-object).

Скажем, тот же самый "text" для MTEXT - отсутствует.

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

Т.е. тебе TextString уже не канает? )

[===AAA===]

Формально - нет, конечно. :-)

TextString - с кодами форматирования
Text - "чистое" содержание текста

Пока не слишком актуально, но вдруг захочется применить какое-нибудь
свойство, которое доступно по (dumpallproperties ...), но недоступно
по (vlax-dump-object) ... и под наником. Уже - увы - только под ним.

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

Offtop: Бросай лисп, на NET все это доступно из коробки

[Сергей812]

Сообщение от ===AAA=== Пока не слишком актуально, но вдруг захочется применить какое-нибудь свойство, которое доступно по (dumpallproperties ...), но недоступно по (vlax-dump-object) ... и под наником. Уже - увы - только под ним.

ну тогда придется перейти на тот же Net - если возможностей нанолиспа будет уже не хватать)

[===AAA===]

Offtop: Вот сейчас с Винды на Астра-Линукс перейдём, точно придётся бросить...

[koMon]

а что нк есть/будет под астра-линукс?

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

Пока все то же самое, что и под виндой. С некоторыми ограничениями на dcl, насколько я помню.

[Ingpro]

Сообщение от Ingpro Можно этот лисп использовать в связке с replace.lsp

Я пытаюсь вызвать лисп "Sel-mtxt-rpl" из лиспа "repl", добавив эти строки

Код:

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

 (load "Sel-mtxt-rpl")
(c:Sel-mtxt-rpl)
(c:repl)

Но это срабатывает только при первой загрузке, если повторить команду "repl", то она
запускается первой, а (load "Sel-mtxt-rpl") вообще не срабатывает.
Мне нужно, чтобы сначала сработал код "Sel-mtxt-rpl", затем "repl".
Посоветуйте,плз, как это можно исправить.

Код:

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

 (defun c:repl (/ actdoc copobj errcount extlst extset fromcen laycol maxpt curlay minpt objlay okcount olayst sclay tocen toobj vlaobj *error*)
  (vl-load-com)
  (defun *ERROR*(msg)
    (if olaySt
      (vla-put-Lock objLay olaySt)
      ); end if
    (vla-EndUndoMark actDoc)
    (princ)
    ); end of *ERROR*
  (defun GetBoundingCenter(vlaObj / blPt trPt cnPt)
  (vla-GetBoundingBox vlaObj 'minPt 'maxPt)
      (setq blPt(vlax-safearray->list minPt)
       trPt(vlax-safearray->list maxPt)
       cnPt(vlax-3D-point
        (list
             (+(car blPt)(/(-(car trPt)(car blPt))2))
             (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2))
          0.0
            ); end list
      ); end vlax-3D-point
     ); end setq
  ); end of GetBoundingCenter
  (if(not(setq extSet(ssget "_I")))
    (progn
      (princ "\nSelect the objects to replace ")
      (setq extSet(ssget))
      ); end progn
    ); end if
  (if(not extSet)
    (princ "\nDistination objects isn't selected!")
    ); end if
  (if
    (and
    extSet
    (setq toObj(entsel "\nSpecify the sample object "))
    ); and and
    (progn
      (setq actDoc
        (vla-get-ActiveDocument
          (vlax-get-Acad-object))
       layCol
        (vla-get-Layers actDoc)
       extLst
        (mapcar 'vlax-ename->vla-object
                    (vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex extSet))))
       vlaObj(vlax-ename->vla-object(car toObj))
       objLay(vla-Item layCol
             (vla-get-Layer vlaObj))
       olaySt(vla-get-Lock objLay)
       fromCen(GetBoundingCenter vlaObj)
       errCount 0
       okCount 0
       ); end setq
      (vla-StartUndoMark actDoc)
      (foreach obj extLst
   (setq toCen(GetBoundingCenter obj)
         scLay(vla-Item layCol
              (vla-get-Layer obj))
              );end setq
   (if(/= :vlax-true(vla-get-Lock scLay))
     (progn
     (setq curLay(vla-get-Layer obj))
     (vla-put-Lock objLay :vlax-false)
     (setq copObj(vla-copy vlaObj))
     (vla-Move copObj fromCen toCen)
     (vla-put-Layer copObj curLay)
     (vla-put-Lock objLay olaySt)
     (vla-Delete obj)
     (setq okCount(1+ okCount))
     ); end progn
     (setq errCount(1+ errCount))
     ); end if
   ); end foreach
      (princ
   (strcat "\n" (itoa okCount) " were changed. "
      (if(/= 0 errCount)
        (strcat (itoa errCount) " were on locked layer! ")
        ""
        ); end if
      ); end strcat
   ); end princ
      (vla-EndUndoMark actDoc)
      ); end progn
    (princ "\nSource object isn't selected! ")
    ); end if
  (princ)
  ); end of c:repl

(load "Sel-mtxt-rpl")
(c:Sel-mtxt-rpl)
(c:repl)
(princ)

Если снова выполнить загрузку "repl", то это сработает, как надо...

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

Вопрос больше подходит под https://forum.dwg.ru/showthread.php?t=22894
А так - загрузку кода и вызов sel-mtxt-rpl стоит засунуть внутрь тела основной команды.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc А так - загрузку кода и вызов sel-mtxt-rpl стоит засунуть внутрь тела основной команды.

Вопрос перенесён туда https://forum.dwg.ru/showthread.php?t=22894?

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

Перенес

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

Offtop: Но дайте мне развидеть этот код...

[Ingpro]

Сообщение от Кулик Алексей aka kpblc загрузку кода и вызов sel-mtxt-rpl стоит засунуть внутрь тела основной команды

Так тоже не получилось... Если в "sel-mtxt-rpl" добавить загрузку repl.lsp, то он (repl.lsp) загружается первым...

[name02]

Держи:
repl.lsp
Но на будущее - старайся писать понятнее - очень трудно понять что ты загружал...

[Ingpro]

Сообщение от name02 Держи: repl.lsp Но на будущее - старайся писать понятнее - очень трудно понять что ты загружал...

Ок, name02, спасибо, работает в нужном порядке!

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

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

Код:

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

 (defun c:repl (/ sel-mtxt-rpl actdoc copobj errcount extlst extset fromcen laycol maxpt curlay minpt objlay okcount olayst sclay tocen toobj vlaobj *error*
              )
  (vl-load-com)

  (defun *error* (msg)
    (if olayst
      (vla-put-lock objlay olayst)
    )     ; end if
    (vla-endundomark actdoc)
    (princ)
  )

  (defun getboundingcenter (vlaobj / blpt trpt cnpt)
    (vla-getboundingbox vlaobj 'minpt 'maxpt)
    (setq blpt (vlax-safearray->list minpt)
          trpt (vlax-safearray->list maxpt)
          cnpt (vlax-3d-point
                 (list
                   (+ (car blpt) (/ (- (car trpt) (car blpt)) 2))
                   (+ (cadr blpt) (/ (- (cadr trpt) (cadr blpt)) 2))
                   0.0
                 )
               )
    )
  )

  (defun sel-mtxt-rpl (/ mtext_filtered_sset mtext_sset pattern)
    (setq pattern             (getpropertyvalue (car (entsel "\nОбразец МТекста для фильтрации: ")) "text")
          mtext_filtered_sset (ssadd)
    )
    (if (setq mtext_sset (ssget '((0 . "mtext"))))
      (sssetfirst
        nil
        (foreach mtext
                       (vl-remove-if-not
                         '(lambda (mtext) (vl-string-search pattern (getpropertyvalue mtext "text")))
                         (vl-remove-if 'listp (mapcar 'cadr (ssnamex mtext_sset)))
                       )
          (ssadd mtext mtext_filtered_sset)
        )
      )
    )
    (princ)
  )

  (sel-mtxt-rpl)
  (if (not (setq extset (ssget "_I")))
    (progn
      (princ "\nSelect the objects to replace ")
      (setq extset (ssget))
    )     ; end progn
  )       ; end if
  (if (not extset)
    (princ "\nDistination objects isn't selected!")
  )       ; end if
  (if
    (and
      extset
      (setq toobj (entsel "\nSpecify the sample object "))
    )     ; and and
     (progn
       (setq actdoc   (vla-get-activedocument (vlax-get-acad-object))
             laycol   (vla-get-layers actdoc)
             extlst   (mapcar 'vlax-ename->vla-object
                              (vl-remove-if
                                'listp
                                (mapcar 'cadr (ssnamex extset))
                              )
                      )
             vlaobj   (vlax-ename->vla-object (car toobj))
             objlay   (vla-item laycol
                                (vla-get-layer vlaobj)
                      )
             olayst   (vla-get-lock objlay)
             fromcen  (getboundingcenter vlaobj)
             errcount 0
             okcount  0
       )  ; end setq
       (vla-startundomark actdoc)
       (foreach obj extlst
         (setq tocen (getboundingcenter obj)
               sclay (vla-item laycol
                               (vla-get-layer obj)
                     )
         ) ;end setq
         (if (/= :vlax-true (vla-get-lock sclay))
           (progn
             (setq curlay (vla-get-layer obj))
             (vla-put-lock objlay :vlax-false)
             (setq copobj (vla-copy vlaobj))
             (vla-move copobj fromcen tocen)
             (vla-put-layer copobj curlay)
             (vla-put-lock objlay olayst)
             (vla-delete obj)
             (setq okcount (1+ okcount))
           ) ; end progn
           (setq errcount (1+ errcount))
         ) ; end if
       )  ; end foreach
       (princ
         (strcat "\n"
                 (itoa okcount)
                 " were changed. "
                 (if (/= 0 errcount)
                   (strcat (itoa errcount) " were on locked layer! ")
                   ""
                 ) ; end if
         ) ; end strcat
       )  ; end princ
       (vla-endundomark actdoc)
     )    ; end progn
     (princ "\nSource object isn't selected! ")
  )       ; end if
  (princ)
)

----- добавлено через 52 сек. -----
Пока бегал по делам, опередили )

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Если честно, я как-то не очень понимаю логику, по которой вся эта связка должна работать. Но вот, как вариант

Алексей, спасибо! И этот код работает! Только просит выбрать объекты вот таким текстом:
Ia?acao IOaenoa aey oeeuo?aoee:
Он и в коде такой почему-то... строка 028 (заменить на: Образец МТекста для фильтрации
Если можно я выложу эти коды в готовые программы, думаю многим будет полезен...

[name02]

Сообщение от Ingpro Если можно я выложу эти коды в готовые программы, думаю многим будет полезен...

Быть может и полезен, только все-таки твою программу надо доработать:
1 Сделать по-русски поясняющие надписи во время работы команды
2 Многие переменные у тебя не объявлены локально - замусоривают память компьютера. Плюс теоретически имена переменных могут совпадать с переменными других программ - что может вызвать ошибки работы

Поправь, не поленись, доведи до ума!

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

Исправил. Постоянно забываю про особенности копирования кода из VLIDE...

[Ingpro]

Сообщение от name02 Быть может и полезен, только все-таки твою программу надо доработать: 1 Сделать по-русски поясняющие надписи во время работы команды 2 Многие переменные у тебя не объявлены локально - замусоривают память компьютера. Плюс теоретически имена переменных могут совпадать с переменными других программ - что может вызвать ошибки работы

...поясняющие надписи по-русски я сделаю, с переменными могу запутаться...

[name02]

Про переменные посмотри тут https://storage.piter.com/upload/new...00467/ch33.pdf pdf-страница номер 10 (описание функции defun).
Если кратко - то все что пишется в скобках после defun - локальные переменные, до знака "/" - аргументы функции (входные переменные), а после знака "/" - переменные используемые во время работы функции. И те и другие "живут" только во время выполнения кода функции

[Ingpro]

Сообщение от name02 Про переменные посмотри тут https://storage.piter.com/upload/new...00467/ch33.pdf pdf-страница номер 10 (описание функции defun).

Спасибо, попробую разобраться...

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

Я бы всерьез задумался о следующем:
1. Обработка ошибок, особенно для варианта запроса чего бы то ни было у пользователя
2. Практически полная переделка логики: какой смысл запрашивать по 100500 наборы, когда можно в лучшем случае обойтись одним?
3. Про области видимости и доступность переменных / локальных функций уже сказали.

[Ingpro]

Сообщение от name02 после знака "/" - переменные используемые во время работы функции

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

Код:

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

 (defun c:repl1 (/ sel-mtxt-rpl actdoc copobj errcount extlst extset fromcen laycol maxpt curlay minpt objlay okcount olayst sclay tocen toobj vlaobj *error*)

(defun sel-mtxt-rpl (/ mtext_filtered_sset mtext_sset pattern)

А локальные создаются с помощью setq?

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

https://autolisp.ru/2011/06/08/funct...bility-region/ :?:

[Ingpro]

Сообщение от name02 Если кратко - то все что пишется в скобках после defun - локальные переменные, до знака "/" - аргументы функции (входные переменные), а после знака "/" - переменные используемые во время работы функции.

Во многих лисп переменные (все?) записываются после ( / ...), варианты до знака "/" мне не встречались...
Например:

Код:

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

 (defun c:ctan ( / *error* grcircle grarc grgetpoint an1 an2 cn1 cn2 di1 di2 ocs rd1 rd2 tmp )

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

Переменные - да. Параметры вызова - до.

[name02]

Это ты просто не видел

До знака "/" записываются аргументы функции - т.е. какие-то данные (числа, строки, объекты и т.п.) что будет использоваться для вычисления итогового значения функции

Код:

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

 (defun summ (a1 a2 / )
   (+ a1 a2)
)

Загрузи в автокад этот лисп. Теперь, чтобы найти сумму двух чисел в командной строке набери (summ 4 5)

[===AAA===]

А те, которые нигде не объявляются - "глобальные"

Код:

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

 (defun summ (a1 a2 / )
  (setq a3 (* a1 a2))
  (+ a1 a2)
)

Здесь это будет а3.

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

(princ a3)

Вернее:

а) В любой момент в текущем сеансе
б) Пока её кто-нибудь не затрёт, забыв объявить в своей функции a3,
как локальную переменную.

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

Сообщение от ===AAA=== В любой момент в текущем сеансе

Только не в ACAD.

[===AAA===]

Ну хорошо, пусть будет "в текущем сеансе для текущего открытого чертежа".
:-)

[Ingpro]

Сообщение от name02 До знака "/" записываются аргументы функции - т.е. какие-то данные (числа, строки, объекты и т.п.) что будет использоваться для вычисления итогового значения функции

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

[koMon]

Сообщение от Ingpro (princ "\nDistination objects isn't selected!")

н/з
(princ "\nDestination objects aren't selected!")

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

Сообщение от Ingpro В моем примере ничего же не вычисляется, просто происходит выделение и замена

А переменные создаются.
На всякий случай пара ссылок (сам пользовался постоянно, да и сейчас юзаю, если приходится в VLIDE возвращаться): https://autolisp.ru/2009/09/10/vlide-misc-01/ ; https://autolisp.ru/2009/09/12/vlide-misc-02/

[Gretech89]

Здравствуйте! Объясните, пожалуйста, логику скрипта.

Так скрипт удаляет полилинии длиной <500:

Код:

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

   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (mapcar
    'vla-delete
    (mapcar
      'vlax-ename->vla-object
      (vl-remove-if
        '(lambda (x)
           (if (> (vla-get-length (vlax-ename->vla-object x)) 500)
             x
           ) ;_ end of if
         ) ;_ end of lambda
        (mapcar 'cadr
                (ssnamex (ssget "_x" '((0 . "LWPOLYLINE"))))
        ) ;_ end of mapcar
      ) ;_ end of vl-remove-if
    ) ;_ end of mapcar
  ) ;_ end of mapcar
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)

Почему он не удаляет все полилинии, если убрать условие?

Код:

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

   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (mapcar
    'vla-delete
    (mapcar
      'vlax-ename->vla-object
      (vl-remove-if
        '(lambda (x)
             x
         ) ;_ end of lambda
        (mapcar 'cadr
                (ssnamex (ssget "_x" '((0 . "LWPOLYLINE"))))
        ) ;_ end of mapcar
      ) ;_ end of vl-remove-if
    ) ;_ end of mapcar
  ) ;_ end of mapcar
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)

Почему необходимо дописать вместо "x" "(entdel x)" и правильно ли это?

Код:

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

   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
  (mapcar
    'vla-delete
    (mapcar
      'vlax-ename->vla-object
      (vl-remove-if
        '(lambda (x)
         (entdel x)
         ) ;_ end of lambda
        (mapcar 'cadr
                (ssnamex (ssget "_x" '((0 . "LWPOLYLINE"))))
        ) ;_ end of mapcar
      ) ;_ end of vl-remove-if
    ) ;_ end of mapcar
  ) ;_ end of mapcar
  (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)

[name02]

потому что функция (vl-remove-if) удаляет из списка все элементы, для которых результат функции '(lambda (x)) будет ложным (равно nil)
В первом варианте в (lambda (x)) возвращается сам элемент если его длина более 500 и nil в противном случае

Во втором варианте у тебя для всех элементов результатом будет элемент списка (не nil), поэтому удаления из исходного списка не происходит

В последнем варианте у тебя при прохождении по каждому элементу списка выполняется действие (entdel x) - т.е. удаляется элемент

Если надо сформировать набор из НЕполилиний, то ssget надо написать так:
(ssget "_X" '((-4 . "<NOT")(0 . "LWPOLYLINE")(-4 . "NOT>")))

Подробнее про фильтры тут

[Gretech89]

name02, благодарю. Стало кристально понятно

[Ingpro]

Хочу просто выбрать полилинию и вставить площадь в кв. м (с коэф. 0.000001) в указанную точку на чертеже, и чтобы текст был подчеркнутый (%%u), но не знаю, как это сделать правильно. Знаю, есть много лиспов для площадей с полями и вставкой в таблицу, но мне это не надо... Где и как в коде прописать коэф. 0.000001 и подчеркивание %%u, подскажите, плз, и точка вставки не работает... В ком. строке пишет:
Команда: AR-OBJ
Укажите точку вставки текста:Ошибка приложения: В команду послан неверный тип
Выберите объекты:
Площадь = 23336443.43, Периметр = 19566.58

Код:

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

 (defun c:AR-OBJ ()
(vl-load-com)
(vl-cmdf "_AREA" "_Object")

;TEXT
(setq txt (entmakex
(list
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
(cons 100 "AcDbText")
(cons 72 0) ; выравнивание влево
(cons 10 '(0 0 0))
(cons 11 '(0 0 0))
(cons 40 250) ;Высота текста
) 
) 
)
;copybase/pasteclip
(setvar "cmdecho" 0)
(princ "\n Укажите точку вставки текста:")
(vl-cmdf "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_none" pause)

(setvar "CMDECHO" 1)
(princ)
)

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

1. У тебя нет получения площади.
2. txt не создается, поскольку там не задана строка
3. Возможный вариант кода (без проверок):

Код:

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

 (vl-load-com)
(defun c:ar-obj (/ adoc ent point) 
  (if 
    (and 
      (= 
        (type 
          (setq ent (vl-catch-all-apply 
                      (function 
                        (lambda () 
                          (car (entsel "\nSelect polyline <Cancel> : "))
                        )
                      )
                    )
          )
        )
        'ename
      )
      (setq ent (vlax-ename->vla-object ent))
      (vlax-property-available-p ent 'area)
      (= 
        (type 
          (setq point (vl-catch-all-apply 
                        (function 
                          (lambda () 
                            (getpoint "\nInsertion point <Cancel> : ")
                          )
                        )
                      )
          )
        )
        'list
      )
      point
    )
    (progn 
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (entmakex 
        (list 
          '(0 . "TEXT")
          '(100 . "AbDbEntity")
          '(100 . "AcDbText")
          '(72 . 0)
          (cons 10 point)
          (cons 11 point)
          '(40 . 250)
          (cons 1 (strcat "%%u" (rtos (* (vla-get-area (vlax-ename->vla-object ent)) 1e-6)) 2 14))
        )
      )
      (vla-endundomark adoc)
    )
  )
  (princ)
)

[Ingpro]

Сообщение от Кулик Алексей aka kpblc 1. У тебя нет получения площади. 2. txt не создается, поскольку там не задана строка 3. Возможный вариант кода (без проверок):

Алексей спасибо, но текст не вставляется:
Select polyline <Cancel> :
Insertion point <Cancel> : ; ошибка: неверный тип аргумента: lentityp #<VLA-OBJECT IAcadLWPolyline 0000000045fac808>

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

В 46 строке убери преобразование в vla-объект, я его по запарке повторно воткнул

----- добавлено через ~1 мин. -----
У меня ощущение, что ты код не проверял и в VLIDE его не смотрел

[Ingpro]

Сообщение от Кулик Алексей aka kpblc В 46 строке убери преобразование в vla-объект, я его по запарке повторно воткнул

Чё-то не получается... А что именно убрать? I do not understand...
(cons 1 (strcat "%%u" (rtos (* (vla-get-area) 1e-6)) 2 14))
; ошибка: слишком мало аргументов

(cons 1 (strcat "%%u" (rtos (* (vlax-ename->vla-object ent) 1e-6)) 2 14))
; ошибка: неверный тип аргумента: lentityp #<VLA-OBJECT IAcadLWPolyline 000000005856adc8>

(cons 1 (strcat "%%u" (rtos (* (vla-get-area (vlax-ename)) 1e-6)) 2 14))
; ошибка: no function definition: VLAX-ENAME

[name02]

В 46 строку запиши:

(cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6)) 2 14))

[Ingpro]

Сообщение от name02 В 46 строку запиши: (cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6)) 2 14))

; ошибка: неверный тип аргумента: stringp 2

[name02]

Напутаны скобки, надо вот так:

(cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6) 2 14)))

[Ingpro]

Сообщение от name02 Напутаны скобки, надо вот так: (cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6) 2 14)))

Спасибо, name02, теперь получилось, уберу 14 зн. после зпт
(cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6) 2 2)))
и будет отлично

[Ingpro]

Код Алексея aka kpblc из поста #4813 с исправленной 46 строкой
Проставляет площадь выбранной полилинии (текст подчеркнутый)
Если не нужен подчеркнутый текст, то 46 (здесь уже 49) строка

Код:

[Выделить все]

 (cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6) 2 2)))

выглядит немного по-другому:

Код:

[Выделить все]

 (cons 1 (rtos (* (vla-get-area ent) 1e-6) 2 2))

Код:

[Выделить все]

 ;; Проставляет площадь полилинии в указанную точку, текст подчеркнутый
;; https://forum.dwg.ru/showthread.php?p=2084327#post2084327
;; Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу) - Страница 241
 (vl-load-com)
(defun c:area-underl-txt (/ adoc ent point) 
  (if 
    (and 
      (= 
        (type 
          (setq ent (vl-catch-all-apply 
                      (function 
                        (lambda () 
                          (car (entsel "\nSelect polyline <Cancel> : "))
                        )
                      )
                    )
          )
        )
        'ename
      )
      (setq ent (vlax-ename->vla-object ent))
      (vlax-property-available-p ent 'area)
      (= 
        (type 
          (setq point (vl-catch-all-apply 
                        (function 
                          (lambda () 
                            (getpoint "\nInsertion point <Cancel> : ")
                          )
                        )
                      )
          )
        )
        'list
      )
      point
    )
    (progn 
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (entmakex 
        (list 
          '(0 . "TEXT")
          '(100 . "AbDbEntity")
          '(100 . "AcDbText")
          '(72 . 0)
          (cons 10 point)
          (cons 11 point)
          '(40 . 250) ; высота текста 250 (замените, если надо другую)
         (cons 1 (strcat "%%u" (rtos (* (vla-get-area ent) 1e-6) 2 2)))
        )
      )
      (vla-endundomark adoc)
    )
  )
  (princ)
)

Иногда слетает ПСК, и точка вставки текста сдвигается относительно указанной точки,
правильно ли будет добавить в код

Код:

[Выделить все]

 (vl-cmdf "_.ucs" "_w")

?

[Кулик Алексей aka kpblc]

entmake / entmakex, насколько я помню, создают примитивы в текущей ПСК. А вот получение точек - тут плаваю, могут быть варианты.

[Ingpro]

Этот код проставляет площадь как бы в кв. футах 15,959,526 S.F. Но в кв. м это = 15.96 кв.м, т.е. эти цифры "похожи".
Реально 15.96 кв.м.= 171,79 кв. футов. И какой-то странный формат с двумя запятыми 15,959,526 S.F....
Но 1 кв. фут = 10,76 кв. м.
Единицы чертежа у меня - миллиметры.
Подскажите чайнику, плз, какая строка в коде отвечает за единицы площади?
Как изменить квадратные футы на кв. метры?

Код:

[Выделить все]

 ;; простановка площадей выбранных закрытых зон в квадратных футах (цикл)

;;;(addtext <string> <point> <real>)
(defun addtext (textstring insertionpoint height / aa)
 (vl-load-com)
 (setq aa (vla-get-activedocument (vlax-get-acad-object)))
 (vla-addtext
 (if (= 1 (vla-get-activespace aa))
 (vla-get-modelspace aa)
 (if (= (vla-get-mspace aa) :vlax-true)
 (vla-get-modelspace aa)
 (vla-get-paperspace aa)
 )
 )
 textstring
 (vlax-3d-point insertionpoint)
 height)
 )

(defun add-comma (txt / strl cont1 lth cont txt1)
 (setq strl (strlen txt)
 cont1 1
 txt1 "")
 (while (and (/= (substr txt cont1 1) ".") (<= cont1 strl))
 (setq cont1 (1+ cont1)))
 (setq lth (1- cont1)
 cont1 1
 cont (1- lth))
 (if (> lth 3)
 (progn
 (while (< cont1 lth)
 (setq let (substr txt cont1 1)
 txt1 (strcat txt1 let))
 (if (and (zerop (rem cont 3)) (eq (type (read let)) 'INT))
 (setq txt1 (strcat txt1 ",")))
 (setq cont (1- cont)
 cont1 (1+ cont1)))
 (while (<= cont1 strl)
 (setq txt1 (strcat txt1 (substr txt cont1 1))
 cont1 (1+ cont1)))
 txt1)
 txt))

(defun get-last-coord (obj / coords last_coord)
 (setq coords (vla-get-coordinates obj)
 coords (vlax-safearray->list (vlax-variant-value coords))
 coords (reverse coords)
 last_coord (list (cadr coords)(car coords)
 )
 )
 last_coord
 )

(defun C:put-area (/ ent vla_obj pt objname vla_text aa)
 (while (setq ent (entsel "\nSelect closed object: "))
 (setq vla_obj (vlax-ename->vla-object (car ent))
 objname (vla-get-objectname vla_obj))
 (if
 (vlax-property-available-p vla_obj 'area)
 (progn
 (if
 (or
 (= "AcDbCircle" objname)
 (and (wcmatch (vla-get-objectname vla_obj) "*Polyline")
 (or (= :vlax-true (vla-get-closed vla_obj))
 (equal (vlax-safearray->list
 (vlax-variant-value
 (vla-get-coordinate vla_obj '0)))
 (get-last-coord vla_obj)
 0.001)
 )
 )
 )
 (progn
 (if (setq pt (getpoint "\nPick text placement: "))
 (progn
 (setq vla_text
 (addtext
 (strcat
 (add-comma
 (rtos
 (vla-get-area vla_obj)
 2
 0))
 " S.F.")
 pt
 (getvar "textsize")))

 ;; alignment to left
 (vla-put-alignment vla_text acAlignmentCenter)

 (vla-put-textalignmentpoint
 vla_text
 (vlax-3d-point pt))

 ;; use current textstyle
 (vla-put-stylename
 vla_text
 (vla-get-name
 (vla-get-activetextstyle
 (setq aa (vla-get-activedocument
 (vlax-get-acad-object)))))))))
 (prompt "\nNot a closed object. ")
 ))))
 (princ))
(princ)

[name02]

Ты проверял работу программы на "эталонном" прямоугольнике (чью площадь можно самому посчитать)?
Программа считает не в футах или дюймах - она считает в просто единицах. Ты сам решаешь, что это за единицы - футы, миллиметры или метры например. В настройках автокада же указываются единицы для преобразования при вставке блоков или внешних ссылок (например генпланист рисует в метрах, а ты в миллиметрах - поэтому при вставке в твой чертеж генплан нужно увеличивать в 1000 раз). Эти настройки на замеры никак не влияют.

Программа выполняет расчет в строках 080-085 и тамже через каждые три символа ставит запятые - видимо так принято там, где работате создатель программы

[Кулик Алексей aka kpblc]

1. Форматируй код.
2. Проверяй единицы чертежа (те же _.dwgunts)

[Ingpro]

Сообщение от name02 Программа выполняет расчет в строках 080-085 и там же через каждые три символа ставит запятые - видимо так принято там, где работате создатель программы

name02, спасибо, а как можно это изменить на формат вывода в кв. м без лишних запятых?

Код:

[Выделить все]

 (rtos (vla-get-area vla_obj) 2 0)) " S.F.")

Эта строка мне понятна, но то, что выше - нет...

[Кулик Алексей aka kpblc]

Сообщение от Ingpro name02, спасибо, а как можно это изменить на формат вывода в кв. м без лишних запятых?

Запускай программу в VLIDE, ставь точки остановки и смотри значения переменных.

[name02]

За простановку запятых отвечает функция add-text - если убрать ее из формирования итоговой строки, то запятые не добавятся

[Ingpro]

Сообщение от name02 За простановку запятых отвечает функция add-text - если убрать ее из формирования итоговой строки, то запятые не добавятся

(defun add-comma (txt / strl cont1 lth cont txt1) строка 020
Если в 035-ой строке
(setq txt1 (strcat txt1 ","))) заменить на ".", получается 15.959.526, а надо 15.96

[name02]

Сообщение от Ingpro А где ставить точки остановки?

Почитай тут https://acad-prog.ru/vlisp/

Сообщение от Ingpro Нужно ли add-comma заменить на add-point

Не туда смотришь - 80-ю строчку стирай, а в 84-й - удаляй одну скобку

[Ingpro]

Сообщение от name02 Не туда смотришь - 80-ю строчку стирай, а в 84-й - удаляй одну скобку

Если так сделать, то число 15959526 в мм, а не в м

[Кулик Алексей aka kpblc]

Туды жа:
https://autolisp.ru/2009/09/10/vlide-misc-01/
https://autolisp.ru/2009/09/12/vlide-misc-02/

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Туды жа: https://autolisp.ru/2009/09/10/vlide-misc-01/ https://autolisp.ru/2009/09/12/vlide-misc-02/

Но там же не про перевод мм в м...

[name02]

Ты читал мое сообщение ?
Ты же, блин, инженер - немного проанализируй код, подумай!

Даю подсказку - строка 082

[Ingpro]

Сообщение от name02 Ты читал мое сообщение ? Ты же, блин, инженер - немного проанализируй код, подумай! Даю подсказку - строка 082

Код:

[Выделить все]

 С этой строчкой получилось:
(rtos (* (vla-get-area vla_obj) 1e-6) 2 2))

Всем спасибо!

[Ingpro]

Есть код, который проставляет размеры прямоугольника в м и футах-дюймах:
1
3000 x 2000
9842'-6" x 6561'-8"
У меня не получается убрать строку с футами-дюймами, чтобы осталось только
1
3000 x 2000

Код:

[Выделить все]

 (defun c:RoomLabel ( /  _Imperial Roomname fc nc h v str p)
(defun _Imperial (v)
  (rtos (cvunit v "meter" "inch") 4 0))
	(while
	 (and
	   (setq Roomname (getstring t "\nEnter room name: "))
	   (setq fc (getpoint "\nPick first corner"))
	   (null (initget 32))
	   (setq nc (getcorner fc "\nPick Next corner"))
	   )
	(setq h (abs (- (car fc)(car nc)))
	      v (abs (- (cadr fc)(cadr nc))))
	(setq str (strcat  (strcase Roomname) "\\P"
			   (rtos h 2 2) " x " (rtos v 2 2) "\\P"
			   (_Imperial h) " x " (_Imperial v)))
	(setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
	(entmakex (list (cons 0 "MTEXT")
			  (cons 100 "AcDbEntity")
			  (cons 100 "AcDbMText")
			  (cons 10 (trans p 1 0))
			  (cons 1 str)
			  (cons 41 (- (car p)(car p)))	
			  (cons 71 5)
			  (cons 72 5)
			  (cons 73 1)
			  (cons 7 (getvar 'TextStyle))
				    )
			  )
	    )
  (princ)
  )

Я пробую закомментировать некоторые строки, но AutoCAD выдает ошибку

; ошибка: неверно сформированный список на входе

Код:

[Выделить все]

 (defun c:RoomLabel ( / Roomname fc nc h v str p)
;(defun c:RoomLabel ( /  _Imperial Roomname fc nc h v str p)
;(defun _Imperial (v)
 ; (rtos (cvunit v "meter" "inch") 4 0))
	(while
	 (and
	   (setq Roomname (getstring t "\nEnter room name: "))
	   (setq fc (getpoint "\nPick first corner"))
	   (null (initget 32))
	   (setq nc (getcorner fc "\nPick Next corner"))
	   )
	(setq h (abs (- (car fc)(car nc)))
	      v (abs (- (cadr fc)(cadr nc))))
	(setq str (strcat  (strcase Roomname) "\\P"
			   (rtos h 2 2) " x " (rtos v 2 2) "\\P"
			 ; (_Imperial h) " x " (_Imperial v)))
...........................

[Кулик Алексей aka kpblc]

Потому что код крайне желательно хоть как-то форматировать. Тогда его читать становится кратно проще:

Код:

[Выделить все]

 (defun c:RoomLabel (/ _Imperial Roomname fc nc h v str p) 
  (defun _Imperial (v) 
    (rtos (cvunit v "meter" "inch") 4 0)
  )
  (while 
    (and 
      (setq Roomname (getstring t "\nEnter room name: "))
      (setq fc (getpoint "\nPick first corner"))
      (null (initget 32))
      (setq nc (getcorner fc "\nPick Next corner"))
    )
    (setq h (abs (- (car fc) (car nc)))
          v (abs (- (cadr fc) (cadr nc)))
    )
    (setq str (strcat (strcase Roomname) 
                      "\\P"
                      (rtos h 2 2)
                      " x "
                      (rtos v 2 2)
                      "\\P"
                      (_Imperial h)
                      " x "
                      (_Imperial v)
              )
    )
    (setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
    (entmakex 
      (list (cons 0 "MTEXT") 
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans p 1 0))
            (cons 1 str)
            (cons 41 (- (car p) (car p)))
            (cons 71 5)
            (cons 72 5)
            (cons 73 1)
            (cons 7 (getvar 'TextStyle))
      )
    )
  )
  (princ)
)

И тут же становится видно, что, где и как комментировать:

Код:

[Выделить все]

 (defun c:RoomLabel (/ _Imperial Roomname fc nc h v str p) 
  ;(defun _Imperial (v)
  ;  (rtos (cvunit v "meter" "inch") 4 0)
  ;)
  (while 
    (and 
      (setq Roomname (getstring t "\nEnter room name: "))
      (setq fc (getpoint "\nPick first corner"))
      (null (initget 32))
      (setq nc (getcorner fc "\nPick Next corner"))
    )
    (setq h (abs (- (car fc) (car nc)))
          v (abs (- (cadr fc) (cadr nc)))
    )
    (setq str (strcat (strcase Roomname) 
                      "\\P"
                      (rtos h 2 2)
                      " x "
                      (rtos v 2 2)
                      ;  "\\P"
                      ;  (_Imperial h)
                      ;  " x "
                      ;  (_Imperial v)
              )
    )
    (setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
    (entmakex 
      (list (cons 0 "MTEXT") 
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans p 1 0))
            (cons 1 str)
            (cons 41 (- (car p) (car p)))
            (cons 71 5)
            (cons 72 5)
            (cons 73 1)
            (cons 7 (getvar 'TextStyle))
      )
    )
  )
  (princ)
)

----- добавлено через 47 сек. -----
Хотя я такой код вряд ли бы выпускал в большую жизнь.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Хотя я такой код вряд ли бы выпускал в большую жизнь.

Алексей, спасибо за быструю реакцию... Футы-дюймы "ушли"...
А почему не выпускать?..

[Кулик Алексей aka kpblc]

Сообщение от Ingpro А почему не выпускать?..

Ну хотя бы потому, что отлова ошибок нет от слова совсем (попробуй в любой момент нажать Esc, порадуйся). Непонятна логика отмены, если что. По Ctrl-Z вроде бы будет откатываться создание каждого примитива, а вот надо оно так или как-то по-другому есть вопрос. (- (car p)(car p)) всегда (по идее) вернет 0 - какой смысл в вычислениях? Ну а про нейминг переменных вообще молчу )

[Ingpro]

(defun *error* (msg)
(princ (strcat "\n function error : " msg))
(princ)
) ;_ end of defun
А какую ошибку будем ловить в лиспе #4837, выход по Esc?, а как это записать?

[name02]

Сообщение от Ingpro А какую ошибку будем ловить в лиспе #4837, выход по Esc?

В русском автокаде нажатие Esc выводит сообщение "Функция прервана."
А уж что делать в случае этой ошибки сам решай - удалять все что создано с момента запуска или ничего или еще что-то

[Ingpro]

Сообщение от name02 В русском автокаде нажатие Esc выводит сообщение "Функция прервана." А уж что делать в случае этой ошибки сам решай - удалять все что создано с момента запуска или ничего или еще что-то

Если бы знал, что делать, не спрашивал бы...
Во многих программах нет отлова ошибок... потому что не все функции этого требуют? или по другим причинам?

[koMon]

потому что красивое окончание/прерывание программы практически не влияет на результат её выполнения.

[Кулик Алексей aka kpblc]

Вопрос - что будет, если пользователь на запрос имени комнаты нажмет Esc? Или при запросе точки?
ИМХО код условия в while должен быть наподобие

Код:

[Выделить все]

 and 
 (= 
   (type 
     (setq Roomname (vl-catch-all-apply 
                      (function 
                        (lambda () 
                          (getstring t "\nEnter room name: ")
                        )
                      )
                    )
     )
   )
   'str
 )
 (/= roomname "")
 (= 
   (type 
     (setq fc (vl-catch-all-apply 
                (function 
                  (lambda () 
                    (getpoint "\nFirst point <Cancel> : ")
                  )
                )
              )
     )
   )
   'list
 )
 fc
 (= 
   (type 
     (setq nc (vl-catch-all-apply 
                (function 
                  (lambda () 
                    (initget 32)
                    (getcorner fc "\nPick Next corner")
                  )
                )
              )
     )
   )
   'list
 )
 nc
    )

Код не проверял, если что

[Ingpro]

Сообщение от koMon потому что красивое окончание/прерывание программы практически не влияет на результат её выполнения.

Т.е. чисто визуальная красота и никакого сбоя программы?

----- добавлено через ~13 мин. -----

Сообщение от Кулик Алексей aka kpblc Вопрос - что будет, если пользователь на запрос имени комнаты нажмет Esc? Или при запросе точки? ИМХО код условия в while должен быть наподобие

Код работает, но пишет в ком. строке:
Enter room name: *Прервано*
First point <Cancel> : *Прервано*
; ошибка: неверный тип аргумента: consp #<%catch-all-apply-error%>

Код:

[Выделить все]

  (defun c:RoomLabel3 (/  Roomname fc nc h v str p) 
  (while 
   (and 
(= 
  (type 
    (setq Roomname (vl-catch-all-apply 
                     (function 
                       (lambda () 
                         (getstring t "\nEnter room name: ")
                       )
                     )
                   )
    )
  )
  'str
)
(/= roomname "")
(= 
  (type 
    (setq fc (vl-catch-all-apply 
               (function 
                 (lambda () 
                   (getpoint "\nFirst point <Cancel> : ")
                 )
               )
             )
    )
  )
  'list
)
fc
(= 
  (type 
    (setq nc (vl-catch-all-apply 
               (function 
                 (lambda () 
                   (initget 32)
                   (getcorner fc "\nPick Next corner")
                 )
               )
             )
    )
  )
  'list
    )
nc
)

    (setq h (abs (- (car fc) (car nc)))
          v (abs (- (cadr fc) (cadr nc)))
    )
    (setq str (strcat (strcase Roomname) 
                      "\\P"
                      (rtos h 2 2)
                      " x "
                      (rtos v 2 2)
                                    )
    )
    (setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
    (entmakex 
      (list (cons 0 "MTEXT") 
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans p 1 0))
            (cons 1 str)
            (cons 41 (- (car p) (car p)))
            (cons 71 5)
            (cons 72 5)
            (cons 73 1)
            (cons 7 (getvar 'TextStyle))
      )
    )
  )
  (princ)
)

че-то по Esc не выходит вообще, приходится принудительно выключать AutoCad...

[Кулик Алексей aka kpblc]

А нечего просто копировать код ) Скобку перед and Пушкин ставить будет?

[Ingpro]

Сообщение от Кулик Алексей aka kpblc А нечего просто копировать код ) Скобку перед and Пушкин ставить будет?

Скобку Пушкин поставил, код #4845 исправил
(while
( and
......
теперь в ком. строке:
Enter room name: *Прервано*
Это красиво?

[Кулик Алексей aka kpblc]

Вот только не надо - ты зачем строку 16 закомментировал?

----- добавлено через ~3 мин. -----
Скопируй свой код в VLIDE и там проверяй, где какая конструкция начинается и заканчивается.

[koMon]

Сообщение от Ingpro Т.е. чисто визуальная красота и никакого сбоя программы?

не, ну если начать нажимать что попало, например esc посерёд программы, то это естественно вызовет аварийное завершение, которое сбоем назвать можно с натяжкой. а если обходится без предыдущего, то вполне себе да)

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Вот только не надо - ты зачем строку 16 закомментировал?

Да это не надо, AutoCad писал про лишнюю скобку, но сейчас нормально...
А *error* добавлять? Где про это почитать?..

[Кулик Алексей aka kpblc]

https://autolisp.ru/2009/09/13/error-catch/

[Ingpro]

Сообщение от Кулик Алексей aka kpblc https://autolisp.ru/2009/09/13/error-catch/

Я там был, но...
"Что и где применять - в принципе, каждый решает сам..."
В каких конкретно функциях применять

Код:

[Выделить все]

 (defun *error* (msg)
      (princ (strcat "\n fun_func-2 error : " msg))
      (princ)
      ) ;_ end of defun

Вместо fun_func-2 нужно ставить что-то другое?

[Кулик Алексей aka kpblc]

Лично я предпочитаю *error* не трогать.

[Ingpro]

В данном случае можно применить такую комбинацию с *error*: ???

Код:

[Выделить все]

  (defun c:RoomLabel-err (/  *error* Roomname fc nc h v str p) 
(defun *error* (msg)
 (if (not
  (member msg '("Function cancelled" "quit / exit abort"))
  )
  (princ msg)
 )
)
  (while 
    (and 
      (setq Roomname (getstring t "\nEnter room name: "))
      (setq fc (getpoint "\nPick first corner"))
      (null (initget 32))
      (setq nc (getcorner fc "\nPick Next corner"))
    )
    (setq h (abs (- (car fc) (car nc)))
          v (abs (- (cadr fc) (cadr nc)))
    )
    (setq str (strcat (strcase Roomname) 
                      "\\P"
                      (rtos h 2 2)
                      " x "
                      (rtos v 2 2)
                                )
    )
    (setq p (mapcar (function (lambda (a b) (/ (+ a b) 2.))) fc nc))
    (entmakex 
      (list (cons 0 "MTEXT") 
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbMText")
            (cons 10 (trans p 1 0))
            (cons 1 str)
            (cons 41 (- (car p) (car p)))
            (cons 71 5)
            (cons 72 5)
            (cons 73 1)
            (cons 7 (getvar 'TextStyle))
      )
    )
  )
  (princ)
)

в ком. строке после Esc:
Enter room name: *Прервано*
Функция отменена
Prettily?

[Ingpro]

Я хочу выбрать рамкой отдельные тексты и преобразовать в отдельные мтексты.
Express-команда TXT2MTX объединяет выбранные тексты в один мтекст.
Если просто набрать в комстроке TXT2MTX (или _.txt2mtx) это работает.

Код:

[Выделить все]

 (defun c:t2mt ( / ss i )
(vl-load-com)
		(setq ss (ssget '((0 . "TEXT"))) i -1)
		(while (< (setq i (1+ i)) (sslength ss))
		 (vl-cmdf "_.txt2mtx" (ssname ss i) "")
	)
		(princ)
)

Почему-то не узнается команда
Неизвестная команда "TXT2MTX".
<имя объекта: FF824700>
Как можно исправить, плз?

[Кулик Алексей aka kpblc]

Попробуй использовать handent

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Попробуй использовать handent

А это куда?

[Кулик Алексей aka kpblc]

(ssname ss i)
преобразуется в (handent (cdr(assoc 5 (entget (ssname ss i)))))
Как-то так примерно

[Ingpro]

Сообщение от Кулик Алексей aka kpblc (ssname ss i) преобразуется в (handent (cdr(assoc 5 (entget (ssname ss i)))))

Код:

[Выделить все]

 (defun c:t2mt ( / ss i )
(vl-load-com)
		(setq ss (ssget '((0 . "TEXT"))) i -1)
		(while (< (setq i (1+ i)) (sslength ss))
		 ;(vl-cmdf "_.txt2mtxt" (ssname ss i) "")
(vl-cmdf "_.txt2mtxt" (handent (cdr(assoc 5 (entget (ssname ss i))))) "")
	)
		(princ)
)

Неизвестная команда "TXT2MTX".
<имя объекта: FF824860>

[Кулик Алексей aka kpblc]

Ты со скобками в строке 6 не ошибся?

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Ты со скобками в строке 6 не ошибся?

6 откр. и 6 закр.???

[Кулик Алексей aka kpblc]

Изначально перед handent стояло 2 скобки.

[koMon]

Сообщение от Ingpro Express-команда TXT2MTX

если это express-команда, и снова автокад 2015, то я думаю её нельзя вызвать функциями command*. нужно попробовать вариант что-то типа (c:txt2mtxt (ssname ss i))...

[Ingpro]

Сообщение от koMon если это express-команда, и снова автокад 2015, то я думаю её нельзя вызвать функциями command*. нужно попробовать вариант что-то типа (c:txt2mtxt (ssname ss i))...

Спаcибо, но ошибка была в txt2mtxt (не хватало последней t)...

Код:

[Выделить все]

 (defun c:t2mt3 ( / ss i )
(vl-load-com)
		(setq ss (ssget '((0 . "TEXT"))) i -1)
		(while (< (setq i (1+ i)) (sslength ss))
		(vl-cmdf "_.txt2mtxt" (handent (cdr(assoc 5 (entget (ssname ss i))))) "")
	)
		(princ)
)

И с этой строкой (вместо 5-й) тоже работает код

Код:

[Выделить все]

 (vl-cmdf "_.txt2mtxt" (ssname ss i) "")

[name02]

Немного улучшил-упростил для использования:
- добавил обработку пустого набора
- убрал ненужные выводы в командную строку и сообщение об ошибке
- добавил отмену - Ctrl+Z вернет все в исходное состояние

Код:

[Выделить все]

 (defun c:t2mt3 (/ ss i old_sett doc *error* )
  (vl-load-com)

  (defun *error* (msg)
    (princ)
  ) ;_ end defun

  (setq ss       (ssget '((0 . "TEXT")))
        old_sett (getvar 'CMDECHO)
        doc      (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end setq

  (vla-StartUndoMark doc)

  (setvar 'CMDECHO 0)

  (if ss
    (repeat (setq i (sslength ss))
      (vl-cmdf "_.txt2mtxt" (ssname ss (setq i (1- i))) "")
    ) ;_ end repeat
  ) ;_ end if

  (setvar 'CMDECHO old_sett)

  (vla-EndUndoMark doc)

  (princ)
) ;_ end defun

Теперь, надеюсь, будет приятнее работать!

[Ingpro]

Сообщение от name02 Немного улучшил-упростил для использования: - добавил обработку пустого набора - убрал ненужные выводы в командную строку и сообщение об ошибке - добавил отмену - Ctrl+Z вернет все в исходное состояние

name02
спасибо большое, теперь полноценный код, возврат к предыдущему состоянию сразу для всех текстов, а не по одному...
Так намного удобнее!

[Ingpro]

Объясните, пожалуйста разницу для этих строк:

Код:

[Выделить все]

 (setq ff "C:\\Program Files\\Autodesk\\AutoCAD 2015\\Fonts\\ARIAL.ttf")

; шрифт должен быть в папке Fonts AutoCAD

Код:

[Выделить все]

 (setq ff (strcat (getenv "WINDIR") "\\FONTS\\ARIAL.ttf"))

; (здесь версия автокада не указывается?)
должен ли быть шрифт в папке Fonts AutoCAD? или достаточно, чтобы он лежал в папке Windows?

[koMon]

складывать шрифты не *. shx в папку fonts автокада это просто какой-то бред, потому как они поддерживаются автокадом на системном уровне.

[Ingpro]

Сообщение от koMon складывать шрифты не *. shx в папку fonts автокада это просто какой-то бред, потому как они поддерживаются автокадом на системном уровне.

Значит эту строку лучше не использовать? Или только для .shx?

Код:

[Выделить все]

 (setq ff "C:\\Program Files\\Autodesk\\AutoCAD 2015\\Fonts\\ARIAL.ttf")

[Кулик Алексей aka kpblc]

Какова конечная цель? Потому как складывать системные ttf хрен пойми куда - так себе затея ИМХО.

----- добавлено через ~1 мин. -----
И, кстати. Начиная с какой-то версии ACAD ttf можно положить просто в каталоги поиска, фонт даже регистрировать не надо - он подхватится.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Какова конечная цель?

Просто хочу, чтобы мой стиль текста создавался при каждом открытии чертежа, у меня это получается, но нет уверенности в правильности кода...

Код:

[Выделить все]

 (defun c:create-txtst-Arl ( / *error* ss eo i ff oldcmd acadDoc)
(vl-load-com)
 (defun *error* (msg)
    (princ)
  ) ;_ end defun

(setq acadApp (vlax-get-Acad-object))
(setq acadDoc (vla-get-ActiveDocument acadApp))
(setq styles (vla-get-textstyles acadDoc))
 
(setq objStyle (vla-add styles "Arial0"))

(setq ff (strcat (getenv "WINDIR") "\\FONTS\\ARIAL.ttf"))
(vla-put-fontfile objStyle ff)

(vla-put-activetextstyle acadDoc objStyle)
(princ)
)
(c:create-txtst-Arl)

Нужно ли в этом коде делать проверку на наличие данного стиля текста?
Т. е. если я открываю чертеж, а в нём этот стиль уже есть?..

[Кулик Алексей aka kpblc]

Насколько я помню, начиная примерно с 2010 версии проверять наличие уже не надо - vla-add в таком случае получит указатель на существующий стиль / слой / ...
Но вот будет ли оно работать, если стиль уже был, но на него назначен shx шрифт - вопрос. Я б подумал на предмет применения стандартов.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Я б подумал на предмет применения стандартов.

Имеются ввиду файлы стандартов подключенных к чертежу?

[Кулик Алексей aka kpblc]

Ну да. Там, насколько я помню, можно много чего настроить

[Ingpro]

Как можно выделить все размеры только определенного стиля на всем чертеже (или выбрать рамкой) и удалить или заменить на другой стиль?
Пытаюсь выделить и удалить, но выдает ошибку:

Код:

[Выделить все]

 (defun C:sel-dimst-del ( )
 (vl-load-com)
(vl-cmdf "_.erase" (ssget (quote ((0 . "*DIMENSION" "_dimstyle" "name-dim-style")))) "")
(princ)
)

[Кулик Алексей aka kpblc]

Со скобками разберись. (ssget '((0 . "*DIMENSION"))), а не та дичь, которую ты написал )

[name02]

Сообщение от Ingpro Как можно выделить все размеры только определенного стиля на всем чертеже (или выбрать рамкой) и удалить или заменить на другой стиль?

Можно сделать так:

Код:

[Выделить все]

 (defun c:test (/ ss i a b new)

  ;; Выбор рамкой всех размеров с размерным стилем "Основной$3" (диаметры)
  (setq ss (ssget '((0 . "*DIMENSION") (3 . "Основной$3"))))

  (repeat (setq i (sslength ss))
    ;; Для удаления объектов из набора
    ;;(ssdel (ssname ss 0) ss)

    ;; Изменение размерного стиля на "Копия Основной"
    (setq a (ssname ss (setq i (1- i))))
    (setq b (entget a))
    (setq new (subst '(3 . "Копия Основной") (assoc 3 b) b))
    (entmod new)
  ) ;_ end repeat

  (princ)

) ;_ end defun

[Ingpro]

Сообщение от name02 Можно сделать так: Код: (defun c:test (/ ss i a b new) ;; Выбор рамкой всех размеров с размерным стилем "Основной$3" (диаметры) (setq ss (ssget '((0 . "*DIMENSION") (3 . "Основной$3"))))

Спасибо, размеры с указанным стилем выбирает, но копию "Копия Основной" не создает и замену не выполняет...
Если стиль "Копия Основной" создать в чертеже, то замена происходит...
Или так и надо?

[Кулик Алексей aka kpblc]

#4877

[name02]

Сообщение от Ingpro Спасибо, но при загрузке снова выдает ошибку (; ошибка: излишние cdrs в точесной паре на входе), хотя размеры с указанным стилем выбирает, но копию и замену не выполняет...

При загрузке чего - файла в документ или при вызове программы?

Насчет копии и замены - ты же сам писал вот это:

Сообщение от Ingpro Как можно выделить все размеры только определенного стиля на всем чертеже (или выбрать рамкой) и удалить или заменить на другой стиль?

Программа выделяет только размеры с определенным размерным стилем и меняет на другой.

Ты отладку программы в VLIDE делаешь или в блокноте?

[Ingpro]

Сообщение от name02 Код: [Выделить все] (setq new (subst '(3 . "Копия Основной") (assoc 3 b) b))

Эта строка не создает копию разм. стиля?

Так я могу удалить размеры с указанным стилем:

Код:

[Выделить все]

 (vl-cmdf "_.erase" (setq ss (ssget '((0 . "*DIMENSION") (3 . "name-dim-style")))) "")

Спасибо, name02

[name02]

1 Функция subst возвращает список, в котором элемент (assoc 3 b) заменен на (3 . "Копия Основной").
2 Я бы удалял объекты не командными методами - не люблю засорять командную строку. Все аккуратнее выглядит.

Ты какой справкой по лиспу пользуешься?

[Ingpro]

Сообщение от name02 Ты какой справкой по лиспу пользуешься?

В основном из интернета...

[name02]

Скачай офлайн справку https://dwg.ru/dnl/ri33 - там есть справка по всем лисповским функциям
Добавь эту справку в настройках автокада:


И тут еще поменяй:


И если ты программы пишешь в блокноте, то лучше переходи в VLIDE - там проще отслеживать и находить ошибки в коде

[Ingpro]

Сообщение от name02 Скачай офлайн справку https://dwg.ru/dnl/ri33 - там есть справка по всем лисповским функциям

Спасибо...

[Alxndr1697]

Сообщение от name02 Скачай офлайн справку https://dwg.ru/dnl/ri33 - там есть справка по всем лисповским функциям

Извиняюсь, что не по теме. Справка от 2020 должна установиться и работать на 2021?

[koMon]

оффлайн справка к автокаду 2021
Offline Help Ru
Offline Help En

[Кулик Алексей aka kpblc]

https://dwg.ru/dnl/ri33 - от 2019 по 2025

[koMon]

кроме 21

[Кулик Алексей aka kpblc]

На 2021 почему-то справки не нашлось в момент загрузки ((

[Ingpro]

Сообщение от koMon оффлайн справка к автокаду 2021 Offline Help Ru Offline Help En

А на эти ссылки вот такая реакция?.. Есть ли возможность приложить архив? Или добавить к https://dwg.ru/dnl/ri33 - от 2019 по 2025

[koMon]

там чёт заморочно с квотами
----- добавлено через ~6 мин. -----
Кулик Алексей aka kpblc,
Алексей, может загрузишь в ri33?

[Ingpro]

Сообщение от koMon там чёт заморочно с квотами AC2021 Offline Help

Так получилось, many thanks!

[Кулик Алексей aka kpblc]

Сообщение от koMon там чёт заморочно с квотами AC2021 Offline Help ----- добавлено через ~6 мин. ----- Кулик Алексей aka kpblc, Алексей, может загрузишь в ri33?

Только дома, на работе мобильный инет подобное не проглотит (((
Админ одобрил, ссылки:
_https://dwg.ru/dnl/15794
_https://dwg.ru/dnl/15795

[Alxndr1697]

Благодарю

[Ingpro]

Код:

[Выделить все]

 (command "_-layer" "_n" "IZM" "_c" "1" "IZM" "_s" "IZM" "_P" "_P" "IZM" "_s" "IZM" "")

Так создается слой с цветом 1 (при печати monochrome цвет - черный)
для цвета RAL 3024 (при печати monochrome цвет - красный) эти строки не работают:

Код:

[Выделить все]

 (command "_-layer" "_n" "IZM" "_c" "RAL 3024" "IZM" "_s" "IZM" "_P" "_P" "IZM" "_s" "IZM" "")

(command "_-layer" "_n" "IZM" "_c" "255.45.33" "IZM" "_s" "IZM" "_P" "_P" "IZM" "_s" "IZM" "")

Как можно это исправить?
В ком. строке: Требуется стандартное имя или номер цвета.

[name02]

Для задания цвета в RGB
(command "_-layer" "_n" "IZM" "_c" "_T" "255,45,33" "IZM" "_s" "IZM" "_P" "_P" "IZM" "_s" "IZM" "")

Для задания цвета прямо в RAL
(command "_-layer" "_n" "IZM" "_c" "_COL" "ral classic" "RAL 3024" "IZM" "_s" "IZM" "_P" "_P" "IZM" "_s" "IZM" "")

[Ingpro]

Сообщение от name02 Для задания цвета в RGB (command "_-layer" "_n" "IZM" "_c" "_T" "255,45,33" "IZM" "_s" "IZM" "_P" "_P" "IZM" "_s" "IZM" "") Для задания цвета прямо в RAL (command "_-layer" "_n" "IZM" "_c" "_COL" "ral classic" "RAL 3024" "IZM" "_s" "IZM" "_P" "_P" "IZM" "_s" "IZM" "")

Спасибо большое, обе строки отлично работают!

[Ingpro]

Код:

[Выделить все]

 ;; устанавливает текущим выбранный размерный стиль
(defun c:dm-sel-style (/)
 (vla-put-activedimstyle
  (vla-get-activedocument (vlax-get-acad-object)) 
  (vla-item (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object)))
            (cdr (assoc 3 (entget (car (entsel)))))
  )
 )
(princ)
)

А как установить текущим размерный стиль "_01_100", указанный в коде? please...

[koMon]

вот так, если об этом речь

Код:

[Выделить все]

 
(vla-put-activedimstyle
  (vla-get-activedocument (vlax-get-acad-object))
  (vla-item (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object)))
			"_01_100"
  )
 )

[Ingpro]

Сообщение от koMon (vla-put-activedimstyle (vla-get-activedocument (vlax-get-acad-object)) (vla-item (vla-get-dimstyles (vla-get-activedocument (vlax-get-acad-object))) "_01_100" ) )

Yes, that's what need! koMon, thanks!
А можно это сделать с помощью commаnd?
(setvar "DIMSTYLE" "_01_100"); не устанавливает!, только выводит имя текущего размерного стиля

[Кулик Алексей aka kpblc]

А зачем команда, если программно работает?

[Ingpro]

Сообщение от Кулик Алексей aka kpblc А зачем команда, если программно работает?

У меня есть лисп

Код:

[Выделить все]

 (defun C:Syst_Var ( ) ; установки System Variable 
(vl-load-com) 
(setvar "celweight" -1) 
(setvar "CELTYPE" "bylayer") 
(setvar "cecolor" "bylayer")
(setvar 'textsize 25)
............................
............................

Хотелось бы туда добавить строку в таком стиле для DIMSTYLE...
А код из поста #4900 можно добавить в чистом виде или нужны дополнительные установки?

[Кулик Алексей aka kpblc]

1. Да, можно
2. В твоем лиспе как минимум нет меток начала / конца отмены
3. Сравни свои несколько штук setvar'ов, и, к примеру:

Код:

[Выделить все]

 (foreach item 
  '(("celweight" . -1)
    ("celtype" . "ByLayer")
    ("cecolor" . "ByLayer")
    ("textsixe" . 25.)
    ("clayer" . "0")
   )
  (setvar (car item) (cdr item))
)

----- добавлено через 39 сек. -----
Если что - такое форматирование выдала VSCode + AutoLisp Extension

[Ingpro]

Сообщение от Кулик Алексей aka kpblc 2. В твоем лиспе как минимум нет меток начала / конца отмены

это не понятно...

[Кулик Алексей aka kpblc]

Сообщение от Ingpro это не понятно...

https://autolisp.ru/2009/09/20/howto_undo/

[Ingpro]

В этом коде точка вставки текста уходит в начало ПСК, а мне нужно в указанную точку, что нужно исправить, please

Код:

[Выделить все]

 (defun c:count-insert-txt-WP ()
  (setq pl (car (entsel "\nВыберите границу (полилинию): ")))
  (if pl
    (progn
      (setq points (mapcar 'cdr
                           (vl-remove-if-not
                             '(lambda (x) (= (car x) 10))
                             (entget pl)
                           )
                  )
      )
      (setq count (sslength (ssget "_wp" points)))

      (setq pt (getpoint "\nУкажите точку для вставки текста: "))

          (entmakex
        (list
         '(0 . "TEXT")                     
         (cons 10 pt)                     
         '(40 . 250.0)                     
         '(7 . "STANDARD")                 
         (cons 1 (strcat (itoa count)))    
         '(50 . 0.0)                       
         '(71 . 0)                         
         '(72 . 1)                        
         '(73 . 0)                         
        )
      )

        (prompt (strcat "\nНайдено объектов: " (itoa count)))
    )
    (prompt "\nНе выбрана полилиния.")
  )
  (princ)
)

или можно как-то поэлегантнее с vla?

[Кулик Алексей aka kpblc]

DXF Reference + https://autolisp.ru/2010/04/06/text-...trib-entities/

[Ingpro]

Чё-то не улавливаю суть, с точкой вставки в указанную точку?..
dxf text 10 First alignment point (in OCS) DXF: X value; APP: 3D point
надо изменить эту строку (cons 10 pt)?
или добавить (cons 11 ...), а чего туда писать?

[koMon]

(entmakex
(list
'(0 . "TEXT")
(cons 10 (trans pt 1 0))
'(40 . 250.0)
'(7 . "STANDARD")
(cons 1 (itoa count))
'(50 . 0.0)
; '(71 . 0)
; '(72 . 1)
; '(73 . 0)
)
)

[Ingpro]

Сообщение от koMon (entmakex (list '(0 . "TEXT") (cons 10 (trans pt 1 0)) '(40 . 250.0) '(7 . "STANDARD") (cons 1 (itoa count)) '(50 . 0.0) ; '(71 . 0) ; '(72 . 1) ; '(73 . 0) ) )

Yes! Вставляет текст в указанную точку!
"Вызывает антирес
И такой ишо разрез:"
где про это красиво написано, что эта строка должна выглядеть именно так (cons 10 (trans pt 1 0)?

[name02]

Сообщение от Ingpro где про это красиво написано, что эта строка должна выглядеть именно так (cons 10 (trans pt 1 0)?

Про то, что группа 10 - DXF Reference для объектов типа TEXT
(trans pt 1 0) - преобразование координат - см. справку по функции

[Ingpro]

А может кто-нибудь попробовать запустить у себя код из поста #4907?
В блокноте нормально отображается, а в командной строке и в подсказках на экране вот такая фигнематика:

Выберите границу (полилинию):
Укажите точку для вставки текста:
Найдено объектов:

Выберите границу (полилинию):
Укажите точку для вставки текста:
Найдено объектов:

Кодировка UTF-8
пробы с другими кодировками ничего не дают, что можно ещё попробовать???
Другие коды нормально отображаются...

[Кулик Алексей aka kpblc]

Да гидрит твою налево!...

Сообщение от Ingpro Кодировка UTF-8

А должна быть ANSI, сколько раз уж говорить-то!

Сообщение от Ingpro пробы с другими кодировками ничего не дают, что можно ещё попробовать???

Либо повторно скопировать код и сохранить в кодировке ANSI, либо заменить кодировку. в 99% случаев срабатывает технология: открыть, выделить все, скопировать, сменить кодировку, вставить, сохранить

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Либо повторно скопировать код и сохранить в кодировке ANSI, либо заменить кодировку. в 99% случаев срабатывает технология: открыть, выделить все, скопировать, сменить кодировку, вставить, сохранить

Не-а
Если ANSI в блокноте, то нормальный вид превращается в Выберите границу (полилинию):

Если по аглицки, то understand...
Select the contour (polyline:
Specify a point to insert the text:
Objects found:
Но вопрос про кодировку завис...

[Кулик Алексей aka kpblc]

Ты внимательно прочитал? Скопировать нормальный вид, сменить кодировку, вставить поверх. В Notepad++ прекрасно работает.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Скопировать нормальный вид, сменить кодировку, вставить поверх. В Notepad++ прекрасно работает.

А в AutoCADе после этого пробовали?
Выбираю ANSI в блокноте и нормальные слова превращаются в ... смысл это копировать?

[name02]

Так надо преобразовать в ANSI

[Кулик Алексей aka kpblc]

Сообщение от Ingpro А в AutoCADе после этого пробовали? Выбираю ANSI в блокноте и нормальные слова превращаются в ... смысл это копировать?

Пробовал, работает.

[Ingpro]

Сообщение от name02 Так надо преобразовать в ANSI

Т.е. недостаточно просто выбрать кодировку, именно преобразовать
Да, так получилось...спасибо.
Не приходилось раньше с таким сталкиваться...

[Konstnt16]

Добрый день, у меня проблема с неправильной отрисовкой штриховки, после внимательного изучения проблему установил что проблема проявляется у тех штриховок у которых граница полилиния и Флаг замкнутости установлен в 0.
Посмотрите правильно ли я код из поста [4877"]https://forum.dwg.ru/showpost.php?p=2086777&postcount=4877[/url] переделал под свой случай

Код:

[Выделить все]

 (defun c:test (/ ss i a b new)
  ;; Выбор рамкой всех штриховок, у которых граница внешняя полилиния DXF код 92 - 7
  (setq ss (ssget '((0 . "HATCH") (92 . 7))))
  (repeat (setq i (sslength ss))
    ;; Установка Флага замкнутости в 1
    (setq a (ssname ss (setq i (1- i))))
    (setq b (entget a))
    (setq new (subst '(73 . 1) (assoc 73 b) b))
    (entmod new)
  ) ;_ end repeat
  (princ)
) ;_ end defun

P.S. Проверил, работает. Спасибо name02 за исходный код.

[===AAA===]

Стандартный виндосовский "Блокнот" автоматически правильно отображает
кодировку русских символов - что UTF-8, что ANSI.

Дело в том, что в самом начале файла UTF-текста находятся спецсимволы,
которые не отображаются на экране, но которые дают понять программе
(в нашем случае - "Блокноту"), как нужно показывать очертания символов.

Из-за этого и получается путаница.

Вроде в "Блокноте" всё хорошо, а в Автокаде - ерунда.

Нужно именно преобразовывать кодировку, но стандартный "Блокнот" для этого не годится.
Нужен или Notepad++ или другой текстовый редактор, который умеет это дело.

[Moi Imena]

Вопрос может глупый, почему нельзя вызвать команду BURST из экспресс тулс, с помощью лисп ?
(defun c:burstselected ()
(setq ss (ssget))
(if ss
(command "_BURST" ss ""))
(princ)
)

[Кулик Алексей aka kpblc]

А если поискать... К примеру, https://forum.dwg.ru/showpost.php?p=593640&postcount=11 + https://forum.dwg.ru/showpost.php?p=1811175&postcount=7 и тому подобные темы по поиску "burst lisp", к примеру

[Ingpro]

По идее код должен сработать в фоновом режиме (назначить слои объектам), но что-то идет не так:
Команда: PLACEOBJLAY
._LAYER
Текущий слой: "Размеры"
Задайте параметр [?/Создать/Установить/Новый/ПЕРеименоватЬ/Вкл/Откл/Цвет/Тип/вЕс/пРозрачность/Материал/пеЧать/Заморозить/РАзморозить/Блок/рАзблок/Конфигурация/опИсание/соГласовать/ВНешняя ссылка]: _New
Имя нового слоя(ев): Circle-all Задайте параметр [?/Создать/Установить/Новый/ПЕРеименоватЬ/Вкл/Откл/Цвет/Тип/вЕс/пРозрачность/Материал/пеЧать/Заморозить/РАзморозить/Блок/рАзблок/Конфигурация/опИсание/соГласовать/ВНешняя ссылка]: _Color
Новый цвет [изПалитры/Альбом] : 230
Неправильное ключевое слово.
; ошибка: Функция прервана.

Код:

[Выделить все]

 ;; создать слой и поместить на него объекты
(defun c:PlaceObjLay (/ ssCircles ssLines ssPlines ssText ssMtext)

  (defun CreateOrUpdateLayer (layerName layerColor)
    (if (not (tblsearch "LAYER" layerName))
 
      (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "")
         (command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) "")
    )
  )

  (CreateOrUpdateLayer "Circle-all" 230)
 
  (setq ssCircles (ssget "_X" '((0 . "CIRCLE"))))
  (if ssCircles
    (command "._CHANGE" ssCircles "" "_Properties" "_LA" "Circle-all" "")
  )
  
  (princ)
)

И появляется выбор свойств для слоя, хотя не должен... Как можно вылечить, плз...
Как-то странно получается: слой 0 становится цветом 230, а слой "Circle-all" создается, но черным цветом...

[name02]

Запусти в автокаде команду (command "._LAYER" "_New" "Circle-all" "_Color" 250) и посмотри, что тебе предлагает автокад для ввода по умолчанию

[Ingpro]

Сообщение от name02 Запусти в автокаде команду (command "._LAYER" "_New" "Circle-all" "_Color" 250) и посмотри, что тебе предлагает автокад для ввода по умолчанию

Предлагает
Список имен слоев для присвоения цвета 250 <Line_obr>:
Нужно повторить имя слоя или как? А если слоя нет?

[name02]

[Ingpro]

но у меня в коде такой строки нет...
(command "._LAYER" "_New" "Circle-all" "_Color" 250)

[name02]

Да, нет. Зато у тебя есть (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "") и после указания цвета, автокад спрашивает, какому слою его назначить - и по умолчанию предлагает имя активного слоя.
Ты же на это не обращаешь внимание и "жмешь" ввод, а надо дать имя layerName!

[Ingpro]

Сообщение от name02 Да, нет. Зато у тебя есть (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "") и после указания цвета, автокад спрашивает, какому слою его назначить - и по умолчанию предлагает имя активного слоя.

Мне надо создать новый слой и назначить этот слой всем кругам...
А если я захочу в этом же коде добавить другой новый слой и другие объекты для присвоения слоя...

Код:

[Выделить все]

  ;; создать слой и поместить на него объекты
(defun c:PlaceObjLay (/ ssCircles ssLines ssPlines ssText ssMtext)

  (defun CreateOrUpdateLayer (layerName layerColor)
    (if (not (tblsearch "LAYER" layerName))
 
      (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "")
         (command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) "")
    )
  )

  (CreateOrUpdateLayer "Circle-all" 230)
 (CreateOrUpdateLayer "Line-all" 5)

  (setq ssCircles (ssget "_X" '((0 . "CIRCLE"))))
  (if ssCircles
    (command "._CHANGE" ssCircles "" "_Properties" "_LA" "Circle-all" "")
  )
 
 (setq ssLines (ssget "_X" '((0 . "LINE"))))
  (if ssLines
    (command "._CHANGE" ssLines "" "_Properties" "_LA" "Line-all" "")
  )

  (princ)
)

[name02]

Сделай так что-ли (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) layerName "")

[Кулик Алексей aka kpblc]

Я б сделал, наверное, отдельную функцию, в которую передавать список точечных пар "Тип объекта" - "Имя слоя". По-быстрому накидал, особо не тестировал:

Код:

[Выделить все]

 (vl-load-com)

(defun c:place-obj-to-layers (/ _kpblc-conv-vla-to-list fun_save-layers-status fun_restore-layers-status fun_change-objects fun_create-layer adoc ent_layer_list
                              layer_status
                             )

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
    *    Конвертация vla в список
    *    Параметры вызова:
      value  ; преобразовываемое значение
    |;
    (cond ((listp value)
           (mapcar (function _kpblc-conv-vla-to-list) value)
          )
          ((= (type value) 'variant)
           (_kpblc-conv-vla-to-list (vlax-variant-value value))
          )
          ((= (type value) 'safearray)
           (if (>= (vlax-safearray-get-u-bound value 1) 0)
             (_kpblc-conv-vla-to-list (vlax-safearray->list value))
           ) ;_ end of if
          )
          ((and (= (type value) 'vla-object)
                (vlax-property-available-p value 'count)
           ) ;_ end of and
           (vlax-for sub value (setq res (cons sub res)))
          ) ;_ end of cond
          (t value)
    ) ;_ end of cond
  ) ;_ end of defun

  (defun fun_save-layers-status (doc / res)
                                ;|
    *    Функция сохранения статуса слоев с одновременной их разблокировкой и разморозкой
    *    Параметры вызова:
      doc   ; документ, для которого надо выполнять обработку
    |;
    (mapcar
      (function
        (lambda (layer)
          (cons layer
                (mapcar
                  (function
                    (lambda (prop / temp)
                      (setq temp (vlax-get-property layer prop))
                      (vl-catch-all-apply
                        (function
                          (lambda ()
                            (vlax-put-property layer prop :vlax-false)
                          ) ;_ end of lambda
                        ) ;_ end of function
                      ) ;_ end of vl-catch-all-apply
                    ) ;_ end of lambda
                  ) ;_ end of function
                  '("freeze" "lock")
                ) ;_ end of mapcar
          ) ;_ end of cons
        ) ;_ end of lambda
      ) ;_ end of function
      (_kpblc-conv-vla-to-list (vla-get-layers doc))
    ) ;_ end of mapcar
  ) ;_ end of defun

  (defun fun_restore-layers-status (doc status)
                                   ;|
    *    Функция восстановления статуса слоев
    *    Параметры вызова:
      doc    ; обрабатываемый документ
      status ; ранее сохраненный список состояний слоев.
    *    ПРИМЕЧАНИЕ. Может сгенерировать ошибку, если в процессе слой из списка был удален / переименован
    |;
    (foreach item status
      (foreach prop (cdr item)
        (vl-catch-all-apply
          (function
            (lambda ()
              (vlax-put-property (car item) (car prop) (cdr prop))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of foreach
    ) ;_ end of foreach
  ) ;_ end of defun

  (defun fun_change-objects (doc param-list / item objtype)
                            ;|
    *    Функция смены слоя для примитивов
    *    Параметры вызова:
      doc        ; документ, в котором выполняется обработка
      param-list ; список параметров вида
        '((<Тип объекта как для SSGET> . <Имя устанавливаемого слоя>)
          (<Тип объекта как для SSGET> . <Имя устанавливаемого слоя>)
          ..
          )            
    |;
    (setq param-list
           (mapcar
             (function
               (lambda (x)
                 (cons (strcase (car x)) (cdr x))
               ) ;_ end of lambda
             ) ;_ end of function
             param-list
           ) ;_ end of mapcar
    ) ;_ end of setq
    (vlax-for block_def (vla-get-blocks doc)
      (vlax-for ent block_def
        (setq objtype (substr (strcase (vla-get-objectname ent)) 5))
        (if (and (setq item (assoc objtype param-list))
                 (setq item (cdr item))
            ) ;_ end of and
          (vla-put-layer ent item)
        ) ;_ end of if
      ) ;_ end of vlax-for
    ) ;_ end of vlax-for
  ) ;_ end of defun

  (defun fun_create-layer (doc name layer-list / res)
                          ;|
    *    Функция создания слоя с настройками
    *    Параметры вызова:
      doc        ; указатель на документ, с которым выполняется работа
      name       ; имя создаваемого слоя
      layer-list ; список настроек слоя вида
      '(("description" . <Описание слоя>)
        ("lineweight" . <Вес линии>)
        ("linetype" . <Тип линии>) ; Тип линии должен быть уже загружен в документ
        )
    |;
    (setq res (vla-add (vla-get-layers doc) name))
    (foreach prop layer-list
      (vl-catch-all-apply
        (function
          (lambda ()
            (vlax-put-property res (car prop) (cdr prop))
          ) ;_ end of lambda
        ) ;_ end of function
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of foreach
    res
  ) ;_ end of defun

  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark adoc)

  (setq ent_layer_list
                       (list (cons "line"
                                   (fun_create-layer
                                     adoc
                                     "Layer-for-lines"
                                     (list (cons "color" 1)
                                           (cons "lineweight" aclnwt025)
                                     ) ;_ end of list
                                   ) ;_ end of fun_create-layer
                             ) ;_ end of cons
                             (cons "circle"
                                   (fun_create-layer
                                     adoc
                                     "Layer-for-circles"
                                     (list (cons "color" 3)
                                           (cons "lineweight" aclnwt053)
                                     ) ;_ end of list
                                   ) ;_ end of fun_create-layer
                             ) ;_ end of cons
                       ) ;_ end of list
        ent_layer_list (mapcar
                         (function
                           (lambda (x)
                             (cons (car x) (vla-get-name (cdr x)))
                           ) ;_ end of lambda
                         ) ;_ end of function
                         ent_layer_list
                       ) ;_ end of mapcar
  ) ;_ end of setq

  (setq layer_status (fun_save-layers-status adoc))
  (fun_change-objects adoc ent_layer_list)
  (fun_restore-layers-status adoc layer_status)

  (vla-endundomark adoc)
  (princ)

) ;_ end of defun

----- добавлено через ~3 мин. -----
Выглядит стремно, согласен - но основной код команды занимает всего ничего ) И в принципе (надеюсь) понятно, что за чем идет, в какой последовательности, и кому и как передается

[Ingpro]

Сообщение от Кулик Алексей aka kpblc Я б сделал, наверное, отдельную функцию, в которую передавать список точечных пар "Тип объекта" - "Имя слоя". По-быстрому накидал, особо не тестировал:

Алексей, Ваш код сработал, спасибо!

Сообщение от name02 Сделай так что-ли (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) layerName "")

Это тоже вроде сработало, ещё потестирую, спасибо, name02!
Заменяю 2 строки и -ура!- работает!

Код:

[Выделить все]

   ;; создать слои и поместить на них объекты
(defun c:PlaceObjLay-name02 (/ ssCircles ssLines ssPlines ssText ssMtext)

  (defun CreateOrUpdateLayer (layerName layerColor)
    (if (not (tblsearch "LAYER" layerName))
 
      ; (command "._LAYER" "_New" layerName "_Color" (itoa layerColor) "")
      ; (command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) "")
(command "._LAYER" "_New" layerName "_Color" (itoa layerColor) layerName "")
(command "._LAYER" "_Set" layerName "_Color" (itoa layerColor) layerName "")
    )
  )

  (CreateOrUpdateLayer "Circle-all" 230)
 (CreateOrUpdateLayer "Line-all" 5)

  (setq ssCircles (ssget "_X" '((0 . "CIRCLE"))))
  (if ssCircles
    (command "._CHANGE" ssCircles "" "_Properties" "_LA" "Circle-all" "")
  )
 
 (setq ssLines (ssget "_X" '((0 . "LINE"))))
  (if ssLines
    (command "._CHANGE" ssLines "" "_Properties" "_LA" "Line-all" "")
  )

  (princ)
)

[Кулик Алексей aka kpblc]

ЕМНИП, для команды _.-layer есть еще и опция _make. Вроде бы и создает, и активирует слой сразу (проверить не могу, машину с кадом уже выключил).

[Ingpro]

Я пытаюсь сделать обратное коду из поста #4865 (преобразовать тексты в отдельные мтексты)
Код расчленяет мтексты, но в ком. строке пишет: Неизвестная команда "MTXT2TXT"

Код:

[Выделить все]

 [(defun c:mtxt2txt (/ ss i old_sett doc *error* )
  (vl-load-com)

  (defun *error* (msg)
    (princ)
  ) ;_ end defun

  (setq ss       (ssget '((0 . "MTEXT")))
        old_sett (getvar 'CMDECHO)
        doc      (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end setq

  (vla-StartUndoMark doc)

  (setvar 'CMDECHO 0)

  (if ss
    (repeat (setq i (sslength ss))
      (vl-cmdf "_.EXPLODE" (ssname ss (setq i (1- i))) "")
    ) ;_ end repeat
  ) ;_ end if
(vl-cmdf "_justifytext" "_P" "" "_mc" "") ; ??
  (setvar 'CMDECHO old_sett)

  (vla-EndUndoMark doc)

  (princ)
) ;_ end defun

Ещё хочу выровнять тексты на "_mc":
(vl-cmdf "_justifytext" "_P" "" "_mc" "")
но выравнивается только один из выбранных...

[koMon]

Сообщение от Ingpro пытаюсь сделать обратное коду из поста #4865

Код:

[Выделить все]

 
(defun c:mtxt2txt (/ ss i old_sett doc *error* )
  (vl-load-com)

  (defun *error* (msg)
    (princ)
  ) ;_ end defun

  (setq ss       (ssget '((0 . "MTEXT")))
        old_sett (getvar 'CMDECHO)
        doc      (vla-get-activedocument (vlax-get-acad-object))
  ) ;_ end setq

  (vla-StartUndoMark doc)
  
  (setvar 'CMDECHO 0)
  
  (if ss
    (repeat (setq i (sslength ss))
      (vl-cmdf "_.EXPLODE" (ssname ss (setq i (1- i))))
      (vl-cmdf "_justifytext" "_P" "" "_mc")
    ) ;_ end repeat
  ) ;_ end if
 ; ??
  
  (setvar 'CMDECHO old_sett)
  
  (vla-EndUndoMark doc)
  (princ)
) ;_ end defun

[Ingpro]

koMon, спасибо, скобочки...

[Gretech89]

Подскажите, пожалуйста, как грамотно реализовать?
Имеется список VLA-объектов (линии), имеется второй список VLA-объектов, который содержит в себе помимо прочих еще и объекты из списка №1. Как исключить из второго списка все объекты, содержащиеся в 1ом?

[Кулик Алексей aka kpblc]

(vl-remove-if '(lambda(x) (member x first-list)) second-list) :?:

[koMon]

(foreach l1_element l1 (setq l2 (vl-remove l1_element l2)))

[Gretech89]

Кулик Алексей aka kpblc, koMon, спасибо, всё как надо!

[Gretech89]

Подскажите, пожалуйста, можно ли избавиться от комбинации foreach-foreach и имеет ли смысл? При большом кол-ве объектов (линий) этот фрагмент кода изрядно подвисает.
И объясните еще для чего "reverse res"? Без переворота списка наблюдаю некорректную работу в коде, но не могу понять почему

Код:

[Выделить все]

 (setq result_ent ((lambda (/ res)
	(foreach a block_cont_1 
		(foreach x block_cont_2
		  (if
		       	(and
		       		(equal (car (vlax-get a 'startpoint)) (car (vlax-get x 'startpoint)) 1e-4)
		       		(equal (cadr (vlax-get a 'startpoint)) (cadr (vlax-get x 'startpoint)) 1e-4)
		       	)
				(setq res (cons x res))
		  )
		)
	)
		    		(reverse res)
		))
   )

[Кулик Алексей aka kpblc]

Без проверки работоспособности:

Код:

[Выделить все]

 
(setq result_ent (apply (function append) 
                        (mapcar 
                          (function 
                            (lambda (x) 
                              (vl-remove-if-not 
                                (function 
                                  (lambda (item) 
                                    (and 
                                      (equal (car (vlax-get item 'startpoint)) (car (vlax-get x 'startpoint)) 1e-4)
                                      (equal (cadr (vlax-get item 'startpoint)) (cadr (vlax-get x 'startpoint)) 1e-4)
                                    )
                                  )
                                )
                                block_cont_1
                              )
                            )
                          )
                          block_cont_2
                        )
                 )
)

Хотя я бы сделал отдельную функцию на получение 2-мерной стартовой точки и использовал бы ее:

Код:

[Выделить все]

 (defun fun_get-startpoint-2d (ent / res) 
  (setq res (vlax-get ent 'startpoint))
  (list (car res) (cadr res))
)

(setq result_ent (apply (function append) 
                        (mapcar 
                          (function 
                            (lambda (x) 
                              (vl-remove-if-not 
                                (function 
                                  (lambda (item) 
                                    (equal (fun_get-startpoint-2d item) (fun_get-startpoint-2d x) 1e-4)
                                  )
                                )
                                block_cont_1
                              )
                            )
                          )
                          block_cont_2
                        )
                 )
)

P.S. reverse нужен, потому что у тебя идет cons - он достаточно сильно отличается от append

[Gretech89]

Кулик Алексей aka kpblc, работоспособность подтвердилась! Спасибо Забавно, но время обработки почти такое же. Видать систему не обманешь.

[Кулик Алексей aka kpblc]

Ну так я и мозг-то особо не подключал ) Если я правильно понял, то надо оставить отрезки, у которых совпадают начальные вершины? Если да, то можно block_cont_1 и block_cont_2 объединить и проходить уже по объединенному списку. Можно заменить элементы - сначала двумерные координаты, потом указатель на примитив, и обрабатывать на основании координат (не понадобится постоянно вычислять значения). Можно в процессе проходки по объединенному списку попробовать исключать из него уже обработанные варианты, можно... Пока что фантазия закончилась. И на написание кода сейчас меня 100% не хватит - сижу в другой задачке, и это надолго

[Gretech89]

Кулик Алексей aka kpblc, понято, спасибо за идеи, поэкспериментирую)

[koMon]

Gretech89,
с одним foreach

Код:

[Выделить все]

 
(setq result_ent nil)
 (foreach l1 block_cont_1
	(if (vl-some '(lambda (l2) (equal (mapcar '+ '(0 0) (vlax-get l1 'startpoint))
									  (mapcar '+ '(0 0) (vlax-get l2 'startpoint))
									  1e-4
							   )
				  )
				  block_cont_2
		)
		(setq result_ent (append result_ent (list l1)))
	)
)

----- добавлено через ~2 мин. -----
Кулик Алексей aka kpblc,
Алексей почему ты используешь function вместо апострОфов, что-то религиозное?

[Кулик Алексей aka kpblc]

Апостроф в компилированном коде немного медленнее, насколько я помню. Ну и мне пару раз хватило словить ошибку PPT при форматировании кода

[koMon]

Gretech89,
1+

Код:

[Выделить все]

 
(apply 'and
	(mapcar '(lambda (l1) (if (vl-some '(lambda (l2) (equal (mapcar '+ '(0 0) (vlax-get l1 'startpoint))
									       					(mapcar '+ '(0 0) (vlax-get l2 'startpoint))
							  								1e-4
						  							 )
					    				)
					    				block_cont_1
				  			  )
				  			  l1
			      		  )
		  	 )
		  	 block_cont_2
	)
)

[Gretech89]

koMon, интересный вариант) а как сюда включить еще проверку конечных вершин endpoint-endpoint?

[koMon]

Gretech89,
я так думаю может так

Код:

[Выделить все]

 
(apply 'and
	(mapcar '(lambda (l1) (if (vl-some '(lambda (l2) (equal (list (mapcar '+ '(0 0) (vlax-get l1 'startpoint)) (mapcar '+ '(0 0) (vlax-get l1 'endpoint)))
									       					(list (mapcar '+ '(0 0) (vlax-get l2 'startpoint)) (mapcar '+ '(0 0) (vlax-get l2 'endpoint)))
							  								1e-4
						  							 )
					    				)
					    				block_cont_1
				  			  )
				  			  l1
			      		  )
		  	 )
		  	 block_cont_2
	)
)

[Gretech89]

Сообщение от koMon я так думаю может так

Благодарю! Я добавил все варианты как могут стыковаться отрезки друг с другом и завернул в цикл, чтобы находить полные цепочки отрезков, которые растут от линий из списка "block_cont_1". На выходе получаем список с несостыкованными отрезками (block_cont_2).

Код:

[Выделить все]

 (while block_cont_1
   (setq result_ent ((lambda (/ res)
	(apply 'and
	(mapcar '(lambda (l1) (if (vl-some '(lambda (l2)
					      (or
					      (equal (mapcar '+ '(0 0) (vlax-get l1 'startpoint)) (mapcar '+ '(0 0) (vlax-get l2 'startpoint)) 1e-4)
					      (equal (mapcar '+ '(0 0) (vlax-get l1 'endpoint)) (mapcar '+ '(0 0) (vlax-get l2 'endpoint)) 1e-4)
					      (equal (mapcar '+ '(0 0) (vlax-get l1 'startpoint)) (mapcar '+ '(0 0) (vlax-get l2 'endpoint)) 1e-4)
					      (equal (mapcar '+ '(0 0) (vlax-get l1 'endpoint)) (mapcar '+ '(0 0) (vlax-get l2 'startpoint)) 1e-4)
					      )
					    )
					    block_cont_1
				  			  )
				  (setq res (cons l1 res))
			      		  )
		  	 )
		  	 block_cont_2
	)
	)
		    (reverse res)
		    ))
   )
  (setq block_cont_2 (vl-remove-if '(lambda(x) (member x result_ent)) block_cont_2))
  (setq block_cont_1 result_ent)
)

[koMon]

Gretech89,
в чём главная идея? есть два сравниваемых списка контуров из отрезков. начинаем сравнивать, находим несовпадающие отрезки и выводим только их в список или ?

[Gretech89]

koMon, да, в целом верно. То, что не совпадает, после удаляем. Цель: оставить контуры и удалить всё лишнее.

[koMon]

Gretech89,
я бы не делал циклы, потому что mapcar сделает всё и сразу как например ниже

Код:

[Выделить все]

 
(defun coincide (line_1 line_2)
	(apply 'or (mapcar '(lambda (what) (equal what
					   (list (mapcar '+ '(0 0) (vlax-get line_2 'startpoint)) (mapcar '+ '(0 0) (vlax-get line_2 'endpoint)))
					   1e-4
				    )
		   	    )
			    (list (list (mapcar '+ '(0 0) (vlax-get line_1 'startpoint)) (mapcar '+ '(0 0) (vlax-get line_1 'endpoint)))
			          (list (mapcar '+ '(0 0) (vlax-get line_1 'endpoint)) (mapcar '+ '(0 0) (vlax-get line_1 'startpoint)))
			    )
	    	   )
	)
)
(setq coincident_lines (mapcar '(lambda (line_1) (if (vl-some '(lambda (line_2) (coincide line_1 line_2)) block_cont_1) line_1)) block_cont_2))
(setq non_coincident_lines (vl-remove nil (mapcar '(lambda (line_1 line_2) (if (and line_1 line_2) line_2 nil)) (mapcar 'not coincident_lines_list) block_cont_2)))
(setq coincident_lines (vl-remove nil coincident_lines))  

[Gretech89]

Сообщение от koMon я бы не делал циклы, потому что mapcar сделает всё и сразу как например ниже

Что-то не получается.. Возможно что-то не так делаю. "coincident_lines_list" - не опечатка?
Прикрепил файлик, на котором тестил.

Код:

[Выделить все]

 (vlax-for block_def (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))

     (setq block_cont_1 ((lambda (/ res)
			(vlax-for block_entry block_def
			(if
				 	(and
						(= "AcDbLine" (vla-get-objectname block_entry))
						(not (equal 8.9859 (vla-get-length block_entry) 1e-4))
					)
						(setq res (cons block_entry res))
			)
			)
				    		(reverse res)
				)
				)
		)

     (setq block_cont_2 ((lambda (/ res)
			(vlax-for block_entry block_def
			(if
				 	(and
						(= "AcDbLine" (vla-get-objectname block_entry))
						(equal 8.9859 (vla-get-length block_entry) 1e-4)
					)
						(setq res (cons block_entry res))
			)
			)
				    		(reverse res)
				)
				)
		)

(defun coincide (line_1 line_2)
	(apply 'or (mapcar '(lambda (what) (equal what
					   (list (mapcar '+ '(0 0) (vlax-get line_2 'startpoint)) (mapcar '+ '(0 0) (vlax-get line_2 'endpoint)))
					   1e-4
				    )
		   	    )
			    (list (list (mapcar '+ '(0 0) (vlax-get line_1 'startpoint)) (mapcar '+ '(0 0) (vlax-get line_1 'endpoint)))
			          (list (mapcar '+ '(0 0) (vlax-get line_1 'endpoint)) (mapcar '+ '(0 0) (vlax-get line_1 'startpoint)))
			    )
	    	   )
	)
)

(setq coincident_lines (mapcar '(lambda (line_1) (if (vl-some '(lambda (line_2) (coincide line_1 line_2)) block_cont_1) line_1)) block_cont_2))
(setq non_coincident_lines (vl-remove nil (mapcar '(lambda (line_1 line_2) (if (and line_1 line_2) line_2 nil)) (mapcar 'not coincident_lines_list) block_cont_2)))
(setq coincident_lines (vl-remove nil coincident_lines))  

(if non_coincident_lines
	(repeat (length non_coincident_lines)
		 (if (not (vlax-erased-p (car non_coincident_lines)))
		   (progn
		 (vla-delete (car non_coincident_lines))
		 (setq non_coincident_lines (cdr non_coincident_lines))
		   )
		   (setq non_coincident_lines (cdr non_coincident_lines))
		   )
	)
)

     )

[koMon]

Сообщение от Gretech89 не опечатка?

100п опечатка

[koMon]

Gretech89,
если я правильно понимаю, то нужно в блоке найти сцепленные отрезки, при этом удалив отдельностоящие от сцепленных. и отдельностоящих и сцепленных может быть не одна группа или одна штука. то что я предложил ни при каких условиях этого не сделает, потому что нацелено на поиск совпадающих отрезков по вершинам только. см. ниже.

[Кулик Алексей aka kpblc]

Вы еще сюды добавьте коллинеарные отрезки ))

[Ingpro]

Команда несколько раз срабатывает, как надо, потом начинает сбоить, в чём может быть причина?

Код:

[Выделить все]

 (defun c:StepPl (/ step-height step-width num-steps start-point points current-point next-point pt)
  (setq step-height 150) 
  (setq step-width 300)  
  (setq num-steps 10)    
  (setq start-point (getpoint "\nУкажите начальную точку: ")) 

  (setq points (list start-point))
  (setq current-point start-point)

  (repeat num-steps
    (setq next-point (list (car current-point) (+ (cadr current-point) step-height)))
    (setq points (append points (list next-point)))
    (setq current-point next-point)

    (setq next-point (list (+ (car current-point) step-width) (cadr current-point)))
    (setq points (append points (list next-point))) 
    (setq current-point next-point)
  )

  (setq points (append points (list (list (+ (car start-point) (* step-width num-steps)) (cadr start-point))))) 

  (command "_.PLINE") 
  (foreach pt points
   ; (command pt)  ; ошибка
(command "_non" pt) ; исправление
  )
  (command "") 
(princ)
)

[Кулик Алексей aka kpblc]

Что значит "сбоить"? Что пишется в консоли? Какие значения переменных при отладке? Про разницу между command, command-s, vl-cmdf в курсе?
P.S. ИМХО проще всего создавать полилинию чисто программно, без использования команд.

[Ingpro]

Сообщение от Кулик Алексей aka kpblc то значит "сбоить"? Что пишется в консоли?

Начинает чертить не ступени, а какую-то ф---ю.
Ничего криминального не пишет...
Укажите начальную точку: _.PLINE
Начальная точка:
Текущая ширина полилинии равна 0.00
Следующая точка или [Дуга/Полуширина/длИна/Отменить/Ширина]:
Следующая точка или [Дуга/Замкнуть/Полуширина/длИна/Отменить/Ширина]:
Следующая точка или [Дуга/Замкнуть/Полуширина/длИна/Отменить/Ширина]:

[Кулик Алексей aka kpblc]

http://forum.dwg.ru/showpost.php?p=271151&postcount=167

[koMon]

(command pt) -> (command "_non" pt)

[Ingpro]

Сообщение от koMon (command pt) -> (command "_non" pt)

Спасибо, это сработало, код в #4961 исправлен.

[Gretech89]

Подскажите, пожалуйста. К примеру: имеется вхождение блока "A". Внутри него блок "B". Я правильно понимаю, что блок "B" не является вхождением на чертеже, т.к. он внутри блока "A"?
В общем задача получить список вложенных блоков причем с определенным именем (имена у вложенных блоков в другие блоки начинаются с одних и тех же символов - "MACRO*"). Делаю я это так:

Код:

[Выделить все]

 	(setq block_in ((lambda (/ res)
		(vlax-for block_def (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
			(if
			  (wcmatch (strcase (vla-get-name block_def)) "MACRO*")
			  (setq res (cons block_def res))
			)
		)
			(reverse res)
	               ))
	)

Загвоздка в том, как получить список вхождений блоков, чтобы далее получить их габаритные координаты (GetBoundingBox). И вообще возможно ли такое? Искомые блоки находятся в блоках и разбивать их нельзя..

[1958]

Вопрос по ssget с условием.
Имеются две переменные: lst - список точек и lay - название слоя.
Кодом

Код:

[Выделить все]

 (setq ss (ssget "_F" (mapcar '(lambda (x) (trans x 0 1)) lst)))

выбираются все примитивы, пересекаемые линией с вершинами из списка lst.
Мне нужно выбрать примитивы не принадлежащие слою lay.
Попробовал так:

Код:

[Выделить все]

 (setq ss (ssget "_F"
                          (mapcar '(lambda (x) (trans x 0 1)) lst)
                          (cons -4 "<NOT")
                          (list (cons 8 lay))
                          (cons -4 "NOT>")
                   )
          )

Результат: Error: слишком много аргументов
В чем ошибка? Или ssget с методом "_F" фильтры со сложными условиями не поддерживается?

[Кулик Алексей aka kpblc]

М.б., так?

Код:

[Выделить все]

 (setq ss (ssget "_F" 
                (mapcar '(lambda (x) (trans x 0 1)) lst)
                (list (cons -4 "<NOT") 
                      (cons 8 lay)
                      (cons -4 "NOT>")
                )
         )
)

[===AAA===]

Кстати.

К выбору "Линией" нужно относиться с осторожностью.

Если среди выбираемых объектов есть тексты, то эта
"линия" может оказаться как раз "между слов" или даже
"между букв" и в результате объект окажется не выбранным.

[1958]

Сообщение от Кулик Алексей aka kpblc М.б., так?

Рахмат, понимаш, катта!

----- добавлено через ~1 мин. -----

Сообщение от ===AAA=== Если среди выбираемых объектов есть тексты, то эта "линия" может оказаться как раз "между слов" или даже "между букв" и в результате объект окажется не выбранным.

Это относится и к пунктирным линиям. Но, что делать!?

[===AAA===]

Это относится и к пунктирным линиям. Но, что делать!?

(ssget "_c" ...)

понадёжнее будет.

Разве, что нужен какой-то "очень хитрый" контур выбора...
Но у меня в реальности такой задачи пока не возникало.

[1958]

Сообщение от ===AAA=== (ssget "_c" ...)

Я сейчас как раз этот вариант рассматриваю.
Как можно изменить список координат типа lst = ((х1 у1) (х2 у2)...(х8 у9)), добавив к каждому элементу по (2 2)?
(mapcar '+ lst '(2 2)) - результата не дает.
Строить линию по списку lst, делать офсет в обе стороны и получать новый список для замкнутого контура - как-то муторно мне кажется.

[koMon]

Сообщение от ===AAA=== Если среди выбираемых объектов есть тексты, то эта "линия" может оказаться как раз "между слов" или даже "между букв" и в результате объект окажется не выбранным.

на этот случай есть переменная textgapselection, которая

Controls whether you can select text or mtext objects within the gaps or spaces between the characters. Value Description 0 Text and mtext objects can be selected only on a character (legacy behavior) 1 Text and Mtext objects can be selected within the gaps or spaces between characters within a line of text

то есть установленная в 1 позволит выбирать *тексты по пробелам и промежуткам между букв.

[Кулик Алексей aka kpblc]

Без проверок:

Код:

[Выделить все]

 (mapcar 
  (function 
    (lambda (point) 
      (mapcar 
        (function +)
        '(2. 2.)
        point
      )
    )
  )
  lst
)

[koMon]

Сообщение от 1958 Это относится и к пунктирным линиям. Но, что делать!?

это вряд ли. физически линия определяется вершинами и линией между ними. пунктиры это графическое представление линии и не должны препятствовать выбору линии например линией выбора.

----- добавлено через ~4 мин. -----

Сообщение от Кулик Алексей aka kpblc (function +)

не сработает сорян) сработает

Код:

[Выделить все]

Command: (mapcar '(lambda (point) (mapcar '+ '(2 2) point)) '((1 1) (2 2 ) (3 3) (4 4)))
((3 3) (4 4) (5 5) (6 6))

[1958]

Сообщение от Кулик Алексей aka kpblc Без проверок: Код:

Спасибо!

[===AAA===]

на этот случай есть переменная textgapselection ...

Как говорится, "да, но..."

а) Она есть не во всех версиях АвтоКада (кажется, появилась с версии 2021)
б) В наноКаде (по крайней мере, в 23.1) её тоже нет
в) В программе, где есть (ssget "_f" ... ) нужно будет озаботиться её проверкой и/или установкой.

Так что "секрамка" - наше всё. :-)

[Ingpro]

Код работает, но "не видит" операцию деления, если ввести "/", то операция выполняется.
В коде [*/+/-//], в ком. строке [*/+/-], как можно исправить, плз?

Код:

[Выделить все]

 ;;; Функция выполнения арифметических операций ("*" "+" "-" "/") с объектами TEXT или MTEXT
;;; -------------------------------------
(defun getNumericValue (ent / edata val str1 str3)
  (setq edata (entget ent))
  (cond
    ((equal (cdr (assoc 0 edata)) "TEXT")
     (setq val (cdr (assoc 1 edata))))  
    ((equal (cdr (assoc 0 edata)) "MTEXT")

     (setq str1 (cdr (assoc 1 edata)))
     (setq str3 (cdr (assoc 3 edata)))  
     (setq val (strcat str1 str3))       
    )
    (T
     (setq val "0") 
    )
  )
  (atof val)
)

;;; ------------------------------------------------------
(defun c:CalculTxt ( / lastOp prompt op ent1 ent2 v1 v2 result inspt validOps)
  (setq validOps '("*" "+" "-" "/")) 

  (setq lastOp (getenv "CALC_TXT_LAST_OP"))

  (setq prompt (strcat "\nВыберите операцию [*/+/-//] <" (if lastOp lastOp "") ">: "))

  (setq op (getstring "\nВыберите операцию [*/+/-//]: "))

  (if (= op "") (setq op lastOp))

  (if (not (member op validOps))
    (progn
      (alert "Недопустимая операция. Используется операция \"+\".")
      (setq op "+")
    )
  )

  (setenv "CALC_TXT_LAST_OP" op)

  (setq ent1 (car (entsel "\nВыберите первый текст или MTEXT: ")))
  (if (null ent1) (exit)) 

  (setq ent2 (car (entsel "\nВыберите второй текст или MTEXT: ")))
  (if (null ent2) (exit)) 

  (setq v1 (getNumericValue ent1))
  (setq v2 (getNumericValue ent2))

  (cond
    ((= op "*") (setq result (* v1 v2)))
    ((= op "+") (setq result (+ v1 v2)))
    ((= op "-") (setq result (- v1 v2)))
    ((= op "/") 
      (if (zerop v2)
        (setq result 0.0) 
        (setq result (/ v1 v2))
      )
    )
    (T (setq result 0.0)) 
  )

  (setq inspt (getpoint "\nУкажите точку вставки результата: "))
  (if (null inspt) (exit))

  (command "_.TEXT" inspt "250" "0" (rtos result 2 2) "")

  (princ)
)

[Кулик Алексей aka kpblc]

ИМХО не лечится. Попробуй нечто типа

Код:

[Выделить все]

 (if (= (type (setq op
                    (vl-catch-all-apply
                      (function
                        (lambda ()
                          (initget "+ - * \\ _ + - * /" 6)
                          (cond
                            ((getkword "\nEnter operation[+/-/*/\\] <+> : "))
                          ) ;_ end of cond
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
             ) ;_ end of setq
       ) ;_ end of type
       'str
    ) ;_ end of =
  (princ (strcat "\n " op " selected"))
) ;_ end of if

[1958]

На https://forums.autodesk.com/t5/visua...r/td-p/9626606 нашел код для определения s/n флэшки:

Код:

[Выделить все]

  (defun UsbDriveSerialNumber (/ fso dr)
  (setq fso (vlax-create-object "Scripting.FileSystemObject"))
  (vlax-for d (vlax-get fso 'Drives)
   (if (= (Vlax-get d 'DriveType) 1)
    (setq dr (cons (list (vla-get-path d) (vla-get-SerialNumber d)) dr))
   )
  )
  (vlax-release-object fso)
  (reverse dr)
 )
 (if (vl-some '(lambda (i) (eq -1754099887 (cadr i)))
              (UsbDriveSerialNumber)
     )
(действие1)
(действие2)
)

В этом коде сравнивается серийный номер флэшки с известным (-1754099887).
Допустим есть список (setq lst (list -1754099887 175646485 927914207)), в котором перечислены серийные номера нескольких флэшек.
Как определить, что флэшка (её серийный номер) попадает в этот список?
Попытался сделать так:

Код:

[Выделить все]

  (if (vl-some '(lambda (i)
                (eq (member (cadr i)
                            (UsbDriveSerialNumber)
                            lst
                    )
                )
               )
     )

Результат: Error: слишком мало аргументов
Что-то я с member напутал.

[name02]

Просто:
(member НОМЕР_ФЛЕШКИ СПИСОК_НОМЕРОВ_ФЛЕШЕК)

Возвращает nil если не найдет и остаток списка начиная с НОМЕР_ФЛЕШКИ

[1958]

Сообщение от name02 Просто: (member НОМЕР_ФЛЕШКИ СПИСОК_НОМЕРОВ_ФЛЕШЕК)

Номер флешки неизвестен и ваше ПРОСТО не вариант.

[Кулик Алексей aka kpblc]

А вот если код отформатировать, станет понятно, где скобки не на своих местах. Уж молчу про то, чтобы прогнать базовую функцию и узнать, чего она вообще возвращает. ))

[name02]

Сообщение от 1958 Как определить, что флэшка (её серийный номер) попадает в этот список?

Функция member - самый простой способ определить вхождения одной величины в список.

Сообщение от 1958 Номер флешки неизвестен и ваше ПРОСТО не вариант.

Никому не известную величину в списке невозможно найти. Вообще никак

Тем не менее, тема форума "Научите лиспу..."

1 Функция UsbDriveSerialNumber возвращает nil если в компьютер не воткнуто флешек, а если воткнуты - то список вида:
(("D:" 1924838121)("H:" 191335465456)("F:" 456798431))
Количество элементов списка зависит от количества воткнутых в компьютер флешек

2 Берешь нужные флешки, втыкаешь в компьютер и запускаешь (UsbDriveSerialNumber)
3 Смотришь на номера и записываешь их в блокнот
4 Пишешь что-то вроде такого:

Код:

[Выделить все]

 ;;Функция для определения валидности флешки
;;возвращает nil - если валидная флешка не найдена
;;T - если найдена
(defun original-flashp (/ UsbDriveSerialNumber flnums valid-flash)

  ;;Список номеров разрешенных флешек
  (setq flnums '(321321356 564684543 456579833 1924838121))

  (defun UsbDriveSerialNumber (/ fso dr)
    (setq fso (vlax-create-object "Scripting.FileSystemObject"))
    (vlax-for d	(vlax-get fso 'Drives)
      (if (= (Vlax-get d 'DriveType) 1)
	(setq dr (cons (list (vla-get-path d) (vla-get-SerialNumber d)) dr))
      ) ;_ end of if
    ) ;_ end of vlax-for
    (vlax-release-object fso)
    (reverse dr)
  ) ;_ end of defun

  ;;вот тут проверяем 
  (foreach fl (UsbDriveSerialNumber)
    (if	(member (cadr fl) flnums)
      (setq valid-flash T)
    ) ;_ end of if
  ) ;_ end of foreach

  valid-flash

) ;_ end of setq

[1958]

Спасибо!
Пункты 1-3 мне были понятны и вопросов не возникало:

Сообщение от name02 1 Функция UsbDriveSerialNumber возвращает nil если в компьютер не воткнуто флешек, а если воткнуты - то список вида: (("D:" 1924838121)("H:" 191335465456)("F:" 456798431)) Количество элементов списка зависит от количества воткнутых в компьютер флешек 2 Берешь нужные флешки, втыкаешь в компьютер и запускаешь (UsbDriveSerialNumber) 3 Смотришь на номера и записываешь их в блокнот

Загвоздка была в:

Сообщение от name02 4 Пишешь что-то вроде такого: Код:

а именно:

Код:

[Выделить все]

 ;;вот тут проверяем 
  (foreach fl (UsbDriveSerialNumber)
    (if	(member (cadr fl) flnums)
      (setq valid-flash T)
    ) ;_ end of if
  ) ;_ end of foreach

Спасибо ещё раз, теперь всё яхши!

[===AAA===]

Защиту по номеру вставленной в данный момент флешки (чтобы работало только "для своих") ваяешь?

[1958]

Сообщение от ===AAA=== Защиту по номеру вставленной в данный момент флешки (чтобы работало только "для своих") ваяешь?

Типа этого. Знаю, что ненадежно. Но просто от дураков.

[Ingpro]

Код "не узнает" MLeader, подскажите, что не так...

Код:

[Выделить все]

 ;; добавить текст в конце нескольких выбранных MLEADER
(defun c:AddTxtML ( / ss textToAdd i ent entData newText)
  (setq textToAdd (getstring "\nВведите текст для добавления: "))
  (setq ss (ssget '((0 . "MLEADER"))))

  (if (null ss) 
    (progn
      (princ "\nНе выбрано ни одной MLeader.")
      (exit)
    )
  )

  (repeat (setq i (sslength ss))
    (setq ent (ssname ss (setq i (1- i))))
    
    (setq entData (entget ent))

    (if (equal (cdr (assoc 0 entData)) "MLEADER")
      (progn
               (setq oldText (cdr (assoc 1 entData)))  

        (setq newText (strcat oldText " " textToAdd)) 

             (setq entData (subst (cons 1 newText) (assoc 1 entData) entData))
        (entmod entData)  
      )
    )
  )
  (princ)
)

[Кулик Алексей aka kpblc]

А провернуть entget не судьба? )

Код:

[Выделить все]

 (cdr(assoc 0 (entget (car (entsel)))))
"MULTILEADER"

[name02]

Еще у тебя в 4 строке выбираются только мультивыноски и проверка 18 избыточна

[Ingpro]

Сообщение от Кулик Алексей aka kpblc А провернуть entget не судьба? )

Изменяю строку 18, но не получается

Сообщение от name02 Еще у тебя в 4 строке выбираются только мультивыноски и проверка 18 избыточна

В 4 строке выбираютя, а в 18 проверяются, убрать проверку?

[name02]

Если ты используешь в ssget фильтры, то в наборе будут только объекты удовлетворяющие фильтру - других не будет. Это даже видно при выделении объектов
И присоединяюсь к

Сообщение от Кулик Алексей aka kpblc А провернуть entget не судьба? )

Текст мультивыноски не в 1-й группе находится

И лучше все-таки не (exit) использовать

[Кулик Алексей aka kpblc]

Да вашу ж за ногу! Разницу между MLEADER и MULTILEADER вообще видно или нет? 18 строка не нужна, у тебя проблема в фильтре ssget! Там кто править будет - Пушкин?

[Red Nova]

Доброго!

Имею динамический блок с атрибутами.
Требуется маркировать этот блок при помощи мультивыноски (Multileader).
Скрипт должен создавать мультивыноску, содержащую два поля, ссылающихся на блок:
Первое поле — значение атрибута блока
Второе — его длина (один из динамических параметров).

Скрипт прекрасно работает, если ссылаться только на одно из этих полей — либо атрибут, либо длину.
Однако, если попытаться объединить оба поля в один текст, мультивыноска создается, но остаётся пустой.

Ниже приведены три команды. Они идентичны, за исключением одной закомментированной строки в test1 и test2.
test1 и test2 работают корректно.
test3 рисует мультивыноску, но текст в ней отсутствует.

Я прилагаю файл .dwg, в котором показан результат выполнения каждой из команд.
Надеюсь, кто-нибудь сможет объяснить вечному чайнику, почему test3 не работает

Код:

[Выделить все]

 (defun c:test1 ( / blk vlablk attlst tagtext)

  (vl-load-com)
  
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
      )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (get-all-atts vlablk))

  (setq tagtext
	 (strcat
   	   ;(strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 (caddr (assoc "TYPE" attlst))))">%).TextString>%")
	   ", L="
	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%")
	   )
	)
  (command "._mleader" pause pause tagtext)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:test2 ( / blk vlablk attlst tagtext)

  (vl-load-com)
  
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
      )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (get-all-atts vlablk))

  (setq tagtext
	 (strcat
   	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 (caddr (assoc "TYPE" attlst))))">%).TextString>%")
	   ", L="
	   ;(strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%")
	   )
	)
  (command "._mleader" pause pause tagtext)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:test3 ( / blk vlablk attlst tagtext)

  (vl-load-com)
  
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
      )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (get-all-atts vlablk))

  (setq tagtext
	 (strcat
   	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 (caddr (assoc "TYPE" attlst))))">%).TextString>%")
	   ", L="
	   (strcat "%<\\AcObjProp Object(%<\\_ObjId " (vl-princ-to-string(Get-ObjectID-x86-x64 vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%")
	   )
	)
  (command "._mleader" pause pause tagtext)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun LM:ss->vla ( ss / i l )
    (if ss
        (repeat (setq i (sslength ss))
            (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
        )
    )
)

(defun Get-ObjectID-x86-x64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
     (if (> (vl-string-search "x64" (getvar "platform")) 0)
       (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
       (rtos (vla-get-objectid obj) 2 0)
     )
  )
)

(defun get-all-atts (obj)
  (if (and obj
    (eq :vlax-true (vla-get-HasAttributes obj))
    (vlax-property-available-p obj 'Hasattributes)
    
      )
    (vl-catch-all-apply
      (function
 (lambda ()
   (mapcar (function (lambda (x)
         (list (vla-get-TagString x)
	       (bg:get-TextString (vlax-vla-object->ename x))
                                    x
         )
       )
    )
    (append (vlax-invoke obj 'Getattributes)
     (vlax-invoke obj 'Getconstantattributes)
    )
   )
 )
      )
    )
  )
)

[name02]

1 Ты не приложил функции (get-all-atts) и (Get-ObjectID-x86-x64)
2 Я нашел их в интернете, но test2 не запускается. Возможно ты не последний вариант программы выложил.
Насколько можно судить (get-all-atts) возвращает список из точечных пар (ИМЯ_АТРИБУТА . ЗНАЧЕНИЕ)
В строке 43 ты пытаешься скормить ей вот это (caddr (assoc "TYPE" attlst)) - результат caddr указанной точечной пары не существует - будет ошибка. Даже больше - для такой пары есть только car и cdr
3 Функция (Get-ObjectID-x86-x64) принимает в качестве аргумента только указатель на объект - ENAME или VLA-OBJECT
Тебе нужно получить объект АТРИБУТ и уже его передавать в (Get-ObjectID-x86-x64)

[koMon]

Red Nova,
можно попробовать вставить текст с полями в уже созданную мвыноску, например так

Код:

[Выделить все]

 
(defun c:test3 ( / blk vlablk attlst tagtext)
  (prompt "\nSelect Tagged Block: ")
  (setvar "nomutt" 1)
  (if
      (setq blk (ssget "_:S" '((0 . "INSERT")(66 . 1))))
      (setq vlablk (LM:ss->vla blk))
  )
  (setvar "nomutt" 0)
  (setq vlablk (car vlablk))
  (setq attlst (mapcar '(lambda (att) (list (vla-get-tagstring att) att)) (vlax-invoke vlablk 'getattributes)))
  (setq tagtext
	  	(strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-Get-ObjectID (cadr (assoc "TYPE" attlst)))) ">%).TextString>%"
	   			",L=" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-Get-ObjectID vlablk)) ">%).Parameter(123).UpdatedDistance \\f \"%lu4%pr3\">%"
		)
  )
  (command "._mleader" pause pause "")
  (vla-put-textstring (vlax-ename->vla-object (entlast)) tagtext)
  (command "_regen")
)

[Red Nova]

Спасибо за ответы!
name02

1 Ты не приложил функции (get-all-atts) и (Get-ObjectID-x86-x64) 2 Я нашел их в интернете, но test2 не запускается. Возможно ты не последний вариант программы выложил. Насколько можно судить (get-all-atts) возвращает список из точечных пар (ИМЯ_АТРИБУТА . ЗНАЧЕНИЕ) В строке 43 ты пытаешься скормить ей вот это (caddr (assoc "TYPE" attlst)) - результат caddr указанной точечной пары не существует - будет ошибка. Даже больше - для такой пары есть только car и cdr 3 Функция (Get-ObjectID-x86-x64) принимает в качестве аргумента только указатель на объект - ENAME или VLA-OBJECT Тебе нужно получить объект АТРИБУТ и уже его передавать в (Get-ObjectID-x86-x64)

Извиняюсь. Добавил недостающие функции.

koMon
Работает! Но требует regen, а для большого файла это тормозить будет. Хотелось бы без regen

[Кулик Алексей aka kpblc]

Можешь попробовать (entupd (entlast))

[Red Nova]

Сообщение от Кулик Алексей aka kpblc Можешь попробовать (entupd (entlast))

Не работает
Также как и не работает (command ".updatefield" (entlast) "")