;;选择集求交点子程序
(defun interss (ss / n1 ssl aobj1 aobj2 n2 ipts pts)
(setq n1 0
ssl (sslength ss)
)
(while (< n1 (1- ssl))
(setq aobj1 (ssname ss n1)
aobj1 (vlax-ename->vla-object aobj1)
n2 (1+ n1)
)
(while (< n2 ssl)
(setq aobj2 (ssname ss n2)
aobj2 (vlax-ename->vla-object aobj2)
ipts (vla-intersectwith
aobj1
aobj2
0
)
ipts (vlax-variant-value ipts)
)
(if (> (vlax-safearray-get-u-bound ipts 1) 0) ;是否有交点
(progn
(setq ipts
(vlax-safearray->list ipts)
)
(while (> (length ipts) 0)
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
) ;此处可以在添加时判断是否有重合点
)
(setq ipts (cdddr ipts))
)
)
)