Условие запуска команды

Условие запуска команды · 30.11.2020, 13:39

Здравствуйте Уважаемые специалисты Автокад!
Код ниже НЕ рабочий - это пользовательская команда Автокада, в которой:
- в начале стоит условие: нулевая или нет высота текста в текущем текстовом стиле.
- затем два варианта хода команды: 1) запустить команду macros, автоматически ввести координаты точки (@0<0), вывести запрос высоты (\), автоматически ввести угол (0). 2) запустить команду macros, автоматически ввести координаты точки (@0<0), автоматически ввести угол (0).

Подскажите пожалуйста, как правильно сделать рабочую команду (в одной строке) с условием и дальнейшим ходом?
"macros" - это команда из лисп macros.lsp, в котором выполняется процедура вставки текста с запросом точки вставки, высоты текста и угла текста.
Заранее спасибо!

Код:

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

^C^C^P(if (/= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) (macros @0<0 \0)(macros @0<0 0)) ^P

Кулик Алексей aka kpblc · 30.11.2020, 14:09

Может, проще код macros поменять?

AlexCondor · 30.11.2020, 14:18

(macros @0<0 \0) - \ - это запрос высоты? Тогда нет пробела. Ну это если с macros'ом все в порядке.

PS. Может проще если высота 0 запустить команду 1, не 0 запустить команду 2.

olga87 · 30.11.2020, 14:28

Мне нужно в команде сослаться на запросы из этого макроса, но с учетом высоты?
Т.е. код команды:

Код:

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

^C^Cmacros _l  @0<0 @0<0 \0 \M ^P

(с запросом высоты)
либо

Код:

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

^C^Cmacros _l  @0<0 @0<0 0 \M ^P

(без запроса)

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

ниже код macros:

Код:

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

