文字加下划线！ 求专家

tyrasv

不會啊，能弄個麼？“”

tyrasv

陨落 发表于 2014-12-27 21:22
应该搞个反应器，能自动变下划线长度

不會，能寫一個麼？

守仁格竹GM

.                                         

maiko

http://bbs.mjtd.com/forum.php?mo ... 47&page=1#pid610655
用G版函数 getTextBox 先求出文字下面角点，再画pline线

tyrasv

maiko 发表于 2014-12-29 18:31
http://bbs.mjtd.com/forum.php?mo ... 47&page=1#pid610655
用G版函数 getTextBox 先求出文字下面角点，再 ...

我只要个下划线，就行了，你给的太复杂了。

kwok

tyrasv 发表于 2014-12-30 21:44
我只要个下划线，就行了，你给的太复杂了。

用6楼的改了一下，其实楼主也可以自己改一下的，自己改才是适合自己想要的效果:
不支持mtext,是mtext要先炸开.

2. ;;文字下画线
   
3. (defun c:tt(/ dd ss i ssn ssdata  box p1 p2 p3 p4 ang)
   
4.   (command "_.undo" "_be")
   
5. (setq ss(ssget '((0 . "text"))))
   
6. (setq i 0)
   
7. (repeat (sslength ss)
   
8. (setq ssn (ssname ss i))
   
9. (setq ssdata (entget ssn))
   
10. (setq key (cdr (assoc 0 ssdata)))
    
11. (command "ucs" "e" ssn)
    
12. (setq box (textbox ssdata))
    
13. (setq p1 (car box))
    
14. (setq p3 (cadr box))
    
15. (setq p2(list (car p3)(cadr p1)))
    
16. (setq p4(list (car p1)(cadr p3)))
    
17. (setq dd (*  (distance p1 p4) 0.1) );;线与字间距
    
18. (setq ang (angle p1 p4))
    
19. (setvar "PLINEWID" (* dd 0.5)) ;下划线宽
    
20. (command "pline" "non" (polar (polar p1 (- ang)dd)pi (* dd  2)) "non" (polar (polar p2 (- ang)dd) (* pi 2) (* dd  2)) "")
    
21. 
    
22. (setq i (1+ i))
    
23. )
    
24. (command "ucs" "")
    
25.   (command "_.undo" "_e")
    
26.   (setvar "PLINEWID" 0)
    
27. (prin1)
    
28. )

;;文字下画线<br /> (defun c:tt(/ dd ss i ssn ssdata  box p1 p2 p3 p4 ang)<br />   (command "_.undo" "_be")<br /> (setq ss(ssget '((0 . "text"))))<br /> (setq i 0)<br /> (repeat (sslength ss)<br /> (setq ssn (ssname ss i))<br /> (setq ssdata (entget ssn))<br /> (setq key (cdr (assoc 0 ssdata)))<br /> (command "ucs" "e" ssn)<br /> (setq box (textbox ssdata))<br /> (setq p1 (car box))<br /> (setq p3 (cadr box))<br /> (setq p2(list (car p3)(cadr p1)))<br /> (setq p4(list (car p1)(cadr p3)))<br /> (setq dd (*  (distance p1 p4) 0.1) );;线与字间距<br /> (setq ang (angle p1 p4))<br /> (setvar "PLINEWID" (* dd 0.5)) ;下划线宽<br /> (command "pline" "non" (polar (polar p1 (- ang)dd)pi (* dd  2)) "non" (polar (polar p2 (- ang)dd) (* pi 2) (* dd  2)) "") <br /> <br /> (setq i (1+ i))<br /> )<br /> (command "ucs" "")<br />   (command "_.undo" "_e")<br />   (setvar "PLINEWID" 0)<br /> (prin1)<br /> )

tyrasv

kwok 发表于 2014-12-31 15:00
用6楼的改了一下，其实楼主也可以自己改一下的，自己改才是适合自己想要的效果:
不支持mtext,是mtext要先 ...

我不会，主要是。

wzg356

基本解决问题了，楼主还要啥要求啊！

陨落

守仁格竹GM 发表于 2014-12-29 13:51
.

你这个不错~

tyrasv

郭文姬happy 发表于 2014-12-26 14:30
(defun c:40()
(initget "T B A")
(setq typ (getkword"\n 画线样式[T顶线， B下划线，A上下线]:"))

上划线好像不能用，   如果文字选多了，会自动乱连，是不是有什么要求？