求高手编写LISP代码
请高手编写LISP代码，实现如下功能：在“”中，当点选图中多线段后，通过代码首先选择插入点在多线段顶点上的图元（名为拐点的块参照），然后再选择与这些图元相隔最近的一串文字，或者是以每个图元为中心框选一定范围内的文字，每个图元仅对应一串文字，最终结果就是，只选择“1、2、3、4、5”这几个文字，而不要把”6、7、8、9、10“这几个文字选进来。谢谢各位高手指教！！！ 本帖最后由 阿然 于 2013-1-2 10:27 编辑(vl-load-com)
(defun c:tt (/ ent ss sstemp el elst txtlst inptlst distlst i)
(if (and (setq ent (car (entsel "\n选择多义线:")))
(setq elst (entget ent))
(equal (cdr (assoc 0 elst)) "LWPOLYLINE")
)
(progn
(setq ss (ssadd ent))
(foreach el elst
(if (equal (car el) 10)
(progn
(setq
sstemp (ssget "C" (cdr el) (cdr el) '((0 . "INSERT")))
)
(setq ss (xr:appendss ss sstemp))
(setq sstemp nil)
)
)
)
(setq i (1- (sslength ss)))
(setq sstemp (ssget "X" '((0 . "TEXT"))))
(setq txtlst (Xr:ss->lst sstemp))
(setq inptlst (mapcar '(lambda (x) (Xr:getobjdxf x 10)) txtlst))
(setq
distlst(mapcar
'(lambda (x)
(distance x (vlax-curve-getClosestPointTo ent x))
)
inptlst
)
)
(setq txtlst (mapcar 'cons distlst txtlst))
(setq txtlst
(vl-sort txtlst '(lambda (e1 e2) (< (car e1) (car e2))))
)
(repeat i
(ssadd (cdr (nth (setq i (1- i)) txtlst)) ss)
)
(command "_.copybase" '(0 0 0) ss "")
(command "_.erase" "all" "")
(command "_.Pasteclip" '(0 0 0))
(setq ss nil
sstemp nil)
)
)
(princ)
)
(defun Xr:getobjdxf (obj code / result elist)
(setq elist (entget obj))
(setq result (cdr (assoc code elist)))
)
(defun Xr:ss->lst (ss / i l)
(if ss
(repeat (setq i (sslength ss))
(setq
l (cons(ssname ss (setq i (1- i)))
l
)
)
)
)
)
(defun Xr:appendss (ss1 ss2 / i)
(if (and ss1
ss2
)
(progn
(setq i -1)
(repeat (sslength ss2)
(ssadd (ssname ss2 (setq i (1+ i))) ss1)
)
)
ss1
)
)
试了一下，不知道能不能用，使用上有点限制：每个图块必须对应一个编号
如果有的图块没有对应的编号，会得不到想要的结果
本帖最后由 xyp1964 于 2013-1-1 23:57 编辑
附件中，每个图块只是有个编号与之靠得比较近，你所说的图块与编号对应是指的什么？ 在我这运行出错，不知为什么？ 出错是指什么呢？程序运行不了还是结果不正确？
选择块还是比较容易，主要是选择几个文字的处理，我是选择了离多义线最近的n个（n＝块个数）文本，假如6离的比5近，那会选择6留下而删除5。 找到出错的地方了，修改了3楼的代码，请重新测试 需要e派工具箱(XCAD)的支持
页:
[1]