对象选择集的交点 vlisp 函数.lsp

对象选择集的交点 VLisp 函数 对象选择集的交点 VLisp 函数

;;;**************************************************************************
;;; No.26-3 求(LINE *POLYLINE ARC CIRCLE ELLIPSE)对象选择集的交点 VLisp 函数 
;;;**************************************************************************
(defun c:test()
  (setq sss (ssget '((0 . "LINE,*POLYLINE,ARC,CIRCLE,ELLIPSE")))
	ptlst1 (th-delsame (getSSCurveInters sss))
	;ptlst2 (LstDelSame ptlst1)
  )
  (princ ptlst1)
  (princ (length ptlst1))
  (princ)
)

;;;;删除表中相同元素（保留一个），并返回新表(太过于精确，还有相同的项没有删除，遗漏,这与捕捉的精度有关)
(defun LstDelSame (ptlst / x nl)
  (foreach x ptlst
    (if (not (member x nl));(vl-member-if  predicate-function list)member 函数一样
      (setq nl (cons x nl));(vl-member-if-not  predicate-function list)和 member 函数一致。
    )
  )
  (setq nl (reverse nl))
  nl
)

(defun th-delsame (pts / pl);(粗糙些，精确小，没相同的项没被删除，没遗漏)
(while pts
	(setq p (car pts)
		pts (cdr pts)
		pts (vl-remove-if '(lambda (x) (equal x p 1e-10)) pts);可以修改精度1e-10,精度越高，重复的元素（没被删除）越多，反之越少。
		pl (cons p pl)
	)
)
(reverse pl)
)

(defun getSSCurveInters	(ss1 / el aobj1 el1 aobj2 ipts pts obj n i )
  (vl-load-com)
	(setq i 0)
	(setq n (sslength ss1))
	(while (< i n)
		(setq obj (vlax-ename->vla-object (ssname ss1 i)))
		(setq el (cons obj el))
		(setq i (+ i 1))
	);end_while
	
  (while el
    (setq aobj1 (car el))
    (if	(setq el1 (cdr el))
      (foreach aobj2 el1
				(if (and (setq ipts (vla-intersectwith aobj1 aobj2 0))
								 (setq ipts (vlax-variant-value ipts))
								 (> (vlax-safearray-get-u-bound ipts 1) 0)
						);end_and
					(progn
				    (setq ipts (vlax-safearray->list ipts))
				    (while (> (length ipts) 0)
				      (setq pts	 (cons (list (car ipts) (cadr ipts) (caddr ipts)) pts)
										ipts (cdddr ipts)
				      );end_setq
				    );end_while
				  );end_progn
				);end_if
      );end_foreach
		);end_if
		(setq el (cdr el))
	);end_while
  (setq pts pts)
);end_defun