;; my_tools.lsp
;; collection of tools
;; 12/22/99  added  len_on_line, fac_on_line, del_layer
;; 12/28/99  added draw_x_axis & draw_y_axis
;; 1/11/00   added load_ltype   load linetype
;;           added make_ln,  make_circ
;; 1/14/00   added off_layer,  on_layer
;; 1/20/00   added asin, acos  for positive argument
;; 2/22/00   adde get_ent_data  for extracting dxf data 
;; 2/25/00   modified textdisplay   added line_angle
;; 2/25/00   added line_length to display line length on the line selected
;; 10/24/02  added make_3dface
;; 2/23/03   added make_pline
;; 6/17/05   added pl_vertices
;; 8/01/05   added slow_arc_1
;; 1/05/06   added move_bar for horizontal precisionn bar
;; 2/02/06   added make_jpg & jpg_setup for image files creation
;; ----------------List of tools-----------------------
;;
;;;1. mathematical utilities
;;;   dtr
;;;   rtd
;;;   tan
;;;   asin		;;arc sine
;;;   acos		;;arc cosine
;;;   2d_vec_prod
;;;   2d_scalar_prod
;;;   shift_pnt
;;;   2d_equation
;;;
;;;2. system variables control
;;;   setup_sysvar
;;;   reset_sysvar
;;;   set_layer		;;define all layers
;;;   set_txstyle
;;;   load_ltype	;;define all line types
;;;
;;;3. basic entity creation
;;;   make_pt
;;;   make_point
;;;   make_line_1
;;;   make_line_2		;;can specify line type
;;;   make_pline
;;;   make_circle
;;;   make_circ		;;can specify line type
;;;   make_arc_cbe
;;;   make_arc_3pt
;;;   textdisplay
;;;   make_donut
;;;   make_3dface
;;;   make_pline		;;make pline from lines
;;;   mark_point	;;display point ID as text
;;;   make_3dpt		;;3d point mark
;;;
;;;4. specialized entity creation utilities
;;;   point_along_line
;;;   point_off_line
;;;   point_sym_line
;;;   normal_to_line
;;;   normal_from_line
;;;   mid_point
;;;   make_mid_pnt
;;;   get_mid_point
;;;   mark_angle
;;;   get_length
;;;   get_distance
;;;   div_bet_pts
;;;   pt_extend
;;;   bar_block1 (block_name bar_length bar_width color_code)
;;;   bar_block2 (block_name bar_length bar_width color_code)
;;;   disp_bar    (block_name insert_point end_point)
;;;   shaded_triangle
;;;   shaded_quad
;;;
;;;5. general geometry utilities
;;;   get_length
;;;   norm_2_line
;;;   len_on_line
;;;   fac_on_line
;;;   slow_line
;;;   slow_circle
;;;   slow_arc
;;;   l_pl_int		;;intersection of a line and pline
;;;   c_pl_int		;;intersection of a circle and pline

;;;
;;;6. general entity , display control utilities
;;;   erase_ent_color
;;;   zoom_r
;;;   del_layer
;;;   off_layer
;;;   off_cur_layer
;;;   on_layer
;;;   get_ent_data
;;;   loc_first		;;find the first entry of DXF code in the list
;;;   my_block_insert
;;;   my_block_def
;;;
;;;---------------------End of List----------------------------------------
;;;************************************************************************
;;;		GROUP 1 : Mathematical aids
;;;1. mathematical utilities
;;;   dtr
;;;   rtd
;;;   tan
;;;   asin		;;arc sine
;;;   acos		;;arc cosine
;;;   2d_vec_prod
;;;   2d_scalar_prod
;;;   shift_pnt
;;;   2d_equation
;;;
;;;************************************************************************
;;; Function: DTR
;;;
;;; degree to radians conversion.
;;;
(defun DTR (a)
  (* pi (/ a 180.))
)					;DTR
;;;************************************************************************
;;; Function: RTD
;;;
;;; radian to degrees conversion.
;;;
(defun RTD (a)
  (/ (* a 180.) pi)
)					;RTD
;;;************************************************************************
;;; Function: TAN
;;;
;;; utility function for tangent.
(defun TAN (theta / sine cosine)
  (setq	sine   (sin theta)
	cosine (cos theta)
  )
  (/ sine cosine)
)					;TAN
;;;************************************************************************
;;; Function: ASIN
;;;
;;; arc sine function  ;; result in radian.
;;;
(defun ASIN (a)
  (atan (/ a (sqrt (- 1.0 (* a a)))))
)					;ASIN
;;;************************************************************************
;;; Function: ACOS
;;;
;;; arc cosine function  ;; result in radian.
;;;
(defun ACOS (a)
  (atan (/ (sqrt (- 1.0 (* a a))) a))
)					;ACOS
;;;************************************************************************
;;; Function: 2D_VEC_PROD
;;;
;;; Make a 2d vector product.
;;;	
(defun 2D_VEC_PROD (pnt_org pnt_1st pnt_2nd /	    x_o	    y_o
		    x_1	    y_1	    x_2	    y_2	    dx_1    dy_1
		    dx_2    dy_2
		   )

  (setq	x_o  (car pnt_org)
	y_o  (cadr pnt_org)
	x_1  (car pnt_1st)
	y_1  (cadr pnt_1st)
	x_2  (car pnt_2nd)
	y_2  (cadr pnt_2nd)
	dx_1 (- x_1 x_o)
	dy_1 (- y_1 y_o)
	dx_2 (- x_2 x_o)
	dy_2 (- y_2 y_o)
  )
  (- (* dx_1 dy_2) (* dx_2 dy_1))
)					;2D_VEC_PROD
;;;************************************************************************
;;; Function: 2D_SCALAR_PROD
;;;
;;; Make a 2d scalar product.
;;;	
(defun 2D_SCALAR_PROD (pnt_org	     pnt_1st	   pnt_2nd	 /
		       x1     y1     x2	    y2	   x3	  y3	 dx12
		       dx13   dy12   dy13
		      )

  (setq	x1   (car pnt_org)
	y1   (cadr pnt_org)
	x2   (car pnt_1st)
	y2   (cadr pnt_1st)
	x3   (car pnt_2nd)
	y3   (cadr pnt_2nd)
	dx12 (- x2 x1)
	dy12 (- y2 y1)
	dx13 (- x3 x1)
	dy13 (- y3 y1)
  )
  (+ (* dx12 dx13) (* dy12 dy13))
)					;2D_SCALAR_PROD
;;;************************************************************************
;;; Function: SHIFT_PNT
;;;
;;; shift a point by (dx,dy).
;;;	
(defun SHIFT_PNT
		 (pnt dxdy / x0	y0 dx dy newx newy new_pnt)

  (setq	x0 (car pnt)
	y0 (cadr pnt)
	dx (car dxdy)
	dy (cadr dxdy)
  )
  (setq	newx (+ x0 dx)
	newy (+ y0 dy)
  )
  (list newx newy)
)					;SHIFT_PNT
;;;************************************************************************
;;; Function: 2D_EQUATION
;;;
;;; solution to linear equation of two variables
;;;    a11 * x  +  a12 * y = c1
;;;    a21 * x  +  a22 * y = c2
;;; 
(defun 2D_EQUATION
		   (a11	a12 c1 a21 a22 c2 / det	x_num y_num x_value
		    y_value)

  (setq	det	(- (* a11 a22) (* a12 a21))
	x_num	(- (* a22 c1) (* a12 c2))
	y_num	(- (* a11 c2) (* a21 c1))
	x_value	(/ x_num det)
	y_value	(/ y_num det)
  )
  (list x_value y_value)
)					;2D_EQUATION
;;;
;;;
;;;************************************************************************
;;;		GROUP 2 : System Variables Control
;;;************************************************************************
;;;
;;;
;;;2. system variables control
;;;   setup_sysvar
;;;   reset_sysvar
;;;   set_layer		;;define all layers
;;;   set_txstyle
;;;   load_ltype	;;define all line types
;;;
;;; Function: SETUP_SYSVAR
;;;
;;; setup system variables.
(defun SETUP_SYSVAR ()
  (setq sblip (getvar "blipmode"))
  (setq scmde (getvar "cmdecho"))
					;(setq sdimdec (getvar "dimdec"))
					;(setq sdimadec (getvar "dimadec"))
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setvar "DIMDEC" 8)
  (setvar "DIMADEC" 8)
  (setvar "DIMTXT" 0.1)
  (setvar "cecolor" "BYLAYER")
  (setvar "clayer" "0")
  (setvar "celtype" "BYLAYER")
  (command "_.ucsicon" "off")
 ; (if (= ICAD 0) (set_txstyle "arial"))
)					;SETUP_SYSVAR
;;;************************************************************************
;;; Function: RESET_SYSVAR
;;;
;;; reset system variables.
;;;	
(defun reset_sysvar ()
  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
  (setvar "cecolor" "BYLAYER")
  (setvar "clayer" "0")
  (setvar "celtype" "BYLAYER")
  (setvar "OSMODE" 0)
					;(command "_.vpoint" "0,0,1")
					;(command "_.vports" "SI")

					;(setvar "dimdec" sdimdec)
					;(setvar "dimadec" sdimadec)

					;(command "_ucsicon" "on")
)					;RESET_SYSVAR
;;;************************************************************************
;;; Function: SET_LAYER
;;;
;;; define layer name according to the color(1 - 8).
;;;	
(defun SET_LAYER (/ ncolor layer_name)
  (setup_sysvar)
  (setq ncolor 1)
  (repeat 255
    (setq layer_name (strcat "layer" (itoa ncolor)))
    (command "_.layer" "_new" layer_name "_color" ncolor layer_name "")
    (setq ncolor (1+ ncolor))
  )
  (reset_sysvar)
)					;SET_LAYER
;;;************************************************************************
;;; Function: SET_TXSTYLE
;;;
;;; define the text styles.
;;;	
(defun SET_TXSTYLE (select_font)
  (if (= ICAD 0) (command "_.style" select_font select_font "" "" "" "" "")
		 (command "-style"  select_font (strcat select_font ".ttf") "" "" "" "" "")
  )
)					;SET_TXSTYLE
;;;************************************************************************
;;; Function: LOAD_LTYPE
;;;
;;; load linetypes to be used
;;; 
(defun LOAD_LTYPE ()
  (setup_sysvar)
					;(command "_linetype" "_load" "continuous" "" "");;Jan 3,2004  T.Iwamoto
  (command "_.linetype" "_load" "center" "" "")
  (command "_.linetype" "_load" "center2" "" "")
  (command "_.linetype" "_load" "centerx2" "" "")
  (command "_.linetype" "_load" "dot" "" "")
  (command "_.linetype" "_load" "dot2" "" "")
  (command "_.linetype" "_load" "dotx2" "" "")
  (command "_.linetype" "_load" "dashed" "" "")
  (command "_.linetype" "_load" "dashed2" "" "")
  (command "_.linetype" "_load" "dashedx2" "" "")
  (command "_.linetype" "_load" "dashdot" "" "")
  (command "_.linetype" "_load" "dashdot2" "" "")
  (command "_.linetype" "_load" "dashdotx2" "" "")
  (command "_.linetype" "_load" "hidden2" "" "")
  (reset_sysvar)

)					;LOAD_LTYPE
;;;
;;;
;;;
;;;************************************************************************
;;;		GROUP 3 : Basic Entity Creation Utilities
;;;************************************************************************
;;;
;;;
;;;3. basic entity creation
;;;   make_pt
;;;   make_point
;;;   make_line_1
;;;   make_line_2		;;can specify line type
;;;   make_circle_1
;;;   make_circle_2		;;can specify line type
;;;   make_arc_cbe
;;;   make_arc_3pt
;;;   textdisplay
;;;   make_donut
;;;   make_3dface
;;;   make_pline		;;make pline from a set of lines
;;;
;;;************************************************************************
;;; Function: MAKE_LINE_1
;;; Make a line using entmake.
;;;
(defun make_line_1 (layer_name color_code pt_from pt_to)

  (entmake (list (cons 0 "LINE")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 pt_from)
		 (cons 11 pt_to)
	   )
  )
  (entlast)
)					;MAKE_LINE_1
;;;************************************************************************
;;; Function: MAKE_LINE_2
;;;
;;; Make a line using entmake. can specify linetype
;;;
(defun MAKE_LINE_2 (layer_name color_code lntype pt_from pt_to)

  (entmake (list (cons 0 "LINE")
		 (cons 8 layer_name)
		 (cons 6 lntype)
		 (cons 62 color_code)
		 (cons 10 pt_from)
		 (cons 11 pt_to)
	   )
  )
  (entlast)
)					;MAKE_LINE_2
;;;************************************************************************
;;; Function: MAKE_POLYLINE
;;;
;;; Make a polyline using entmake. 
;;;
(defun make_polyline (pl_layer	 pl_color   pl_ltype   pl_list
		      pl_closed	 /	    nindex     pt_cur
		      pt_zero
		     )
;;;
  (entmake (list (cons 0 "POLYLINE")	;entity
		 (cons 8 pl_layer)	;layer name
		 (cons 62 pl_color)	;color
		 (cons 6 pl_ltype)	;linetype
		 (cons 66 1)		;vertex to follow
	   )
  )
  (setq	nindex	0
	pt_zero	(nth 0 pl_list)
  )

  (while (setq pt_cur (nth nindex pl_list))
    (entmake (list (cons 0 "VERTEX") (cons 10 pt_cur)))
    (setq nindex (1+ nindex))

  )
;;;while loop
  (if (= 1 pl_closed)
    (entmake (list (cons 0 "VERTEX") (cons 10 pt_zero)))
  )
  ;;close if loop

  (entmake (list (cons 0 "SEQEND")))

  (entlast)
)
;;make_polyline

