 ;__2004.01.07.09.16_____________________________________
 ;__样条曲线--〉复义线___BY__WKAI__晓东CAD论坛___________
(defun c:spl2pl	(/	    pts	       min_distacne	     vlo
		 st_par	    ed_par     ent	  n
		 max_angle_rad	       max_an	  MAX_ANGLE
		 ZHF_TIME_DOT	       MAX_ANGLE_RAD	     PTS
		 X	    Y	       T1	  T2	     T3
		)
 ;________________________________________________________
 ;________________________________________________________
  (defun t1 (vl_obj    start_par end_par   /	     dis_m_m
	     ed_p      ed_pt	 mid_p	   mid_pt    mid_pt_vlo
	     st_p      st_pt
	    )
    (setq st_p	     start_par
	  ed_p	     end_par
	  st_pt	     (vlax-curve-getpointatparam vl_obj st_p)
	  ed_pt	     (if (vlax-curve-getpointatparam vl_obj ed_p)
		       (vlax-curve-getpointatparam vl_obj ed_p)
		       (vlax-curve-getendpoint vl_obj)
		     )
	  mid_p	     (/ (+ st_p ed_p) 2.0)
	  mid_pt     (mapcar '(lambda (x y) (/ (+ x y) 2.0)) st_pt ed_pt)
	  mid_pt_vlo (vlax-curve-getpointatparam vl_obj mid_p)
	  dis_m_m    (distance mid_pt_vlo mid_pt)
    )
    (if	(or (> (t3 ed_pt st_pt mid_pt_vlo t) max_angle_rad)
	    (and (< (t3 ed_pt st_pt mid_pt_vlo t) max_angle_rad)
		 (t2 vl_obj st_p ed_p st_pt ed_pt)
	    )
	)
      (progn
	(t1 vl_obj st_p mid_p)
	(t1 vl_obj mid_p ed_p)
      )
      (setq pts (append pts (list mid_pt_vlo) (list ed_pt)))
    )
  )
 ;_____________________________________________________________
  (defun t2 (vl st_par ed_par s_pt e_pt / run delta_p n lst pt)
    (setq run	  t
	  delta_p (- ed_par st_par)
	  lst	  '(0.0001 0.01 0.25) ;_测试采样表
	  n	  -1
    )
    (while (and run (< (setq n (1+ n)) (length lst)))
      (setq pt (vlax-curve-getpointatparam
		 vl
		 (+ st_par (* delta_p (nth n lst)))
	       )
      )
      (if (> (t3 e_pt s_pt pt t) max_angle_rad)
	(setq run nil)
      )
      (if (> (t3 s_pt e_pt pt t) max_angle_rad)
	(setq run nil)
      )
      (setq pt (vlax-curve-getpointatparam
		 vl
		 (- ed_par (* delta_p (nth n lst)))
	       )
      )
      (if (> (t3 e_pt s_pt pt t) max_angle_rad)
	(setq run nil)
      )
      (if (> (t3 s_pt e_pt pt t) max_angle_rad)
	(setq run nil)
      )
    )
    (not run)
  )
 ;_____________________________________________________________
  (defun t3 (p1 p2 p3 rad)
    (if	rad
      (abs (- (angle p2 p3) (angle p2 p1)))
      (* 180 (/ (abs (- (angle p2 p3) (angle p2 p1))) pi))
    )
  )
  (setq	vlo	      (vlax-ename->vla-object
			(setq ent (car (entsel "\n选择spline：")))
		      )
	st_par	      (vlax-curve-getstartparam vlo)
	ed_par	      (vlax-curve-getendparam vlo)
	pts	      (list (vlax-curve-getstartpoint vlo))
	max_angle     (if
			(setq
			  max_an (getreal (strcat "\n许可角度误差<"
						  (if max_angle
						    (rtos max_angle 2 2)
						    (rtos (setq max_angle 10))
						  )
						  ">:"
					  )
				 )
			)
			 max_an
			 max_angle
		      )
	max_angle_rad (* pi (/ max_angle 180.0)) ;_最大许可误差角度弧度
  )
  (setq zhf_time_dot nil)
  (z_timer)
  (t1 vlo st_par ed_par)
  (command "pline")
  (foreach n pts (command "non" n))
  (command)
  (princ (strcat "\n创建一条顶点数为"
		 (itoa (length pts))
		 "的复义线。"
	 )
  )
  (princ (z_timer))
  (princ)
)
 ;________________________________________________________
 ;________________________________________________________
(princ "\n样条曲线--〉复义线___BY__WKAI__晓东CAD论坛")






