求组文本拆分框选问题！！

tianbob · 发表于 2018-5-2 22:34

本帖最后由 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)
)

(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) 
)

但是只能对单独的一行文本进行拆分，不能框选多行文本，特请求大师帮忙优化和修改，感激不尽。

武林至尊李小龙 · 发表于 2018-5-3 11:08

路过，学习了，很受用。

xyz002 · 发表于 2019-12-26 08:23

谢谢楼主分享！

账号		自动登录	找回密码
密码			注册

[提问] 求组文本拆分框选问题！！

本帖子中包含更多资源

浏览过的版块