;;;************************************************************************
;;; Function: MAKE_CIRCLE_1
;;;
;;; Make a circle using entmake.
;;;	
(defun make_circle_1 (layer_name color_code pt_center cir_rad)

  (entmake (list (cons 0 "CIRCLE")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 pt_center)
		 (cons 40 cir_rad)
	   )
  )
  (entlast)
)					;MAKE_CIRCLE_1
;;;************************************************************************
;;; Function: MAKE_CIRCLE_2
;;;
;;; Make a circle using entmake. specify line type
;;;	
(defun MAKE_CIRCLE_2 (layer_name color_code lntype pt_center cir_rad)

  (entmake (list (cons 0 "CIRCLE")
		 (cons 8 layer_name)
		 (cons 6 lntype)
		 (cons 62 color_code)
		 (cons 10 pt_center)
		 (cons 40 cir_rad)
	   )
  )
  (entlast)
)					;MAKE_CIRCLE_2
;;;************************************************************************
;;; Function: MAKE_ARC
;;;
;;; Make an arc using entmake.---pnt_center ,pnt_start, angle
(defun MAKE_ARC	(layer_name    color_code    pt_center
		 pt_start      travel_angle  /
		 angle_begin   delta_angle   angle_end
		 radius
		)
  (setq	angle_begin (angle pt_center pt_start)
	delta_angle (dtr travel_angle)
	angle_end   (+ angle_begin delta_angle)
	radius	    (distance pt_center pt_start)
  )

  (entmake (list (cons 0 "ARC")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 pt_center)
		 (cons 40 radius)
		 (cons 50 angle_begin)
		 (cons 51 angle_end)
	   )
  )
  (entlast)
)					;MAKE_ARC
;;;************************************************************************
;;; Function: MAKE_ARC_CBE
;;;
;;; Make an arc using entmake.---center  begin  end  option
;;;
(defun MAKE_ARC_CBE (layer_name	  color_code   pt_center
		     pt_begin	  pt_end       /
		     radius	  angle_begin  angle_end
		    )
  (setq	radius	    (distance pt_center pt_begin)
	angle_begin (angle pt_center pt_begin)
	angle_end   (angle pt_center pt_end)
  )
  (entmake (list (cons 0 "ARC")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 pt_center)
		 (cons 40 radius)
		 (cons 50 angle_begin)
		 (cons 51 angle_end)
	   )
  )
  (entlast)
)					;MAKE_ARC_CBE
;;;************************************************************************
;;; Function: MAKE_ARC_3PT
;;;
;;; Make an arc using entmake.---3 points input  option
;;; Arc starts from pnt_1 through pnt_2 and ends at pnt_3
(defun MAKE_ARC_3PT (layer_name	     color_code	     pnt_1   pnt_2
		     pnt_3   /	     x1	     x2	     x3	     y1
		     y2	     y3	     x1sqr   x2sqr   x3sqr   y1sqr
		     y2sqr   y3sqr   a11     a12     a21     a22
		     c1	     c2	     center  xc	     yc	     radius
		     dx	     dy	     angle_begin     angle_end
		    )
  (setq	x1	    (car pnt_1)
	y1	    (cadr pnt_1)
	x2	    (car pnt_2)
	y2	    (cadr pnt_2)
	x3	    (car pnt_3)
	y3	    (cadr pnt_3)
	x1sqr	    (* x1 x1)
	x2sqr	    (* x2 x2)
	x3sqr	    (* x3 x3)
	y1sqr	    (* y1 y1)
	y2sqr	    (* y2 y2)
	y3sqr	    (* y3 y3)
	a11	    (* 2 (- x1 x2))
	a12	    (* 2 (- y1 y2))
	a21	    (* 2 (- x1 x3))
	a22	    (* 2 (- y1 y3))
	c1	    (+ x1sqr (- x2sqr) y1sqr (- y2sqr))
	c2	    (+ y1sqr (- y3sqr) x1sqr (- x3sqr))
	center	    (2d_equation a11 a12 c1 a21 a22 c2)
	xc	    (car center)
	yc	    (cadr center)
	dx	    (- x1 xc)
	dy	    (- y1 yc)
	radius	    (sqrt (+ (* dx dx) (* dy dy)))
	angle_begin (angle center pnt_1)
	angle_end   (angle center pnt_3)
  )

  (entmake (list (cons 0 "ARC")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 center)
		 (cons 40 radius)
		 (cons 50 angle_begin)
		 (cons 51 angle_end)
	   )
  )
  (entlast)
)					;MAKE_ARC_3PT
;;;************************************************************************
;;; Function: MAKE_PT
;;;
;;; Make a point using entmake.
;;;
(defun MAKE_PT (layer_name color_code point)

  (entmake (list (cons 0 "POINT")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 point)
	   )
  )
  (entlast)
)					;MAKE_PT
;;;************************************************************************
;;; Function: MAKE_POINT
;;;
;;; Make a point using entmake.added pt_id as extended data
;;;
(defun MAKE_POINT (layer      color	 pt	    pt_id
		   loc_id     chr_size	 /	    last_pnt_ent
		   ext_ent
		  )
  (entmake (list (cons 0 "POINT")
		 (cons 8 layer)
		 (cons 62 color)
		 (cons 10 pt)
	   )
  )

  (setq	last_pnt_ent (entget (entlast))
	ext_ent	     (list -3
			   (list "my_point"
				 (cons 1000 pt_id)
				 (cons 1070 loc_id)
			   )
		     )
	new_pnt_ent
		     (append last_pnt_ent (list ext_ent))
  )
  (entmod new_pnt_ent)
;;; display point-id according to the loc_id

  (setq	dx 0.0
	dy 0.0
  )
  (setq	dxy_unit (/ chr_size 5.0)
	half_chr (/ chr_size 2.0)
	qtr_chr	 (/ chr_size 4.0)
	down_chr (* chr_size 1.1)
  )
  (if (= loc_id 1)
    (setq dx dxy_unit)
  )
  (if (= loc_id 2)
    (setq dy dxy_unit
	  dx (- qtr_chr)
    )
  )
  (if (= loc_id 3)
    (setq dx (- chr_size))
  )
  (if (= loc_id 4)
    (setq dy (- (+ chr_size dxy_unit)))
  )
  (setq	new_x (+ (car pt) dx)
	new_y (+ (cadr pt) dy)
  )
  (setq new_pnt_ent (entlast))
  (command "_.text" (list new_x new_y) chr_size 0.0 pt_id)
  (setq new_txt_ent (entlast))

)					;MAKE_POINT
;;;************************************************************************
;;; Function: MAKE_3DPT
;;;
;;; Make a point using entmake.
;;;
(defun MAKE_3DPT (layer_name color_code point)

  (entmake (list (cons 0 "POINT")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 point)
	   )
  )
  (entlast)
  (command "_.insert" "pt_mark" point "" "" "")

)					;MAKE_3DPT
;;;************************************************************************
;;;
(defun make_pt_mark (3d_mark_size      /	px1	 px2
		     py1      py2      pz1	pz2	 x_unit
		     y_unit   z_unit
		    )

  (if (= 3d_mark_size nil)
    (setq 3d_mark_size 0.1)
  )
  ;;default value 0.1 inch

  (setq	plen 3d_mark_size
	mlen (- 3d_mark_size)
	px1  (list plen 0)
	px2  (list mlen 0)
	py1  (list 0 plen)
	py2  (list 0 mlen)
	pz1  (list 0 0 plen)
	pz2  (list 0 0 mlen)
  )
  (make_line_1 "0" 0 px1 px2)
  (setq x_unit (entlast))
  (make_line_1 "0" 0 py1 py2)
  (setq y_unit (entlast))
  (make_line_1 "0" 0 pz1 pz2)
  (setq z_unit (entlast))
  (command "_.block" "pt_mark" '(0 0) x_unit y_unit z_unit "")
)

;;;************************************************************************
;;; Function: MARK_POINT
;;;
;;; draw a point id 
;;;
(defun MARK_POINT (pt dx dy pt_id chr_size / new_x new_y)

;;; display point-id at pt with offset(dx,dy)

  (setq	dx    (* dx chr_size)
	dy    (* dy chr_size)
	new_x (+ (car pt) dx)
	new_y (+ (cadr pt) dy)
  )
  (command "_.text" (list new_x new_y) chr_size 0.0 pt_id)

)					;MARK_POINT
;;;***************************************************************************
;;; Function: MAKE_RECT
;;;
;;; Make a rectangle using simple command.
;;;
(defun MAKE_RECT (pnt1 pnt2)

  (command "_.rectangle" pnt1 pnt2)
  (entlast)
)					;MAKE_RECT
;;;************************************************************************
;;; Function: TEXTDISPLAY
;;;
;;; text command.
;;;	
(defun TEXTDISPLAY (outtext text_loc text_height text_angle)
  (command "_.text" text_loc text_height text_angle outtext)
)					;TEXTDISPLAY
;;;************************************************************************
;;; Function: MARK_ID
;;;
;;; Mark a Point ID 
;;;
(defun MARK_ID (
		pt_loc
		pt_id
		loc_id
		chr_size
	       )
;;; display point-id according to the loc_id

  (setq	dx 0.0
	dy 0.0
  )
  (setq	dxy_unit (/ chr_size 5.0)
	half_chr (/ chr_size 2.0)
	qtr_chr	 (/ chr_size 4.0)
	down_chr (* chr_size 1.1)
  )
  (if (= loc_id 1)
    (setq dx dxy_unit)
  )
  (if (= loc_id 2)
    (setq dy dxy_unit
	  dx (- qtr_chr)
    )
  )
  (if (= loc_id 3)
    (setq dx (- chr_size))
  )
  (if (= loc_id 4)
    (setq dy (- (+ chr_size dxy_unit)))
  )
  (setq	new_x (+ (car pt_loc) dx)
	new_y (+ (cadr pt_loc) dy)
  )
  (command "_.text" (list new_x new_y) chr_size 0.0 pt_id)
)					;MARK_ID
;;;************************************************************************
;;;
;;; Function: MAKE_DONUT
;;;
;;; Make a donut using entmake.
;;;
(defun MAKE_DONUT (layer_name color_code in_rad out_rad pnt_loc)
  (command "_.layer" "_set" layer_name "")
  (command "_.donut" in_rad out_rad pnt_loc "")
  (command "_.layer" "_set" "0" "")
  (entlast)
)					;MAKE_DONUT
;;;
;;;************************************************************************
;;; Function: MAKE_3DFACE
;;;
;;; Make a 3dface object using entmake.
;;; 	For triangle let pt_3 = pt_4
;;;
(defun MAKE_3DFACE (layer_name color_code pt_1 pt_2 pt_3 pt_4)

  (entmake (list (cons 0 "3DFACE")
		 (cons 8 layer_name)
		 (cons 62 color_code)
		 (cons 10 pt_1)
		 (cons 11 pt_2)
		 (cons 12 pt_3)
		 (cons 13 pt_4)
	   )
  )
  (entlast)
)					;MAKE_3DFACE
;;;************************************************************************
;;;MAKE_PLINE
;;;make one pline entity from lines in one layer_name
(defun MAKE_PLINE (layer_name / ss slen)
  (setq	ss   (ssget "X" (list (cons 0 "LINE") (cons 8 layer_name)))
	slen (sslength ss)
  )
;;;pick the coord data of the first line element
  (command "_.pedit" (ssname ss 0) "Y" "Join" "all" "" "")
  (entlast)
)					;MAKE_PLINE
;;;
;;;
;;;************************************************************************
;;;		GROUP 4 : Specialized Entity Creation Utilities
;;;************************************************************************
;;;
;;;4. specialized entity creation utilities
;;;   point_along_line
;;;   point_off_line
;;;   point_sym_line
;;;   normal_to_line
;;;   normal_from_line
;;;   mid_point
;;;   make_mid_pnt
;;;   get_mid_point
;;;   mark_angle
;;;
;;;************************************************************************
;;;
;;; Function: POINT_OFF_LINE
;;;
;;; get a point off the line segment defined by two end points and angle.
;;;	
;; pnt_a   pnt_b    end points
;; loc_from_a       ratio of distance from pnt_a to length AB
;; theta            angle in radian from line AB
;; v_length         vector length off the line
;; 
(defun POINT_OFF_LINE
		      (pnt_a   pnt_b   loc_from_a      theta   v_length
		       /       xa      xb      ya      yb      dist_ab
		       dx      dy
		      )

  (setq	xa	 (car pnt_a)
	ya	 (cadr pnt_a)
	xb	 (car pnt_b)
	yb	 (cadr pnt_b)
	dist_ab	 (distance pnt_a pnt_b)
	dx	 (- xb xa)
	dy	 (- yb ya)
	xm	 (+ xa (* loc_from_a dx))
	ym	 (+ ya (* loc_from_a dy))
	theta_ab (angle pnt_a pnt_b)
  )
  (polar (list xm ym) (+ theta theta_ab) v_length)
)					;POINT_OFF_LINE
;;;************************************************************************
;;; Function: POINT_ALONG_LINE
;;;
;;; get a point off the line segment defined by two end points and angle.
;;;	
;;;This is the same as plt					; 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 pnt_a to length AB
;; output           point data (x,y)
(defun POINT_ALONG_LINE
			(pnt_a	pnt_b  loc_from_a    /	    xa
			 xb	ya     yb     dist_ab	    dx
			 dy	xm     ym
			)

  (setq	xa	(car pnt_a)
	ya	(cadr pnt_a)
	xb	(car pnt_b)
	yb	(cadr pnt_b)
	dist_ab	(distance pnt_a pnt_b)
	dx	(- xb xa)
	dy	(- yb ya)
	xm	(+ xa (* loc_from_a dx))
	ym	(+ ya (* loc_from_a dy))
  )
  (list xm ym)
)					;POINT_ALONG_LINE
;;;************************************************************************
;;; Function: PLT
;;;
; 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
	   (pnt_a pnt_b	loc_from_a / xa	xb ya yb dist_ab dx dy xm ym)

  (setq	xa (car pnt_a)
	ya (cadr pnt_a)
	xb (car pnt_b)
	yb (cadr pnt_b)
	dx (- xb xa)
	dy (- yb ya)
	xm (+ xa (* loc_from_a dx))
	ym (+ ya (* loc_from_a dy))
  )
  (list xm ym)
)					;PLT
;;;************************************************************************
;;; Function: PLD
;;;
;;; 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
	   (pnt_a pnt_b	dist_from_a / xa xb ya yb dx dy	xm ym loc_from_a)

  (setq	xa	   (car pnt_a)
	ya	   (cadr pnt_a)
	xb	   (car pnt_b)
	yb	   (cadr pnt_b)
	dx	   (- xb xa)
	dy	   (- yb ya)
	loc_from_a (/ dist_from_a (distance pnt_a pnt_b))
	xm	   (+ xa (* loc_from_a dx))
	ym	   (+ ya (* loc_from_a dy))
  )
  (list xm ym)
)					;PLT
;;;************************************************************************
;;; Function: POINT_SYM_LINE
;;;
;;; utility to get a point symmetrically located wrt a line selected.
;;;	PNT_A , PNT_B		define a line segment
;;;	PNT_C			A point off the line segment AB
(defun POINT_SYM_LINE
		      (pnt_a pnt_b pnt_c / theta theta1	theta2 dist_ac)

  (setq	theta1	(angle pnt_a pnt_c)
	theta2	(angle pnt_a pnt_b)
	theta	(- (* 2.0 theta2) theta1)
	dist_ac	(distance pnt_a pnt_c)
  )
  (polar pnt_a theta dist_ac)
)					;POINT_SYM_LINE
;;;************************************************************************
;;; Function: NORMAL_LINE
;;;
;;; Draw a normal from a point to a line defined by two end points
;;;
(defun NORMAL_LINE (pnt_3 pnt_1	pnt_2 color /	  x0	x1    x2
		    x3	  y0	y1    y2    y3	  dx	dy    a
		    b	  c	x_num y_denom
		   )

  (setq	x1 (car pnt_1)
	x2 (car pnt_2)
	x3 (car pnt_3)
	y1 (cadr pnt_1)
	y2 (cadr pnt_2)
	y3 (cadr pnt_3)
	dx (- x1 x2)
	dy (- y1 y2)
  )
  (if (= dx 0.0)
    (setq x0 x1
	  y0 y3
    )
  )					;parallel to y-axis
  (if (= dy 0.0)
    (setq x0 x3
	  y0 y1
    )
  )					;parallel to x-axis
  (if (and (/= dx 0.0) (/= dy 0.0))
    (setq
      a	      (/ dy dx)
      b	      (- y1 (* a x1))
      c	      (+ y3 (/ x3 a))
      x_num   (- c b)
      x_denom (+ a (/ 1.0 a))
      x0      (/ x_num x_denom)
      y0      (+ b (* a x0))
    )
  )
  (make_line_1 "0" color pnt_3 (list x0 y0))
)					;NORMAL_LINE
;;;************************************************************************
;;; Function: PT_NORMAL_2PT
;;;
;;; Draw a normal from a point to a line defined by two end points
;;;
(defun PT_NORMAL_2PT (pnt_3 pnt_1 pnt_2  /	  x0	x1    x2
		    x3	  y0	y1    y2    y3	  dx	dy    a
		    b	  c	x_num x_denom
		   )

  (setq	x1 (car pnt_1)
	x2 (car pnt_2)
	x3 (car pnt_3)
	y1 (cadr pnt_1)
	y2 (cadr pnt_2)
	y3 (cadr pnt_3)
	dx (- x1 x2)
	dy (- y1 y2)
  )
  (if (= dx 0.0)
    (setq x0 x1
	  y0 y3
    )
  )					;parallel to y-axis
  (if (= dy 0.0)
    (setq x0 x3
	  y0 y1
    )
  )					;parallel to x-axis
  (if (and (/= dx 0.0) (/= dy 0.0))
    (setq
      a	      (/ dy dx)
      b	      (- y1 (* a x1))
      c	      (+ y3 (/ x3 a))
      x_num   (- c b)
      x_denom (+ a (/ 1.0 a))
      x0      (/ x_num x_denom)
      y0      (+ b (* a x0))
    )
  )
  (list x0 y0)
)					;PT_NORMAL_2PT
;;;************************************************************************
;;; Function: PT_NORMAL_LINE
;;;
;;; Draw a normal from a point to a line defined by line entity 
;;;
(defun PT_NORMAL_LINE (pnt_3 line_12  /	  x0	x1    x2
		    x3	  y0	y1    y2    y3	  dx	dy    a
		    b	  c	x_num x_denom pnt_1 pnt_2
		   )
  (setq pnt_1 (cdr (assoc 10 (entget line_12)))
	pnt_2 (cdr (assoc 11 (entget line_12)))
  	x1 (car pnt_1)
	x2 (car pnt_2)
	x3 (car pnt_3)
	y1 (cadr pnt_1)
	y2 (cadr pnt_2)
	y3 (cadr pnt_3)
	dx (- x1 x2)
	dy (- y1 y2)
  )
  (if (= dx 0.0)
    (setq x0 x1
	  y0 y3
    )
  )					;parallel to y-axis
  (if (= dy 0.0)
    (setq x0 x3
	  y0 y1
    )
  )					;parallel to x-axis
  (if (and (/= dx 0.0) (/= dy 0.0))
    (setq
      a	      (/ dy dx)
      b	      (- y1 (* a x1))
      c	      (+ y3 (/ x3 a))
      x_num   (- c b)
      x_denom (+ a (/ 1.0 a))
      x0      (/ x_num x_denom)
      y0      (+ b (* a x0))
    )
  )
   (list x0 y0)
)					;PT_NORMAL_2PT
;;;************************************************************************
;;; Function: NORMAL_FROM_LINE
;;;
;;; draw a normal line from a point on the line defined by two end points
;;;
(defun NORMAL_FROM_LINE	(pnt_0	   pnt_1     pnt_2     color
			 /	   x0	     x1	       x2
			 y0	   y1	     y2	       ang_12
			 line_length	     left_ang  right_ang
			 pnt_left  pnt_right half_pi
			)

  (setq half_pi (/ pi 2.0))
  (setq	x1	    (car pnt_1)
	x2	    (car pnt_2)
	x0	    (car pnt_0)
	y1	    (cadr pnt_1)
	y2	    (cadr pnt_2)
	y0	    (cadr pnt_0)
	ang_12	    (angle pnt_1 pnt_2)
	line_length (distance pnt_1 pnt_2)
	left_ang    (+ ang_12 half_pi)
	right_ang   (- ang_12 half_pi)
	pnt_left    (polar pnt_0 left_ang line_length)
	pnt_right   (polar pnt_0 right_ang line_length)
  )
  (make_line_1 "0" color pnt_left pnt_right)

)					;NORMAL_FROM_LINE
;;;************************************************************************
;;; Function: MARK_ANGLE
;;;
;;; attach an angle mark.
;;; assume that angle is less than 180 degrees
(defun MARK_ANGLE
		  (pnt_aa     pnt_oo	 pnt_bb	    arc_rad
		   ang_mark   chr_size	 loc_id	    /
		   ang_ob     ang_oa	 ang_mid    tmp_mid
		   arc_start  arc_mid	 arc_aa	    arc_bb
		   dx	      dy	 dxy_unit   half_chr
		   qtr_chr    down_chr	 new_x	    new_y
		   angle_aob
		  )

  (if (<= chr_size 0.0)
    (setq chr_size 0.25)
  )
  (set_txstyle "symbol")		;switch to symbol font
  (setq	ang_ob (angle pnt_oo pnt_bb)
	ang_oa (angle pnt_oo pnt_aa)
  )
  (setq	arc_aa	(polar pnt_oo ang_oa arc_rad)
	arc_bb	(polar pnt_oo ang_ob arc_rad)
	tmp_mid	(mid_point arc_aa arc_bb)
	ang_mid	(angle pnt_oo tmp_mid)
	arc_mid	(polar pnt_oo ang_mid arc_rad)
  )
  (setq	dx 0.0
	dy 0.0
  )
  (setq	dxy_unit (/ chr_size 5.0)
	half_chr (/ chr_size 2.0)
	qtr_chr	 (/ chr_size 4.0)
	down_chr (* chr_size 1.1)
  )

  (if (= loc_id 1)
    (setq dx dxy_unit
	  dy (- half_chr)
    )
  )
  (if (= loc_id 2)
    (setq dx (- qtr_chr)
	  dy dxy_unit
    )
  )
  (if (= loc_id 3)
    (setq dx (- chr_size)
	  dy (- half_chr)
    )
  )
  (if (= loc_id 4)
    (setq dy (- (+ chr_size dxy_unit)))
  )

  (setq	new_x (+ (car arc_mid) dx)
	new_y (+ (cadr arc_mid) dy)
  )
  (if (> (2d_vec_prod pnt_oo pnt_aa pnt_bb) 0.)
    (setq arc_start arc_aa
	  ang_sign 1
    )
;;;counter clockwise

    (setq arc_start arc_bb
	  ang_sign -1
    )
;;;clockwise
  )
  (setq angle_aob (rtd (* ang_sign (angle_3p pnt_oo pnt_aa pnt_bb))))

  (command "_.arc" "CE" pnt_oo arc_start "Angle" angle_aob)
  (textdisplay ang_mark (list new_x new_y) chr_size 0)
  (set_txstyle "arial")
)					;MARK_ANGLE
;;;************************************************************************
;;; Function: MID_POINT
;;;
;;; find the mid point , given two end points.
;;;	
(defun MID_POINT
		 (pnt_a	pnt_b /	x_a x_b	y_a y_b	x_mid y_mid)

  (setq	x_a   (car pnt_a)
	y_a   (cadr pnt_a)
	x_b   (car pnt_b)
	y_b   (cadr pnt_b)
	x_mid (* 0.5 (+ x_a x_b))
	y_mid (* 0.5 (+ y_a y_b))
  )
  (list x_mid y_mid)
)					;MID_POINT
;;;************************************************************************
;;; Function: MAKE_MID_PNT
;;;
;;; find the mid point , given two end points.
;;; display point ID
(defun MAKE_MID_PNT
		    (pnt_a   pnt_b   layer   color   pt_id   loc_id
		     chr_size	     /	     x_a     x_b     y_a
		     y_b     x_mid   y_mid   mid_pnt
		    )

  (setq	x_a	(car pnt_a)
	y_a	(cadr pnt_a)
	x_b	(car pnt_b)
	y_b	(cadr pnt_b)
	x_mid	(* 0.5 (+ x_a x_b))
	y_mid	(* 0.5 (+ y_a y_b))
	mid_pnt	(list x_mid y_mid)
  )
  (make_point layer color mid_pnt pt_id loc_id chr_size)

)					;MAKE_MID_PNT
;;;************************************************************************
;;; Function: GET_MID_POINT
;;;
;;; find the mid point , given two end points.
;;;	
(defun C:GET_MID_POINT (/ pnt_a	pnt_b x_a x_b y_a y_b x_mid y_mid
			mid_pnt)
  (setq	pnt_a (getpoint "\nPick the first point:")
	pnt_b (getpoint "\nPick the second point:")
  )
  (setq	x_a	(car pnt_a)
	y_a	(cadr pnt_a)
	x_b	(car pnt_b)
	y_b	(cadr pnt_b)
	x_mid	(* 0.5 (+ x_a x_b))
	y_mid	(* 0.5 (+ y_a y_b))
	mid_pnt	(list x_mid y_mid)
  )
  (make_pt "0" 0 mid_pnt)
)					;MID_POINT
;;;
;;;************************************************************************
;;; Function: C:DIV_BET_PTS
;;;
;;; find the mid point , given two end points.
;;;	
(defun C:DIV_BET_PTS (/	pnt_a pnt_b num_div line_ent)
  (setq	pnt_a (getpoint "\nPick the first point:")
	pnt_b (getpoint pnt_a "\nPick the second point:")
  )
  (command "_.line" pnt_a pnt_b "")

  (setq line_ent (entlast))
  (setq num_div (getint "\nHow many divisions"))

  (command "_.divide" line_ent num_div)
  (entdel line_ent)
)					;C:DIV_BET_PTS
;;;************************************************************************
;;; Function: DIV_BET_PTS
;;;
;;; divide into equal length between 2 points , given two end points.
;;;	
(defun DIV_BET_PTS (pnt_a pnt_b	num_div	/ line_ent)
  (command "_.line" pnt_a pnt_b "")
  (setq line_ent (entlast))
  (command "_.divide" line_ent num_div)
  (entdel line_ent)
)					;DIV_BET_PTS
;;;************************************************************************
;;; Function: NTH_BET_PTS
;;;
;;; divide into equal length between 2 points , given two end points.
;;;	
(defun NTH_BET_PTS (pnt_a  pnt_b  num_div	nth    /      fact
		    x_a	   x_b	  y_a	 y_b	dx     dy     new_x
		    new_y
		   )
  (setq	fact  (/ nth (float num_div))
	x_a   (car pnt_a)
	y_a   (cadr pnt_a)
	x_b   (car pnt_b)
	y_b   (cadr pnt_b)
	dx    (- x_b x_a)
	dy    (- y_b y_a)
	new_x (+ x_a (* fact dx))
	new_y (+ y_a (* fact dy))
  )
  (list new_x new_y)

)					;DIV_BET_PTS
;;;************************************************************************
;;; Function: GET_DISTANCE
;;;
;;; find the distance , given two end points.
;;;	
(defun C:GET_DISTANCE (/	 pnt_a	   pnt_b     str_xa
		       str_ya	 str_xb	   str_yb    str_dist
		       text_1	 text_2	   text_3
		      )
  (setq	pnt_a (getpoint "\nPick the first point:")
	pnt_b (getpoint pnt_a "\nPick the second point:")
  )
  (setq
    str_xa    (rtos (car pnt_a) 2 10)
    str_ya    (rtos (cadr pnt_a) 2 10)
    str_xb    (rtos (car pnt_b) 2 10)
    str_yb    (rtos (cadr pnt_b) 2 10)
    this_dist (distance pnt_a pnt_b)

    text_2    (strcat "First  Pt: " str_xa " , " str_ya)
    text_3    (strcat "Second Pt: " str_xb " , " str_yb)
    text_1    (strcat "Distance : " (rtos this_dist 2 10))
  )
  (terpri)
  (prin1 text_1)
  (terpri)
  (prin1 text_2)
  (terpri)
  (prin1 text_3)
  (terpri)


)					;C:GET_DISTANCE
;;;************************************************************************
;;; Function: PT_EXTEND
;;;
;;; given points A & B, create a point beyond B with a given distance from A specifed
;;; by a multiplier.
;;;	
(defun C:PT_EXTEND (/ pnt_a pnt_b mult line_ent	x_a x_b	y_a y_b	dx dy
		    new_x new_y)
  (setq	pnt_a (getpoint "\nPick the first point:")
	pnt_b (getpoint pnt_a "\nPick the second point:")
  )
  (command "_.line" pnt_a pnt_b "")

  (setq line_ent (entlast))
  (setq mult (getreal "\nGive the multiplier"))
  (setq	x_a    (car pnt_a)
	y_a    (cadr pnt_a)
	x_b    (car pnt_b)
	y_b    (cadr pnt_b)
	dx     (- x_b x_a)
	dy     (- y_b y_a)
	new_x  (+ x_a (* dx mult))
	new_y  (+ y_a (* dy mult))
	new_pt (list new_x new_y)
  )
  (command "_.point" new_pt)
  (entdel line_ent)

)					;C:PT_EXTEND
;;;************************************************************************
;;; Function: PT_EXTEND
;;;
;;; given points A & B, create a point beyond B with a given distance from A specifed
;;; by a multiplier.
;;;	
(defun PT_EXTEND (pnt_a	pnt_b mult / x_a x_b y_a y_b dx	dy new_x new_y)

  (setq	x_a    (car pnt_a)
	y_a    (cadr pnt_a)
	x_b    (car pnt_b)
	y_b    (cadr pnt_b)
	dx     (- x_b x_a)
	dy     (- y_b y_a)
	new_x  (+ x_a (* dx mult))
	new_y  (+ y_a (* dy mult))
	new_pt (list new_x new_y)
  )
  (command "_.point" new_pt)

)					;PT_EXTEND
;;;
;;;************************************************************************
;;;		GROUP 5 : General Geometry Utilities
;;;************************************************************************
;;;FUNCTION LIST
;;;	1. get_length
;;;	2. norm_2_line
;;;	3. len_on_line
;;;	4. fac_on_line
;;;	5. slow_line
;;;	6. slow_circle
;;;	7. slow_arc
;;;	8. l_pl_int
;;;	9. c_pl_int
;;;************************************************************************
;;; Function: GET_LENGTH
;;;
;;; get line length  utility function.
;;;	
(defun GET_LENGTH
		  (line_entity / ent_list pnt_1	pnt_2 line_length)

  (setq	ent_list (entget line_entity)
	pnt_1	 (cdr (assoc 10 ent_list))
	pnt_2	 (cdr (assoc 11 ent_list))
  )
  (distance pnt_1 pnt_2)
)					;GET_LENGTH
;;;
;;;************************************************************************
;;; Function: GET_LENGTH
;;;
;;; get line length  utility function.
;;;	
(defun C:GET_LENGTH (/ pnt_1 pnt_2)
  (setq	pnt_1	   (getpoint "\nFirst Point:")
	pnt_2	   (getpoint "\n Second Point")
	cur_length (distance pnt_1 pnt_2)
  )
  (terpri)

  (alert (strcat "Distance\n" (rtos cur_length 2 10)))
)					;C:GET_LENGTH
;;;
;;;************************************************************************
;;; Function: NORM_2_LINE
;;;
;;; Returns distance from a point to a line defined by two end points
;;;
(defun NORM_2_LINE (pnt_1  pnt_2  pnt_0	 /	x0     x1     x2
		    y0	   y1	  y2	 dx1	dx2    dy1    dy2
		    vec_prod
		   )

  (setq	x1	 (car pnt_1)
	x2	 (car pnt_2)
	x0	 (car pnt_0)
	y1	 (cadr pnt_1)
	y2	 (cadr pnt_2)
	y0	 (cadr pnt_0)
	dx1	 (- x0 x1)
	dx2	 (- x2 x1)
	dy1	 (- y0 y1)
	dy2	 (- y2 y1)
	;;vec_prod (abs (- (* dx1 dy2) (* dy1 dx2)))
;;;if a ref point is in the right hand side of the line
;;; then the distance is positve.
	vec_prod (- (* dx1 dy2) (* dy1 dx2))
  )
  (/ vec_prod (distance pnt_1 pnt_2))
)					;NORM_2_LINE
;;;************************************************************************
;;; Function: LEN_ON_LINE
;;; 
;;;find a point between 2 points giving length from point1 toward point2
(defun LEN_ON_LINE
		   (pnt_1   pnt_2   length  /	    p1x	    p2x
		    p1y	    p2y	    mid_x   mid_y   factor1 factor2
		   )

  (setq	factor1	(/ length (distance pnt_1 pnt_2))
	factor2	(- 1.0 factor1)
	p1x	(car pnt_1)
	p1y	(cadr pnt_1)
	p2x	(car pnt_2)
	p2y	(cadr pnt_2)
	mid_x	(+ (* factor1 p2x) (* factor2 p1x))
	mid_y	(+ (* factor1 p2y) (* factor2 p1y))
  )
  (list mid_x mid_y)
)					;LEN_ON_LINE	
;;;************************************************************************
;;; Function: FAC_ON_LINE
;;;
;;;find a point between 2 points giving a factor.( e.g. 0.5 for mid point)
(defun FAC_ON_LINE
		   (pnt_1 pnt_2	factor1	/ p1x p2x p1y p2y mid_x	mid_y
		    factor2)

  (setq	factor2	(- 1.0 factor1)
	p1x	(car pnt_1)
	p1y	(cadr pnt_1)
	p2x	(car pnt_2)
	p2y	(cadr pnt_2)
	mid_x	(+ (* factor1 p2x) (* factor2 p1x))
	mid_y	(+ (* factor1 p2y) (* factor2 p1y))
  )
  (list mid_x mid_y)
)					;FAC_ON_LINE
;;;************************************************************************
;;; Function: SLOW_LINE
;;;
;;;draw a line slowly between two given points
;;;
(defun SLOW_LINE (n_section  layer_name	color_code pnt_begin
		  pnt_end    /		n_section  nstep
		  x0	     x1		delta_x	   y0
		  y1	     delta_y	pnt_cur	   x_next
		  y_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)
	delta_x	(/ (- x1 x0) (float n_section))
	delta_y	(/ (- y1 y0) (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))
	    pnt_next (list x_next y_next)
      )
      (command "_.line" pnt_begin pnt_next "")
      (entdel (entlast))
    )
    (setq nstep (+ 1 nstep))
  )
  (make_line_1 layer_name color_code pnt_begin pnt_end)
					;final displayed line

  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
)					;SLOW_LINE
;;;************************************************************************
;;; Function: SLOW_CIRCLE
;;;
;;;draw a circle slowly given center and radius
;;;
(defun SLOW_CIRCLE (n_section	 layer_name   color_code   pnt_center
		    radius	 /	      nstep	   unit_step
		    pnt_ref
		   )

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

  (setq n_section 200)
  (setq	unit_step (/ 360. (float n_section))
	nstep	  1
	pnt_ref	  (list (+ (car pnt_center) radius) (cadr pnt_center))
  )

  (while (< nstep n_section)
    (progn
      (setq step (* nstep unit_step))
      (command "_.arc" "_C" pnt_center pnt_ref "_A" step)
      (entdel (entlast))
    )
    (setq nstep (+ 1 nstep))
  )
  (make_circle_1 layer_name color_code pnt_center radius)
					;final displayed circle

  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
)					;SLOW_CIRCLE

