;;计算多段线自交点 By 明经通道 Gu_xl 2014.06.21
(defun gxl-polyselfinters (OBJ	  /	 LST	I      ISCLOSED
			   FLAG	  OBJ1	 LST1	FLAG1  OBJ2   L
			   LL	  PS	 P	RESULT lst0
			  )
  (if (= 'ename (type obj))
    (setq obj (vlax-ename->vla-object obj))
  )
  (setq lst (vlax-invoke obj 'explode))
  (setq lst0 lst)
  (setq i (length lst))
  (setq	isclosed (equal	(vlax-curve-getstartpoint obj)
			(vlax-curve-getendpoint obj)
			1e-6
		 )
  )
  (if (> i 1)
    (progn
      (setq flag t)
      (while lst
	(setq obj1  (car lst)
	      lst   (cdr lst)
	      lst1  lst
	      flag1 t
	)
	(while lst1
	  (setq	obj2 (car lst1)
		lst1 (cdr lst1)
	  )
	  (setq l (vlax-invoke obj1 'IntersectWith obj2 0))
	  (setq ll nil)
	  (while l
	    (setq p  (list (car l) (cadr l) (caddr l))
		  l  (cdddr l)
		  ll (cons p ll)
	    )
	  )
	  (if flag1
	    (progn
	      (foreach p ll
		(if
		  (not (or
			 (equal p (vlax-curve-getStartPoint obj2) 1e-6)
			 (equal p (vlax-curve-getendPoint obj2) 1e-6)
		       )
		  )
		   (setq result (cons p result))
		)
	      )
	      (setq flag1 nil)
	    )
	    (progn
	      (if lst1
		(setq result (append result ll))
		(progn
		  (if (and flag isclosed)
		    (foreach p ll
		      (if
			(not
			  (or
			    (equal p
				   (vlax-curve-getStartPoint obj1)
				   1e-6
			    )
			    (equal p (vlax-curve-getendPoint obj1) 1e-6)
			  )
			)
			 (setq result (cons p result))
		      )
		    )
		    (setq result (append result ll))
		  )
		  (setq flag nil)
		)
	      )
	    )
	  )

	)
      )
    )
  )
  (foreach a lst0 (vla-delete a))
  ;;除重点
  (setq	result
	 (vl-sort
	   result
	   '(lambda (a b)
	      (if (equal (car a) (car b) 1e-6)
		(< (cadr a) (cadr b))
		(< (car a) (car b))
	      )
	    )
	 )
  )
  (setq l nil)
  (while result
    (setq l	 (cons (setq n (car result)) l)
	  result (cdr result)
    )
    (while (and result (equal n (car result) 1e-6))
      (setq result (cdr result))
    )
  )
  (reverse l)
)
(defun c:tt ()
  (while
    (setq e (car (entsel "\n选择多段线:")))
     (setq pl (gxl-polyselfinters e))
    (setvar 'pdsize 5)
    ;;绘制交点
     (mapcar '(lambda (x)
		(vl-cmdf "point" "non" (trans x 0 1) )
	      )
	     pl
     )
    ;;显示焦点坐标
     (princ pl)
  )
  (princ)
)