;****************************************;
;* This is "ac_lxy.lsp" program		*;		
;* It include some share functions	*;
;* Completely complied at 02/01/99	*;
;* Last changed  at 02/01/99		*;
;* ZX Mold Ltd  XY.Liao			*;
;****************************************;
;*************************** err handle function ****************************;
;;LCA - COMMENT: *error* defun no longer evaluates as a list.
;;LCA - COMMENT: *error* defun no longer evaluates as a list.
(defun-q *error*(msg)
  (if (= "quit / exit abort" msg)
    (setq msg nil)
  )
  (if (= "Function cancelled" msg)
    (setq msg nil)
  )
  (if msg
    (alert (strcat "´íÎó:" msg))
  )
  (ac_lxy_set)
  (exit)
)
;****************************End of function********************************; 

;************************ system var reset function ************************;
(defun ac_lxy_set()
  (if la_old
    (setvar "clayer" la_old)
  )
  (if lt_old
    (setvar "celtype" lt_old)
  )
  (if co_old
    (setvar "cecolor" co_old)
  )
  (if pw_old
    (setvar "plinewid" pw_old)
  )
  (if os_old
    (setvar "osmode" os_old)
  )
  (if dim_old
    (command "dimstyle" "" dim_old)
  )
  (if st_old
    (setvar "textstyle" st_old)
  )
  (if or_old
    (setvar "orthomode" or_old)
  )
  (if bp_old
    (setvar "orthomode" bp_old)
  )
)
;****************************End of function********************************; 

;*********************** create wipeout box function ***********************;
(defun wipebox(lxy_ptlist)
  (command "_.pline")
  (foreach lxy_pt lxy_ptlist (command lxy_pt))
  (command "_c")
  (command "_.wipeout" "_frame" "_off")
  (command "_.wipeout" "_new" (entlast) "_yes")
  (entlast)
)
;****************************End of function********************************; 