;;; 
;;; Function: SLOW_ARC
;;;
;;;draw an arc slowly given center and starting point & endpoint
;;;
(defun SLOW_ARC	(n_speed       layer_name    color_code
		 pnt_center    pnt_start     travel_angle
		 ang_dir       /
		)
  (setq s_angdir (getvar "angdir"))
  (setq sblip (getvar "blipmode"))
  (setq scmde (getvar "cmdecho"))
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setvar "angdir" ang_dir)

  (setq radius (distance pnt_center pnt_start))
  (setq	unit_step (/ travel_angle (float n_speed))
	nstep	  1
	pnt_ref	  (list (+ (car pnt_center) radius) (cadr pnt_center))
  )

  (while (< nstep n_speed)
    (progn
      (setq step (* nstep unit_step))
      (command "_.arc" "_C" pnt_center pnt_start "_A" step)
      (entdel (entlast))
    )
    (setq nstep (+ 1 nstep))
  )					;while loop
  (command "_.arc" "_C"	pnt_center pnt_start "_A" travel_angle)
					;final displayed arc

  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
  (setvar "angdir" s_angdir)
)					;SLOW_ARC
;;;
;;;
;;; 
;;; Function: SLOW_ARC_1	Variation of SLOW_ARC  ;;;*** added
;;;
;;;draw an arc slowly given center and starting point & endpoint
;;;
(defun SLOW_ARC_1 (n_speed	 layer_name    color_code
		   pnt_center	 pnt_start     travel_angle
		   ang_dir	 /
		  )
  (setq	s_color	 (getvar "cecolor")
	s_angdir (getvar "angdir")
	sblip	 (getvar "blipmode")
	scmde	 (getvar "cmdecho")
  )
  (setvar "blipmode" 0)
  (setvar "cmdecho" 0)
  (setvar "angdir" ang_dir)
  (setvar "cecolor" (itoa color_code))
;;;***
  (make_line_1 "0" color_code pnt_center pnt_start)
;;;***
  (setq start_rad (entlast))
  (setq	radius	  (distance pnt_center pnt_start)
	unit_step (/ travel_angle (float n_speed))
	nstep	  1
	pnt_ref	  (list (+ (car pnt_center) radius) (cadr pnt_center))
	base_pos  (angle pnt_center pnt_start)
		  ;;in radian  ***
  )

  (while (< nstep n_speed)
    (progn
      (setq step (* nstep unit_step))
      (command "_.arc" "_C" pnt_center pnt_start "_A" step)
      (entdel (entlast))
      (setq pnt_end (polar pnt_center (+ base_pos (dtr step)) radius))
;;;***
      (grdraw pnt_center pnt_end color_code)
;;; ***
    )
    (setq nstep (+ 1 nstep))
  )					;while loop
  (command "_.arc" "_C"	pnt_center pnt_start "_A" travel_angle)
					;final displayed arc

  (setvar "blipmode" sblip)
  (setvar "cmdecho" scmde)
  (setvar "angdir" s_angdir)
  (setvar "cecolor" s_color)
;;;***

)					;SLOW_ARC_1
;;;	
;;L_PL_INT
;;;find out the intersection between a line segment defined by pnt_1 & pnt_2
;;; and pline given by entity list
(defun L_PL_INT	(pnt_1	   pnt_2     pl_list   /	 Found
		 init_loc  next	     _loc      pnt_old	 pnt_new
		 pnt_of_int
		)
  (setq	init_loc (loc_first pl_list 10)	;position of the first node entry
	next_loc init_loc		;initialize node data location
	pnt_old	 (cdr (nth init_loc pl_list))
	Found	 nil
  )
;;;
  (while
    (and (setq pnt_new (cdr (nth (setq next_loc (+ 4 next_loc)) pl_list)))
	 (not Found)
    )
					;check if this line segment intersect with the line
     (setq pnt_of_int (inters pnt_1 pnt_2 pnt_old pnt_new))
     (if (= pnt_of_int nil)
       (setq pnt_old pnt_new)
       (setq Found T)
     )
  )
  (prin1 pnt_of_int)
)					;L_PL_INT
;;;
;;C_PL_INT
;;;find out the intersection between a line segment defined by pnt_1 & pnt_2
;;; and pline given by entity list
(defun C_PL_INT	(c_cent	   c_rad     pl_list   /	 Found
		 init_loc  next	     _loc      pnt_old	 pnt_new
		 pnt_of_int
		)
  (setq	init_loc (loc_first pl_list 10)	;position of the first node entry
	next_loc init_loc		;initialize node data location
	pnt_old	 (cdr (nth init_loc pl_list))
	Found	 nil
  )
;;;
  (while
    (and (setq pnt_new (cdr (nth (setq next_loc (+ 4 next_loc)) pl_list)))
	 (not Found)
    )
					;check if this line segment intersect with the line
     (setq pnt_1      (polar c_cent (angle c_cent pnt_old) c_rad)
	   pnt_2      (polar c_cent (angle c_cent pnt_new) c_rad)
	   pnt_of_int (inters pnt_1 pnt_2 pnt_old pnt_new)
     )
     (if (= pnt_of_int nil)
       (setq pnt_old pnt_new)
       (setq Found T)
     )
  )
  (prin1 pnt_of_int)
)					;C_PL_INT
;;;
;;;************************************************************************
;;;		GROUP 6 : General Utilities, display control utilities
;;;************************************************************************
;;;
;;;
;;;6. general entity , display control utilities
;;;	function name			usage example
;;;   erase_ent_color		(erase_ent_color "line" 5)
;;;   erase_ent			(erase "circle")
;;;   zoom_r
;;;   del_layer
;;;   off_layer
;;;   off_cur_layer
;;;   on_layer
;;;  
;;;   loc_first
;;;
;;;************************************************************************
;;; Function: ERASE_ENT_COLOR
;;;
;;; erase entity with a specific color code
;;;		entity_name	entity name (e.g. "LINE", "CIRCLE", "ARC", etc)
;;;		color_code	color code (e.g. 1  for red, etc)
;;; 	  
(defun ERASE_ENT_COLOR
		       (entity_name  color_code	  /
			ent_list     ent_length	  t_index
		       )

  (setq	ent_list   (ssget "X"
			  (list (cons 0 entity_name) (cons 62 color_code))
		   )
	ent_length (sslength ent_list)
	t_index	   0
  )
  (repeat ent_length
    (entdel (ssname ent_list t_index))
    (setq t_index (1+ t_index))
  )
)					;ERASE_ENT_COLOR
;;;************************************************************************
;;; Function: ERASE_ENT
;;;
;;; erase entity 
;;; 		entity_name    e.g.  "LINE", "CIRCLE",etc
(defun ERASE_ENT
		 (entity_name /	ent_list ent_length t_index)

  (setq	ent_list   (ssget "X" (list (cons 0 entity_name)))
	ent_length (sslength ent_list)
	t_index	   0
  )
  (repeat ent_length
    (entdel (ssname ent_list t_index))
    (setq t_index (1+ t_index))
  )
)					;ERASE_ENT
;;;************************************************************************
;;; Function: ZOOM_R
;;;
;;; zoom and then regen
;;; 
(defun ZOOM_R (lower_left upper_right)

  (command "_.zoom" lower_left upper_right)
  (command "_.regen")

)					;ZOOM_R
;;;************************************************************************
;;; Function: Z_R
;;;
;;; zoom and then regen(interactive mode)
;;; 
(defun C:Z_R (/ lower_left upper_right)

  (setq	lower_left  (getpoint "\nSelect lower left corner:")
	upper_right (getcorner lower_left "\nSelect upper right corner:")
  )
  (command "_.zoom" lower_left upper_right)
  (command "_.regen")

)					;Z_R
;;;************************************************************************
;;; Function: Z_E
;;;
;;; zoom -extent(interactive mode)
;;; 
(defun C:Z_E ()

  (command "_.zoom" "E")
  (command "_.regen")

)					;Z_E
;;;************************************************************************
;;; Function: DEL_LAYER
;;;
;;; delete all the entities of the selected layer
;;; 
(defun DEL_LAYER
		 (layer_name / del_set n index)

  (setq del_set (ssget "X" (list (cons 8 layer_name))))
  (setq n (sslength del_set))

  (setq index 0)
  (repeat n
    (entdel (ssname del_set index))
    (setq index (1+ index))
  )
)					;DEL_LAYER	

					;