(defun c:macros ( / oldcmd oldosmode olderr ss ei tmp fixedtxth ai pti amode ptt i)
(setq oldcmd (getvar "cmdecho")
oldosmode (getvar "osmode")
olderr *error*
)
(defun *error* (msg)
(if (not (member msg (list "Отменено.")))
(princ (strcat "\nОшибка: " msg))
)
(setvar "cmdecho" oldcmd)
(setvar "osmode" oldosmode)
(setq *error* olderr)
(princ)
)
(if
(or
(setq ss (ssget "_i" (list (cons 0 "INSERT"))))
(setq ss (ssget (list (cons 0 "INSERT"))))
)
(progn
(setvar "cmdecho" 0)
(setvar "osmode" 0)
;; #tni_dist
(if (not #tni_dist)
(setq #tni_dist 0.0)
)
(princ
"\nВведите расстояние от блока до текста <"
)
(princ #tni_dist)
(princ ">: ")
(setq tmp (getdist))
(if tmp
(setq #tni_dist tmp)
)
;; #tni_txth
(if (not #tni_txth)
(setq #tni_txth 2.5)
)
(setq textdat (tblsearch "style" (getvar "textstyle")))
(if (/= 0.0 (cdr (assoc 40 textdat)))
(setq fixedtxth 1)
(setq fixedtxth 0)
)
(if (= fixedtxth 0)
(progn
(princ "\nВведите высоту текста <")
(princ #tni_txth)
(princ ">: ")
(setq tmp (getdist))
(if tmp
(setq #tni_txth tmp)
)
)
)
;; #tni_ang
(if (not #tni_ang)
(setq #tni_ang 0.0)
)
(princ "\nВведите угол <")
(princ #tni_ang)
(princ ">: ")
(setq tmp (getorient))
(if tmp
(setq #tni_ang (* 180.0 (/ tmp pi)))
)
;; #tni_text
(if (not #tni_text)
(setq #tni_text "Пример текста")
)
(princ "\nВведите текст <")
(princ #tni_text)
(princ ">: ")
(setq tmp (getstring T))
(if (/= tmp "")
(setq #tni_text tmp)
)
;; Добавление текста
(initget "L M C R")
(setq amode (getkword "\nВыберите выравнивание для текста [Left Align (L) / Middle Align (M) / Center Align (C) / Right Align (R)] <Left>: "))
(if (not amode)
(setq amode "L")
)
(setq i -1)
(cond
((= fixedtxth 1)
(repeat (sslength ss)
(setq ei (ssname ss (setq i (1+ i)))
ai (entget ei)
pti (cdr (assoc 10 ai))
ptt (polar pti (* pi (/ #tni_ang 180.0)) #tni_dist)
)
(cond
((= amode "L")
(command "_.-text" "_l" ptt #tni_ang #tni_text)
)
((= amode "M")
(command "_.-text" "_m" ptt #tni_ang #tni_text)
)
((= amode "C")
(command "_.-text" "_c" ptt #tni_ang #tni_text)
)
((= amode "R")
(command "_.-text" "_r" ptt #tni_ang #tni_text)
)
)
)
)
((= fixedtxth 0)
(repeat (sslength ss)
(setq ei (ssname ss (setq i (1+ i)))
ai (entget ei)
pti (cdr (assoc 10 ai))
ptt (polar pti (* pi (/ #tni_ang 180.0)) #tni_dist)
)
(cond
((= amode "L")
(command "_.-text" "_l" ptt #tni_txth #tni_ang #tni_text)
)
((= amode "M")
(command "_.-text" "_m" ptt #tni_txth #tni_ang #tni_text)
)
((= amode "C")
(command "_.-text" "_c" ptt #tni_txth #tni_ang #tni_text)
)
((= amode "R")
(command "_.-text" "_r" ptt #tni_txth #tni_ang #tni_text)
)
)
)
)
)
(princ "\nГотово!")
(setvar "osmode" oldosmode)
(setvar "cmdecho" oldcmd)
)
(princ "\nНе найдены объекты.")
)
(setq *error* olderr)
(princ)
)

Может проще если высота 0 запустить команду 1, не 0 запустить команду 2. - Как это сделать???

Сергей812 · 30.11.2020, 15:16

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

olga87 · 30.11.2020, 21:31

Если в главном коде лиспа через if определить 2-е функции, то как их выбрать по условию в коде команды?

Код:

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

^C^C^P(if (...)(функция1 с опциями)(функция0 с опциями))

Сергей812 · 30.11.2020, 21:37

Цитата:

Сообщение от olga87

Если в главном коде лиспа через if определить 2-е функции, то как их выбрать по условию в коде команды?

я бы сделал третий лисп, который и подвесил бы на команду) Все равно же подгружаете *.lsp .

olga87 · 30.11.2020, 22:01

Код:

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

(defun c:3()
(initget "Y N")
(setq option (getkword "\nDo you want to do this [Y/N] <N>: "))
(setq textdat (tblsearch "style" (getvar "textstyle")))
(if (/= 0.0 (cdr (assoc 40 textdat)))
(N)
(Y)
)
)

Как дальше не знаю?

Код:

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

^C^C^P(if (Y)(функция1 с опциями)(функция0 с опциями))

Сергей812 · 30.11.2020, 23:00

Цитата:

Сообщение от olga87

(if (Y)(функция1 с опциями)(функция0 с опциями))

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

Кулик Алексей aka kpblc · 30.11.2020, 23:55

К сожалению, сейчас не могу ни запустить ACAD, ни протестировать код. Все в качестве варианта.
Если заранее известна высота текста (судя по коду и запросам - хотя ох как я не люблю в качестве разделителей пробелы! - проблема прежде всего именно в этом), я бы написал код, который в зависимости от переданного параметра использует:
- высоту текстового стиля, если она не 0
- значение перемнной textsize
- предустановленное значение
- и при этом выполняет ровно те же функции, которые и нужны.
--
Ай, ладно, попробую что-нибудь нарисовать...

Код:

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

 (vl-load-com)

(defun make-txt-by-blocks (param / selset dist height ang text pt)
                          ;|
*    Создание текстов около точек вставки блоков
* https://forum.dwg.ru/showthread.php?p=1910206#post1910206
*    Параметры вызова:
  param   ; список необязательных параметров вида
    '(("dist" . <Значение отступления от точки вставки>) ; nil -> 0.0
      ("angle" . <Угол поворота текста, градусов>) ; nil -> 0.0
      ("height" . <Высота текста по умолчанию>) ; nil -> запрос у пользователя
      ("textsize" . <Использовать сист.перем. TEXTSIZE>) ; при задании и отсутствии height используется именно она
      )
*    Примеры вызова:
(make-txt-by-blocks nil)
(make-txt-by-blocks '(("dist" . 10.)))
(make-txt-by-blocks '(("dist" . 10.) ("textsize" . t)))
(make-txt-by-blocks '(("dist" . 16.) ("height" . 2.5) ("angle" . 0.)))
|;
  (if (and (or (setq selset (ssget "_I" '((0 . "INSERT"))))
               (= (type (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))))))))
                  'pickset
               ) ;_ end of =
           ) ;_ end of or
           (setq selset ((lambda (/ tab item)
                           (repeat (setq tab  nil
                                         item (sslength selset)
                                   ) ;_ end setq
                             (setq tab (cons (ssname selset (setq item (1- item))) tab))
                           ) ;_ end of repeat
                         ) ;_ end of lambda
                        )
           ) ;_ end of setq
           (= (type
                (setq dist (vl-catch-all-apply
                             (function (lambda ()
                                         (cond ((cdr (assoc "dist" param)))
                                               (t
                                                (initget 6)
                                                (cond ((getdist (strcat "\nВведите расстояние от блока до текста <"
                                                                        (rtos (cond ((not #def-dist) (setq #def-dist 0.))
                                                                                    (#def-dist)
                                                                              ) ;_ end of cond
                                                                              2
                                                                        ) ;_ end of rtos
                                                                        "> : "
                                                                ) ;_ end of strcat
                                                       ) ;_ end of getdist
                                                      )
                                                      (#def-dist)
                                                      (t (setq #def-dist 0.))
                                                ) ;_ end of cond
                                               )
                                         ) ;_ end of cond
                                       ) ;_ end of lambda
                             ) ;_ end of function
                           ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
              'real
           ) ;_ end of =
           (= (type
                (setq height (vl-catch-all-apply
                               (function
                                 (lambda ()
                                   (initget 6)
                                   (cond ((cdr (assoc "height" param)))
                                         ((cdr (assoc "textsize" param)) (getvar "textsize"))
                                         ((getdist (strcat "\nВведите высоту текста <"
                                                           (rtos (cond ((not #def-height) (setq #def-height (getvar "textsize")))
                                                                       (#def-height)
                                                                 ) ;_ end of cond
                                                                 2
                                                           ) ;_ end of rtos
                                                           "> : "
                                                   ) ;_ end of strcat
                                          ) ;_ end of getdist
                                         )
                                         (t #def-height)
                                   )
                                 ) ;_ end of lambda
                               ) ;_ end of function
                             ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
              'real
           ) ;_ end of =
           (> height 0.)
           (= (type
                (setq ang (vl-catch-all-apply (function (lambda ()
                                                          (cond ((cdr (assoc "angle" param)))
                                                                ((getangle (strcat "\nВведите угол наклона текста <"
                                                                                   (rtos (cond (#def-angle)
                                                                                               ((setq #def-angle 0.))
                                                                                         ) ;_ end of cond
                                                                                         2
                                                                                   ) ;_ end of rtos
                                                                                   "> : "
                                                                           ) ;_ end of strcat
                                                                 ) ;_ end of getangle
                                                                )
                                                                (t #def-angle)
                                                          ) ;_ end of cond
                                                        ) ;_ end of lambda
                                              ) ;_ end of function
                          ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
              'real
           ) ;_ end of =
           (= (type
                (setq text (vl-catch-all-apply (function (lambda (/ value)
                                                           (setq value (getstring t
                                                                                  (strcat "\nВведите образец текста <"
                                                                                          (cond (#def-text)
                                                                                                ((setq #def-text "abc"))
                                                                                          ) ;_ end of cond
                                                                                          "> : "
                                                                                  ) ;_ end of strcat
                                                                       ) ;_ end of getstring
                                                           ) ;_ end of setq
                                                           (if (/= value "")
                                                             (setq #def-text value)
                                                             (setq value #def-text)
                                                           ) ;_ end of if
                                                           value
                                                         ) ;_ end of lambda
                                               ) ;_ end of function
                           ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
              'str
           ) ;_ end of =
           (/= text "")
           (= (type
                (setq align (vl-catch-all-apply
                              (function (lambda ()
                                          (initget "Left Right Middle _ L R M")
                                          (cond ((getkword "\nУкажите выравнивание [Left/Right/Middle] <Left> : "))
                                                (t "L")
                                          ) ;_ end of cond
                                        ) ;_ end of lambda
                              ) ;_ end of function
                            ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
              ) ;_ end of type
              'str
           ) ;_ end of =
      ) ;_ end of and
    (progn (setq #def-angle ang
                 #def-text text
                 #def-height height
                 #def-dist dist
           ) ;_ end of setq
           (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
           (foreach ent selset
             (setq pt (polar (cdr (assoc 10 (entget ent))) (* pi (/ ang 180.)) #def-dist))
             (entmakex (list (cons 0 "TEXT")
                             (cons 40 #def-height)
                             (cons 10 pt)
                             (cons 11 pt)
                             (cons 1 #def-text)
                             (cons 73 0)
                             (cons 72
                                   (cond ((= align "M") 1)
                                         ((= align "R") 2)
                                         (t 0)
                                   ) ;_ end of cond
                             ) ;_ end of cons
                       ) ;_ end of list
             ) ;_ end of entmakex
           ) ;_ end of foreach
           (vla-endundomark adoc)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

Чисто теоретически можно добавить и параметры угла поворота, и текст "по умолчанию", и... Вообще все что угодно можно сделать. Было бы желание

olga87 · 01.12.2020, 07:33

Спасибо!
Код попробовала: не работает "текст по умолчанию" (если нажать Enter) и выравнивание (всегда влево).

Кулик Алексей aka kpblc · 01.12.2020, 07:59

Я вчера прогонял - вроде работало.

----- добавлено через ~3 ч. -----
Код обновил, забирай. Особо не проверял - некогда

olga87 · 01.12.2020, 13:32

Спасибо!
Если использовать, например:

Код:

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

(make-txt-by-blocks '(("dist" . 0.) ("textsize" . nil) ("angle" . 0.)))

то код работает, но всегда идет запрос высоты и используется всегда текстовый стиль Standard.
Можете подсказать, как исправить код, чтобы использовался текущий текстовый стиль, если высота в стиле 0 - то запрос высоты, иначе если высота в стиле фиксированная и не 0 - то без запроса взять ее?

Код:

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

(if (zerop (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))(progn(???)(prin1))(progn(???)(prin1)))

Кулик Алексей aka kpblc · 01.12.2020, 14:01

Я не прописывал принудительное назначение текстового стиля. Теоретически должно создаваться именно с текущими настройками - стилем, цветом, весом линии, слоем и т.д. А так - см. DXF Reference и в коде надо будет менять список, передаваемый entmakex.
Высота у меня запрашивается, поскольку изначально именно так я понял вопрос. В принципе, никто не мешает передавать точечную пару '("height" . <Устанавливаемая высота>), если высота текста известна.

olga87 · 02.12.2020, 08:27

Подскажите пожалуйста, как в коде #10 ввести расстояние (параметр dist) , например, @1<90, т.е. мне нужно от точки вставки блока указать точку (для текста) по оси Y на 1 вверх?

Кулик Алексей aka kpblc · 02.12.2020, 12:44

olga87, у меня нет возможности реализовывать все вопросы. Советую обратиться в тему "Научите лиспу на примере..." в разделе "Программирование". Там, скорее всего, объяснят, что и как добавить / убавить / заменить. И самое главное - почему.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Перенести команды из меню mnu в существующий cuix	olga87	AutoCAD	0	26.11.2020 09:04
Что прописать в acad.lsp чтобы всегда загружались пользовательские лисп команды?	overband	LISP	43	07.02.2013 14:47
Варианты контекстного меню, вызываемого в процессе работы команды	hwd	Программирование	14	24.12.2012 11:02
Почему блок содержащий атрибут теряет его при приминении к блоку команды разместить?	Роман Амосов	Динамические блоки	2	20.05.2012 12:25
Прозрачные команды	Vova	AutoCAD	17	21.06.2006 05:33

30.11.2020, 13:39		#1
Условие запуска команды olga87 Регистрация: 28.05.2007 Сообщений: 208 Здравствуйте Уважаемые специалисты Автокад! Код ниже НЕ рабочий - это пользовательская команда Автокада, в которой: - в начале стоит условие: нулевая или нет высота текста в текущем текстовом стиле. - затем два варианта хода команды: 1) запустить команду macros, автоматически ввести координаты точки (@0<0), вывести запрос высоты (\), автоматически ввести угол (0). 2) запустить команду macros, автоматически ввести координаты точки (@0<0), автоматически ввести угол (0). Подскажите пожалуйста, как правильно сделать рабочую команду (в одной строке) с условием и дальнейшим ходом? "macros" - это команда из лисп macros.lsp, в котором выполняется процедура вставки текста с запросом точки вставки, высоты текста и угла текста. Заранее спасибо! Код: [Выделить все] ^C^C^P(if (/= 0.0 (cdr (assoc 40 (tblsearch "style" (getvar "textstyle"))))) (macros @0<0 \0)(macros @0<0 0)) ^P
Просмотров: 2411