想取得所有（直接，间接）与指定线相交的线，但程序太慢

meflying

写了一下，你看看：

2. 
   
3. (if (not olderr)
   
4.   (setq olderr *error*)
   
5. )
   
6. 
   
7. (defun *error* (msg)
   
8. (setq en (getvar "errno"))
   
9. (setq errmsg (strcat "errno=" (itoa en) "\nError:" msg))
   
10. (alert errmsg)
    
11. (setq *error* olderr)
    
12. )
    
13. 
    
14. (defun getcolor()
    
15.   (if (not c)
    
16.     (setq c 1)
    
17.     (progn
    
18.       (if (< c 7)
    
19.         (setq c (1+ c))
    
20.         (setq c 1)
    
21.       )
    
22.     )
    
23.   )
    
24. )
    
25. 
    
26. (defun setcolor(sname color / sinf)
    
27.   (setq sinf (entget sname))
    
28.   (if (assoc 62 sinf)
    
29.     (setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))
    
30.     (setq sinf (append sinf (list (cons 62 color))))
    
31.   )
    
32.   (entmod sinf)
    
33. )
    
34. 
    
35. (defun getinterLine(entMother entLine / ent pt1 pt2 ss n i entList)
    
36.   (ssadd entLine ssAll)
    
37.   (setq ent (entget entLine))
    
38.   (setq pt1 (cdr (assoc 10 ent)))
    
39.   (setq pt2 (cdr (assoc 11 ent)))
    
40.   (setq ss (ssget "f" (list pt1 pt2) '((0 . "LINE"))))
    
41.   (if entMother (ssdel entMother ss))
    
42.   (ssdel entLine ss)
    
43.   (setq n (sslength ss))
    
44.   (setq i 0)  
    
45.   (while (< i n)
    
46.     (setq entList (append entList (list (ssname ss i))))
    
47.     (setq i (1+ i))
    
48.   )
    
49.   (setq ss nil)
    
50.   (setq i 0)
    
51.   (repeat n
    
52.     (if (not (ssmemb (setq ent (nth i entList)) ssAll))
    
53.       (getinterLine entLine ent)
    
54.     )
    
55.     (setq i (1+ i))
    
56.   )
    
57.   ssAll
    
58. )
    
59. 
    
60. (defun c:main( / ent i)  
    
61.   (setq ent (car (entsel "Select the Line...")))
    
62.   (if (/= (cdr (assoc 0 (entget ent))) "LINE")
    
63.     (exit)
    
64.   )
    
65.   (setq ssall (ssadd))
    
66.   (Getinterline nil ent)
    
67.   (setq i 0)
    
68.   (setq c (getcolor))
    
69.   (setcolor ent c)
    
70.   (repeat (sslength ssAll)
    
71.     (setcolor (ssname ssAll i) c)
    
72.     (setq i (1+ i))
    
73.   )
    
74.   (setq ssAll nil)
    
75.   (setq *error* olderr)
    
76.   (princ)
    
77. )
    

<br /> (if (not olderr)<br />   (setq olderr *error*)<br /> )<br /> <br /> (defun *error* (msg)<br /> (setq en (getvar "errno"))<br /> (setq errmsg (strcat "errno=" (itoa en) "\nError:" msg))<br /> (alert errmsg)<br /> (setq *error* olderr)<br /> )<br /> <br /> (defun getcolor()<br />   (if (not c)<br />     (setq c 1)<br />     (progn<br />       (if (< c 7)<br />         (setq c (1+ c))<br />         (setq c 1)<br />       )<br />     )<br />   )<br /> )<br /> <br /> (defun setcolor(sname color / sinf)<br />   (setq sinf (entget sname))<br />   (if (assoc 62 sinf)<br />     (setq sinf (subst (cons 62 color) (assoc 62 sinf) sinf))<br />     (setq sinf (append sinf (list (cons 62 color))))<br />   )<br />   (entmod sinf)<br /> )<br /> <br /> (defun getinterLine(entMother entLine / ent pt1 pt2 ss n i entList)<br />   (ssadd entLine ssAll)<br />   (setq ent (entget entLine))<br />   (setq pt1 (cdr (assoc 10 ent)))<br />   (setq pt2 (cdr (assoc 11 ent)))<br />   (setq ss (ssget "f" (list pt1 pt2) '((0 . "LINE"))))<br />   (if entMother (ssdel entMother ss))<br />   (ssdel entLine ss)<br />   (setq n (sslength ss))<br />   (setq i 0)  <br />   (while (< i n)<br />     (setq entList (append entList (list (ssname ss i))))<br />     (setq i (1+ i))<br />   )<br />   (setq ss nil)<br />   (setq i 0)<br />   (repeat n<br />     (if (not (ssmemb (setq ent (nth i entList)) ssAll))<br />       (getinterLine entLine ent)<br />     )<br />     (setq i (1+ i))<br />   )<br />   ssAll<br /> )<br /> <br /> (defun c:main( / ent i)  <br />   (setq ent (car (entsel "Select the Line...")))<br />   (if (/= (cdr (assoc 0 (entget ent))) "LINE")<br />     (exit)<br />   )<br />   (setq ssall (ssadd))<br />   (Getinterline nil ent)<br />   (setq i 0)<br />   (setq c (getcolor))<br />   (setcolor ent c)<br />   (repeat (sslength ssAll)<br />     (setcolor (ssname ssAll i) c)<br />     (setq i (1+ i))<br />   )<br />   (setq ssAll nil)<br />   (setq *error* olderr)<br />   (princ)<br /> )<br />