;;;************************************************************************
;;; Function: DRAW_X_AXIS
;;;
;;; draw x-coordinate values along the y=const  line
;;; 
(defun DRAW_X_AXIS
		   (y_ref      x_from	  x_to	     step_x
		    y_offset   hx	  chr_height /
		    x_value    ref_pnt	  pnt_upper  pnt_lower
		    x_label    pnt_text
		   )

  (setq half_pi (* 0.5 pi))
  (command "_.line" (list x_from y_ref) (list x_to y_ref) "")
  (setq x_value x_from)
  (while (<= x_value x_to)
    (setq ref_pnt   (list x_value y_ref)
	  pnt_upper (polar ref_pnt half_pi hx)
	  pnt_lower (polar ref_pnt (- half_pi) hx)
    )
    (setq x_label (rtos x_value 2 1))
    (setq pnt_text (polar ref_pnt half_pi y_offset))
    (make_line_1 "0" 8 pnt_lower pnt_upper)
    (command "_.text" pnt_text chr_height "0" x_label)

    (setq x_value (+ x_value step_x))
  )
)					;DRAW_X_AXIS
;;;************************************************************************
;;; Function: DRAW_X_AXIS
;;;
;;; draw x-coordinate values along the y=const  line
;;; 
(defun C:DRAW_X_AXIS ()

  (setq y_ref (getreal "\nY coordinate value:"))
  (setq x_from (getreal "\nX_start value:"))
  (setq x_to (getreal "\nX_end value:"))
  (setq step_x (getreal "\nX_step value<0.5> "))
  (setq
    y_offset (getreal
	       "\nCharacter display offset from the Y-ref line <0>:"
	     )
  )
  (setq hx (getreal "\nhalf of the tick mark length<0.1> :"))
  (setq chr_height (getreal "\ncharacter height<0.1> "))

  (setq half_pi (* 0.5 pi))
  (command "_.line" (list x_from y_ref) (list x_to y_ref) "")
  (setq x_value x_from)
  (while (<= x_value x_to)
    (setq ref_pnt   (list x_value y_ref)
	  pnt_upper (polar ref_pnt half_pi hx)
	  pnt_lower (polar ref_pnt (- half_pi) hx)
    )
    (setq x_label (rtos x_value 2 1))
    (setq pnt_text (polar ref_pnt half_pi y_offset))
    (make_line_1 "0" 8 pnt_lower pnt_upper)
    (command "_.text" pnt_text chr_height "0" x_label)

    (setq x_value (+ x_value step_x))
  )
)					;DRAW_X_AXIS
;;;
;;************************************************************************
;;; Function: DRAW_Y_AXIS
;;;
;;; draw y-coordinate values along the x = const  line
;;; 
(defun DRAW_Y_AXIS
		   (x_ref      y_from	  y_to	     step_y
		    x_offset   hy	  chr_height /
		    y_value    ref_pnt	  pnt_right  pnt_left
		    y_label    pnt_text
		   )

  (setq half_pi (* 0.5 pi))
  (command "_.line" (list x_ref y_from) (list x_ref y_to) "")
  (setq y_value y_from)
  (while (<= y_value y_to)
    (setq ref_pnt   (list x_ref y_value)
	  pnt_right (polar ref_pnt 0.0 hy)
	  pnt_left  (polar ref_pnt pi hy)
    )
    (setq y_label (rtos y_value 2 1))
    (setq pnt_text (polar ref_pnt pi (- x_offset)))

    (command "_.text" pnt_text chr_height "0" y_label)

    (make_line_1 "0" 0 pnt_left pnt_right)
    (setq y_value (+ y_value step_y))
  )
)					;DRAW_Y_AXIS
;;;************************************************************************
;;; Function: DRAW_Y_AXIS
;;;
;;; draw y-coordinate values along the x = const  line
;;; 
(defun C:DRAW_Y_AXIS
		     (x_ref	 y_from	    y_to       step_y
		      x_offset	 hy	    chr_height /
		      y_value	 ref_pnt    pnt_right  pnt_left
		      y_label	 pnt_text
		     )

  (setq half_pi (* 0.5 pi))
  (command "_.line" (list x_ref y_from) (list x_ref y_to) "")
  (setq y_value y_from)
  (while (<= y_value y_to)
    (setq ref_pnt   (list x_ref y_value)
	  pnt_right (polar ref_pnt 0.0 hy)
	  pnt_left  (polar ref_pnt pi hy)
    )
    (setq y_label (rtos y_value 2 1))
    (setq pnt_text (polar ref_pnt pi (- x_offset)))

    (command "_.text" pnt_text chr_height "0" y_label)

    (make_line_1 "0" 0 pnt_left pnt_right)
    (setq y_value (+ y_value step_y))
  )
)					;C:DRAW_Y_AXIS
;;;***********************************************************************
;;;ANGLE_3P
					; compute angle between two intersecting line elements
					; ratio of vector product and scalar product is tangent
