Тема: LISP. Вставка текста в разрыв линии

;************ ctrim.lsp **********************************
;   Вставка текста с текущим стилем в разрыв линии.
;   Шрифт стиля не должен иметь фиксированную высоту.
;
(DEFUN C:CTRIM ( / PNT MRK SZE RAD)
    (setvar "CMDECHO" 0)
    (setq OSX (getvar "OSMODE"))
    (setvar "OSMODE" 512)
    (setq PNT (getpoint "\n Укажите место разрыва:"))
    (setq SZE (getvar "TEXTSIZE"))
    (setq RAD (+ SZE (/ SZE 3.0)))
    (command "_CIRCLE" PNT RAD)
    (setq EL (ENTLAST))
    (command "_TRIM" EL "" PNT "")
    (command "_ERASE" EL "")
    (setq MRK (getstring "\n Введите текст (3 знака Max):"))
    (command "_TEXT" "_M" PNT "" "0" MRK)
    (setvar "OSMODE" OSX)
    (PRINC)
)

Возможный макрос для кнопки или пункта меню:

^C^C^P(if (not C:CTRIM) (load "ctrim")) CTRIM

Re: LISP. Вставка текста в разрыв линии

Текс в указанную точку линии вставляется номально, но исходная линия при этом не разрывается. Или надо было использовать для этого не сплошную линию, а например пунктирную и пытаться вставить в её разрыв. Хотя в программе прописана команда TRIM. В своё время я пытался в программе использовать команду TRIM, но отказался от неё из-за ненадёжности её работы. Эта команда мне показалось больше расчтина на интерактивное указание участка обрезки. Может я что-то недопонимаю или делаю не так?

Re: LISP. Вставка текста в разрыв линии

ИМХО: Желательно использовать Express Tools - textmask. В таком случае:

(defun breake-line-by-text( / _osmode_)
  (setq _osmode_ (getvar "osmode"))
  (command "wipeout" "_Frames" "_Off")
  (command "_dtext")
  (while (/= (getvar "cmdactive") 0)
    (command pause)
    );_while
  (command "textmask" "_Last" "")
  );_defun

Макрос для вызова:

^C^C(if (not (break-line-by-text)) (load "break-line-by-text.lsp"));(break-line-by-text)

Предупреждение: программа не может считаться хоть сколько-то законченной.
Ограничения применения:
1. Создается однострочный текст;
2. Работает только над последним созданным текстом;
3. Если в файле есть объекты с применением wipeout, эти объекты могут поменять свой вид;
4. Не меняются настройки маски;
5. На компьютере должны быть установлены Express Tools;
6. Удаление "разрыва" без подготовки - немного нервное занятие.
На самом деле ограничений и тонкостей тут до дури, перечислил то, что лежит на поверхности.
---
Переделывать на многострочный не буду - можно и самостоятельно, заменив всего одну строку. Если будет применяться многострочный текст, пп.1 и 2 ограничений снимаются.
Можно дополнительно запрашивать значения отступов,

Re: LISP. Вставка текста в разрыв линии

Тьфу, елки-моталки, пост обрубился - "Нам разум дал стальные руки-крюки!"
Можно дополнительно запрашивать варианты установок, но уже лениво думать. Пятница всеж-таки

Re: LISP. Вставка текста в разрыв линии

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

Re: LISP. Вставка текста в разрыв линии

Некоторые дополнения:
1. Функцию надо переобозвать на (defun break-line-by-text()
<..>
)
2. Небольшая доработочка: при создании однострочного текста меняется выравнивание на центр по середине высоты:

(defun break-line-by-text( / _osmode_)
  (setq _osmode_ (getvar "osmode"))
  (setvar "osmode" 512) ; привязка Nearest
  (command "wipeout" "_Frames" "_Off")
  (command "_dtext" "_Justify" "_MC")
  (while (/= (getvar "cmdactive") 0)
    (command pause)
    );_while
  (command "textmask" "_Last" "")
  (setvar "osmode" _osmode_)
  );_defun

