;;;series summation 
;;;	SUMSQR_2.LSP
;;;	Sept 25, 2003	Takaya Iwamoto
;;;	Copyright 2006  Takaya Iwamoto
;;;	Aug 2,2006	Takaya Iwamoto used sumsqr_1.lsp as a template
;;;	Aug 3, 2006	added group name & arrows
;;;**ref**
;;;J.H.Conway, "The book of Numbers", p 49
;;;
(defun c:sumsqr_2 (  / last_1 last_2 )
  (setup_sumsqr2)
  (setq nstep 2)
  (while (= (Yes_or_No "Go to next step ?") "_Y")
    (nxn_cube nstep)
    (IF	(= JPG_YES 1)
      (make_jpg)
    )
    (setq nstep (1+ nstep))
  )
;;;end of while loop
  (setq nstep (1- nstep))
;;;draw boundary lines for 3 groups
  (draw_boundary)
  (IF (= JPG_YES 1)
    (make_jpg)
  )
;;;display texts and arrows
  (text_arrow)
  (IF (= JPG_YES 1)
    (make_jpg)
  )

 
(reset_sysvar)
)
;;;C:sumsqr_2
;;;
;;;draw_boundary
(defun draw_boundary( )
   (setq p0 (shift_pnt pnt_org '(0 1.35))
	p1 (shift_pnt pnt_org (list (- (* space_left nstep) 0.75) (+ (* space_down nstep) 0.75)) )
	p2 (shift_pnt pnt_org (list (+ (* space_right nstep) 0.75) (+ (* space_down nstep) 0.75)) )
	p3 (shift_pnt pnt_org (list 0. (+ (* space_down nstep) 0.75)))
	p1_down (shift_pnt p1 (list 0. (- (* space_down nstep) 1.) ))
	p2_down (shift_pnt p2 (list 0. (- (* space_down nstep) 1.)) )
	p3_down (shift_pnt p3 (list 0. -0.25))
  )
  (command "_.pline" p0 "_width" 0.10 "" p1 p2 "cl")
  (command "_.pline" p1 "_width" 0.10 "" p1_down p3_down p3 "cl")
  (command "_.pline" p2 "_width" 0.10 "" p2_down p3_down p3 "cl")
)
;;;
;;;text_arrow
(defun text_arrow(  / mid_p01 mid_p1d3d mid_p2d3d pnt_a pnt_b pnt_c pa_arrow pb_arrow pc_arrow)
	(setq mid_p01 (mid_point p0 p1)
        mid_p1d3d (mid_point p1_down p3_down)
	mid_p2d3d (mid_point p2_down p3_down)
	pnt_a (shift_pnt mid_p01 '(-1.0 0.5))
	pnt_b (shift_pnt mid_p1d3d '(0.25 -1.5))
	pnt_c (shift_pnt mid_p2d3d '(-1.0 -1.5))
	pa_arrow (shift_pnt pnt_a '(-0.5 1.85))
	pb_arrow (shift_pnt pnt_b '(1.0 -1.0))
	pc_arrow (shift_pnt pnt_c '(-1.0 1.0))
  	)
	
  (textdisplay "A"   pnt_a  1.25 0.)
  (textdisplay "B"   pnt_b  1.25 0.)
  (textdisplay "C"   pnt_c  1.25 0.)
  (command "_.insert" "white_arrow" pa_arrow 2.0 2.0 0.0)
  (command "_.insert" "white_arrow" pb_arrow 2.0 2.0 45.) 
  (command "_.insert" "white_arrow" pc_arrow 2.0 2.0 -45.) 
)
;;;
;;;
(defun setup_sumsqr2 ( )
  (setup_sysvar)
  (setvar "PDMODE" 32)
  (setvar "PDSIZE" -3)
  (if (/= (getvar "UNDOCTL") 0)
    (command "_.undo" "_C" "_N")
  )					;no und
  (command "shademode" "Gouraud")
  (setq space_down -1.5
        space_right 1.5
	space_left -1.5
	ref_len 15.
	lower_left '(-9 -16.0)
	upper_right '(9. 2.)
  )
  (setq	pnt_org	'(0 0 )
	pnt_c1 (shift_pnt pnt_org '(0.1 0))
	pnt_1_left (shift_pnt pnt_org (list space_left space_down))
	pnt_1_right (shift_pnt pnt_org (list space_right space_down))
	pnt_2 (shift_pnt pnt_org (list 0. space_down))
  )
  (command "_.zoom" "W" lower_left upper_right) 
  (my_block_insert "red_1_ring" pnt_org 0.5)
  (my_block_insert "red_1_ring" pnt_1_right 0.5)
  (my_block_insert "red_1_ring" pnt_1_left 0.5)
  ;(my_block_insert "red_1_ring" pnt_2 0.5)

  ;;this will be used as a reference later
  (setq ss1 (ssadd))


   
  (command "_.regen")
  (IF (= JPG_YES 1)
    (make_jpg)
  )

)
;;;SETUP_sumsqr2
;;;
;;;nxn_cube	create N by N cubes using array command
;;;
(defun nxn_cube	(num / pnt_base col_id ring_name base_ring)
  (setq pnt_base (shift_pnt pnt_org (list 0 (* space_down (1- num)) ))
	pnt_c2 (shift_pnt pnt_base '(-0.1 0))
  )
	
  (setq	col_id	  (rem num 7)
	ring_name
		  (cond	((= col_id 0) "white_7_ring")
			((= col_id 1) "red_1_ring")
			((= col_id 2) "yellow_2_ring")
			((= col_id 3) "green_3_ring")
			((= col_id 4) "cyan_4_ring")
			((= col_id 5) "blue_5_ring")
			((= col_id 6) "magenta_6_ring")
			(t "white_7_ring")
		  )
  )
  
  (my_block_insert ring_name pnt_base 0.5)
  (setq base_ring (entlast))
;;;use COPY command (NUM - 1) times to add one new ring to the bottom of the existing column 
  (setq nminus_1 (1- num)
	step 1
  )
  (repeat nminus_1
	(setq pnt_right (shift_pnt pnt_base (list (* space_left step) (* space_down step)))
		pnt_left (shift_pnt pnt_base (list (* space_right step) (* space_down step)))
	)
	(command "_.copy" base_ring "" pnt_base pnt_right)
	(command "_.copy" base_ring "" pnt_base pnt_left)
	(setq step (1+ step))
  )
;;;make a selection set for the center rings
  (setq ss (ssget "C" pnt_c1 pnt_c2)
	right_shift (* space_right num)
	left_shift (* space_left num)
	down_shift (* space_down num)
	pnt_r (shift_pnt pnt_base (list right_shift down_shift))
	pnt_l (shift_pnt pnt_base (list left_shift down_shift))
  )
;;;copy ss to pnt_r & pnt_l
  (command "_.copy" ss "" pnt_base pnt_r "")
  (command "_.copy" ss "" pnt_base pnt_l "")
  
)
;;;NXN_CUBE
;;;
(defun c:square_pyramid	()
  (setup_ball)
  (setq nstep 2)
  (while (= (Yes_or_No "Go to next step ?") "_Y")
    (nxn_ball nstep)
    (IF	(= JPG_YES 1)
      (make_jpg)
    )
    (setq nstep (1+ nstep))
  )
;;;end of while loop
  (reset_sysvar)
)
;;;C:square_pyramid
;;;
;;;
(defun setup_ball ()
  (setup_sysvar)
	;(setvar "PDMODE" 32)
	;(setvar "PDSIZE" -3)
  (if (/= (getvar "UNDOCTL") 0)
    (command "_.undo" "_C" "_N")
  )		;no und
  (command "shademode" "Gouraud")
  (setq ref_len 15.)
  (setq	z_up	'(0 0 2)
	z_down	'(0 0 -5)
	x_left	'(-10 0 0)
	x_right	'(10 0 0)
	y_far	'(0 10 0)
	y_near	'(0 -10 0)
  )
  (make_pt "0" 0 z_up)
  (make_pt "0" 0 z_down)
  (make_pt "0" 0 x_left)
  (make_pt "0" 0 x_right)
  (make_pt "0" 0 y_far)
  (make_pt "0" 0 y_near)

  (command "_.vpoint" "-18.3967,-26.1979,22.8342")
  ;;SW isometric view

  (my_block_insert
    "white_ball"
    (list -1 -1 (- ref_len 2))
    1.0
  )
  (setq ref_ball1 (entlast))
  ;;this will be used as a reference later

  (command "_.zoom" "_EXTENT")
  (command "_.regen")
  (IF (= JPG_YES 1)
    (make_jpg)
  )

)
;;;SETUP_ball
;;;
;;;
;;;nxn_ball	create N by N cannon-ball pyramid using array command
;;;
(defun nxn_ball	(num / pnt_ins col_id ball_name base_ball)
  (setq pnt_ins (list (- num) (- num) (- ref_len (* num 2.))))
  (setq	col_id	  (rem num 7)
	ball_name
		  (cond	((= col_id 0) "white_ball")
			((= col_id 1) "red_ball")
			((= col_id 2) "yellow_ball")
			((= col_id 3) "green_ball")
			((= col_id 4) "cyan_ball")
			((= col_id 5) "blue_ball")
			((= col_id 6) "magenta_ball")
			(t "white_ball")
		  )
  )
  (princ pnt_ins)
  (terpri)
  (my_block_insert ball_name pnt_ins 1.0)
  (setq base_ball (entlast))
;;;use ARRAY command to make N x N 
  (command "_.array" base_ball "" "_R" num num 2.0 2.0)
)
;;;NXN_ball
;;;************************************************************************
;;; Function: PLT_3D
;;;
;;; get a point off the line segment defined by two end points and angle.
;;;	
					; utility routine 
;; get a point along the line segment defined by two end points 
;;
;; pnt_a pnt_b      end points
;; loc_from_a       ratio of distance from a to length AB
;; output           point data (x,y)
(defun PLT_3D
	      (pnt_a  pnt_b  loc_from_a	   /	  xa	 xb	ya
	       yb     za     zb	    dist_ab	  dx	 dy	dz
	       xm     ym     zm
	      )

  (setq	xa (car pnt_a)
	ya (cadr pnt_a)
	za (caddr pnt_a)
	xb (car pnt_b)
	yb (cadr pnt_b)
	zb (caddr pnt_b)
	dx (- xb xa)
	dy (- yb ya)
	dz (- zb za)
	xm (+ xa (* loc_from_a dx))
	ym (+ ya (* loc_from_a dy))
	zm (+ za (* loc_from_a dz))
  )
  (list xm ym zm)
)					;PLT_3D
;;;************************************************************************
;;; Function: PLD_3d
;;;
;;; get a point off the line segment defined by two end points and angle.
;;;	
					; utility routine 
;; get a point along the line segment defined by two end points 
;;
;; pnt_a pnt_b      end points
;; dist_from_a      distance from a to b
;;
;; output           point data (x,y)
;;
(defun PLD_3D
	      (pnt_a  pnt_b  dist_from_a   /	  xa	 xb	ya
	       yb     za     zb	    dx	   dy	  dz	 xm	ym
	       zm     loc_from_a
	      )

  (setq	xa	   (car pnt_a)
	ya	   (cadr pnt_a)
	za	   (caddr pnt_a)
	xb	   (car pnt_b)
	yb	   (cadr pnt_b)
	zb	   (caddr pnt_b)
	dx	   (- xb xa)
	dy	   (- yb ya)
	dz	   (- zb za)
	loc_from_a (/ dist_from_a (distance pnt_a pnt_b))
	xm	   (+ xa (* loc_from_a dx))
	ym	   (+ ya (* loc_from_a dy))
	zm	   (+ za (* loc_from_a dz))
  )
					;(princ zm)
  (list xm ym zm)

)					;PLD_3D
;;;
;;;*******************************************************************************************
;;;		move_ent_3d      move a sinlge entity slowly
;;;
(defun move_ent_3d (move_entity		  pnt_start  pnt_end
		    n_speed    ndiv	  ncolor     layer_name
		    /	       nstep	  pnt_from   pnt_to
		    inc
		   )
  (setq	inc	 (/ 1. ndiv)
	nstep	 1
	pnt_from pnt_start
	pnt_to	 (plt_3d pnt_start pnt_end inc)
  )
  (repeat ndiv
    (slow_line_3d n_speed layer_name ncolor pnt_from pnt_to)
    (entdel (entlast))
;;;test delete the trace
    (command "_.move" move_entity "" pnt_from pnt_to)

    (setq nstep	   (1+ nstep)
	  pnt_from pnt_to
	  pnt_to   (plt_3d pnt_start pnt_end (* inc nstep))
    )
  )
)
;;;move_ent_3d
;;;

;;; Function: SLOW_LINE_3D
;;;
;;;draw a line slowly between two given points
;;;
(defun SLOW_LINE_3D (n_section	layer_name color_code pnt_begin
		     pnt_end	/	   n_section  nstep
		     x0		x1	   delta_x    y0
		     y1		delta_y	   z0	      z1
		     delta_z	pnt_cur	   x_next     y_next
		     z_next	pnt_next
		    )

  (setq sblip (getvar "blipmode"))
  (setq scmde (getvar "cmdecho"))
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)

  (setq nstep 1)
  (setq	x0	(car pnt_begin)
	x1	(car pnt_end)
	y0	(cadr pnt_begin)
	y1	(cadr pnt_end)
	z0	(caddr pnt_begin)
	z1	(caddr pnt_end)
	delta_x	(/ (- x1 x0) (float n_section))
	delta_y	(/ (- y1 y0) (float n_section))
	delta_z	(/ (- z1 z0) (float n_section))
  )
  (setq pnt_cur pnt_begin)

  (while (< nstep n_section)
    (progn

      (setq x_next   (+ x0 (* delta_x nstep))
	    y_next   (+ y0 (* delta_y nstep))
	    z_next   (+ z0 (* delta_z nstep))
	    pnt_next (list x_next y_next z_next)
      )
      (command "_.line" pnt_begin pnt_next "")
      (entdel (entlast))
    )
    (setq nstep (+ 1 nstep))
  )
  (make_line_1 layer_name color_code pnt_begin pnt_end)
		;slow displayed line
  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
)					;SLOW_LINE_3d
;;;************************************************************************