(defun ANGLE_3P
		(pt0	pt1    pt2    /	     x0	    y0	   x1
		 y1	x2     y2     v1x    v1y    v2x	   v2y
		 v1	v2     vector_prod   scalar_prod
		)

  (setq	x0 (car pt0)
	y0 (cadr pt0)
	x1 (car pt1)
	y1 (cadr pt1)
	x2 (car pt2)
	y2 (cadr pt2)
  )
  (setq	v1x (- x1 x0)
	v1y (- y1 y0)
	v2x (- x2 x0)
	v2y (- y2 y0)
  )

  (setq vector_prod (- (* v1x v2y) (* v2x v1y))) ;vector product

  (setq v1 (distance pt0 pt1))		;distance or vector length
  (setq v2 (distance pt1 pt2))

  (setq scalar_prod (+ (* v1x v2x) (* v1y v2y)))

  (atan vector_prod scalar_prod)	;result in radian
)					;ANGLE_3P
;;;**************************************************************************	
;;;
;;;GET_ENT_DATA
;;;
(defun GET_ENT_DATA
		    (entity_id
		     el_id
		    )
  (cdr (assoc el_id (entget entity_id)))
)					;GET_ENT_DATA
;;;
;;LOC_FIRST
;;;find out the position of the first entry of DXFCODE  in the list assuming that element exists
(defun LOC_FIRST (list code / element pos)
  (setq	element	(assoc code list)
	pos	0
  )
  (while (not (equal (nth pos list) element))
    (setq pos (1+ pos))
  )
)					; LOC_FIRST
;;;**************************************************************************
;;;
;;;
(defun MY_BLOCK_INSERT (block_name insert_pnt xy_scale)
  (command "_.insert" block_name insert_pnt xy_scale xy_scale 0.)
)					;MY_BLOCK_INSERT
;;;
;;;
(defun MY_BLOCK_DEF (block_name base_pnt sel_set)
  (command "_.block" block_name base_pnt sel_set "")
)
;;MY_BLOCK_DEF
;;;
;;;
;;;
;;;
(defun MY_BLOCK_INSERT2	(block_name insert_pnt xy_scale angle)
  (command "_.insert" block_name insert_pnt xy_scale xy_scale angle)
)					;MY_BLOCK_INSERT2
;;;
;;;
;;;**************************************************************************
;;;
;;;LINE_LENGTH
;;;display a line length on the line selected
(defun c:LINE_LENGTH
		     (/	ent_list end_a end_b dist_ab line_angle	str_dist)
  (if (= str_height nil)
    (setq str_height (getreal "\nSpecify string height <0.25>: "))
  )
  (if (<= str_height 0)
    (setq str_height 0.25)
  )
  ;;default value
  (while
    (setq ent_list (entget (car (entsel "\nPick a line segment"))))
     (setq end_a      (cdr (assoc 10 ent_list))
	   end_b      (cdr (assoc 11 ent_list))
	   dist_ab    (distance end_a end_b)
	   line_angle (rtd (angle end_a end_b))
	   str_dist   (rtos dist_ab 2 5)
     )
     (textdisplay
       str_dist
       (mid_point end_a end_b)
       str_height
       line_angle
     )
  )
;;; while loop

)					;LINE_LENGTH
;;;
;;;************************************************************************
;;;		GROUP 6 : General Utilities, display control utilities
;;;************************************************************************
;;;
;;; Function: OFF_LAYER
;;;
;;; set a layer off
;;;	
(defun OFF_LAYER (layer_off)
  (command "-layer" "off" layer_off "" "")

)					;OFF_LAYER
;;;************************************************************************
;;; Function: OFF_CUR_LAYER
;;;
;;; set a current layer off
;;;	
(defun OFF_CUR_LAYER (layer_off)
  (command "_.layer" "off" layer_off "Y" "")

)					;OFF_CUR_LAYER
;;;************************************************************************
;;; Function: ON_LAYER
;;;
;;; set a layer on
;;;	
(defun ON_LAYER	(layer_on)
  (command "_.layer" "on" layer_on "")

)					;ON_LAYER
;;;******************************************************************************
;;;
;;;SPLIT_V
;;;split windows vertically or horizontally
(defun SPLIT_V ()
  (command "_.vports" "2" "v")
)					;SPLIT_V
;;;
;;;SPLIT_H
;;;
(defun SPLIT_H ()
  (command "_.vports" "2" "h")
)					;SPLIT_H
;;;
;;;SINGLE_WIN
;;;
(defun SINGLE_WIN ()
  (command "_.vports" "si")
)					;SINGLE_WIN
;;;
;;;(vports) output
;;;Horizontal case
;;;((2 (0.0 0.5) (1.0 1.0)) (3 (0.0 0.0) (1.0 0.5)))
;;;Vertical case
;;;((3 (0.5 0.0) (1.0 1.0)) (2 (0.0 0.0) (0.5 1.0)))
;;;
;;;BAR_BLOCK1
;;;
					;define a bar shaped block with a specified name
					;this block will be used for link mechanism
