这个程序还有几个问题，大家帮忙解决一下！！！

q3_2006

275437962 发表于 2013-12-29 21:45
我看了，你是先选一组，然后再选所有要处理的，可是我执行程序不是这样的提示，没有要求我选全部的，只是 ...

2. ;;;第二版,只能处理各组图元数量相同的情况
   
3. (defun c:tt ( / a b bnm box dxf5 el en i l la lst lst_en lst_hand n pt ss ss0 ssx x y)
   
4.         (defun lst2ss (lst_en / ss en)
   
5.     (setq ss (ssadd))
   
6.     (foreach en        lst_en
   
7.         (if (= (type en) 'ename)
   
8.             (ssadd en ss)        
   
9.         )
   
10.     )
    
11.     (if        (= (sslength ss) 0)
    
12.         nil
    
13.         ss
    
14.     )
    
15. )
    
16. (defun fd ( l n / a b )
    
17.     (while l
    
18.         (repeat n
    
19.             (setq a (cons (car l) a)
    
20.                   l (cdr l)
    
21.             )
    
22.         )
    
23.         (setq b (cons (reverse a) b)
    
24.               a nil
    
25.         )
    
26.     )
    
27.     (reverse b)
    
28. )
    
29.         (vl-load-com)
    
30.         (vl-cmdf "undo" "be")
    
31.         (print "\n选择任意一组处理对象:")
    
32.         (setq ss0 (ssget '((0 . "LINE")))
    
33.                 n (sslength ss0)
    
34.                 la (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss0 0)) 'Layer )
    
35.         )
    
36.         (print "\n选择全部处理对象:")
    
37.         (setq ss (ssget (list '(0 . "LINE")))
    
38.                 bnm (getstring "\输入块名:")
    
39.                 i 0
    
40.             lst_hand '()
    
41.       )
    
42.       (repeat (sslength ss)
    
43.         (setq en (ssname ss i)
    
44.               dxf5 (cdr (assoc 5 (entget en)))
    
45.         )
    
46.         (setq lst_hand (cons dxf5 lst_hand))
    
47.         (setq i (1+ i))
    
48.       )
    
49.       (setq lst_hand (vl-sort lst_hand (function (lambda (x y) (< x y)))))
    
50.       (setq lst (fd (mapcar 'handent lst_hand) n))
    
51.       (mapcar '(lambda(x)
    
52.       (setq ssx (lst2ss x)
    
53.               box (acet-geom-ss-extents ssx t)
    
54.               pt (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))
    
55.       )
    
56.       (command "erase" ssx "")
    
57.       (command "-insert" bnm pt "" "" "")
    
58.       (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
    
59.       (vlax-for X
    
60.      (vla-item (vla-get-blocks
    
61.    (vla-get-activedocument (vlax-get-acad-object))
    
62.         )
    
63.         bnm
    
64.      )
    
65.     (setq el (cons (vlax-vla-object->ename X) el))
    
66.   )
    
67.   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)
    
68.        ) lst)
    
69.         (vl-cmdf "undo" "e")
    
70. )

;;;第二版,只能处理各组图元数量相同的情况<br /> (defun c:tt ( / a b bnm box dxf5 el en i l la lst lst_en lst_hand n pt ss ss0 ssx x y)<br />         (defun lst2ss (lst_en / ss en)<br />     (setq ss (ssadd))<br />     (foreach en        lst_en<br />         (if (= (type en) 'ename)<br />             (ssadd en ss)        <br />         )<br />     )<br />     (if        (= (sslength ss) 0)<br />         nil<br />         ss<br />     )<br /> )<br /> (defun fd ( l n / a b )<br />     (while l<br />         (repeat n<br />             (setq a (cons (car l) a)<br />                   l (cdr l)<br />             )<br />         )<br />         (setq b (cons (reverse a) b)<br />               a nil<br />         )<br />     )<br />     (reverse b)<br /> )<br />         (vl-load-com)<br />         (vl-cmdf "undo" "be")<br />         (print "\n选择任意一组处理对象:")<br />         (setq ss0 (ssget '((0 . "LINE")))<br />                 n (sslength ss0)<br />                 la (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss0 0)) 'Layer )<br />         )<br />         (print "\n选择全部处理对象:")<br />         (setq ss (ssget (list '(0 . "LINE")))<br />                 bnm (getstring "\输入块名:")<br />                 i 0<br />             lst_hand '()<br />       )<br />       (repeat (sslength ss)<br />         (setq en (ssname ss i)<br />               dxf5 (cdr (assoc 5 (entget en)))<br />         )<br />         (setq lst_hand (cons dxf5 lst_hand))<br />         (setq i (1+ i))<br />       )<br />       (setq lst_hand (vl-sort lst_hand (function (lambda (x y) (< x y)))))<br />       (setq lst (fd (mapcar 'handent lst_hand) n))<br />       (mapcar '(lambda(x)<br />       (setq ssx (lst2ss x)<br />               box (acet-geom-ss-extents ssx t)<br />               pt (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))<br />       )<br />       (command "erase" ssx "")<br />       (command "-insert" bnm pt "" "" "")<br />       (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)<br />       (vlax-for X<br />      (vla-item (vla-get-blocks<br />    (vla-get-activedocument (vlax-get-acad-object))<br />         )<br />         bnm<br />      )<br />     (setq el (cons (vlax-vla-object->ename X) el))<br />   )<br />   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)<br />        ) lst)<br />         (vl-cmdf "undo" "e")<br /> )

q3_2006

下线...有问题.明天再说..

275437962

q3_2006 发表于 2013-12-29 21:56
下线...有问题.明天再说..

好的，早点休息！！谢谢了！！

275437962

q3_2006 发表于 2013-12-29 21:55

兄弟，我试了，这个程序第一次执行可以，后退再试就会叠加的，而且我发现一个问题，如果这一个层里面有两类符号，就麻烦，框选会把两类符号一起选上，这样这两类符号就不能区别，我觉得不区别直线的长度和角度还是不行啊，我觉得你前面开发的思路是对的，只是再改一下，应该就好了！！！
我实际情况，是这一层里，有几类要处理的符号。

q3_2006

275437962 发表于 2013-12-29 22:22
兄弟，我试了，这个程序第一次执行可以，后退再试就会叠加的，而且我发现一个问题，如果这一个层里面有两 ...

不是几类符号的问题,图示两图一个是4个图元组成,一个是3个,当然不能块处理.你自己可以变通一下,这种情况用第一版的程序来处理不就得了......另外,我的代码用了ET函数...你的CAD也需要安装ET工具才能正常运行...

q3_2006

第一版和第二版已经注明(中间版全部删除),你可以选择处理方式,我只能做到这个程度了...

1993063

好热闹.................

275437962

q3_2006 发表于 2013-12-30 07:19
第一版和第二版已经注明(中间版全部删除),你可以选择处理方式,我只能做到这个程度了...

兄弟，就是的，我安装了ET扩展工具后，不管执行几次，也不会叠加了，不过我在想，后面的程度能不能改一下，就是在选择全部处理对象时，可以采用任意多边的方式选择，这样就好用了，呵呵，我是不是意想天开哦！！！

q3_2006

275437962 发表于 2013-12-30 10:28
兄弟，就是的，我安装了ET扩展工具后，不管执行几次，也不会叠加了，不过我在想，后面的程度能不能改一下 ...

2. 
   
3. ;;选择闭合多线形内及与多边形相交的对象处理
   
4. (defun c:tt ( / a b c bnm box dxf5 el en i l la lst lst_en lst_hand n pt pts ss ss0 ssx x y)
   
5.         (defun lst2ss (lst_en / ss en)
   
6.     (setq ss (ssadd))
   
7.     (foreach en        lst_en
   
8.         (if (= (type en) 'ename)
   
9.             (ssadd en ss)        
   
10.         )
    
11.     )
    
12.     (if        (= (sslength ss) 0)
    
13.         nil
    
14.         ss
    
15.     )
    
16. )
    
17. (defun fd ( l n / a b )
    
18.     (while l
    
19.         (repeat n
    
20.             (setq a (cons (car l) a)
    
21.                   l (cdr l)
    
22.             )
    
23.         )
    
24.         (setq b (cons (reverse a) b)
    
25.               a nil
    
26.         )
    
27.     )
    
28.     (reverse b)
    
29. )
    
30.         (vl-load-com)
    
31.         (vl-cmdf "undo" "be")
    
32.         (print "\n选择任意一组处理对象:")
    
33.         (setq ss0 (ssget '((0 . "LINE")))
    
34.                 n (sslength ss0)
    
35.                 la (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss0 0)) 'Layer )
    
36.         )
    
37.         (setq c (car (entsel "\n选择闭合多边形:"))
    
38.                 pts (mapcar        'cdr(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget c)))
    
39.                 ss (ssget "cp" pts '((0 . "LINE")))
    
40.                 bnm (getstring "\输入块名:")
    
41.                 i 0
    
42.             lst_hand '()
    
43.         )
    
44.       (repeat (sslength ss)
    
45.         (setq en (ssname ss i)
    
46.               dxf5 (cdr (assoc 5 (entget en)))
    
47.         )
    
48.         (setq lst_hand (cons dxf5 lst_hand))
    
49.         (setq i (1+ i))
    
50.       )
    
51.       (setq lst_hand (vl-sort lst_hand (function (lambda (x y) (< x y)))))
    
52.       (setq lst (fd (mapcar 'handent lst_hand) n))
    
53.       (mapcar '(lambda(x)
    
54.       (setq ssx (lst2ss x)
    
55.               box (acet-geom-ss-extents ssx t)
    
56.               pt (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))
    
57.       )
    
58.       (command "erase" ssx "")
    
59.       (command "-insert" bnm pt "" "" "")
    
60.       (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)
    
61.       (vlax-for X
    
62.      (vla-item (vla-get-blocks
    
63.    (vla-get-activedocument (vlax-get-acad-object))
    
64.         )
    
65.         bnm
    
66.      )
    
67.     (setq el (cons (vlax-vla-object->ename X) el))
    
68.   )
    
69.   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)
    
70.        ) lst)
    
71.         (vl-cmdf "undo" "e")
    
72. )

<br /> ;;选择闭合多线形内及与多边形相交的对象处理<br /> (defun c:tt ( / a b c bnm box dxf5 el en i l la lst lst_en lst_hand n pt pts ss ss0 ssx x y)<br />         (defun lst2ss (lst_en / ss en)<br />     (setq ss (ssadd))<br />     (foreach en        lst_en<br />         (if (= (type en) 'ename)<br />             (ssadd en ss)        <br />         )<br />     )<br />     (if        (= (sslength ss) 0)<br />         nil<br />         ss<br />     )<br /> )<br /> (defun fd ( l n / a b )<br />     (while l<br />         (repeat n<br />             (setq a (cons (car l) a)<br />                   l (cdr l)<br />             )<br />         )<br />         (setq b (cons (reverse a) b)<br />               a nil<br />         )<br />     )<br />     (reverse b)<br /> )<br />         (vl-load-com)<br />         (vl-cmdf "undo" "be")<br />         (print "\n选择任意一组处理对象:")<br />         (setq ss0 (ssget '((0 . "LINE")))<br />                 n (sslength ss0)<br />                 la (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss0 0)) 'Layer )<br />         )<br />         (setq c (car (entsel "\n选择闭合多边形:"))<br />                 pts (mapcar        'cdr(vl-remove-if-not '(lambda (x) (= (car x) 10))(entget c)))<br />                 ss (ssget "cp" pts '((0 . "LINE")))<br />                 bnm (getstring "\输入块名:")<br />                 i 0<br />             lst_hand '()<br />         )<br />       (repeat (sslength ss)<br />         (setq en (ssname ss i)<br />               dxf5 (cdr (assoc 5 (entget en)))<br />         )<br />         (setq lst_hand (cons dxf5 lst_hand))<br />         (setq i (1+ i))<br />       )<br />       (setq lst_hand (vl-sort lst_hand (function (lambda (x y) (< x y)))))<br />       (setq lst (fd (mapcar 'handent lst_hand) n))<br />       (mapcar '(lambda(x)<br />       (setq ssx (lst2ss x)<br />               box (acet-geom-ss-extents ssx t)<br />               pt (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))<br />       )<br />       (command "erase" ssx "")<br />       (command "-insert" bnm pt "" "" "")<br />       (Vlax-Put-Property (Vlax-Ename->Vla-Object (entlast)) 'Layer la)<br />       (vlax-for X<br />      (vla-item (vla-get-blocks<br />    (vla-get-activedocument (vlax-get-acad-object))<br />         )<br />         bnm<br />      )<br />     (setq el (cons (vlax-vla-object->ename X) el))<br />   )<br />   (mapcar '(lambda (x) (VLA-PUT-COLOR (Vlax-Ename->Vla-Object x) 0))el)<br />        ) lst)<br />         (vl-cmdf "undo" "e")<br /> )

275437962

q3_2006 发表于 2013-12-30 10:41

兄弟，再不弄了，我都快不好意思，这个多边形的很好，其实前面的我刚试了，在进行选择全部处理对象进，可以多次选择，其实已经满足要求了，只是有时不太稳定，偶尔会出现叠加的现象，我把CAD关闭重新启动就行了，还有就是原来两个符号距离近的，那么插入块的时候，这两个块的位置有些变化，不过已经很了不起了！！！从一开始，没有人理会，到后来，你不厌其烦的给解决，谢谢了，虽然中间出了点小插曲儿，呵呵，现在我觉得这不重要了！！！