测试很长时间,测试中除XP:Flatten没有被替换,其他函数用过相似函数替换,结果一样,没有找到原因,哪位大侠百忙中抽空帮忙指点指点,谢谢了。附件是测试的DWG文件
;;;选择集转vla图元表
;;;ss->vla List
(defun LM:ss->vla(SS / E I L)
(if ss
((lambda (i / e L)
(while (setq e (ssname ss (setq i (1+ i))))
(setq L (cons (vlax-ename->vla-object e) L))
)
L
)
-1
)
)
)
;;;提取线的端点
(defun Get_line_point (SS / PT PTS)
(mapcar '(lambda (x / pt pts)
(progn
(setq pt (vlax-curve-getendpoint x))
(setq pts (cons pt pts))
(setq pt (vlax-curve-getstartpoint x))
(setq pts (cons pt pts))
) ;_progn
) ;_lambda
ss
) ;_mapcar
)
;;;多层表转换单层表
(defun XP:Flatten (lst)
(if lst
(if (listp (car lst))
(append (XP:Flatten (car lst)) (XP:Flatten (cdr lst)))
(list lst)
)
)
)
;;;提取相同点, by 阿然
(defun findsame (lst)
(if lst
(if (member (car lst) (cdr lst))
(append (list (car lst)) (findsame (cdr lst)))
(findsame (cdr lst))
)
)
)
(defun findsame2 (l1 / l2) ;_by llsheng_73
;;;查找表中重复元素
(while l1
(if (member (car l1) (cdr l1))
;_(setq l2 (append l2 (list (car l1))))
(setq l2 (cons (car l1) l2))
)
(setq l1 (vl-remove (car l1) l1))
)
l2
)
;;;删除重复制点,保留一个点
(defun gxl-delsame (L);_by Gu_lx
(if L
(cons (car L) (gxl-delsame (vl-remove (car L) (cdr L))))
)
)
(defun c:tt (/ SS PTS pts1)
(vl-load-com)
(setvar "cmdecho" 0)
(setq ss (ssget '((0 . "*LINE,ARC"))))
(setq ss (LM:ss->vla ss));选择集转vla图元表
(setq pts (Get_line_point ss));提取线的端点
(setq pts (XP:Flatten pts));多层表转换单层表,获取所有端点
(princ "\n 所有端点\n")
(print pts)
(princ "\n 所有端点\n")
(setq pts1 (findsame pts));;提取相同端点
(princ "\n 提取出相同端点\n")
(print pts1)
(princ "\n 提取出相同端点\n")
(princ)
)