[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