LISP. Разрыв (обрыв, ...) строчки в указанной точке (Страница 1 из 2)

;|====================================================
 Разрыв (обрыв, ...) строчки в указанной точке
 Программа Дениса Флюстикова "Str_Den" от 24.05.08:
 учтены коды подчеркивания и надчеркивания текста
 Макрос для кнопки: ^C^C^P(load "Str_Den");Str_Den
 Замечания и предложения по адресу fd-@mail.ru
====================================================|;
(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")
(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 (caadr (Textbox a8)))
(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 (strcat a3 a8)
      a6 (subst (cons 1 a8)(assoc 1 a) a)
      a6 (- a4 (caadr (Textbox a6)))
      a1 (entlast)
      a (entget a1))
(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 a5 (vl-catch-all-apply 'entsel
(list "\nВыберите текст:"))))
(setq a2 nil)
(if (= (type a5) 'LIST)(progn
(setq a (entget (car a5)))
(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)
      a6 (strcat a8 " " a6))
(repeat a7
(setq a6 (strcat " " a6)))
(entmod (subst (cons 1 a6)(assoc 1 a) a))
)))))))))))
(princ "\nТочка за границами текста")
)))))
(setvar "OSMODE" OSMODE)
(command "_.undo" "_e")
(setvar "CMDECHO" 1)
(princ)
)

(while (/= (cdr (assoc 0 a)) "TEXT")
(if (setq a5 (car (entsel "\nВыберите однострочный текст:")))
(setq a (entget a5)))
)

(while (/= (cdr (assoc 0 a)) "TEXT")
  (if (setq a5 (car (entsel "\nВыберите однострочный текст:")))
    (progn (redraw a5 3)(setq a (entget a5)))
  )
)

(vl-cmdf "_.regenall")