求高手编写LISP代码

fhcd88

请高手编写LISP代码，实现如下功能：在“”中，当点选图中多线段后，通过代码首先选择插入点在多线段顶点上的图元（名为拐点的块参照），然后再选择与这些图元相隔最近的一串文字，或者是以每个图元为中心框选一定范围内的文字，每个图元仅对应一串文字，最终结果就是，只选择“1、2、3、4、5”这几个文字，而不要把”6、7、8、9、10“这几个文字选进来。谢谢各位高手指教！！！

阿然

1. (vl-load-com)
   
2. (defun c:tt (/ ent ss sstemp el elst txtlst inptlst distlst i)
   
3.   (if (and (setq ent (car (entsel "\n选择多义线:")))
   
4.      (setq elst (entget ent))
   
5.      (equal (cdr (assoc 0 elst)) "LWPOLYLINE")
   
6.       )
   
7.     (progn
   
8.       (setq ss (ssadd ent))
   
9.       (foreach el elst
   
10.   (if (equal (car el) 10)
    
11.     (progn
    
12.       (setq
    
13.         sstemp (ssget "C" (cdr el) (cdr el) '((0 . "INSERT")))
    
14.       )
    
15.       (setq ss (xr:appendss ss sstemp))
    
16.       (setq sstemp nil)
    
17.     )
    
18.   )
    
19.       )
    
20.       (setq i (1- (sslength ss)))
    
21.       (setq sstemp (ssget "X" '((0 . "TEXT"))))
    
22.       (setq txtlst (Xr:ss->lst sstemp))
    
23.       (setq inptlst (mapcar '(lambda (x) (Xr:getobjdxf x 10)) txtlst))
    
24.       (setq
    
25.   distlst  (mapcar
    
26.       '(lambda (x)
    
27.          (distance x (vlax-curve-getClosestPointTo ent x))
    
28.        )
    
29.       inptlst
    
30.     )
    
31.       )
    
32.       (setq txtlst (mapcar 'cons distlst txtlst))
    
33.       (setq txtlst
    
34.        (vl-sort txtlst '(lambda (e1 e2) (< (car e1) (car e2))))
    
35.       )
    
36.       (repeat i
    
37.   (ssadd (cdr (nth (setq i (1- i)) txtlst)) ss)
    
38.       )
    
39.       (command "_.copybase" '(0 0 0) ss "")
    
40.       (command "_.erase" "all" "")
    
41.       (command "_.Pasteclip" '(0 0 0))
    
42.       (setq ss nil
    
43.       sstemp nil)
    
44.     )
    
45.   )
    
46.   (princ)
    
47. )
    
48. 
    
49. (defun Xr:getobjdxf (obj code / result elist)
    
50.   (setq elist (entget obj))
    
51.   (setq result (cdr (assoc code elist)))
    
52. )
    
53. 
    
54. (defun Xr:ss->lst (ss / i l)
    
55.   (if ss
    
56.     (repeat (setq i (sslength ss))
    
57.       (setq
    
58.   l (cons  (ssname ss (setq i (1- i)))
    
59.     l
    
60.     )
    
61.       )
    
62.     )
    
63.   )
    
64. )
    
65. (defun Xr:appendss (ss1 ss2 / i)
    
66.   (if (and ss1
    
67.     ss2
    
68.       )
    
69.     (progn
    
70.       (setq i -1)
    
71.       (repeat (sslength ss2)
    
72. (ssadd (ssname ss2 (setq i (1+ i))) ss1)
    
73.       )
    
74.     )
    
75.     ss1
    
76.   )
    
77. )

(vl-load-com)<br /> (defun c:tt (/ ent ss sstemp el elst txtlst inptlst distlst i)<br />   (if (and (setq ent (car (entsel "\n选择多义线:")))<br />      (setq elst (entget ent))<br />      (equal (cdr (assoc 0 elst)) "LWPOLYLINE")<br />       )<br />     (progn<br />       (setq ss (ssadd ent))<br />       (foreach el elst<br />   (if (equal (car el) 10)<br />     (progn<br />       (setq<br />         sstemp (ssget "C" (cdr el) (cdr el) '((0 . "INSERT")))<br />       )<br />       (setq ss (xr:appendss ss sstemp))<br />       (setq sstemp nil)<br />     )<br />   )<br />       )<br />       (setq i (1- (sslength ss)))<br />       (setq sstemp (ssget "X" '((0 . "TEXT"))))<br />       (setq txtlst (Xr:ss->lst sstemp))<br />       (setq inptlst (mapcar '(lambda (x) (Xr:getobjdxf x 10)) txtlst))<br />       (setq<br />   distlst  (mapcar<br />       '(lambda (x)<br />          (distance x (vlax-curve-getClosestPointTo ent x))<br />        )<br />       inptlst<br />     )<br />       )<br />       (setq txtlst (mapcar 'cons distlst txtlst))<br />       (setq txtlst<br />        (vl-sort txtlst '(lambda (e1 e2) (< (car e1) (car e2))))<br />       )<br />       (repeat i<br />   (ssadd (cdr (nth (setq i (1- i)) txtlst)) ss)<br />       )<br />       (command "_.copybase" '(0 0 0) ss "")<br />       (command "_.erase" "all" "")<br />       (command "_.Pasteclip" '(0 0 0))<br />       (setq ss nil<br />       sstemp nil)<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> (defun Xr:getobjdxf (obj code / result elist)<br />   (setq elist (entget obj))<br />   (setq result (cdr (assoc code elist)))<br /> )<br /> <br /> (defun Xr:ss->lst (ss / i l)<br />   (if ss<br />     (repeat (setq i (sslength ss))<br />       (setq<br />   l (cons  (ssname ss (setq i (1- i)))<br />     l<br />     )<br />       )<br />     )<br />   )<br /> )<br /> (defun Xr:appendss (ss1 ss2 / i)<br />   (if (and ss1<br />     ss2<br />       )<br />     (progn<br />       (setq i -1)<br />       (repeat (sslength ss2)<br /> (ssadd (ssname ss2 (setq i (1+ i))) ss1)<br />       )<br />     )<br />     ss1<br />   )<br /> )

试了一下，不知道能不能用，使用上有点限制：每个图块必须对应一个编号
如果有的图块没有对应的编号，会得不到想要的结果

xyp1964

fhcd88

附件中，每个图块只是有个编号与之靠得比较近，你所说的图块与编号对应是指的什么？

fhcd88

在我这运行出错，不知为什么？

阿然

出错是指什么呢？程序运行不了还是结果不正确？
选择块还是比较容易，主要是选择几个文字的处理，我是选择了离多义线最近的n个（n＝块个数）文本，假如6离的比5近，那会选择6留下而删除5。

阿然

找到出错的地方了，修改了3楼的代码，请重新测试

zwf100

需要e派工具箱(XCAD)的支持