3. И самое главное - не уверен насчет программной возможности использовать многострочный текст.

Re: LISP. Вставка текста в разрыв линии

> Анатолий Б
Возможность устройства разрыва линии зависит от масштаба отображения на экране места вставки текста (зуммирование). Играет роль переменная "PICKBOX". Программа не моя, выложил "как есть".

Re: LISP. Вставка текста в разрыв линии

Позвольте и мне вставить свои пять копеек:
http://cadhlp.kulichki.net/old/prog3/prg3-2.htm#kig
______________
Удачи.

Re: LISP. Вставка текста в разрыв линии

Ну и я тоже, за компанию:)
LTEXT.LSP

;;;Программа для ввода текста в разрыве линии.
;;; Apelsinov
(defun c:ltext (/      dcl_id st     vysota texstyle      olderr prim
        lin    sel    xy3    ang1   ang       texta  xy2     xy1
        dlin   mult   A         st      obozn  orient formtext
           )
  (setq sel T)
;;;  Извлечение ранее введенных параметров
(if (null *ltext_properties_list*)
  (setq *ltext_properties_list* (list "" "Above" "1"))
)
  (setq    obozn  (nth 0 *ltext_properties_list*)
    orient
           (nth 1 *ltext_properties_list*)
    mult
           (nth 2 *ltext_properties_list*)
  )
  (_MODES '("CMDECHO" "OSMODE"))
  (SETQ olderr *ERROR*)
  (SETQ *ERROR* TOPO_ERR)
  (setvar "cmdecho" 0)
  ;;-------------------------------------------------------------------------
  (if (< (setq dcl_id (load_dialog "ltext.dcl")) 0)
    (exit)
  )
  (if (not (new_dialog "Ltext" dcl_id))
    (exit)
  )
;;;multiple
  (set_tile "mult" mult)
;;;Обозначение
  (set_tile "a1" obozn)
  (mode_tile "a1" 2)
                    ;(action_tile
                    ;   "a1"
                    ;  "(if (eq $value \"\") (mode_tile \"ok\" 1)(mode_tile \"ok\" 0))")
;;;Ориентация
   (set_tile "b1" orient)
;;; Указание высоты текста
  (action_tile
    "c1"
    "(if (or (<= (atoi $value) 0)) (progn
        (alert \"Invalid height!\")
        (mode_tile \"c1\" 2))))"
  )
  (set_tile "c1" (rtos (getvar "textsize")))
;;; Тектовый стиль
  (start_list "d1" 3)
  (setq
    st (cons (add_list (cdr (assoc 2 (setq A (tblnext "STYLE" T)))))
         st
       )
  )
  (while A
    (progn
      (setq A (tblnext "STYLE"))
      (if A
    (setq st (cons (add_list (cdr (assoc 2 A))) st))
      )
    )
  )
  (end_list)
  (set_tile "d1"
        (rtos (vl-position (getvar "textstyle") (reverse st)))
  )
;;;-----------ok---------------
  (action_tile
    "ok"
    "(setq vysota (atof (get_tile \"c1\")))
          (setq obozn (get_tile \"a1\"))
          (setq texstyle  (nth (atoi (get_tile \"d1\")) (reverse st)))
          (setq orient (get_tile \"b1\"))
          (setq mult (get_tile \"mult\"))
    (done_dialog)"
  )
  (action_tile "cancel" "(done_dialog)(exit)")
;;;Диалог
  (start_dialog)
  (unload_dialog dcl_id)
  ;;-------------------------------------------------------------------------------
  (setq A nil)
  (While (null A)
    (setq prim nil
      sel  nil
    )
    (while (/= prim "LINE")
      (while (null sel)
    (initget "Exit")
    (setq sel (entsel "\n Select line [Exit]:"))
      ) ;_ while
      (if (eq sel "Exit")
    (exit)
      )
      (setq lin (car sel))
      (setq prim (cdr (assoc 0 (entget lin))))
      (if (/= prim "LINE")
    (progn
      (alert "This object not LINE!!!")
      (setq sel nil)
    ) ;_ progn
      ) ;_ if
    ) ;_ while
    (setq ang (angle (cdr (assoc 10 (entget lin)))
             (cdr (assoc 11 (entget lin)))
          ) ;_ angle
    ) ;_ setq
    (vl-load-com)
    (setq xy3 (vlax-curve-getClosestPointTo
        (vlax-ename->vla-object lin)
        (trans (cadr sel) 1 0)
          ) ;_ vlax-curve-getClosestPointTo
    ) ;_ setq
    (setq ang1 ang)
    (if
      (and (> ang1 (/ pi 2)) (<= ang1 (* pi 1.5)))
       (setq ang1 (+ ang1 pi))
    ) ;_ if
;;;    *********************************
;;;    То что было раньше-фигня какая-то, и где мои были глаза!
;;;    (if    (eq orient "Above")
;;;      (setq xy3 (polar xy3 (+ ang1 (/ pi 2)) vysota))
;;;    ) ;_ if
;;;    (if    (eq orient "Undo")
;;;      (setq xy3 (polar xy3 (- ang1 (/ pi 2)) vysota))
;;;    ) ;_ if
;;;******************************************
;;;    Перепишу ка я это все:
    (setq formtext
       (cdr    (assoc orient
               '(("Above" . 1) ("Centered" . 2) ("Undo" . 3))
        )
       )
    )
;;;    вот такие пироги и все оки оки
    (setq texta    (list '(0 . "TEXT")
              (cons 1 obozn)
              (cons 40 vysota)
              (cons 50 ang1)
              (cons 10 xy3)
              (cons 11 xy3)
              (cons 7 texstyle)
              '(72 . 1)
              (cons 73 formtext)
              '(-3 ("ACAD" (1000 . "LineText")))
        ) ;_ list
    ) ;_ setq
    (entmake texta)
    (setq texta (entget (entlast)))
    (setq dlin (+ vysota
          (- (caadr (textbox texta)) (caar (textbox texta)))
           ) ;_ +
    ) ;_ setq
    (setq xy2 (trans (polar xy3 ang (/ dlin 2)) 0 1))
    (setq xy1 (trans (polar xy3 (- ang pi) (/ dlin 2)) 0 1))
    (setvar "osmode" 0)
    (if    (eq orient "Centered")
      (command "_break" lin xy1 xy2)
    ) ;_ if
    (if    (eq mult "0")
      (setq A t)
    )
  )
  (setvar "textstyle" texstyle)
  (setvar "textsize" vysota)
  (setq *ltext_properties_list* (list obozn orient mult))
  (_MODER)
  (SETQ *ERROR* olderr)
  (princ)
) ;_ defun
;;; Функция обработки ошибок
(DEFUN TOPO_ERR    (msg)
  (_MODER)
  (if (and texstyle vysota obozn orient mult)
    (progn
      (setvar "textstyle" texstyle)
      (setvar "textsize" vysota)
      (setq *ltext_properties_list* (list obozn orient mult))
    )
  )
  (IF (/= msg "quit / exit abort")
    (PRINC (STRCAT "\n Error:: " msg))
    (princ "*Cancel*")
  ) ;_ IF
) ;_ DEFUN
;;; Функция сохранения данных
(DEFUN _MODES (a)
  (SETQ mlst NIL)
  (REPEAT (LENGTH a)
    (SETQ mlst (APPEND mlst (LIST (LIST (CAR a) (GETVAR (CAR a))))))
    (SETQ a (CDR a))
  ) ;_ REPEAT
) ;_ DEFUN
;;; Функция восстановления данных
(DEFUN _MODER ()
  (REPEAT (LENGTH mlst)
    (SETVAR (CAAR mlst) (CADAR mlst))
    (SETQ mlst (CDR mlst))
  ) ;_ REPEAT
) ;_ DEFUN

И файл LTEXT.DCL

Ltext: dialog {label = "Line Text";
:row {
spacer_1;
:edit_box {label= "Enter text:"; edit_width=20;fixed_width_font=true;key="a1";}
:column {
:ok_button {label= " Apply ";is_default=true; key="ok";}
:cancel_button {is_cancel=true; key="cancel";}
}
}
:row {
spacer_1;
:radio_column {label="Orientation"; key="b1";
:radio_button {label="Above"; key="Above";value="0";}
:radio_button {label="Centered"; key="Centered";value="1";}
:radio_button {label="Undo"; key="Undo";value="0";}}
spacer_1;
:column {label="Options";
:edit_box {label= "Text heidht:"; edit_width=5; key="c1";}
:popup_list {label= "Text style:"; edit_width=10; height=10; fixed_height=true; key="d1";}
:toggle {label= "Multiple"; value="0"; key="mult";}
spacer_1;
}
spacer_1;
}
spacer_1;
:text {label="Apelsinov. LineText 7";}
}

Re: LISP. Вставка текста в разрыв линии

Интересное приложение
Почемуто полилинию шириной 1 мм не разрезало, может что не так делаю?

Re: LISP. Вставка текста в разрыв линии

> Рашит
Если это ко мне вопрос, то и не должно было - лолько для линий ( line ).

Re: LISP. Вставка текста в разрыв линии

А можна переделать под полинию???

Re: LISP. Вставка текста в разрыв линии

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

(defun c:breakup (/ p1 ang txt sz szall tmpcirc)
 (setq p1  (getpoint "\n Точка разрыва : ")
       ang (* (/ (getangle p1 "\n Угол наклона текста : ") pi) 180)
       txt (getstring 1 "\n Текст : ")
       sz  (getvar "TEXTSIZE"))
 (command "_text" "_j" "_mc" p1 "" ang txt "" "")
 (setq szall (textbox (entget (entlast))))
(princ szall)
 (setq szall (- (car (cadr szall)) (car (car szall))))
 (entdel (entlast))
 (command "_circle" p1 (+ (/ szall 2) (* 0.5 sz)))
 (setq tmpcirc (entlast))
 (command "_trim" tmpcirc "" p1 ""
          "_erase" tmpcirc ""
          "_text" "_j" "_mc" p1 "" ang txt "" ""))

Re: LISP. Вставка текста в разрыв линии

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

(defun c:breakup (/ p1 ang txt sz szall tmpcirc)
 (setq p1  (getpoint "\n Точка разрыва : ")
       ang (* (/ (getangle p1 "\n Точка задающая угол наклона текста : ") pi) 180)
       txt (getstring 1 "\n Текст : ")
       sz  (getvar "TEXTSIZE"))
 (command "_text" "_j" "_mc" p1 "" ang txt "")          ;рисуем текст в точке разрыва
 (setq szall (textbox (entget (entlast))))
 (setq szall (- (car (cadr szall)) (car (car szall))))  ;замеряем его длину
 (entdel (entlast))                                     ;удаляем текст
 (command "_circle" p1 (+ (/ szall 2) (* 0.5 sz)))      ;рисуем круг в точке разрыва
                                                         по размеру текста
 (setq tmpcirc (entlast))
 (command "_trim" tmpcirc "" p1 ""                      ;обрезаем все что внутри круга
          "_erase" tmpcirc ""                           ;удаляем круг
          "_text" "_j" "_mc" p1 "" ang txt ""))         ;опять рисуем текст

Объединить оба примера могла бы функция типа vl-addtext. Но ее описание я не могу взять, т.к. хелп что-то глючит. Да и работать она не будет под acad lt + extender.

Re: LISP. Вставка текста в разрыв линии

Замечательно! Очень полезный лисп от Леши! Не хватает только одного: запроса размера текста в разрыве. Добавьте, кто может, плиз...

Re: LISP. Вставка текста в разрыв линии

(defun c:breakup (/ p1 ang txt sz szall tmpcirc)
 (princ "\nВысота текста < ")(princ (getvar "TEXTSIZE"))(princ " >: ")
 (initget 6)
 (setq sz (getdist))
 (if sz (setvar "TEXTSIZE" sz) )
 (setq p1  (getpoint "\n Точка разрыва : ")
       ang (* (/ (getangle p1 "\n Точка задающая угол наклона текста : ") pi) 180)
       txt (getstring 1 "\n Текст : ")
       sz  (getvar "TEXTSIZE"))
 (command "_text" "_j" "_mc" p1 "" ang txt "")          ;рисуем текст в точке разрыва
 (setq szall (textbox (entget (entlast))))
 (setq szall (- (car (cadr szall)) (car (car szall))))  ;замеряем его длину
 (entdel (entlast))                                     ;удаляем текст
 (command "_circle" p1 (+ (/ szall 2) (* 0.5 sz)))      ;рисуем круг в точке разрыва
                                                         по размеру текста
 (setq tmpcirc (entlast))
 (command "_trim" tmpcirc "" p1 ""                      ;обрезаем все что внутри круга
          "_erase" tmpcirc ""                           ;удаляем круг
          "_text" "_j" "_mc" p1 "" ang txt ""))         ;опять рисуем текст

Re: LISP. Вставка текста в разрыв линии

Спасибо!!!

Re: LISP. Вставка текста в разрыв линии

В ходе проверочных экспериментов выяснилось что менять переменную textsize не имеет смысла. Она лишь показывает какой был последний размер текста и больше ни на что не влияет. Для задания размера текста пришлось использовать команду style. Вот код (на акаде2007 работает):

(defun c:breakup (/ p1 ang txt sz szall tmpcirc)
 (setq p1  (getpoint "\n Точка разрыва : ")
       ang (* (/ (getangle p1 "\n Точка задающая угол наклона текста : ") pi) 180)
       txt (getstring 1 "\n Текст : ")
       sz  (getdist (strcat "\nВысота текста <" (rtos (getvar "TEXTSIZE")) ">: ")))
 (command "_style" "" "" sz "" "" "" "" ""
          "_text" "_j" "_mc" p1 ang txt "")
 (setq szall (textbox (entget (entlast))))
 (setq szall (- (car (cadr szall)) (car (car szall))))
 (entdel (entlast))
 (command "_circle" p1 (+ (/ szall 2) (* 0.5 sz)))
 (setq tmpcirc (entlast))
 (command "_trim" tmpcirc "" p1 ""
          "_erase" tmpcirc ""
          "_text" "_j" "_mc" p1 ang txt ""))

Re: LISP. Вставка текста в разрыв линии

Здравствуйте, есть ли что-нибудь автоматизированное для выполнения данной задачи?
Задача: Имеются множество линий на которых нанесён текст, необходимо одной командой оборвать все линии вокруг, нанесённого текста? (-----T1----)

Re: LISP. Вставка текста в разрыв линии

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

Re: LISP. Вставка текста в разрыв линии

Нашел интересную команду TEXTMASK в меню express вот она то и мнимо обрезает линии.. Урра

Re: LISP. Вставка текста в разрыв линии

Кто-нибудь знает как запустить поиск определенного текста, например "Т21", и для него применить команду TEXTMASK?

Re: LISP. Вставка текста в разрыв линии

> Jon63
Есть способ по проще. В свойствах Mtext выбрать Background mask_yes.  Плюсом этого способа есть то, что при перемещении текста маска перемещается вместе с текстом, в отличии от TEXTMASK