范围内文字合并

永不言弃

范围内文字合并

gwar

谢谢楼主的分享

zk2140

lselsetp nil

香田里浪人

无法下载，请楼主再上传

永不言弃

香田里浪人

永不言弃 发表于 2013-11-23 16:56

下载失败，临时文件或其所在磁盘不可写

永不言弃

不清楚，我这儿能下载的

香田里浪人

不然，请楼主直接发布源码，可否？

永不言弃

2. (defun c:tt ()
   
3.   (vl-load-com)
   
4.   (print "选择范围")
   
5.   (setq ss (ssget (list '(0 . "LWPOLYLINE"))))
   
6.   (setq  nn1 0
   
7.   k 0
   
8.   )
   
9.   (repeat (sslength ss)
   
10.     (setq sty (ssname ss nn1))
    
11.     (setq sty1 (entget sty))
    
12.     (ertwefewfds)
    
13.     (setq nn1 (1+ nn1))
    
14.   )
    
15.   (print (strcat "共处理了" (rtos nn1 2 0) "个文字"))
    
16.   (princ)
    
17. )
    
18. 
    
19. 
    
20. (defun ertwefewfds ();;;取出文字
    
21.   (setq  lis (mapcar 'cdr
    
22.         (vl-remove-if '(lambda (x) (/= (car x) 10)) sty1)
    
23.       )
    
24.   )
    
25.   (setq t1 (ssget "wp" lis (list (cons 0 "TEXT"))))
    
26.   (if (/= t1 nil)
    
27.     (sijfioweuofj)
    
28.     )
    
29. 
    
30. )
    
31. 
    
32. 
    
33. 
    
34. (defun sijfioweuofj()
    
35.   (setq  n (sslength t1)
    
36.   m 0
    
37.   )
    
38. (setq lj "")
    
39.   (while (< m n)
    
40.     (setq e (entget (ssname t1 m))
    
41.     m (1+ m)
    
42.     )
    
43.    
    
44.     (setq trr (strcat  (cdr (assoc 1 e)) lj ))
    
45.     (setq lj  trr)
    
46.     (print (strcat "正在处理：" trr))
    
47.     (princ)
    
48.   )
    
49.   (setq xwzz (vlax-ename->vla-object (cdr(car(entget (ssname t1 0))))))
    
50.   (vla-put-textstring xwzz trr)
    
51.   (if (> n 1)(werwcdfvxvd))
    
52.        )
    
53. 
    
54. (defun werwcdfvxvd ()
    
55.   (setq aaa 1)
    
56.   (repeat (- n 1)
    
57.    
    
58.   (setq
    
59.     xwzz (vlax-ename->vla-object (cdr (car (entget (ssname t1 aaa)))))
    
60.   )
    
61.     (setq aaa (1+ aaa))
    
62.   (vla-put-textstring xwzz "")
    
63.     )
    
64. )
    
65. 
    
66. 
    
67. 
    
68. 
    

(defun c:tt ()<br />   (vl-load-com)<br />   (print "选择范围")<br />   (setq ss (ssget (list '(0 . "LWPOLYLINE"))))<br />   (setq  nn1 0<br />   k 0<br />   )<br />   (repeat (sslength ss)<br />     (setq sty (ssname ss nn1))<br />     (setq sty1 (entget sty))<br />     (ertwefewfds)<br />     (setq nn1 (1+ nn1))<br />   )<br />   (print (strcat "共处理了" (rtos nn1 2 0) "个文字"))<br />   (princ)<br /> )<br /> <br /> <br /> (defun ertwefewfds ();;;取出文字<br />   (setq  lis (mapcar 'cdr<br />         (vl-remove-if '(lambda (x) (/= (car x) 10)) sty1)<br />       )<br />   )<br />   (setq t1 (ssget "wp" lis (list (cons 0 "TEXT"))))<br />   (if (/= t1 nil)<br />     (sijfioweuofj)<br />     )<br /> <br /> )<br /> <br /> <br /> <br /> (defun sijfioweuofj()<br />   (setq  n (sslength t1)<br />   m 0<br />   )<br /> (setq lj "")<br />   (while (< m n)<br />     (setq e (entget (ssname t1 m))<br />     m (1+ m)<br />     )<br />     <br />     (setq trr (strcat  (cdr (assoc 1 e)) lj ))<br />     (setq lj  trr)<br />     (print (strcat "正在处理：" trr))<br />     (princ)<br />   )<br />   (setq xwzz (vlax-ename->vla-object (cdr(car(entget (ssname t1 0))))))<br />   (vla-put-textstring xwzz trr)<br />   (if (> n 1)(werwcdfvxvd))<br />        )<br /> <br /> (defun werwcdfvxvd ()<br />   (setq aaa 1)<br />   (repeat (- n 1)<br />     <br />   (setq<br />     xwzz (vlax-ename->vla-object (cdr (car (entget (ssname t1 aaa)))))<br />   )<br />     (setq aaa (1+ aaa))<br />   (vla-put-textstring xwzz "")<br />     )<br /> )<br /> <br /> <br /> <br /> <br />

陈亚娣

找了好久这种程序正是我需要的，谢谢

香田里浪人

试用一下
错误: 参数类型错误: lselsetp nil

香田里浪人

2004试用一下
错误: 参数类型错误: lselsetp nil
是不是2004版本不能用？