;******************** init list box in dialog function *********************;
(defun ini_list(list_name table_name)
  (start_list list_name)
  (mapcar 'add_list table_name)
  (end_list)
)
;****************************End of function********************************; 

;******************* get item sequence in a list function ******************;
(defun xh_get(item list / n)
  (setq counti nil)
  (setq n 0)
  (while (< n (length list))
	(if (= item (nth n list))
	  (setq counti n)
	)
	(setq n (+ n 1))
  )
  (setq counti counti)
)
;********************************* End of function *********************************;

;************************** Change string to list function *************************;
(defun strtolst(string / i j ret_list)
  (setq i 2)
  (setq j 1)
  (while (<= i (strlen string))
    (if (= " " (substr string i 1))
      (progn
	(if ret_list
	  (setq ret_list (append ret_list (list (substr string j (- i j)))))
	  (setq ret_list (list (substr string j (- i j))))
	)
	(setq j (+ i 1))
      )
    )
    (if (and (<= j i) (= i (strlen string)))
      (setq ret_list (append ret_list (list (substr string j (+ (- i j) 1)))))
    )
    (setq i (+ i 1))
  )
  ret_list
)
;********************************* End of function *********************************;

;**************************** Get entities point function **************************;
;Return entities point list
;Lwpolyline---vertexes list
;Line---------start point and end point list
;Arc----------center point, start point and end point list
;circle-------center point and radius list
;Symtax: (ep_list entity_data)
;***********************************************************************************;
(defun ep_list(ent / en lst lst1 ptt1 ptt2 pt_1 pt_2 nt_l nt_h nt_r ent_n)

  (defun dxf(n e) (cdr (assoc n e)));defun local function

  (if (or (not ent) (not (listp ent)))
    (exit)
  )
  (if (setq en (dxf 0 ent))
    (cond
      ((= "LWPOLYLINE" en)
        (setq ptt1   (dxf 10 ent))
        (setq ent_n (dxf 90 ent))
        (setq ent   (member (assoc 10 ent) ent))
        (while (> ent_n 1)
          (setq bugl (dxf 42 ent))
          (setq ent (cdr ent))
          (if (= 0 bugl)
            (progn
              (setq ptt2  (dxf 10 ent))
              (setq lst1 (list "L" ptt1 ptt2))
            )
            (progn
              (setq ptt2 (dxf 10 ent))
	      (setq nt_l   (distance ptt1 ptt2)
		    nt_h   (abs (/ (* bugl nt_l) 2))
		    nt_r	(/ (* (+ (* bugl bugl) 1) nt_l) (* 4 (abs bugl)))
	      )
	      (cond
	        ((< bugl -1)
	          (setq pt_1     ptt2
			pt_2     ptt1
                  )
	 	  (setq ang1 (angle pt_1 pt_2)
			ang2 (- ang1 (/ pi 2))
		  )
		)
		((and (< bugl 0) (>= bugl -1))
	          (setq pt_1     ptt2
			pt_2     ptt1
                  )
	 	  (setq ang1 (angle pt_1 pt_2)
			ang2 (+ ang1 (/ pi 2))
		  )
		)
		((and (<= bugl 1) (> bugl 0))
	          (setq pt_1     ptt1
			pt_2     ptt2
                  )
	 	  (setq ang1 (angle pt_1 pt_2)
			ang2 (+ ang1 (/ pi 2))
		  )
		)
		((> bugl 1)
	          (setq pt_1     ptt1
			pt_2     ptt2
                  )
	 	  (setq ang1 (angle pt_1 pt_2)
			ang2 (- ang1 (/ pi 2))
		  )
		)
	      )
	      (setq mid_pt (polar pt_1 ang1 (/ nt_l 2))
		    cen_pt (polar mid_pt ang2 (abs (- nt_r nt_h)))
              )
	      (setq lst1 (list "A" cen_pt pt_1 pt_2))
            )
          )
	  (setq ptt1   (dxf 10 ent))
          (setq ent   (member (assoc 10 ent) ent))
	  (setq ent_n (- ent_n 1))
          (if lst
            (setq lst (append lst (list lst1)))
            (setq lst (list "PL" lst1))
          )
        )
      )
      ((= "LINE" en)
        (setq lst (list "L" (dxf 10 ent) (dxf 11 ent)))
      )
      ((= "CIRCLE" en)
        (setq lst (list "C" (dxf 10 ent) (dxf 40 ent)))
      )
      ((= "ARC" en)
        (setq arc_bpt (dxf 10 ent))
	(setq arc_r (dxf 40 ent))
        (setq arc_ang1 (dxf 50 ent))
        (setq arc_ang2 (dxf 51 ent))
        (setq arc_spt1 (polar arc_bpt arc_ang1 arc_r)
	      arc_spt2 (polar arc_bpt arc_ang2 arc_r)
        )
        (setq lst (list "A" arc_bpt arc_spt1 arc_spt2))
      )
    )
  )
  lst
)
;********************************* End of function *********************************;


;************************* Get intersection point function1 ************************;
;;===Return two line intersection point
;;===if    having int point and the point is on the side of end point2 
;;===then  return the point's ordinate
;;===else  return nil
;;===Sytex: (line_int <start_point1> <end_point1> <start_point2> <end_point2>)
;***********************************************************************************;
(defun line_int(point1 point2 point3 point4 / ret_flag1		ret_flag2)
  (setq line_inspt nil)
  (if (setq line_inspt (inters point1 point2 point3 point4 nil))
    (progn
      (setq angle1 (angle point3 point4))
      (setq angle2 (angle point3 line_inspt))
      (if (> 0.0001 (abs (- angle1 angle2)))
        (setq ret_flag1 T)
        (setq ret_flag1 nil)
      )
      (if (or (and (>= (car line_inspt) (car point1)) (<= (car line_inspt) (car point2)))
	      (and (<= (car line_inspt) (car point1)) (>= (car line_inspt) (car point2)))
	      (and (>= (cadr line_inspt) (cadr point1)) (<= (cadr line_inspt) (cadr point2)))
	      (and (<= (cadr line_inspt) (cadr point1)) (>= (cadr line_inspt) (cadr point2)))
          )
        (setq ret_flag2 t)
        (setq ret_flag2 nil)
      )
    )
  )
  (if (and line_inspt ret_flag1 ret_flag2)
    line_inspt
    nil
  )
)
;********************************* End of function *********************************;


;************************* Get intersection point function2 ************************;
;;=Return the intersection point of a line and a arc
;;=if    having int point and the point is on the side of end_pt_line 
;;=then  return the point's ordinate list
;;=else  return nil
;;=Sytex: (arc_int <cen_pt>  <start_pt_arc>  <end_pt_arc>  <start_pt_line>  <end_pt_line>)
;***********************************************************************************;
(defun arc_int(point0 point1 point2 point3 point4 
;/ ret_pt1 	ret_pt2 	pt_temp1 
;						    pt_temp2 	ang_temp1 	ang_temp2
;						    ang_temp3 	ang1 		ang2 
;						    ang3
)
(princ "arc_int\n")
  (setq cir (distance point0 point1))
  (setq ang1 (angle point0 point1)
	ang2 (angle point0 point2)
	ang3 (angle point3 point4)
  )
  (if (> ang1 ang2)
    (setq ang1 (- ang1 (* pi 2)))
  )
  (if (setq intpt_sel (circ_int point3 point4 point0 cir))
    (if (= 1 (length intpt_sel))
      (progn
	(setq pt_temp1 (car intpt_sel))
        (setq ang_temp1 (angle point0 pt_temp1))
	(setq ang_temp3 (angle point3 pt_temp1))
	(if (and (> 0.0001 (abs (- ang3 ang_temp3)))
		 (and (>= ang_temp1 ang1) (<= ang_temp1 ang2))
            )
          (setq ret_pt1 pt_temp1)
        )
      )
      (progn
	(setq pt_temp1 (car intpt_sel))
	(setq pt_temp2 (cadr intpt_sel))
	(setq ang_temp1 (angle point0 pt_temp1))
	(setq ang_temp2 (angle point0 pt_temp2))
	(setq ang_temp3 (angle point3 pt_temp1))
	(setq ang_temp4 (angle point3 pt_temp2))
	(if (and (> 0.0001 (abs (- ang3 ang_temp3)))
		 (or (and (>= ang_temp1 ang1) (<= ang_temp1 ang2))
		     (and (>= (- ang_temp1 (* pi 2)) ang1) (<= (- ang_temp1 (* pi 2)) ang2))
                 )
            )
          (setq ret_pt1 pt_temp1)
          (setq ret_pt1 nil)
        )
	(if (and (> 0.0001 (abs (- ang3 ang_temp4)))
		 (and (>= ang_temp2 ang1) (<= ang_temp2 ang2))
            )
          (setq ret_pt2 pt_temp2)
          (setq ret_pt2 nil)
        )
      )
    )
  )
  (if (not ret_pt2)
    (if (not ret_pt1)
      nil
      ret_pt1
    )
    (if (not ret_pt1)
      ret_pt2
      (if (> (distance point3 ret_pt1) (distance point3 ret_pt2))
        (list ret_pt2 ret_pt1)
        (list ret_pt1 ret_pt2)
      )
    )
  )
)
;********************************* End of function *********************************;


;************************* Get intersection point function3 ************************;
;* Return the intersection point of a line and a circle
;* if having int point, the return value is the point's ordinate list
;* else the return value is nil
;* Sytex: (circ_int  start_pt_line  end_pt_line  center_pt_circle  radius_circle)
;***********************************************************************************;
(defun circ_int(point1 point2 pt_cen cir / ver_lb 	k 		b 		a0 
					   b0 		c0 		temp 		pt1_temp 
					   pt2_temp	x1 		x2 		y1 
					   y2)
  (if (< (abs (- 1.0 (/ (car point1) (car point2)))) 0.0001);if line is parallelism to y axis
    (setq ver_lb 1)					    ;then
    (setq ver_lb 0)					    ;else
  );if
  (cond 
    ((= 0 ver_lb)

  ;;;;k=(y2-y1)/(x2-x1);;;;
      (setq k (/ (- (cadr point2) (cadr point1)) 
 	         (- (car point2) (car point1)))) 

  ;;;b=(x2y1-x1y2)/(x2-x1);;;
      (setq b (/ (- (* (car point2) (cadr point1)) 
		    (* (car point1) (cadr point2))
		 ) 
		 (- (car point2) (car point1)))) 

  ;;;;a0=k^2+1;;;;
      (setq a0 (+ 1 (* k k))) 

  ;;;;b0=2kb-(2x0+2ky0);;;;
      (setq b0 (- (* 2 k b) 
                  (+ (* 2 (car pt_cen)) 
		     (* 2 k (cadr pt_cen))
		  )
	       )) 

  ;;;;c0=x0^2+(b-y0)^2+r^2;;;;
      (setq c0 (- (+ (* (car pt_cen) (car pt_cen)) 
		     (* (- b (cadr pt_cen)) (- b (cadr pt_cen)))
		  ) 
                  (* cir cir))) 

  ;;;;temp=b^2-4a0c0;;;;
      (setq temp (- (* b0 b0) (* 4 a0 c0))) 

      (if (>= temp 0) ;if temp>=0
        (progn
 	  (setq x1 (/ (+ (- 0 b0) (sqrt temp)) (* 2 a0)))
 	  (setq y1 (+ (* k x1) b))
 	  (setq x2 (/ (- (- 0 b0) (sqrt temp)) (* 2 a0)))
 	  (setq y2 (+ (* k x2) b))
 	  (setq pt1_temp (list x1 y1))
 	  (setq pt2_temp (list x2 y2))
 	  (if (= 0 temp)
	    (setq pt2_temp nil)
	  )
        )
        (setq pt1_temp nil
              pt2_temp nil)
      )
    )
    ((= 1 ver_lb)
      (setq b (car point1))
      (setq a0 1)
      (setq b0 (- 0 (* 2 (cadr pt_cen))))
      (setq c0 (- (+ (* (cadr pt_cen) (cadr pt_cen)) 
		     (* (- b (car pt_cen)) (- b (car pt_cen)))
                  ) 
                  (* cir cir)))
      (setq temp (- (* b0 b0) (* 4 a0 c0)))
      (if (>= temp 0)
        (progn
 	  (setq y1 (/ (+ (- 0 b0) (sqrt temp)) (* 2 a0)))
 	  (setq x1 b)
 	  (setq y2 (/ (- (- 0 b0) (sqrt temp)) (* 2 a0)))
 	  (setq x2 b)
 	  (setq pt1_temp (list x1 y1))
 	  (setq pt2_temp (list x2 y2))
 	  (if (= 0 temp)
	    (setq pt2_temp nil)
	  )
        )
        (setq pt1_temp nil
              pt2_temp nil)
      )
    )
  )
  (if pt1_temp
    (if (not pt2_temp)
      (list pt1_temp)
      (list pt1_temp pt2_temp)
    )
  )    
)
;********************************* End of function *********************************;


;************************* Get intersection point function4 ************************;
;get intersection point between line and pline
;point1 and point2 are two point on a line
;pline_ent is pline entity
;if    having intersection point and the point is on the side of point2
;then  return the point
;else  return nil
;***********************************************************************************;
(defun pline_int(point1 point2 pline_ent mtrptlst / intpt i pt_list
)

  (setq pt_list (ep_list (entget pline_ent)))
  (cond 
    ((= "L" (car pt_list))
      (if (not mtrptlst)
        ;(setq intpt (line_int (wtou (nth 1 pt_list)) (wtou (nth 2 pt_list)) point1 point2))
	(PROGN
	
	(setq intpt (line_int (nth 1 pt_list) (nth 2 pt_list) point1 point2))
	(print "not mtrptlst")
	)
	(PROGN 
	
        (setq intpt (line_int (mtou (nth 1 pt_list) mtrptlst)
			      (mtou (nth 2 pt_list) mtrptlst)
			      point1 point2)
        )
	(PRInt "NOT XXX\N")
	)
      )
    )
    ((= "C" (car pt_list))
      (if mtrptlst
        (setq intpt (circ_int point1 point2 
			      (mtou (nth 1 pt_list) mtrptlst)
			      (* (nth 2 pt_list) (caddr (last mtrptlst))))
        )
        ;(setq intpt (circ_int point1 point2 (wtou (nth 1 pt_list)) (nth 2 pt_list)))
	(setq intpt (circ_int point1 point2 (nth 1 pt_list) (nth 2 pt_list)))
      )
    )
    ((= "A" (car pt_list))
      (if mtrptlst
        (setq intpt (arc_int (mtou (nth 1 pt_list) mtrptlst) 
	                     (mtou (nth 2 pt_list) mtrptlst) 
			     (mtou (nth 3 pt_list) mtrptlst)
		             point1 point2)
        )
        ;(setq intpt (arc_int (wtou (nth 1 pt_list)) (wtou (nth 2 pt_list)) (wtou (nth 3 pt_list)) point1 point2))
	(setq intpt (arc_int (nth 1 pt_list) (nth 2 pt_list) (nth 3 pt_list) point1 point2))
      )
    )
    ((= "PL" (car pt_list))
      (setq pt_count (- (length pt_list) 1))
      (setq i 1)
      (while (and (not intpt) (<= i pt_count))
        (setq intpt (nth i pt_list))
        (if mtrptlst
	  (cond
	    ((= "A" (car intpt))
              (setq intpt (arc_int (mtou (nth 1 intpt) mtrptlst) 
				   (mtou (nth 2 intpt) mtrptlst) 
				   (mtou (nth 3 intpt) mtrptlst) 
			           point1 point2)
              )
              (if intpt
	        (setq intpt (car intpt))
              )
            )
            ((= "L" (car intpt))
              (setq intpt (line_int (mtou (nth 1 intpt) mtrptlst)
              			    (mtou (nth 2 intpt) mtrptlst)				
			            point1 point2)
              )
            )
            ((= intpt (nth i pt_list))
              (setq intpt nil)
            )
          )
	  (cond
	    ((= "A" (car intpt))
              (setq intpt (arc_int (wtou (nth 1 intpt)) (wtou (nth 2 intpt)) (wtou (nth 3 intpt)) point1 point2))
              (if intpt
	        (setq intpt (car intpt))
              )
            )
            ((= "L" (car intpt))
              ;(setq intpt (line_int (wtou (nth 1 intpt)) (wtou (nth 2 intpt)) point1 point2))
		(setq intpt (line_int (nth 1 intpt) (nth 2 intpt) point1 point2))
            )
            ((= intpt (nth i pt_list))
              (setq intpt nil)
            )
          )
        )
        (setq i (+ i 1))
      )
    )
  )
  intpt
)
;************************************* End of function *************************************;


;*********************************** Make block function ***********************************;
;make block from entities selection
(defun mblk(blk_name blk_intpt blk_sel)
  (command "block" blk_name blk_intpt blk_sel "")
  (command "insert" blk_name blk_intpt "" "" "")
)
;************************************* End of function *************************************;


;******************************** Make block xdata function ********************************;
;add extend data to a entity
(defun mxdata(ent_name xlist / ed)
  (setq ed (entget ent_name))
  (setq ed (append ed xlist))
  (entmod ed)
)
;************************************* End of function *************************************;


;*************************** define private message box function ***************************;
(defun yn(msg / ret yn_id)
  (if (and msg (/= "" msg))
    (progn
      (setq yn_id (load_dialog "yn.dcl"))
      (if (not (new_dialog "yndlg" yn_id))
        (progn
          (alert "ÏµÍ³ÎÄ¼þ¶ªÊ§!")
          (exit)
        )
      )
      (set_tile "msg" msg)
      (action_tile "accept" "(done_dialog 1)")
      (action_tile "cancel" "(done_dialog 0)")
      (setq ret (start_dialog))
      (unload_dialog yn_id)
    )
  )
  ret
)
;************************************* End of function *************************************;


;****************** Translate ordinate between WCS mcs and UCS function ********************;
;translate WCS TO UCS: (wtou <point_WCS> )
;translate UCS TO WCS: (utow <point_UCS> )
;translate mCS TO WCS: (mtow <point_MCS> <mtrlst> )
;translate mCS TO UCS: (mtou <point_MCS> <mtrlst> )
;*******************************************************************************************;
(defun wtou(point)
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
  (setq pt (list (- (car point)  (car (command "ucsorg")))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
                 (- (cadr point) (cadr (command "ucsorg")))
           ))
)
(defun utow(point)
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
  (setq pt (list (+ (car point)  (car (command "ucsorg")))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
                 (+ (cadr point) (cadr (command "ucsorg")))
            ))
)
(defun mtow(point mtrlst)
	
  (setq m00 (nth 0 (nth 0 mtrlst))
	m01 (nth 1 (nth 0 mtrlst))
	m02 (nth 2 (nth 0 mtrlst))
	m10 (nth 0 (nth 1 mtrlst))
	m11 (nth 1 (nth 1 mtrlst))
	m12 (nth 2 (nth 1 mtrlst))
	m20 (nth 0 (nth 2 mtrlst))
	m21 (nth 1 (nth 2 mtrlst))
	m22 (nth 2 (nth 2 mtrlst))
	m30 (nth 0 (nth 3 mtrlst))
	m31 (nth 1 (nth 3 mtrlst))
	m32 (nth 2 (nth 3 mtrlst))
  )

  (if (>= (length point) 2)
    (progn

      (if (= 2 (length point))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
        (setq point (append point (list (caddr (command "ucsorg")))))
      )
      (setq point (list (+ (* (car point) m00) (* (cadr point) m10) (* (caddr point) m20) m30)
	                (+ (* (car point) m01) (* (cadr point) m11) (* (caddr point) m21) m31)
	                (+ (* (car point) m02) (* (cadr point) m12) (* (caddr point) m22) m32)
                  )
      )
    )

    (setq point nil)
  )
  point
)
(defun mtou(point mtrlst)
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
  (setq point (list (- (car  (mtow point mtrlst))  (car (command "ucsorg")))
;;LCA - WARNING: The UCSORG sysvar has changed.
;;LCA - WARNING: The UCSORG sysvar has changed.
                    (- (cadr (mtow point mtrlst))  (cadr (command "ucsorg")))
            ))
)
;************************************* End of function *************************************;


;****************************** Trim space from string function ****************************;
;(lxy_trim <string> )
; Trims leading and trailing spaces from strings.
;*******************************************************************************************;
(defun lxy_trim (string)
  (cond 
    ((/= (type string) 'str) nil)
    (t (lxy_l_trim (lxy_r_trim string)))
  )
)
(defun lxy_l_trim (string)
  (cond 
    ((eq string "") string)
    ((/= " " (substr string 1 1)) string)
    (t (lxy_l_trim (substr string 2)))
  )
)
(defun lxy_r_trim (string)
  (cond 
    ((eq string "") string)
    ((/= " " (substr string (strlen string) 1)) string)
    (t (lxy_r_trim (substr string 1 (1- (strlen string)))))
  )
)
;************************************* End of function *************************************;

;******************************** Get word sequence function *******************************;
; (lxy_word <string> <word> )
; Get word's sequence in string
;*******************************************************************************************;
(defun lxy_word(string word / i count_i)
  (if (/= (type string) 'str)
    nil
    (progn
      (setq i 0)
      (while (<= (+ i (strlen word)) (strlen string))
	(if (= word (substr string (+ i 1) (strlen word)))
	  (setq count_i (+ i 1))
	)
	(setq i (+ i 1))
      )
      (if count_i count_i nil)
    )
  )
)
;************************************* End of function *************************************;

;******************************** Get word sequence function *******************************;
; (ini_useri2)
; Initializing "useri2" system variable
;*******************************************************************************************;
(defun ini_useri2(/ strtmp	epin_count pin_count)
  (setq block_list '())
  (setq new_search nil)
  (while (setq new_search (tblnext "BLOCK" (not block_list)))
    (if new_search
      (setq block_list (cons (cdr (assoc 2 new_search)) block_list))
    )
  )
  (if block_list 
    (foreach str block_list
      (progn
        (setq i (strlen str))
        (if (> i 10)
	  (progn
            (setq strtmp (substr str 1 10))
	    (if (= "AC_LXY_BLK" (strcase strtmp))
	      (if useri2_count 
		(if (> (atoi (substr str 11)) useri2_count)
		  (setq useri2_count (atoi (substr str 11)))
		)
		(setq useri2_count (atoi (substr str 11)))
	      )
	    )
	  )
        )
      )
    )  
  )
  (if useri2_count
    (setvar "useri2" (+ 1 useri2_count))
    (setvar "useri2" 0)
  )
)
;************************************* End of function *************************************;

;*********************************** Translate real to char ********************************;
(defun RemZeroR(num / temp)
  (cond
    ((= 'REAL (type num))
      (if (equal 0.0 num 0.00001)
        (setq temp "0.0")
        (progn
          (setq temp (rtos num 2 5))
 	  (if (lxy_word temp ".")
            (while (= "0" (substr temp (strlen temp) 1))
	      (setq temp (substr temp 1 (- (strlen temp) 1)))
	    )
          )
	  (if (= "." (substr temp (strlen temp) 1))
	    (setq temp (substr temp 1 (- (strlen temp) 1)))
	  )
        )
      )
    )
    ((= 'INT (type num))
      (setq temp (itoa num))
    )
    ((= 'STR (type num))
      (setq temp (lxy_trim num))
    )
    ((not num) (setq temp ""))
  )
  temp
)
;************************************* End of function *************************************;

;************************************ Convert ASCII Code to Char ***************************;
(defun char(num / Arry1 Arry2)
  (setq Arry1 '("a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t"
		"u" "v" "w" "x" "y" "z"))
  (if (and (>= num 65) (<= num 90))
    (setq temp (strcase (nth (- num 65) Arry1)))
    (if (and (>= num 97) (<= num 126))
      (setq temp (nth (- num 97) Arry1))
      (setq temp nil)
    )
  )
  temp
)
;************************************* End of function *************************************;