;;(gxl-GetSamplet CURVE d) 按弦高返回曲线拟合样本点
;;参数 curve = 曲线图元名/对象名
;;     d = 弦高限差值
;;   By Gu_xl 明经通道，2015.04.01修正了SPLINE的一个Bug
(defun gxl-GetSamplet (CURVE D / PerDistToLine GETPOINTS NAME DXF PL I)
  (defun PerDistToLine (pt p1 p2 / norm)
    (setq norm (mapcar '- p2 p1)
	  p1   (trans p1 0 norm)
	  pt   (trans pt 0 norm)
    )
    (abs (- (car pt) (car p1)))
  )
  (defun getpoints (curve stPar enPar d / ps pe pm)
    (setq ps (vlax-curve-getPointAtParam curve stPar)
	  pe (vlax-curve-getPointAtParam curve enPar)
	  pm (vlax-curve-getPointAtParam curve (* 0.5 (+ stPar enPar)))
    )

   (if pm
    (if	(<= (PerDistToLine pm ps pe) d)
      (list pe)
      (append (getpoints curve stpar (* 0.5 (+ stPar enPar)) d)
	      (getpoints curve (* 0.5 (+ stPar enPar)) enPar d)
      )
    )

  (list pe)
  )
  )
  (if (= 'vla-object (type curve))
    (setq curve (vlax-vla-object->ename curve))
  )
  (cond
    ((=	"LINE"
	(setq name (cdr (assoc 0 (setq dxf (entget curve)))))
     )
     (list (vlax-curve-getStartPoint curve)
	   (vlax-curve-getEndPoint curve)
     )
    )
    ((= "ARC" name)
     (cons (vlax-curve-getstartpoint curve)
	   (getpoints curve
		      (vlax-curve-getStartParam curve)
		      (vlax-curve-getEndParam curve)
		      d
	   )
     )
    )
    ((= "CIRCLE" name)
     (cons (vlax-curve-getstartpoint curve)
	   (append
	     (getpoints	curve
			0
			pi
			d
	     )
	     (getpoints	curve
			pi
			2pi
			d
	     )
	   )
     )
    )
    ((= "ELLIPSE" name)
     (if (vlax-curve-isClosed curve)
       (cons (vlax-curve-getstartpoint curve)
	     (append
	       (getpoints curve
			  0
			  pi
			  d
	       )
	       (getpoints curve
			  pi
			  2pi
			  d
	       )
	     )
       )
       (cons (vlax-curve-getstartpoint curve)
	     (getpoints	curve
			(vlax-curve-getStartParam curve)
			(vlax-curve-getEndParam curve)
			d
	     )
       )
     )
    )
    ((= "SPLINE" name)
     (setq
       pl (mapcar 'cdr
		  (vl-remove-if-not '(lambda (x) (= 11 (car x))) dxf)
	  )
     )
     (if (not pl)
       (setq pl
	      (mapcar
		'(lambda (x) (vlax-curve-getclosestpointto curve (cdr x)))
		(vl-remove-if-not '(lambda (x) (= 10 (car x))) dxf)
	      )
       )
     )
     (setq pl (mapcar '(lambda (x)
			 (vlax-curve-getParamAtPoint
			   curve
			   x
			 )
		       )
		      pl
	      )
     )
     (if (equal (car pl) (last pl) 1e-6)

        (setq

	 pl (reverse
	      (cons (vlax-curve-getEndParam curve) (cdr (reverse pl)))
	    )
       )
     )
     (setq pl (mapcar 'list pl (cdr pl))
     )
     (setq pl
	    (apply 'append
		   (mapcar
		     '(lambda (x)
			(list
			  (list (car x) (* 0.5 (apply '+ x)))
			  (list (* 0.5 (apply '+ x)) (cadr x))
			)
		      )
		     pl
		   )
	    )
     )
     (cons
       (vlax-curve-getStartPoint curve)
       (apply
	 'append
	 (mapcar '(lambda (x)
		    (apply 'GETPOINTS (append (cons curve x) (list d)))
		  )
		 pl
	 )
       )
     )
    )
    ((WCMATCH name "*POLYLINE")
     (setq pl nil
	   i  -1
     )
     (while (< i (vlax-curve-getEndParam curve))
       (setq pl (cons (setq i (1+ i)) pl))
     )
     (setq pl (reverse pl)
	   pl (mapcar 'list pl (cdr pl))
     )
     (cons
       (vlax-curve-getStartPoint curve)
       (apply
	 'append
	 (mapcar '(lambda (x)
		    (apply 'GETPOINTS (append (cons curve x) (list d)))
		  )
		 pl
	 )
       )
     )
    )
  )
)