cad批量交点打断 lisp_【悬赏5明经币求程序】求"交点打断"的lisp

;;选择集求交点子程序

(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))

)

)

)