(defun BAR_BLOCK1 (bar_name    bar_length  bar_width   color_code
		   /	       half_width  m_half_width
		   pnt_1       pnt_2	   pnt_3       pnt_4
		   l_center    r_center	   b_1	       b_2
		   b_3	       hatch_1	   layer_name  hole_rad
		  )
  (setq	half_width   (* 0.5 bar_width)
	m_half_width (- half_width)
	pnt_1	     (list 0 half_width)
	l_center     '(0 0)
	pnt_2	     (list 0 m_half_width)
	pnt_3	     (list bar_length m_half_width)
	r_center     (list bar_length 0)
	pnt_4	     (list bar_length half_width)
	hole_rad     (/ half_width 4.)
	layer_name   (strcat "layer" (itoa color_code))
  )
  (command "_.layer" "_set" layer_name "")
  (command "_.pline"	     pnt_1    "Arc"    "ce"	l_center
	   pnt_2    "Li"     pnt_3    "Arc"    "ce"	r_center
	   pnt_4    "Li"     "Cl"
	  )
  (setq b_1 (entlast))
  (make_circle_1 layer_name 0 l_center hole_rad)
  (setq b_2 (entlast))
  (make_circle_1 layer_name 0 r_center hole_rad)
  (setq b_3 (entlast))
  (command "_.hatch" "_solid" b_1 b_2 b_3 "")
  (setq hatch_1 (entlast))
  (command "_.block" bar_name '(0 0) hatch_1 b_1 b_2 b_3 "")
  (command "_.layer" "_set" "0" "")
)					;BAR_BLOCK1
;;;
;;;BAR_BLOCK2
;;;
					;define a bar shaped block with a specified name
					;this block will be used for link mechanism
(defun BAR_BLOCK2 (bar_name    bar_length  bar_width   color_code
		   /	       half_width  m_half_width
		   pnt_1       pnt_2	   pnt_3       pnt_4
		   l_center    r_center	   b_1	       b_2
		   b_3	       b_4	   b_5	       hatch_1
		   layer_name  hole_rad	;third_width pt_1 pt_2 pt_3 pt_4
		  )
  (setq	half_width   (* 0.5 bar_width)
	m_half_width (- half_width)
	pnt_1	     (list 0 half_width)
	l_center     '(0 0)
	pnt_2	     (list 0 m_half_width)
	pnt_3	     (list bar_length m_half_width)
	r_center     (list bar_length 0)
	pnt_4	     (list bar_length half_width)
	hole_rad     (/ half_width 4.)
	layer_name   (strcat "layer" (itoa color_code))
	third_width  (* 0.3 bar_width)
	pt_1	     (list bar_width third_width)
	pt_2	     (list bar_width (- third_width))
	pt_3	     (list (- bar_length bar_width) (- third_width))
	pt_4	     (list (- bar_length bar_width) third_width)
  )
  (command "_.layer" "_set" layer_name "")
  (command "_.pline"	     pnt_1    "Arc"    "ce"	l_center
	   pnt_2    "Li"     pnt_3    "Arc"    "ce"	r_center
	   pnt_4    "Li"     "Cl"
	  )
  (setq b_1 (entlast))
  (make_circle_1 layer_name 0 l_center hole_rad)
  (setq b_2 (entlast))
  (make_circle_1 layer_name 0 r_center hole_rad)
  (setq b_3 (entlast))
  (command "_.pline" pt_1 pt_2 pt_3 pt_4 "cl")
  (setq b_4 (entlast))
  (make_line_1
    layer_name
    0
    (list (+ bar_width third_width) 0)
    (list (- (car pt_4) third_width) 0)
  )
  (setq b_5 (entlast))
  (command "_.hatch" "_solid" b_1 b_2 b_3 b_4 "")
  (setq hatch_1 (entlast))
  (command "_.block" bar_name '(0 0) hatch_1 b_1 b_2 b_3 b_4 b_5 "")
  (command "_.layer" "_set" "0" "")
)					;BAR_BLOCK2
;;;
;;;DISP_BAR
;;;display bar block
(defun DISP_BAR	(block_name insert_pnt tip_pnt / insert_ang)

  (setq insert_ang (rtd (angle insert_pnt tip_pnt)))
  (command "_.insert" block_name insert_pnt 1.0	1.0 insert_ang "")
)					;DISP_BAR
;;;
;;;
;;;CG_POINT
;;;compute the center of gravity point given 3 points
(defun CG_POINT	(pt_1 pt_2 pt_3	/ x1 x2	x3 y1 y2 y3 new_x new_y)
  (setq	x1    (car pt_1)
	y1    (cadr pt_1)
	x2    (car pt_2)
	y2    (cadr pt_2)
	x3    (car pt_3)
	y3    (cadr pt_3)
	new_x (/ (+ x1 x2 x3) 3.)
	new_y (/ (+ y1 y2 y3) 3.)
  )
  (list new_x new_y)
)					;CG_POINT
;;;
;;;
;;;UNIT_VEC
;;;	pt_a	start point
;;;	pt_b	end point
;;;USAGE
;;;		vec_out (unit_vec ref_pnt target_pt)
;;;		vec_len (car vec_out)
;;;		unit_x (cadr vec_out)
;;;		unit_y (caddr vec_out
;;;
(defun UNIT_VEC	(pt_a pt_b / x_a x_b y_a y_b dx	dy u_x u_y vec_len)
  (setq	x_a	(car pt_a)
	x_b	(car pt_b)
	y_a	(cadr pt_a)
	y_b	(cadr pt_b)
	dx	(- x_b x_a)
	dy	(- y_b y_a)
	vec_len	(sqrt (+ (* dx dx) (* dy dy)))
	u_x	(/ dx vec_len)
	u_y	(/ dy vec_len)
  )
  (list vec_len u_x u_y)
)					;UNIT_VEC
;;;
;;;BEEP command
;;;assuming that there is a file named my_beep
;;;containing  7  (BEL)
;;;   the way to make this file
;;;	(setq f (open "my_beep" "w"))
;;;	(write-char 7 f)
;;;	(close f)
;;;
(defun c:BEEP ()
  (command "_.type" "my_beep")
)
;;BEEP
;;;
(defun get_last_ent ()
  (setq last_ent (entget (entlast)))
)
;;;GET_LAST_ENT
;;;
;;;
(defun tri_about_pt (pt_center pt_ref	 pt2	   pt3	     ndiv
		     nspeed    angle	 angdir	   ncolor    /
		     inc       nstep	 pnt_from  pnt_to    last_pl
		     last_hat
		    )
  (setq	inc	  (/ 1. ndiv)
	nstep	  1
	pt_from	  pnt_ref
	inc_angle (/ angle (float ndiv))
	radius	  (distance pt_center pt_ref)
  )
;;;the first pline and shaded triangle
  (command "_.pline" pt_ref pt2 pt_3 "C")
  (setq last_pl (entlast))
  (command "_.hatch" "_solid" last_pl "")
  (setq last_hat (entlast))
  (repeat ndiv

    (slow_arc nspeed "0" ncolor	pt_center pt_from inc_angle angdir)
    (entdel last_pl)
    (entdel last_hat)

    (command "_.pline" pt1 pt2 pnt_to "_c")
    (setq last_pl (entlast))
    (command "_.hatch" "_solid" last_pl "")
    (setq last_hat (entlast))
	(make_jpg)	;;only when jpg_yes = 1
    (setq nstep	   (1+ nstep)
	  pnt_from pnt_to
	  pnt_to   (plt pnt_start pnt_end (* inc nstep))
    )
  )

)					;TRI_ABOUT_PT
;;;
(defun tri_along_line (layer	 pnt_start pnt_end   ndiv
		       nspeed	 pt1	   pt2	     ncolor
		       /	 inc	   nstep     pnt_from
		       pnt_to	 last_pl   last_hat
		      )
  (setq	inc	 (/ 1. ndiv)
	nstep	 1
	pnt_from pnt_start
	pnt_to	 (plt pnt_start pnt_end inc)
  )
;;;the first pline and shaded triangle
  (command "_.pline" pt1 pt2 pnt_start "_C")
  (setq last_pl (entlast))
  (command "_.hatch" "_solid" last_pl "")
  (setq last_hat (entlast))
  (repeat ndiv

    (slow_line nspeed layer ncolor pnt_from pnt_to)
    (entdel last_pl)
    (entdel last_hat)
    (command "_.pline" pt1 pt2 pnt_to "_c")
    (setq last_pl (entlast))
    (command "_.hatch" "_solid" last_pl "")
	
    (setq last_hat (entlast))
	(make_jpg)	;;;only when jpg_yes = 1
    (setq nstep	   (1+ nstep)
	  pnt_from pnt_to
	  pnt_to   (plt pnt_start pnt_end (* inc nstep))
    )
  )
  (setq	last_hatch last_hat
	last_pline last_pl
  )

)					;TRI_ALONG_LINE

;;;COPY_ROTATE
;;;copy then rotate a line entity
(defun C:copy_rotate ()
					;Copy the entity data points, layer, color	
  (setq	base_line (entsel "Select an object")
	line_list (entget (car base_line))
	new_ent	  (list
		    (assoc 0 line_list)
		    (assoc 8 line_list)
		    (assoc 10 line_list)
		    (assoc 11 line_list)
		  )
  )
					;Make a new entity
  (entmake new_ent)
  (setq new_obj (entlast))
					;specify a center of rotation
  (setq rot_pnt (entsel "\nSelect a center of rotation"))
  (setq	rot_angle (getreal "\nInput rotation angle in degrees: ")
  )
					;use ACAD rotate command to rotate	
  (command "_.rotate" new_obj "" (cadr rot_pnt) rot_angle)
)					;COPY_ROTATE
;;;
;;;*****************************************************************************************
;;;
(defun quad_along_line (layer	 pnt_start	   pnt_end  ndiv
			nspeed	 pt1	  pt2	   ncolor   dist
			/	 inc	  nstep	   pnt_from pnt_to
			last_pl	 last_hat
		       )
  (setq	inc	 (/ 1. ndiv)
	nstep	 1
	pnt_from pnt_start
	pnt_to	 (plt pnt_start pnt_end inc)
	pnt_fol	 (pld pnt_to pnt_start dist)
  )
;;;the first pline and shaded triangle
  (command "_.pline" pt1 pt2 pnt_start pnt_fol "C")
  (setq last_pl (entlast))
  (command "_.hatch" "_solid" last_pl "")
  (setq last_hat (entlast))
  (repeat ndiv

    (slow_line nspeed layer ncolor pnt_from pnt_to)
    (entdel last_pl)
    (entdel last_hat)
    (setq pnt_fol (pld pnt_to pnt_start dist))
    (command "_.pline" pt1 pt2 pnt_to pnt_fol "_c")
    (setq last_pl (entlast))
    (command "_.hatch" "_solid" last_pl "")
    (setq last_hat (entlast))
	(make_jpg)
    (setq nstep	   (1+ nstep)
	  pnt_from pnt_to
	  pnt_to   (plt pnt_start pnt_end (* inc nstep))
    )
  )
  (setq	last_hatch last_hat
	last_pline last_pl
  )

)					;QUAD_ALONG_LINE
;;;
;;;*******************************************************************************************
;;;		move_ent      move a sinlge entity slowly
;;;
(defun move_ent	(move_entity pnt_start pnt_end n_speed ndiv ncolor
		 layer_name)
  (setq	inc	 (/ 1. ndiv)
	nstep	 1
	pnt_from pnt_start
	pnt_to	 (plt pnt_start pnt_end inc)
  )
  (repeat ndiv
    (slow_line n_speed layer_name ncolor pnt_from pnt_to)
    (entdel (entlast))
;;;test delete the trace
    (command "_.move" move_entity "" pnt_from pnt_to)
	(make_jpg)
    (setq nstep	   (1+ nstep)
	  pnt_from pnt_to
	  pnt_to   (plt pnt_start pnt_end (* inc nstep))
    )
  )
)
;;;move_ent
;;;
;;;*******************************************************************************************
;;;		copy_move_ent      copy_move a sinlge entity slowly
;;;
(defun copy_move_ent (move_entity  pnt_start	pnt_end
		      n_speed	   ndiv		ncolor
		      layer_name
		     )
  (setq	inc	 (/ 1. ndiv)
	nstep	 1
	pnt_from pnt_start
	pnt_to	 (plt pnt_start pnt_end inc)
  )
  (repeat ndiv
    (slow_line n_speed layer_name ncolor pnt_from pnt_to)
    (entdel (entlast))
;;;test delete the trace
    (command "_.move" move_entity "" pnt_from pnt_to)
	(make_jpg)
    (setq nstep	   (1+ nstep)
	  pnt_from pnt_to
	  pnt_to   (plt pnt_start pnt_end (* inc nstep))
    )
  )
)
;;;copy_move_ent
;;;
;;;*******************************************************************************************
;;;		rotate_ent      rotate a single entity slowly
;;;
(defun rotate_ent (rot_entity	  pnt_axis	 pnt_start
		   total_rot_angle		 n_speed
		   n_repeat	  ncolor
		  / r_step)

  (setq	pnt_st	  pnt_start
	rot_step  (/ total_rot_angle n_repeat)
	cur_angle (rtd (angle pnt_axis pnt_start))
	len	  (distance pnt_axis pnt_start)
	r_step 1
  )
  (repeat n_repeat
    (slow_arc n_speed "0" ncolor pnt_axis pnt_st rot_step 0)
    (entdel (entlast))
;;;test delete the trace
    (command "_.rotate" rot_entity "" pnt_axis rot_step)
	(make_jpg)
    (setq pnt_st (polar	pnt_axis
			(dtr (setq cur_angle (+ cur_angle rot_step)))
			len
		 )
    )
	(setq r_step (1+ r_step))
	(if (= (rem r_step 5) 0) (make_jpg))
  )
)
;;;rotate_ent
;;;
;;;*******************************************************************************************
;;;		copy_rotate_ent      copy_rotate a single entity slowly
;;;
(defun copy_rotate_ent (rot_entity     pnt_axis	      pnt_start
			total_rot_angle		      n_speed
			n_repeat       ncolor
		       )

  (setq	pnt_st	  pnt_start
	rot_step  (/ total_rot_angle n_repeat)
	cur_angle (rtd (angle pnt_axis pnt_start))
	len	  (distance pnt_axis pnt_start)
  )
  (repeat n_repeat
    (slow_arc n_speed "0" ncolor pnt_axis pnt_st rot_step 0)
    (entdel (entlast))
;;;test delete the trace
    (command "_.rotate" rot_entity "" pnt_axis rot_step)
	(make_jpg)
    (setq pnt_st (polar	pnt_axis
			(dtr (setq cur_angle (+ cur_angle rot_step)))
			len
		 )
    )
  )
)
;;;copy_rotate_ent
;;;*******************************************************************************************
;;;		pick_entity      pick the named entity
;;;
(defun pick_entity (entity_name / correct_pick)
  (setq correct_pick nil)
  (cond
    ((= entity_name "POINT")
     (while (not correct_pick)
       (if
	 (and
	   (setq this_entity (entsel "Pick a Point\n"))
	   (= "POINT"
	      (cdr (assoc 0 (setq this_list (entget (car this_entity)))))
	   )
	 )
	  (setq correct_pick T)
       )
       (princ "Not a point !!")
     )
;;;;while loop
    )					;end of POINT
    ((= entity_name "LINE")
     (while (not correct_pick)
       (if
	 (and
	   (setq this_entity (entsel "Pick a Line\n"))
	   (= "LINE"
	      (cdr (assoc 0 (setq this_list (entget (car this_entity)))))
	   )
	 )
	  (setq correct_pick T)
       )
       (princ "Not a line !!")
     )
;;;;while loop
    )					;end of LINE

    ((= entity_name "CIRCLE")
     (while (not correct_pick)
       (if
	 (and
	   (setq this_entity (entsel "Pick a Circle\n"))
	   (= "CIRCLE"
	      (cdr (assoc 0 (setq this_list (entget (car this_entity)))))
	   )
	 )
	  (setq correct_pick T)
       )
       (princ "Not a circle !!")
     )
;;;;while loop
    )					;end of CIRCLE

    ((= entity_name "TEXT")
     (while (not correct_pick)
       (if
	 (and
	   (setq this_entity (entsel "Pick a Text\n"))
	   (= "TEXT"
	      (cdr (assoc 0 (setq this_list (entget (car this_entity)))))
	   )
	 )
	  (setq correct_pick T)
       )
       (princ "Not a text !!")
     )
;;;;while loop
    )					;end of TEXT

    ((= entity_name "ARC")
     (while (not correct_pick)
       (if
	 (and
	   (setq this_entity (entsel "Pick an Arc\n"))
	   (= "ARC"
	      (cdr (assoc 0 (setq this_list (entget (car this_entity)))))
	   )
	 )
	  (setq correct_pick T)
       )
       (princ "Not an arc !!")
     )
;;;;while loop

    )					;end of ARC
  )
  ;;end of COND
)
;;;PICK_ENTITY
;;;
;;;**************************DEFINE_TRIANGLE*************************************
;;;		utility program to define 3 apex by picking 2 lines
;;;		
;;;DEFINE_TRIANGLE
(defun C:define_triangle (/	   tri_a    tri_b    pnt_x    pnt_y
			  dist_ax  dist_bx  dist_ay  dist_by  small
			  pnt_a	   pnt_b    pnt_c
			 )
  (pick_entity "LINE")
  (setq tri_a this_list)
  (pick_entity "LINE")
  (setq tri_b this_list)

  (setq
    pnt_a   (cdr (assoc 10 tri_a))
    pnt_b   (cdr (assoc 11 tri_a))
    pnt_x   (cdr (assoc 10 tri_b))
    pnt_y   (cdr (assoc 11 tri_b))
    dist_ax (distance pnt_a pnt_x)
    dist_bx (distance pnt_b pnt_x)
    dist_ay (distance pnt_a pnt_y)
    dist_by (distance pnt_b pnt_y)
    small   1.e-12
  )
  (if (or (< dist_ax small) (< dist_bx small))
    (setq pnt_c pnt_y)
  )
  (if (or (< dist_ay small) (< dist_by small))
    (setq pnt_c pnt_x)
  )
  (setq	tri_pnt_a pnt_a
	tri_pnt_b pnt_b
	tri_pnt_c pnt_c
  )


)					;DEFINE_TRIANGLE
;;;
;;;********************************************************************************
;;;
(defun shaded_triangle (layer_name pnt_1 pnt_2 pnt_3)

  (command "_.layer" "_set" layer_name "")
  (command "_.pline" pnt_1 pnt_2 pnt_3 "_c")
  (setq pl_last (entlast))
  (command "_.hatch" "_solid" pl_last "")
  (entdel pl_last)
  (command "_.layer" "_set" "0" "")
  (entlast)

)
;;
;;;
(defun shaded_quad (layer_name pnt_1 pnt_2 pnt_3 pnt_4)

  (command "_.layer" "_set" layer_name "")
  (command "_.pline" pnt_1 pnt_2 pnt_3 pnt_4 "_c")
  (setq pl_last (entlast))
  (command "_.hatch" "_solid" pl_last "")
  (entdel pl_last)
  (command "_.layer" "_set" "0" "")
  (entlast)

)
;;
;;;
;;;
;;;
;;;BLINK_LAYER
;;;
;;;make all objects in a certain layer on & off with a specified time delay
;;;
(defun blink_layer (layer_name delay_time repeat_times)
  (setq	on_time	 delay_time
	off_time (/ delay_time 4)
  )
  (repeat repeat_times
    (command "_.layer" "_off" layer_name "")
    (command "_.delay" off_time)
    (command "_.layer" "_on" layer_name "")
    (command "_.delay" on_time)
  )
)
;;;
;;
;;;
;;;REFRESH_ALL		delete all entities including blocks
;;;
(defun C:REFRESH_ALL ()
  (command "_.erase" "_ALL" "")
  (command "_.purge" "_B" "" "_No")
  (setvar "cecolor" "BYLAYER")
  (setvar "clayer" "0")
  (setvar "celtype" "BYLAYER")
  (setvar "OSMODE" 0)
  (command "_.vpoint" "0,0,1")
  (command "_.vports" "_SI")
)
;;REFRESH_ALL
;;;
;;;
;;;del_all_ent		delete all entities including blocks
;;;
(defun C:del_all_ent ()
  (command "_.erase" "_ALL" "")
  (command "_.purge" "_B" "" "_No")
  
)
;;Del_all_ent
;;;
;;;
;;;INIT_MYTOOLS
;;;
;;;initialize layer setting and line type
;;;
(defun C:INIT_MYTOOLS ()
  (set_txstyle "arial")
					;(load "c:/myprogram/my_tools")
  (set_layer)
  (load_ltype)
)					;INIT_MYTOOLS
;;;
;;;bisect_angle 
;;;bisect an angle defined by 3 points O, A, B in the right hand rule.
;;;
(defun bisect_angle (pt_o    pt_a    pt_b    /	     len_oa  len_ob
		     pt_aa   pt_bb   l_ref   pt_mid  pt_c1   pt_c2
		    )

  (setq	len_oa (distance pt_o pt_a)
	len_ob (distance pt_o pt_b)
  )
  (if (>= len_oa len_ob)
    (progn
      (setq pt_aa pt_a
	    pt_bb (pld pt_o pt_b len_oa)
	    l_ref len_oa
      )
    )
    (progn
      (setq pt_bb pt_b
	    pt_aa (pld pt_o pt_a len_ob)
	    l_ref len_ob
      )
    )

  )
  (setq	pt_mid (mid_point pt_aa pt_bb)
	pt_c1  (pld pt_o pt_mid l_ref)
	pt_c2  (plt pt_c1 pt_o 2.0)
  )
  (list pt_c1 pt_c2)

)					;BISECT_ANGLE	
;;;
;;set_color
(defun set_color (color_id)
  (command "_.color" color_id)		;color_id = either the predefined strings like
					;"bylayer" "red","cyan", "yellow",etc or color id number
)
;;set_color
;;;
;;solid_hatch
(defun solid_hatch (entity_id color_id)
  (command "_.color" color_id)
  (command "_.hatch" "_solid" entity_id "")
  (entlast)
)
;;solid_hatch	
;;;;;	
;;;	YES_OR_NO
;; Yes or No query routine
(defun Yes_or_No (message / yn)
  (initget "Yes No")
  (setq yn (getkword (strcat message " [Yes/No] <Y>: ")))
  (if (null yn)
    (setq yn "Yes")
  )
  (setq	yn (if (= yn "Yes")
	     "_Y"
	     "_N"
	   )
  )
)
;;;
;;;************************************************************************
;;; Function: ROT
;;;
					; utility routine 
;; get a coordinate of a point "p1" after it is rotated thru angle "theta" about a point "p0" 
;;
;; p0, p1	    end points
;; theta            angle in degrees
;;
;; output           point data (x,y)
;;
(defun ROT (p0 p1 theta	/ x0 x1	y0 y1 angle sine cosine	dx_new dy_new
	    x_new y_new)

  (setq	x0     (car p0)
	y0     (cadr p0)
	x1     (car p1)
	y1     (cadr p1)
	dx     (- x1 x0)
	dy     (- y1 y0)
	angle  (dtr theta)
	cosine (cos angle)
	sine   (sin angle)
	dx_new (- (* cosine dx) (* sine dy))
	dy_new (+ (* sine dx) (* cosine dy))
	x_new  (+ x0 dx_new)
	y_new  (+ y0 dy_new)
  )
  (list x_new y_new)
)					;ROT
;;;***************************************************************************	
;;;
;;;
;;;ARBENTRY
;;;
(defun C:ARBENTRY (mesg)
  (initget 128)
  (setq num (getreal mesg))
  (if (= 'STR (type num))
    (setq num (eval (read num)))
    num
  )
)
;;;ARBENTRY  input number incl. specified number
;;;***************************************************************************
;;;
;;;LINE_TEXT
;;;	add a text along the line defined by 2 points p1 & p2
;;;		when el = 0  no lines drawn
;;;	             e1 is non-zero, a line with a cut in the center will be drawn
;;;			p1 to p1e, p2e to p2 
;;;			where p1e & p2e are as defined in the code below
;;; 
(defun line_text (p1	   p2	    el	     string   chr_size nh
		  nv	   /	    p1e	     p2e      mid_p12  dxdy
		  pnt_text text_angle
		 )

  (setq	p1e	   (plt p1 p2 el)
	p2e	   (plt p2 p1 el)
	mid_12	   (mid_point p1 p2)
	dxdy	   (list (* chr_size nh) (* chr_size nv))
	pnt_text   (shift_pnt mid_12 dxdy)
	text_angle (rtd (angle p1 p2))
  )
  (if (/= el 0.0)
    (progn
      (make_line_1 "0" 0 p1 p1e)
      (make_line_1 "0" 0 p2e p2)
    )
  )

  (command "_.text" pnt_text chr_size text_angle string "")
)
;;;LINE_TEXT
;;;
;;;PL_VERTICES
					; This routine accepts a polyline and returns a list of the polyline's vertices.
(defun pl_vertices (pl_entity  /	  pline
					;entity list for pl_entity
		    nodes		;number of nodes
		    the_rest		;list starting with the first node
		    cnt			;counter
		    index		;index for node location
		    cur_list		;node list
		    pline_list		;the node list
		   )
  (setq pline (entget pl_entity))	;entity list for the pline 
  (setq	nodes	   (cdr (assoc 90 pline))
	the_rest   (member (assoc 10 pline) pline)
	cnt	   0
	pline_list nil
  )
  (repeat nodes
    (setq index	     (* 4 cnt)		;every 4th location
	  cur_list   (list (cdr (nth index the_rest)))
	  pline_list (append pline_list cur_list)
	  cnt	     (1+ cnt)
    )
  )
  pline_list				;return list
)
;;;PL_VERTICES
;;;
;;;
;;;MOVE_BAR
;;;display bar at the precision display meter
(defun move_bar	(test_data meter_scale / x_val x_power x_pnt bar_pnt
		 logx x_sign)

  (setq	x_val (abs test_data)
	logx  (log x_val)
  )

  (if (> logx 0.)
    (setq x_sign -1.)
    (setq x_sign 1.)
  )

  (setq	x_power	(* pm_factor (abs logx) x_sign)
	x_pnt	(+ m_x (* meter_scale x_power))
	bar_pnt	(list x_pnt m_y)
  )
  (entdel old_bar)
  (my_block_insert "prec_bar" bar_pnt meter_scale)
  (setq old_bar (entlast))
;;;prec_bar just created
)					;MOVE_BAR
;;;
;;;;;;;
;;;Utility routine for making jpg file when JPG_YES flag is on
;;;
;;;jpg_filename		JPG OUTPUT FILENAME
;;;jpg_count		jpg file sequence number
;;;JPG_YES		flag set 1 before jpgout option is enabled
;;;all the above variables user defined.
;;;
(defun make_jpg	()
  (if (= JPG_YES 1)
    (progn
      (command "_.jpgout"
	       (strcat jpg_filename "_" (itoa jpg_count))
	       ""
      )
      (setq jpg_count (+ 1 jpg_count))
    )
	(command "_.delay" delay_time)
  )					;end of IF
)
;;;jpgout case
;;;
;;;
;;;JPG_SETUP
;;;initialize jpgout option by specifying file name and setting counter to 1
;;;
(defun jpg_setup (output_filename)
  ;;***jpgfile save***
;;;jpgfile name assigned
  (setq	jpg_filename output_filename
	jpg_count    1
	delay_time 500
  )
)
;;;JPG_SETUP
;;;
;;;;;;;
;;;Utility routine for making dwg file when DWG_YES flag is on
;;;
;;;dwg_filename		DWG OUTPUT FILENAME
;;;dwg_count		dwg file sequence number
;;;DWG_YES		flag set 1 before jpgout option is enabled
;;;all the above variables user defined.
;;;
(defun make_dwg	()
  (if (= DWG_YES 1)
    (progn
      (command "_.saveas" ""  (strcat dwg_filename "_" (itoa dwg_count))  )
      (setq dwg_count (+ 1 dwg_count))
      (command "_.delay" delay_time)
    );;end of progn
  )					;end of IF
)
;;;jpgout case
;;;
;;;
;;;DWG_SETUP
;;;initialize jpgout option by specifying file name and setting counter to 1
;;;
(defun dwg_setup (output_filename)
  ;;***dwgfile save***
;;;dwgfile name assigned
  (setq	dwg_filename output_filename
	dwg_count    1
	delay_time 1000
  )
)
;;;DWG_SETUP
;;;
;;;
;;; 
;;;color code conversion  HSL to RGB
;;;HSL example (35,50,75)
;;;range  H (0-360), S & L (0-100)
;;;RGB example (223,197,159)
;;;range  R,G,B (0 - 255)
;;;HSL_2_RGB
;;;
(defun hsl_2_rgb(hue sat lum / 
		hu sa lu 
		one_third one_sixth two_third half
		p q tr tg tb ind_r ind_g ind_b
		)
;;noramlize HSL values
	(setq hu (/ hue 360.)
		sa (/ sat 100.)
		lu (/ lum 100.)	
		one_third (/ 1. 3.)
		one_sixth (/ 1. 6.)
		two_third (/ 2. 3.)
		half 0.5
	)
;;define p,q parameters depening on the lum value
	(if (< lu 0.5)	
		(setq q (* lu (+ 1. sa)))
		(setq q (+ lu sa (- (* lu sa))))
	);;end if
	(setq p (- (* 2 lu) q))
;;temp values for TR,TG,TB
	(setq tr (+ hu one_third)
		tg hu
		tb (- hu one_third)
	)
;;modify TR,TG,TB depending on its value
	(if (< tr 0.) (setq tr (1+ tr)))
	(if (> tr 1.) (setq tr (1- tr)))
	(if (< tg 0.) (setq tg (1+ tg)))
	(if (> tg 1.) (setq tg (1- tg)))
	(if (< tb 0.) (setq tb (1+ tb)))
	(if (> tb 1.) (setq tb (1- tb)))
;;final adjustment for TR
	(cond
		((< tr one_sixth) (setq tr (+ p (* 6 tr (- q p)) )) )	 
		((and (>= tr one_sixth) (< tr half))
			(setq tr q))
		((and (>= tr half) (< tr two_third))
			(setq tr (+ p (* (- q p) 6 (- two_third tr))))) 
		( (>= tr two_third) (setq tr p))
		(t nil)
	);;;end of cond 
;;final adjustment for TG
	(cond
		((< tg one_sixth) (setq tg (+ p (* 6 tg (- q p)) )) )	 
		((and (>= tg one_sixth) (< tg half))
			(setq tg q))
		((and (>= tg half) (< tg two_third))
			(setq tg (+ p (* (- q p) 6 (- two_third tg))))) 
		( (>= tg two_third) (setq tg p))
		(t nil)
	);;;end of cond
;;final adjustment for TB
	(cond
		((< tb one_sixth) (setq tb (+ p (* 6 tb (- q p)) )) )	 
		((and (>= tb one_sixth) (< tb half))
			(setq tb q))
		((and (>= tb half) (< tb two_third))
			(setq tb (+ p (* (- q p) 6 (- two_third tb))))) 
		( (>= tb two_third) (setq tb p))
		(t nil)
	);;;end of cond
			
;;convert tr,tg,tb back to RGB index
	(setq ind_r (fix (* 255 tr))
		ind_g (fix (* 255 tg))
		ind_b (fix (* 255 tb))
	)
	;(setq output (list ind_r ind_g ind_b))
	(setq rgb_index (strcat (itoa ind_r) "," (itoa ind_g) 
					  "," (itoa ind_b)))
	



);;;
;;;
;;;
;;; Function: SET_FRACTAL_LAYER
;;;
;;; define layer name from layer1 up to layer500
;;; and assign color by RGB color code
;;;	
(defun SET_FRACTAL_LAYER (/ layer_cnt layer_name rgb_code)
  (setup_sysvar)
  (setq layer_cnt 1)
  (repeat 500
    (setq layer_name (strcat "layer" (itoa layer_cnt))
	rgb_code (hsl_2_rgb (rem layer_cnt 360) 70 40)
    )
	(princ "rgb code = ")(princ rgb_code)(terpri)
    (command "_.layer" "_new" layer_name "_color" "_T" rgb_code layer_name "")
    (setq layer_cnt (1+ layer_cnt))
  )
 (reset_sysvar) 
)					;SET_FRACTAL_LAYER
;;;
;;; Function: SET_FRACTAL_LAYER2
;;;
;;; define layer name from layer1 up to layer999
;;; and assign color by RGB color code
;;;	
(defun SET_FRACTAL_LAYER2 (/ layer_cnt layer_name rgb_code)
  (setup_sysvar)
  (setq layer_cnt 1)
  (repeat 999
    (setq layer_name (strcat "layer" (itoa layer_cnt))
	rgb_code (hsl_2_rgb (rem layer_cnt 360) 70 40)
    )
	(princ "rgb code = ")(princ rgb_code)(terpri)
    (command "_.layer" "_new" layer_name "_color" "_T" rgb_code layer_name "")
    (setq layer_cnt (1+ layer_cnt))
  )
 (reset_sysvar) 
)					;SET_FRACTAL_LAYER2
;;;************************************************************************

;;;
;;; Function: LAYER_COLOR_test
;;;
;;; define layer name from layer1 up to layer500
;;; and assign color by RGB color code
;;;	
(defun C:LAYER_COLOR_TEST (/ layer_cnt layer_name rgb_code total_lay col_inc col_code)
  (setup_sysvar)
  (setq layer_cnt 1)
  (setq total_lay (getint "\nTotal number of layers (def=360)"))
	(if (= total_lay nil) (setq total_lay 360))
  (setq col_inc (/ 360. total_lay))
  (repeat total_lay
    (setq col_code (fix (* layer_cnt col_inc)))
    (setq layer_name (strcat "layer" (itoa layer_cnt))
	rgb_code (hsl_2_rgb col_code 70 40)
    )
	;(princ "rgb code = ")(princ rgb_code)(terpri)
    (command "_.layer" "_new" layer_name "_color" "_T" rgb_code layer_name "")
    (setq layer_cnt (1+ layer_cnt))
  )
 (reset_sysvar) 
)					;SET_FRACTAL_LAYER
;;;
;;;
;;;************************************************************************
;;; 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
;;;
;;;
;;;MAKE_ALLJPG
;;;
(defun c:make_alljpg()
	(setq dwg_name (getstring "\nDWG file name:  ")
		num_file (getint "\nNumber of DWG files:  ")
		view_dir (getpoint "\View direction")
		cnt 0
		jpg_yes 1
		pnt_org '(0 0 0)
	)
	(jpg_setup dwg_name)
	
  (repeat num_file
	(setq file_name (strcat dwg_name "_" (itoa (1+ cnt))))
	(command "_.insert" file_name pnt_org "1.0" "1.0" "" "")
	(command "_.vpoint" view_dir)
	(command "_.zoom" "_E")
	(command "_.regen")
	(command "delay" 5000)
	(make_jpg)
	(command "delay" 5000)
	(c:refresh_all)
	(command "delay" 5000)
	(setq cnt (1+ cnt))
  );;;end of repeat loop
	(setq jpg_yes 0)
);;;
;;;
(princ)