恳请大师帮忙优化一下能框选问题
恳请大师帮忙优化一下框选问题：源码是本论坛上的，在此谢过作者。此程序只能对单独的一行文本进行拆分，不能框选多行文本，特请求大师帮忙优化和修改，感激不尽。
(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)
)
各位大神麻烦帮帮忙！谢谢谢谢 本帖最后由 llsheng_73 于 2018-7-2 23:49 编辑
如果这是你自己写的，你完全能够把它改成你需要的，如果你是从别处拿来的，最好从哪得来的叫谁改
这么长的"长篇大论",很少会有人有兴趣去下这个苦力先去读懂它，除非刚好有类似需要或者实在很闲并且心情相当不错
原程序中以ascii值160来分界汉字，实在不知道依据是什么，(vl-list->string'(145 210))，(vl-list->string'(129 68 ))难道它们都是一个单字节符号?
(vl-list->string'(169 183))得到的难道会是汉字？
llsheng_73 发表于 2018-7-2 23:36
如果这是你自己写的，你完全能够把它改成你需要的，如果你是从别处拿来的，最好从哪得来的叫谁改
这么长的 ...
确实这样，我宁愿重写也不愿读一大堆别人的代码。如果是高手的代码，可以学习借鉴，但是大部分无法理解的问题乱麻型代码。 别人的代码不说修改
阅读都很累
一个是排版和书写习惯
一个是参数命名习惯
比如llsheng_73就习惯不加空格:funk:
有人喜欢每个反括号后面加";cond"之类
我则喜欢使用tab对齐上下行文字
某些真心不错的代码或程序需要借鉴学习时
首先要做的是重新排版、替换参数
然后是阅读消化理解
最后才是改造之后应用到自己的程序中
正如yxp所说
宁愿重写也不愿读别人的代码
所以这也是论坛里同类程序如此之多的原因
对小白来说
来到这个论坛找程序
要么努力适应别人的操作习惯
要么搜遍所有同类程序
一个一个试用找到自己习惯的
还有就是多少学习点编程的知识
不说自己编出来
起码能修改简单的程序为自己所用 有些程序是套件中的一环
有其针对性必需得有相应的图纸中的特定 图元/元素
缺了这dwg时则无从调试验证
(if(> (ascii txt1) 160)
或许就是如此搭配着滴...
看到版主的教程，慢慢研究，谢谢谢谢
页:
[1]