根据首行改字高左对齐并按一定间距排序

繁花落叶

2. (defun c:wzpx (/ e1 e2 ent heigh heighy i inpoint k lst ob ob_ptx ob_pty pt
   
3.          pto ptx ss
   
4.       )
   
5.   (prompt "\n欢迎使用由Gavin业余时间写的程序！ 本程序命令：wzpx")
   
6.   (prompt "\n本程序主要功能：将文字左对齐并按一定间距排序！")
   
7.   (setq ss (ssget '((0 . "text"))))
   
8.   (setq i 0
   
9.   lst '()
   
10.   )
    
11.   (repeat (sslength ss)
    
12.     (setq ent (ssname ss i))
    
13.     (setq inpoint (Vlax-Get (Vlax-Ename->Vla-Object ent) 'InsertionPoint))
    
14.     (setq lst (append
    
15.     (list (cons ent inpoint))
    
16.     lst
    
17.         )
    
18.     )
    
19.     (setq i (1+ i))
    
20.   )
    
21.   (setq lst (vl-sort lst (function (lambda (e1 e2)
    
22.              (< (caddr e1) (caddr e2))
    
23.            )
    
24.        )
    
25.       )
    
26.   )
    
27.   (setq ob_ptx (cadr (last lst)))
    
28.   (setq ob_pty (caddr (last lst)))
    
29.   (setq heigh (Vlax-Get (Vlax-Ename->Vla-Object (car (last lst))) 'Height))
    
30.   (setq k 0)
    
31.   (repeat (length lst)
    
32.     (setq ob (Vlax-Ename->Vla-Object (car (nth k lst))))
    
33.     (setq pt (Vlax-Get ob 'InsertionPoint))
    
34.     (setq ptx (subst
    
35.     ob_ptx
    
36.     (car pt)
    
37.     pt
    
38.         )
    
39.     )
    
40.     (setq heighy (- ob_pty (* 1.2 heigh (- (length lst) (1+ k)))))
    
41.     (setq pto (subst
    
42.     heighy
    
43.     (cadr ptx)
    
44.     ptx
    
45.         )
    
46.     )
    
47.     (Vlax-Put-Property ob 'InsertionPoint (Vlax-3d-Point pto))
    
48.     (Vlax-Put-Property ob 'Height heigh)
    
49.     (setq k (1+ k))
    
50.   )
    
51.   (princ)
    
52. )
    

(defun c:wzpx (/ e1 e2 ent heigh heighy i inpoint k lst ob ob_ptx ob_pty pt<br />          pto ptx ss<br />       )<br />   (prompt "\n欢迎使用由Gavin业余时间写的程序！ 本程序命令：wzpx")<br />   (prompt "\n本程序主要功能：将文字左对齐并按一定间距排序！")<br />   (setq ss (ssget '((0 . "text"))))<br />   (setq i 0<br />   lst '()<br />   )<br />   (repeat (sslength ss)<br />     (setq ent (ssname ss i))<br />     (setq inpoint (Vlax-Get (Vlax-Ename->Vla-Object ent) 'InsertionPoint))<br />     (setq lst (append<br />     (list (cons ent inpoint))<br />     lst<br />         )<br />     )<br />     (setq i (1+ i))<br />   )<br />   (setq lst (vl-sort lst (function (lambda (e1 e2)<br />              (< (caddr e1) (caddr e2))<br />            )<br />        )<br />       )<br />   )<br />   (setq ob_ptx (cadr (last lst)))<br />   (setq ob_pty (caddr (last lst)))<br />   (setq heigh (Vlax-Get (Vlax-Ename->Vla-Object (car (last lst))) 'Height))<br />   (setq k 0)<br />   (repeat (length lst)<br />     (setq ob (Vlax-Ename->Vla-Object (car (nth k lst))))<br />     (setq pt (Vlax-Get ob 'InsertionPoint))<br />     (setq ptx (subst<br />     ob_ptx<br />     (car pt)<br />     pt<br />         )<br />     )<br />     (setq heighy (- ob_pty (* 1.2 heigh (- (length lst) (1+ k)))))<br />     (setq pto (subst<br />     heighy<br />     (cadr ptx)<br />     ptx<br />         )<br />     )<br />     (Vlax-Put-Property ob 'InsertionPoint (Vlax-3d-Point pto))<br />     (Vlax-Put-Property ob 'Height heigh)<br />     (setq k (1+ k))<br />   )<br />   (princ)<br /> )<br />

广易精通

垂直向的文字重叠了，能再加个循环就更完美了

zhangcan0515

楼主这个源码可以学习不错，谢谢

yk1216

谢谢楼主分享

清风明月名字

谢谢楼主的分享，试用了，非常好，收藏备用了！

yoyoho

谢谢楼主分享,收藏学习!

菜卷鱼

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99960

繁花落叶

菜卷鱼 发表于 2014-1-5 09:25
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99960

这个可以参考。

香田里浪人

繁花落叶 发表于 2014-1-5 11:16
这个可以参考。

两者各有特色

tianyi1230

1.2倍行高！

sabbathcn

试了试貌似有时候不起作用哦

springwillow

sabbathcn 发表于 2014-12-16 11:48
试了试貌似有时候不起作用哦

程序只是改变的插入点，也就是组码10，当文字为中、右、调整时，程序就不起作用的了。

sabbathcn

springwillow 发表于 2014-12-16 13:54
程序只是改变的插入点，也就是组码10，当文字为中、右、调整时，程序就不起作用的了。

时而管用时而不管用
是和字体有关还是和文字的位置有关系呢？