求组文本拆分框选问题！！
本帖最后由 tianbob 于 2018-5-2 22:37 编辑感谢明经论坛，得一文字拆分，程序如下：
(defun tiao ()
(setq ang1 (atan y x))
(setq d (distance pt pt1))
(setq pt1 (polar pt (+ ang ang1) d))
)
(defun nextt (n /)
(setq post (+ post n))
(if (= hsc 0.8)
(setq pt (polar pt angle_ (* distxt 0.9)))
(setq pt (polar pt angle_ distxt))
)
)
(defun C:exstr (/ styelay ent sel ellayt sty txt pt
highscale angle_ angpost distxt stxt
dxdy dxx dyy pt1p txt1 stxt1 ang1
xy n
)
(setq stye (getvar "textstyle"))
(setq lay (getvar "clayer"))
(setvar "CMDECHO" 0)
(setq ent (car (entsel "\n选择文字:")))
(if (/= ent nil)
(progn
(setq sel (entget ent))
(if (= "TEXT" (cdr (assoc 0 sel)))
(progn
(setq el (cdr (assoc -1 sel)))
(command "erase" el "")
(setq layt (cdr (assoc 8 sel)))
(setq sty (cdr (assoc 7 sel)))
(setq txt (cdr (assoc 1 sel)))
(setq pt (cdr (assoc 10 sel)))
(setq high (cdr (assoc 40 sel)))
(setq scale (cdr (assoc 41 sel)))
(setq angle_ (cdr (assoc 50 sel)))
(setq ang (/ (* angle_ 180) pi))
(setq post 1)
(setq distxt (* high scale))
(princ
(strcat "\n文字间隔 : <" (rtos distxt 2 3) ">")
)
(setq distxt (getreal))
(if (= distxt nil)
(setq distxt (* high scale))
)
(command "style" sty "" "0" scale "0" "" "" "")
(command "layer" "s" layt "")
(setq p 1);
(setq hsc 1);
(setq txt1 (substr txt p 1)); 判断文字串中
(repeat (strlen txt); 是否有汉字,
(if(> (ascii txt1) 160)
(setq hsc 0.8)
);; 汉字ASCII大
(setq p (1+ p));; 于160
(setq txt1 (substr txt p 1)) ;
);
(setq stxt nil)
(while (/= stxt "")
(setq stxt (substr txt post 1))
(if(<= (ascii stxt) 160)
;; 文字是西文
(progn
(setq dx (car pt))
(setq dy (cadr pt))
;; 处理以%开始的扩展字符
(cond ((= (ascii stxt) 37) ; 文字是: %
(progn
(setq stxt1 (substr txt (+ post 1) 1))
(if (= (ascii stxt1) 37)
;;判断下一个文字是否也是: %
(progn
(setq stxt (substr txt post 5))
(if (= hsc 0.8)
(progn
(setq x (* high 0.188))
(setq dxx (+ dx x))
(setq y (* high scale 0.1))
(setq dyy (+ dy y))
)
(progn
(setq dxx dx)
(setq dyy dy)
)
)
(setq pt1 (list dxx dyy))
;;(if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1
(command "text" pt1 (* high hsc) ang stxt)
(nextt 5)
)
(progn
(if (= hsc 0.8)
(progn
(setq x (* high 0.188))
(setq dxx (+ dx x))
)
(setq dxx dx)
)
(if (= hsc 0.8)
(progn
(setq y (* high scale 0.1))
(setq dyy (+ dy y))
)
(setq dyy dy)
)
(setq pt1 (list dxx dyy))
; (if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1
(command "text" pt1 (* high hsc) ang stxt)
(nextt 1)
)
)
)
)
; 处理以%开始的扩展字符结束
; 处理其它的字母和数字
(T
(progn
(if (= hsc 0.8)
(progn
(setq x (* high 0.188))
(setq dxx (+ dx x))
)
(setq dxx dx)
)
(if (= hsc 0.8)
(progn
(setq y (* high scale 0.1))
(setq dyy (+ dy y))
)
(setq dyy dy)
)
(setq pt1 (list dxx dyy))
(if (= hsc 0.8)
(tiao)
);如果有汉字, 调整pt1
(command "text" pt1 (* high hsc) ang stxt)
(nextt 1)
)
)
; 处理其它的字母和数字结束
)
)
; 处理汉字
(progn
(setq stxt (substr txt post 2))
(command "text" pt high ang stxt)
(setq post (+ post 2))
(setq pt (polar pt angle_ distxt))
)
; 处理汉字结束
)
)
(command "style" stye "" "" "" "" "" "" "")
(command "layer" "s" lay "")
(redraw)
)
(princ "\nObject is not a TEXT !")
)
)
)
(princ)
)
但是只能对单独的一行文本进行拆分，不能框选多行文本，特请求大师帮忙优化和修改，感激不尽。
路过，学习了，很受用。 谢谢楼主分享！
页:
[1]