;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                                                                   ;;
;;                    程序名稱：自動統計圓角                         ;;
;;                                                                   ;;
;;	              作   者： 藍建仁                               ;;
;;	              時   間： 2003.05.09                           ;;
;;                                                                   ;;
;;*******************************************************************;;
;;歡迎使用!!!!	                                                     ;;
;;	                                                             ;;
;;	                                                             ;;
;;                                                                   ;;
;;	                                                             ;;
;;                                                         統贏資訊  ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;*********************************************主程序************************************
(defun c:Dimr()
  (setq ss (ssget))
  (setq s1 (ssget "p" '((0 . "ARC"))))
  (list_hand)
  (setq r_list '())
  (repeat (sslength s1)
    (if (not (member
	(setq tmp (cdr (assoc 40 (entget (ssname s1 n))))) r_list))
        (setq r_list (append r_list (list tmp))))
    (setq n (1+ n)))
    (setq m 0)
    (setq s 0) 
  (repeat (length r_list)
    (setq arc_num (sslength (ssget "x" (list (cons 40 (nth s r_list))))))
    (setq arc_r (nth s r_list))
    (setq sn (1+ sn))
    (setq s2 (ssget "x" (list (cons 40 (nth s r_list)))))
    (setq m 0)
    (repeat arc_num
      (setq arc_cen (cdr(assoc 10 (entget (ssname s2 m)))))
      (Dim_text)
      (setq m (1+ m)))
    (list_arc)
    (setq s (1+ s)))
    (prin1)
  )

;******************************************子程序-----（表列半徑）*********************
(defun list_arc()
  (setq pt1 pt4 pt5 pt6 pt7 pt8 pt2 pt3)
    (setq pt4 (polar pt1 (* pi 1.5) hh))
    (setq pt6 (polar pt5 (* pi 1.5) hh))
    (setq pt8 (polar pt7 (* pi 1.5) hh))
    (setq pt3 (polar pt2 (* pi 1.5) hh))
    (command "pline" pt2 pt3 pt4 pt1 "")
    (command "line" pt5 pt6 "")
    (command "line" pt7 pt8 "")
    (command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0  (chr sn))
    (command "text" "m" (inters pt5 pt8 pt7 pt6) (/ hh 2) 0 arc_num)
    (command "text" "m" (inters pt7 pt3 pt2 pt8) (/ hh 2) 0  (rtos arc_r 2 2))
  )

;******************************************子程序-----（插入表頭）*********************
(defun list_hand ()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq n 0 r 0)
  (setq sn 64 )
  (setq pt1 (getpoint "\n請輸入列表插入點:"))
  (setq ww (getdist "\n請輸入列表寬度<60>:"))
  (if (null ww ) (setq ww 60.0))
  (setq hh (getdist pt1 "\n請輸入欄高<8>:"))
  (if (null hh ) (setq hh 8.0))
  (setq pt2 (polar pt1 0 ww))
  (setq pt3 (polar pt2 (* pi 1.5) hh))
  (setq pt4 (polar pt1 (* pi 1.5) hh))
  (command "pline" pt1 pt2 pt3 pt4 "c")
  (setq pt5 (polar pt1 0 (/ ww 3)))
  (setq pt6 (polar pt5 (* pi 1.5) hh))
  (setq pt7 (polar pt5 0 (/ ww 3)))
  (setq pt8 (polar pt7 (* pi 1.5) hh))
  (command "line" pt5 pt6 "")
  (command "line" pt7 pt8 "")
  (command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 "符號")
  (command "text" "m" (inters pt5 pt8 pt6 pt7) (/ hh 2) 0 "數量")
  (command "text" "m" (inters pt7 pt3 pt8 pt2) (/ hh 2) 0 "半徑")
  )

;******************************************子程序---（插入文字）*********************
(defun Dim_text ()
  (command "text" "m" arc_cen "" 0 (chr sn))
  )

(defun x ()
  (setq a 0)
  (repeat (sslength ss)
    (setq sbj_name (cdr(assoc 0 (entget(ssname ss a)))))
    (if (= sbj_name "LWPOLYLINE")
      (command "_EXPLODE"  ss ))))
  
(princ "loaded")
(prin1)
