Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
Для версий ACAD старше 2002 код утяжеляется:
(if (= a10 "Р")(repeat 7 (redraw a1 2)(princ)(command "_.delay" 80) (redraw a1 1)(princ)(command "_.delay" 80) ))
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
LISP. Разрыв (обрыв, ...) строчки в указанной точке (Страница 2 из 2)
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Сообщения с 26 по 35 из 35
- Kosarev
- Активный участник
- Kosarev
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
или как вариант...
(if (= a10 "Р")(repeat 4 (command "_.rotate" a1 "" (cdr (assoc 10 a)) -20 "_.delay" 80) (command "_.rotate" a1 "" (cdr (assoc 10 a)) 20 "_.delay" 80) ))
- Малявка
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
Да, прикольненько. А можешь сделать, чтобы буквы у хвоста поочередно (как в бегущих огнях) поменяли цвет на красный, оранжевый, желтый, зеленый, голубой и синий и вернули свой первоначальный цвет?
Хотя это уже к теме "фенечки", а не "готовые программы". И тем не менее...
Предполагаю, для начала надо программно сосчитать количество знаков в хвосте.
Что дальше - даже не предполагаю...
- Kosarev
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
Вообще-то всякими-разными прибомбасами злоупотреблять не стоит, особенно при попытке модернизировать чьи-либо готовые коды, особенно когда это делают любители, типа меня. Это чревато появлением сбойных ситуаций и т.п.
Буквами отдельно моргать трудно, целым хвостом просто, поэтому для желающих представляю несколько более-менее безопасных (на мой взгляд) вариантов...
;; просто моргаем
(if (and (= a10 "Р")(= (type a1) 'ENAME))(repeat 7
(redraw a1 2)(princ)(command "_.delay" 80)
(redraw a1 1)(princ)(command "_.delay" 80)
))
;; киваем
(if (and (= a10 "Р")(= (type a1) 'ENAME))
((lambda (/ obj oldrot)
(setq oldrot (vla-get-rotation (setq obj (vlax-ename->vla-object a1))))
(vl-catch-all-apply (function (lambda ()(repeat 3
(command "_.rotate" a1 "" (cdr (assoc 10 a)) -20 "_.delay" 80)
(command "_.rotate" a1 "" (cdr (assoc 10 a)) 20 "_.delay" 80)
))))
(vla-put-rotation obj oldrot)(vlax-release-object obj)
))
)
;; радуга
(if (and (= a10 "Р")(= (type a1) 'ENAME))
((lambda (/ obj oldcol)
(setq oldcol (vla-get-color (setq obj (vlax-ename->vla-object a1))))
(vl-catch-all-apply (function (lambda ()(repeat 2
(vla-put-color obj 1)(princ)(command "_.delay" 150)
(vla-put-color obj 4)(princ)(command "_.delay" 150)
(vla-put-color obj 6)(princ)(command "_.delay" 150)
(vla-put-color obj 3)(princ)(command "_.delay" 150)
(vla-put-color obj 2)(princ)(command "_.delay" 150)
))))
(vla-put-color obj oldcol)(vlax-release-object obj)
))
)- Kosarev
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
Для первого варианта не помешает...
;; моргаем
(if (and (= a10 "Р")(= (type a1) 'ENAME))
(if (vl-catch-all-error-p (vl-catch-all-apply
(function (lambda ()(repeat 7
(redraw a1 2)(princ)(command "_.delay" 80)
(redraw a1 1)(princ)(command "_.delay" 80)
)))))
(redraw a1 1)
)
)
- Денис Флюстиков
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
> Kosarev
Понравилась твоя идея мигнуть обрезанной частью строки. Спасибо. Код подправил.
;|====================================================
Разрыв (обрыв, ...) строчки в указанной точке
Программа Дениса Флюстикова "Str_Den" от 06.06.08
Макрос для кнопки:
^C^C^P(load "Str_Den");Str_Den
Замечания и предложения по адресу fd-@mail.ru
Большое спасибо Kosarev за помощь в доработке программы
====================================================|;
(defun c:Str_Den (/ n a a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 OSMODE)
(setq a nil)
(while (/= (cdr (assoc 0 a)) "TEXT")
(if (setq a5 (car (entsel "\nВыберите однострочный текст:")))
(setq a (entget a5)))
)
(setq OSMODE (getvar "OSMODE")
n '("l" "c" "r" "a" "m" "f")
a7 (nth (cdr (assoc 72 a)) n )
n '("" "b" "m" "t")
n (nth (cdr (assoc 73 a)) n )
a7 (strcat "_" n a7)
a9 (cdr (assoc 50 a))
a2 (cdr (assoc 10 a))
a2 (trans a2 0 1))
(setvar "CMDECHO" 0)
(command "_.undo" "_g")
(redraw a5 3)
(if (> (rem OSMODE 128) 63)
(setvar "OSMODE" (- OSMODE 64)))
(initget 6 "Р У Н В П")
(if (not (vl-catch-all-error-p
(setq a3 (vl-catch-all-apply 'getpoint
(list "\nточка Разрыва или вторую часть[Удалить/на Новую строку/Вставить в текст/Перенести]<В текст>:")))))
(progn
(setq a10 a3)
(if (null a3)(setq a10 "В"))
(if (= (type a3) 'LIST)
(setq a10 "Р")
(setq a3 (vl-catch-all-apply 'getpoint
(list "\nУкажите точку разделения:"))))
(setvar "OSMODE" OSMODE)
(if (= (type a3) 'LIST)(progn
(setq a1 (cos (- (angle a2 a3) a9))
a3 (* a1 (distance a2 a3))
a4 (caadr (Textbox a))
a6 a4
a1 (cdr (assoc 1 a))
n (strlen a1))
(if (and (< a3 a4)(> a3 0))(progn
(vl-cmdf "_.justifytext" a5 "" "_l")
(vl-cmdf "_.copy" a5 "" a2 a2)
(setq a (entget a5)
a11 a1)
(while (and (> a6 a3)(> n 0))
(setq a11 (substr a11 1 n)
a11 (vl-string-right-trim " " a11)
a8 (subst (cons 1 a11)(assoc 1 a) a)
a6 (subst '(51 . 0)(assoc 51 a8) a8)
a6 (caadr (Textbox a6)))
(if (wcmatch a11 "*%%?")
(setq n (- n 3))
(if (wcmatch a11 "*\U+????")
(setq n (- n 7))
(if (wcmatch a11 "*%%###")
(setq n (- n 5))
(setq n (1- n)))))
)
(entmod a8)
(setq a6 "%%U"
a8 1
a11 (strcase a11))
(while (wcmatch a11 (strcat "*" a6 "*"))
(setq a6 (strcat a6 "*%%U")
a8 (1+ a8)))
(if (= 0 (rem a8 2))
(setq a3 "%%U")
(setq a3 ""))
(setq a6 "%%O"
a8 1)
(while (wcmatch a11 (strcat "*" a6 "*"))
(setq a6 (strcat a6 "*%%O")
a8 (1+ a8)))
(if (= 0 (rem a8 2))
(setq a3 (strcat a3 "%%O")))
(setq a8 (substr a1 (1+ (strlen a11))(strlen a1))
a8 (vl-string-left-trim " " a8)
a8 (strcat a3 a8)
a6 (subst (cons 1 a8)(assoc 1 a) a)
a6 (- a4 (caadr (Textbox a6)))
a1 (entlast)
a (entget a1))
(if (= a10 "Р")(progn
(command "_.delay" 80)
(redraw a1 2)
(princ)
(command "_.delay" 80)
))
(if (= a10 "Н")
(setq a9 (- a9 (/ pi 2))
a6 (cdr (assoc 40 a))
a6 (* 5 (/ a6 3))))
(setq a2 (polar a2 a9 a6)
a2 (trans a2 1 0)
a (subst (cons 10 a2)(assoc 10 a) a)
a2 (trans a2 0 1))
(entmod (subst (cons 1 a8)(assoc 1 a) a))
(vl-cmdf "_.justifytext" a5 a1 "" a7)
(if (= a10 "П")
(vl-cmdf "_.move" a1 "" a2 pause)
(if (and (/= a10 "Р")(/= a10 "Н"))(progn
(command "_.erase" a1 "")
(if (= a10 "В")
(while a2
(if (vl-catch-all-error-p
(setq a (vl-catch-all-apply 'entsel
(list "\nВыберите текст:"))))
(setq a2 nil)
(if (= (type a) 'LIST)(progn
(setq a (entget (car a)))
(if (wcmatch (cdr (assoc 0 a)) "*TEXT")(progn
(setq a2 nil
a4 (cdr (assoc 1 a))
a6 (vl-string-left-trim " " a4)
a7 (- (strlen a4) (strlen a6))
a8 (vl-string-right-trim " " a8))
(if (and (wcmatch a8 "*`-")(not (wcmatch a8 "*`-`-")))
(setq a8 (vl-string-right-trim "-" a8)
a6 (strcat a8 a6))
(setq a6 (strcat a8 " " a6))
)
(repeat a7
(setq a6 (strcat " " a6)))
(entmod (subst (cons 1 a6)(assoc 1 a) a))
)))))))))))
(princ "\nТочка за границами текста")
)))))
(redraw a5 4)
(setvar "OSMODE" OSMODE)
(command "_.undo" "_e")
(setvar "CMDECHO" 1)
(princ)
)#32 11 февраля 2010г. 12:54:24 (изменено: Денис Флюстиков, 11 февраля 2010г. 13:10:23)
- Денис Флюстиков
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
Пришлось переводить спецификации сделанные примитивами AutoCAD в Excel, где размещение текста в ячейках было за счет пробелов в строчках и для корректной работы конвертера написал программку разбивки текста по ячейкам. Функция программы подходит к данной теме, поэтому размещаю здесь, может, кому пригодится.
;|====================================================
Разбивка на отдельные слова строк в местах,
где рядом стоят два и более пробела
Программа Дениса Флюстикова "Str1_Den"
Макрос для кнопки:
^C^C^P(load "Str1_Den");Str1_Den
Замечания и предложения по адресу fd-@mail.ru
====================================================|;
(defun C:Str1_Den (/ ww1 ww2 ww3 ww4 ww5 ww6 ww7 ww8 ww9)
(setq ww1 2 ; Мин. кол-во пробелов (0 - разделение на буквы)
ww8 "")
(repeat ww1 (setq ww8 (strcat " " ww8)))
(setq ww1 (strcat "*" ww8 "*")
ww1 (list '(0 . "TEXT")(cons 1 ww1))
ww9 0)
(if (null (setq ww7 (ssget "_I" ww1)))
(setq ww7 (ssget ww1))
)
(if ww7 (progn
(repeat (sslength ww7)
(setq ww1 (ssname ww7 0)
ww7 (ssdel ww1 ww7)
ww5 (ssadd ww1 (ssadd))
ww2 (entget ww1)
ww6 (list (cdr (assoc 72 ww2))(cdr (assoc 73 ww2)))
ww2 (subst '(72 . 2)(assoc 72 ww2) ww2)
ww2 (subst '(73 . 0)(assoc 73 ww2) ww2)
ww3 (cdr (assoc 10 ww2)))
(entmod ww2)
(setq ww4 (entget ww1)
ww3 (mapcar '- ww3 (cdr (assoc 10 ww4)))
ww3 (mapcar '+ ww3 (cdr (assoc 11 ww4)))
ww4 (subst (cons 11 ww3)(assoc 11 ww4) ww4)
ww3 (cdr (assoc 1 ww4))
ww2 (vl-string-left-trim " " ww3)
ww4 (subst (cons 1 ww2)(cons 1 ww3) ww4))
(entmod ww4)
(setq ww1 (entget ww1))
(while (and (setq ww3 (vl-string-search ww8 ww2))
(/= ww2 ""))
(if (= ww8 "")(cond
((wcmatch ww2 "%%?*")(setq ww3 3))
((wcmatch ww2 "\U+????*")(setq ww3 7))
((wcmatch ww2 "%%###*")(setq ww3 5))
(T (setq ww3 1))
))
(setq ww4 (substr ww2 1 ww3)
ww2 (substr ww2 (+ ww3 1 (strlen ww8)))
ww2 (vl-string-left-trim " " ww2)
ww3 (subst (cons 1 ww4) (assoc 1 ww1) ww1)
ww1 (subst (cons 1 ww2) (assoc 1 ww1) ww1))
(if (= "" ww4)
(entmod ww1)(progn
(setq ww4 (cdr (assoc 10 ww1)))
(if (= "" ww2)(progn
(entmod ww3)
(setq ww3 (cdr (assoc -1 ww1)))
)(progn
(entmake ww3)
(entmod ww1)
(setq ww3 (entlast)
ww9 (1+ ww9))
))
(setq ww5 (ssadd ww3 ww5)
ww1 (entget ww3)
ww3 (mapcar '- ww4 (cdr (assoc 10 ww1)))
ww3 (mapcar '+ ww3 (cdr (assoc 11 ww1)))
ww1 (subst (cons 11 ww3) (assoc 11 ww1) ww1))
(entmod ww1)
))
(setq ww1 (entget (ssname ww5 0)))
)
(repeat (sslength ww5)
(setq ww1 (ssname ww5 0)
ww5 (ssdel ww1 ww5)
ww2 (entget ww1)
ww2 (subst (cons 72 (car ww6)) '(72 . 2) ww2)
ww2 (subst (cons 73 (cadr ww6)) '(73 . 0) ww2)
ww3 (cdr (assoc 10 ww2)))
(entmod ww2)
(setq ww1 (entget ww1)
ww3 (mapcar '- ww3 (cdr (assoc 10 ww1)))
ww3 (mapcar '+ ww3 (cdr (assoc 11 ww1)))
ww1 (subst (cons 11 ww3)(assoc 11 ww1) ww1))
(entmod ww1)
)
)
))
(princ (strcat "\nВыполнено разрезов текста: " (itoa ww9)))
(princ)
)
- gomer
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
Спасибо большое за программку :D . Очень нужна в работе. :D Пока заметил единственный недостаток: при переносе на новую строку текст выравнивается только по левому краю, относительно исходного, даже если выравнивание исходного течкста другое (например Вправо или Центр), Давно хочу программу с разрывом строки на лету: то есть указал текст и все что слева лежит на месте, а все что справа перемещаем в другую точку... :?: :?: :?:
- Денис Флюстиков
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
;|====================================================
Разрыв (обрыв, ...) строчки в указанной точке
Программа Дениса Флюстикова "Str_Den" от 30.09.10
Новое:
разделение горизонтальных строчек по вертикальной
линии (правый клик при первом диалоге)
Макрос для кнопки:
^C^C^P(load "Str_Den");Str_Den
Замечания и предложения по адресу fd-@mail.ru
Большое спасибо Kosarev за помощь в доработке программы
====================================================|;
(defun c:Str_Den (/ n a a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14)
(setq a1 (getvar "OSMODE")
a12 nil
a13 nil
a14 (ssadd))
(if (setq a5 (car (entsel "\nВыберите однострочный текст или <Горизонтальные строчки>:")))
(if (= (cdr (assoc 0 (entget a5))) "TEXT")
(setq a12 (ssadd a5 (ssadd)))
(setq a5 nil)
))
(if a5 (progn
(redraw a5 3)
(if (> (rem a1 128) 63)
(setvar "OSMODE" (- a1 64)))
(initget 6 "Р У Н В П")
(if (not (vl-catch-all-error-p
(setq a13 (vl-catch-all-apply 'getpoint
(list "\nточка Разрыва или вторую часть[Удалить/на Новую строку/Вставить в текст/Перенести]<В текст>:")))))
(progn
(setq a10 a13)
(if (null a13)(setq a10 "В"))
(if (= (type a13) 'LIST)
(setq a10 "Р")
(setq a13 (vl-catch-all-apply 'getpoint
(list "\nУкажите точку разделения:"))))
(setvar "OSMODE" a1)
))
(redraw a5 4)
)
(if (setq a12 (ssget '((0 . "TEXT")(50 . 0))))(progn
(setq a1 (getvar "CURSORSIZE")
a10 "Р")
(setvar "CURSORSIZE" 100)
(setq a13 (vl-catch-all-apply 'getpoint
(list "\nВертикальная линия разделения строк:")))
(setvar "CURSORSIZE" a1)
)))
(setvar "CMDECHO" 0)
(command "_.undo" "_g")
(if (= (type a13) 'LIST)
(repeat (sslength a12)
(setq a5 (ssname a12 0)
a12 (ssdel a5 a12)
a (entget a5)
a9 (cdr (assoc 50 a))
a2 (cdr (assoc 10 a))
a2 (mapcar '+ a2 '(0 0))
a2 (trans a2 0 1)
a7 (list (cdr (assoc 72 a))(cdr (assoc 73 a)))
a (subst '(72 . 0)(assoc 72 a) a)
a (subst '(73 . 0)(assoc 73 a) a))
(entmod a)
(setq a1 (cos (- (angle a2 a13) a9))
a3 (* a1 (distance a2 a13))
a4 (caadr (Textbox a))
a6 a4
a1 (cdr (assoc 1 a))
n (strlen a1))
(if (and (< a3 a4)(> a3 0))(progn
(vl-cmdf "_.copy" a5 "" "@" "@")
(setq a (entget a5)
a11 a1)
(while (and (> a6 a3)(> n 0))
(setq a11 (substr a11 1 n)
a11 (vl-string-right-trim " " a11)
a8 (subst (cons 1 a11)(assoc 1 a) a)
a6 (subst '(51 . 0)(assoc 51 a8) a8)
a6 (caadr (Textbox a6)))
(if (wcmatch a11 "*%%?")
(setq n (- n 3))
(if (wcmatch a11 "*\U+????")
(setq n (- n 7))
(if (wcmatch a11 "*%%###")
(setq n (- n 5))
(setq n (1- n)))))
)
(entmod a8)
(setq a6 "%%U"
a8 1
a11 (strcase a11))
(while (wcmatch a11 (strcat "*" a6 "*"))
(setq a6 (strcat a6 "*%%U")
a8 (1+ a8)))
(if (= 0 (rem a8 2))
(setq a3 "%%U")
(setq a3 ""))
(setq a6 "%%O"
a8 1)
(while (wcmatch a11 (strcat "*" a6 "*"))
(setq a6 (strcat a6 "*%%O")
a8 (1+ a8)))
(if (= 0 (rem a8 2))
(setq a3 (strcat a3 "%%O")))
(setq a8 (substr a1 (1+ (strlen a11))(strlen a1))
a8 (vl-string-left-trim " " a8)
a8 (strcat a3 a8)
a6 (subst (cons 1 a8)(assoc 1 a) a)
a6 (- a4 (caadr (Textbox a6)))
a1 (entlast)
a (entget a1)
a14 (ssadd a1 a14))
(if (= a10 "Н")
(setq a9 (- a9 (/ pi 2))
a6 (cdr (assoc 40 a))
a6 (* 5 (/ a6 3))))
(setq a2 (polar a2 a9 a6)
a2 (trans a2 1 0)
a (subst (cons 10 a2)(assoc 10 a) a)
a2 (trans a2 0 1)
a4 a5)
(entmod (subst (cons 1 a8)(assoc 1 a) a))
(repeat 2
(setq a (entget a4)
a6 (assoc 10 a)
a (subst '(72 . 2)'(72 . 0) a))
(entmod a)
(setq a (entget a4)
a (subst (cons 72 (car a7))'(72 . 2) a)
a (subst (cons 73 (cadr a7))'(73 . 0) a))
(entmod a)
(setq a (entget a4)
a9 (assoc 10 a)
a (subst a6 a9 a)
a6 (mapcar '- (cdr a6) (cdr a9))
a9 (assoc 11 a)
a6 (mapcar '+ a6 (cdr a9))
a (subst (cons 11 a6) a9 a))
(entmod a)
(setq a4 a1)
)
(if (= a10 "П")
(vl-cmdf "_.move" a1 "" a2 pause)
(if (and (/= a10 "Р")(/= a10 "Н"))(progn
(command "_.erase" a1 "")
(if (= a10 "В")
(while a2
(if (vl-catch-all-error-p
(setq a (vl-catch-all-apply 'entsel
(list "\nВыберите текст:"))))
(setq a2 nil)
(if (= (type a) 'LIST)(progn
(setq a (entget (car a)))
(if (wcmatch (cdr (assoc 0 a)) "*TEXT")(progn
(setq a2 nil
a4 (cdr (assoc 1 a))
a6 (vl-string-left-trim " " a4)
a7 (- (strlen a4) (strlen a6))
a8 (vl-string-right-trim " " a8))
(if (and (wcmatch a8 "*`-")(not (wcmatch a8 "*`-`-")))
(setq a8 (vl-string-right-trim "-" a8)
a6 (strcat a8 a6))
(setq a6 (strcat a8 " " a6))
)
(repeat a7
(setq a6 (strcat " " a6)))
(entmod (subst (cons 1 a6)(assoc 1 a) a))
)))))))))))
(princ "\nТочка за границами текста")
)
))
(if (= a10 "Р")
(if (> (sslength a14) 0)
(repeat 2
(command "_.erase" a14 "")
(princ)
(command "_.delay" 80
"_.undo" 2)
)))
(command "_.undo" "_e")
(setvar "CMDECHO" 1)
(princ)
)
- gomer
- Активный участник
Re: LISP. Разрыв (обрыв, ...) строчки в указанной точке
Спасибочки :D Все ок! Вот бы еще междустрочный интервал можно было бы задавать "на лету" (как опцию) :idea:
Сообщения с 26 по 35 из 35
Тему читают: 1 гость
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форум работает на PunBB, при поддержке Informer Technologies, Inc
