;;;Utility tool for dividing pline entinty into equal parts.
;;;
;;;	EVOLUTE.LSP
;;;
;;;	Steps:
;;;		#1	Select a pline entity (including Spline, ellipse, circle,polygon)
;;;		#2	Ask for the first point (Yes 0r No)
;;;		#3	Specify a number of division
;;;				Total length is shown as a reference
;;;		#4	Divide and show points
;;;		#5	Ask for the end point creation (Yes or No)
;;;		#6	Output  is  Selection set named  Cur_sset
;;;
;;;	March 19,2005	Takaya Iwamoto
;;;	May 26  ,2006	Takaya Iwamoto  added evolute_manual command
;;;	June 03,2006	Takaya Iwamoto	added Radical_Axis
;;;	June 12,2006	T.iwamoto	added draw_ellipse_evolute
;;;*****************************************************************
;;;	Copyright July 2006	Takaya Iwamoto
;;;*****************************************************************
;;;
(defun c:evolute ()
  (setup_sysvar)
  (c:divide_pline)
  (3p_circles cur_sset 1)
  (command "_.layer" "_off" "layer255" "")
  (reset_sysvar)
)
;;;;
;;;;
(defun C:DIVIDE_PLINE ()
  (setq	cur_sset nil
	cur_sset (ssadd)
  )		;initialize selection set cur_sset
  (setq pl_ent (entsel "\nSelect a polyline entity"))
  (if (= (Yes_or_No "\Want to define a starting point ?") "_Y")
    (progn
      (setq pnt_0 (getpoint "\Define a point"))
      (make_pt "0" 1 pnt_0)
      (setq EL1 (entlast))
      (ssadd EL1 cur_sset)	;; EL1 is the 1-st entry in cur_sset
      (setq START_PT 1)
    )
    (progn
      (setq EL1 (entlast))
      (setq START_PT nil)		;No start point specified
    )
  )
		;(get_length pl_ent)	;Get total pline length
  (setq nseg (getint "\nNumber of division ?(def = 10)"))
  (if (= nseg nil)
    (setq nseg 10)
  )
  (command "_.divide" pl_ent nseg)	;divide the entity into nseg

  (if (= START_PT nil)
    (setq EL1 (entnext EL1))
  )
  (princ "EL1=")
  (princ EL1)
  (terpri)

  (while EL1
    (ssadd EL1 cur_sset)		;add EL1 to cur_sset
    (setq EL1 (entnext EL1))		;EL1 = next POINT entity 
  )

  (if (= (Yes_or_No "\Want to define the end point ?") "_Y")
    (progn
      (setq pnt_end (getpoint "\Define the last point"))
      (make_pt "0" 3 pnt_end)
      (ssadd (entlast) cur_sset)
    )
  )
  (setq total_num (sslength cur_sset))
  (princ (strcat "\nNumber of points in cur_sset = "
		 (itoa total_num)
	 )
  )
  (terpri)
  (princ cur_sset)
)
;;;DIVIDE_PLINE
;;;
;;;Utility tools for drawing eggs
;;;Finding the center of radius 
;;;
;;;	March 06,2005
;;;	By Takaya Iwamoto
;;;
;;;
;;;`POINT_LIST	output  point selection set  --> ss
;;;
(defun point_list ()
  (setvar "OSMODE" 8)
  (setq ss (ssadd))
  (while (setq this_entity (entsel "Pick a Point\n"))
    (if	(= "POINT"
	   (cdr (assoc 0 (setq this_list (entget (car this_entity)))))
	)
      (progn
	(ssadd (car this_entity) ss)
	(princ "\nA point is picked")
	(terpri)
      )
      (princ "Not a point !!")
    )
    ;;end of if
  )
;;;;while loop
)
;;;POINT_LIST
;;;* ASSOC_DATA 
;;;  Input    dxf code , entity data list.
;;;* Output   the data element of the association pair.
;;;*
(defun assoc_data (code elist)
;;;Returns the association pair without 1st element
  (cdr (assoc code elist))
)					;
;;;*
;;;
(defun 3p_circles (ss	    CLOSED   /	      nbase    n_repeat
		   n0	    n1	     n2	      pt_0     pt_1
		   pt_2	    last_circle	      lc_center
		  )
;;;When the curved is closed , the first 2 data will be added at the end

  (setq	nbase	 0
	pt_total (sslength ss)
  )
  (if (= CLOSED 1)
    (setq pt_total (+ 2 pt_total))
  )
  (setq	n_repeat (- pt_total 2)
	circle_count 0
  )
  (repeat n_repeat
    (setq n0 nbase
	  n1 (1+ n0)
	  n2 (1+ n1)
    )
    (if	(= nbase (- n_repeat 2))
      (setq n2 0)
    )
    (if	(= nbase (- n_repeat 1))
      (setq n1 0
	    n2 1
      )
    )

    (setq pt_0 (assoc_data 10 (entget (ssname ss n0)))
	  pt_1 (assoc_data 10 (entget (ssname ss n1)))
	  pt_2 (assoc_data 10 (entget (ssname ss n2)))
    )
    (command "_.layer" "_set" "layer255" "")
    (command "_.circle" "_3P" pt_0 pt_1 pt_2)
    (command "_.layer" "_set" "0" "")
					;(make_arc_cbe "0" 4 pnt_org pnt_b pnt_e)

    (setq last_circle (entget (entlast)))
    (setq lc_center (assoc_data 10 last_circle)
	  lc_radius (assoc_data 40 last_circle)
    )
    (setq ncolor (rem (setq circle_count (1+ circle_count)) 8))
    (make_arc_cbe "0" ncolor lc_center pt_1 pt_2)

    (make_pt "0" 1 lc_center)
    (make_line_1 "0" 8 pt_1 lc_center)
;;;
    (if	(= nbase 0)
      (setq pnt_old lc_center)
      (progn
	(make_line_1 "0" 3 pnt_old lc_center)
	;;connect center
	(setq pnt_old lc_center)
      )
    )
    (setq nbase (1+ nbase))
					;(alert "\nNext step?")
					;(command "_.delay" 500)		;;give enough time for data manipulation
					;(entdel last_circle)
  )
;;; repeat loop
)
;;;3p_circles
;;;
;;;
;;;TEST_ELLIPSE		Draw an ellipse for test purpose
;;;
(defun C:TEST_ELLIPSE ()
  (setq a_val (getreal "\nInput a-value (def = 2.0): "))
  (if (= a_val nil)
    (setq a_val 2.)
  )
  (setq b_val (getreal "\nInput b-value (def = 1.0): "))
  (if (= b_val nil)
    (setq b_val 1.)
  )

  (setq	a_minus	(list (- a_val) 0)
	a_plus	(list a_val 0)
	b_plus	(list 0 b_val)
	b_minus	(list 0 (- b_val))
  )
  (setq	x_left	'(-3 0)
	x_right	'(3 0)
	y_up	'(0 2)
	y_down	'(0 -2)
  )
  (make_line_1 "0" 8 x_left x_right)
  (make_line_1 "0" 8 y_down y_up)
  (command "_.ellipse" a_minus a_plus b_plus)

  (command "_.zoom" "_EXTENT")
  (command "_.regen")
)
;;;TEST_ELLIPSE
;;;
;;;
;;;DRAW_ELLIPSE_EVOLUTE		Draw an evolute curve for a given ellipse 
;;;ellipse is given as (x/a)^2 + (y/b)^2 = 1, then its evolute is (x/A)^(2/3) + (y/B)^(2/3) = 1
;;;where  Aa = Bb = a*a - b*b, and min & max radius are b*b/a and a*a/b respectively.
;;;
;;;Ref. "A Handdbook on curves and their properties"  by Robert C.Yates
;;;	"A Book of Curves" by E.H.Lockwood
;;; 
(defun C:DRAW_ELLIPSE_EVOLUTE ()
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -2)

  (setq a_val (getreal "\nInput a-value (def = 2.0): "))
  (if (= a_val nil)
    (setq a_val 2.)
  )
  (setq b_val (getreal "\nInput b-value (def = 1.0): "))
  (if (= b_val nil)
    (setq b_val 1.)
  )

  (setq	a_minus	(list (- a_val) 0)
	a_plus	(list a_val 0)
	b_plus	(list 0 b_val)
	b_minus	(list 0 (- b_val))
  )
  (setq	x_left	'(-3 0)
	x_right	'(3 0)
	y_up	'(0 1.5)
	y_down	'(0 -3.5)
  )
  (make_line_1 "0" 8 x_left x_right)
  (make_line_1 "0" 8 y_down y_up)
  (command "_.ellipse" a_minus a_plus b_plus)

;;;draw evolute only for upper half of this ellipse for   ( -a <= x <= a )
  (setq	a2_m_b2	 (- (* a_val a_val) (* b_val b_val))
	big_a	 (/ a2_m_b2 a_val)
	big_b	 (/ a2_m_b2 b_val)
	two_by_3 (/ 2. 3.)
	r_min	 (/ (* b_val b_val) a_val)
	r_max	 (/ (* a_val a_val) b_val)
	x_max	 (- a_val r_min)
	x_min	 (- x_max)
	pnt_ca	 (list x_min 0)
	pnt_cad	 (list x_max 0)
	pnt_cb	 (list 0 (- b_val r_max))
	n_div	 100
	step	 (/ (* 2 x_max) (float n_div))
	minus_a	 (- a_val)
	plus_a	 a_val
  )
;;;Min & Max radii points
  (make_pt "0" 1 pnt_ca)
  (make_pt "0" 1 pnt_cad)
  (make_pt "0" 2 pnt_cb)
;;;find evolute points and connect by line segments
  (setq	pnt_old	pnt_ca
	n_count	1
  )
  (repeat 100
    (setq x_pos	  (+ x_min (* step n_count))
	  y_t	  (abs (- 1. (expt (/ (abs x_pos) big_a) two_by_3)))
	  y_pos	  (- (* big_b (sqrt (expt y_t 3.))))
	  pnt_new (list x_pos y_pos)
    )
    (make_line_1 "0" 3 pnt_old pnt_new)

    (setq n_count (1+ n_count)
	  pnt_old pnt_new
    )
  )
;;;end of repeat loop

  (make_circle_1 "0" 8 pnt_ca r_min)
  (make_circle_1 "0" 8 pnt_cad r_min)
  (make_circle_1 "0" 8 pnt_cb r_max)

  (command "_.zoom" "_EXTENT")
  (command "_.regen")
)
;;;DRAW_ELLIPSE_EVOLUTE
;;;
;;;
;;;Pick up 3 points to define a circle. Its center and radius are drawn.
;;;
(defun c:evolute_manual	()
  (setup_sysvar)
  (setq chr_size 0.02)
  (setq ncount 0)

  (repeat 20
    (setq tri_pnt (ssget '((0 . "POINT"))))
    ;;select "point" only

    (setq pt_0 (assoc_data 10 (entget (ssname tri_pnt 0)))
	  pt_1 (assoc_data 10 (entget (ssname tri_pnt 1)))
	  pt_2 (assoc_data 10 (entget (ssname tri_pnt 2)))
    )
    (command "_.circle" "_3P" pt_0 pt_1 pt_2)
    (setq last_circle (entget (entlast)))
    (setq lc_center (assoc_data 10 last_circle)
	  lc_radius (assoc_data 40 last_circle)
    )
    (make_pt "0" 1 lc_center)
    (textdisplay (itoa ncount) lc_center chr_size 0.)

    (make_line_1 "0" 8 pt_0 lc_center)
    (setq ent_1 (entlast))
    (make_line_1 "0" 8 pt_2 lc_center)
    (setq ent_2 (entlast))
    (command "_.trim" ent_1 ent_2 "" PAUSE PAUSE "")
    (make_line_1 "0" ncount pt_1 lc_center)

    (setq ncount (1+ ncount))
  )
;;;repeat loop
  (reset_sysvar)
)
;;;
;;;
;;;
;;;Radical_axis
;;;Draw a radical axis
;;;definition of radical axis
;;;Let c(x,y) = x*x + y*y +2gx + 2fy + c = 0  and  c'(x,y) = x*x + y*y + 2f'x + 2g'y + c' = 0
;;;Then c(x,y) - c'(x,y) = 0 is a equation for the line, called radical axis.
;;;The length of the tangent line drawn from a point on the radical axis to both circles are the same.
;;;Ref. Dan Pedoe "Geometry  A comprehensive course", p. 106
;;;
(defun C:Radical_axis ()
  (setq	c1_elist (entget (car (entsel "\nSelect the first circle")))
	c2_elist (entget (car (entsel "\nSelect the second circle")))
	pt1	 (cdr (assoc 10 c1_elist))
	pt2	 (cdr (assoc 10 c2_elist))
	g1	 (- (car pt1))
	f1	 (- (cadr pt1))
	g2	 (- (car pt2))
	f2	 (- (cadr pt2))
	r1	 (cdr (assoc 40 c1_elist))
	r2	 (cdr (assoc 40 c2_elist))
	c1	 (+ (* f1 f1) (* g1 g1) (- (* r1 r1)))
	c2	 (+ (* f2 f2) (* g2 g2) (- (* r2 r2)))
	g1_m_g2	 (- g1 g2)
	f1_m_f2	 (- f1 f2)
	c1_m_c2	 (- c1 c2)
	pt_x	 (* 0.5 (- (/ c1_m_c2 g1_m_g2)))
	pt_y	 (* 0.5 (- (/ c1_m_c2 f1_m_f2)))
	pnt_x	 (list pt_x 0)
	pnt_y	 (list 0 pt_y)
  )
  (make_pt "0" 0 pnt_x)
  (make_pt "0" 0 pnt_y)
  (make_line_1 "0" 0 pnt_x pnt_y)
)
;;;Radical_axis
;;;
;;;
;;;
(defun Radical_axis (c1_elist	     c2_elist	     /	     pt1
		     pt2     f1	     f2	     g1	     g2	     r1
		     r2	     c1	     c2	     g1_m_g2 f1_m_f2 c1_m_c2
		     pt_x    pt_y
		    )
  (setq
    pt1	    (cdr (assoc 10 c1_elist))
    pt2	    (cdr (assoc 10 c2_elist))
    g1	    (- (car pt1))
    f1	    (- (cadr pt1))
    g2	    (- (car pt2))
    f2	    (- (cadr pt2))
    r1	    (cdr (assoc 40 c1_elist))
    r2	    (cdr (assoc 40 c2_elist))
    c1	    (+ (* f1 f1) (* g1 g1) (- (* r1 r1)))
    c2	    (+ (* f2 f2) (* g2 g2) (- (* r2 r2)))
    g1_m_g2 (- g1 g2)
    f1_m_f2 (- f1 f2)
    c1_m_c2 (- c1 c2)
    pt_x    (* 0.5 (- (/ c1_m_c2 g1_m_g2)))
    pt_y    (* 0.5 (- (/ c1_m_c2 f1_m_f2)))
    pnt_x   (list pt_x 0)
    pnt_y   (list 0 pt_y)
  )
  (make_pt "0" 0 pnt_x)
  (make_pt "0" 0 pnt_y)
  (make_line_1 "0" 0 pnt_x pnt_y)
)
;;;Radical_axis
;;;
;;;
;;;Evolute_data
;;;make a list of evolute point data
;;;
(defun C:Make_pnt_List ()
  (setq evolute_pnt_list nil)
  (repeat 10
    (setq sel_obj	   (entsel "\nPick a point")
	  pnt_sel	   (cadr sel_obj)
	  ent_name	   (cdr (assoc 0 (entget (car sel_obj))))
	  evolute_pnt_list (append evolute_pnt_list (list pnt_sel))
    )
  )
;;;end of repeat loop
)
;;;MAKE_PNT_LIST
;;;