;********以下是子程序部分********
;********改变线型********
(defun cen () (command "linetype" "s" "center" "" "color" 2))
(defun hid () (command "linetype" "s" "hidden" "" "color" 6))
(defun con () (command "linetype" "s" "continuous" "" "color" 4))
(defun con1 () (command "linetype" "s" "continuous" "" "color" 131))
(defun din () (command "linetype" "s" "continuous" "" "color" 2))
;********加中心线********
(defun CEN_L ()
   (setq CN_L (entget (entlast)))
   (cen)(command "line" (polar (cdr (assoc 10 CN_L)) (/ pi 2) 
			(+ (cdr (assoc 40 CN_L)) (/ (cdr (assoc 40 CN_L)) 8)))
			(polar (cdr (assoc 10 CN_L)) (/ pi -2) 
			(+ (cdr (assoc 40 CN_L)) (/ (cdr (assoc 40 CN_L)) 8))) ""
		 "line" (polar (cdr (assoc 10 CN_L)) 0
		        (+ (cdr (assoc 40 CN_L)) (/ (cdr (assoc 40 CN_L)) 8))) 
		        (polar (cdr (assoc 10 CN_L)) (* pi -1) 
			(+ (cdr (assoc 40 CN_L)) (/ (cdr (assoc 40 CN_L)) 8))) ""))
;********标注圆的X轴的坐标尺寸********
(defun ORD_X (plw pl CN_L / L_ORD)
   (setq X_X (nth 1 (assoc 10 CN_L))
         Y_Y (nth 2 (assoc 10 CN_L)))
 (if (< Y_Y 0)
   (setq X_X_Y -1)
   (setq X_X_Y 1))
   (setq L_ORD (/ plw (* 2 X_X_Y)))
   (din)(command "dim" "ordinate" (list X_X (+ Y_Y (* (cdr (assoc 40 CN_L)) X_X_Y)))
                                  (list X_X (+ L_ORD (* pl 0.02 X_X_Y))) "" "e"))
;********标注圆的Y轴的坐标尺寸********
(defun ORD_y (CN_L pl / W_ORD)
   (setq X_X_X (nth 1 (assoc 10 CN_L))
         Y_Y_Y (nth 2 (assoc 10 CN_L)))
(if (< X_X_X 0)
   (setq Y_Y_X -1)
   (setq Y_Y_X 1))
   (setq W_ORD (/ pl (* 2 Y_Y_X)))   
   (din)(command "dim" "ordinate" (list (+ X_X_X (* (cdr (assoc 40 CN_L)) Y_Y_X)) Y_Y_Y)
                                  (list	(+ W_ORD (* pl 0.02 Y_Y_X)) Y_Y_Y) "" "e"))
;********以下是非标准模胚的规格的主程序********
(defun c:ord (/ olderr ocm oco obl pl pw p1 p2 p3 p4 p5 p6 p7 p8 p10 p20 p30 p40 p60 p80
        sogp  DO_P FO_P TYPE_P P_O_I IH_T I_D CN_L  GP_D SP_D C_RAD1 S_RAD1 c_RAD2 m_c_rad
        sandp R_RAD1 R_RAD2 C1 C2 C3 C4 C10 C20 C30 C40 C_POT1 C_POT2 C_POT3 C_POT4 TOP1 TOP2
        lp1 lp2 lp3 lp4 lp5 lp6 po1 po2 po3 po4 po5 po6 po7 po8 po9 po10 po11 po12 po13 
        po14 po15 po17 po18 po19 po20 po21 po22 po23 po24 po25 po26 po27 po28 po29 po30
        po31 po32 po33 po34 po35 po36 po37 po38 ang1 ang2 pw1 lp7 lp8 lp9 lx1 ly1 L_W 
        th1 th2 ll1 lw1 aa bb po03 po04 p032 s_y gp m_c_rad  rp spbl bsw bsw_e
        ep1 ep2 ep3 ep4 ep10 ep20 ep30 ep40 rpc1 rpc2 rpc3 rpc4 pock_rr pock_ah pock_bh pock_h
        scrwb scrwe scrws scw_d1 scw_d2 scrw_c scrwb_n scrwe_n scrw_c scrw_cx scrw_cy a_yn
        swc1 swc2 swc3 swc4 swc5 swc6 swc7 swc8 swc9 swc10    p023 p013 p015 p016 otxt oset
        src1 src2 src3 src4 src5 src6 src7 src8 src9 src10    po47 work_1 ss olup ozin )
  (setq ocm (getvar "cmdecho")
	obl (getvar "blipmode")
	oco (getvar "cecolor")
        otxt (getvar "textstyle")  
        ozin (getvar "dimzin")     olup (getvar "luprec")
	olderr *ERROR*
	*error* ai_abort )
  (setvar "cmdecho" 0)    (command "_.UNDO" "_GROUP")    (setvar "blipmode" 0) 
  (setvar "dimzin" 8) (setvar "luprec" 4)
  (setq ono (getstring "\n请输入订单号: "))
  (initget 1)
  (setq  pw (getreal "\n请输入板的长度： "))
  (initget 1)
  (setq pl (getreal "\n请输入板的宽度: "))
  (initget 1 "S s P p ")
  (setq TYPE_P (getkword "\n请选择模胚类型:大水口系统 S/细水口系统 P?<S/P>:"))
  (if (= TYPE_P "P")
      (progn
      (initget 1 "I i O o")
      (setq P_O_I (getkword "\n请选择水口边的位置:在内 I?/在外 O?<I/O>?"))))
  (initget 1 "I i H h")
  (setq IH_T (getkword "\n请选择模型:工字模I/直身模H?<I/H>:"))
  (if (= IH_T "I")
      (progn
        (initget 1)
        (setq I_D (getreal "\n请输入工字模单边缩进值："))
        (setq plw (+ pw (* I_D 2)))
      )
        (setq plw pw) )
  (load "c:/Autolisp/setgp.LSP") (setgp pl)
  (setq gp (getreal (strcat "\n请输入直钉规格<" (rtos sogp) ">:")))
  (if (/= gp nil) (setq sogp gp))
  (initget "S s Y y ")
  (setq s_y (getkword "\n请选择直钉位置：直钉在B板S/直钉在A板Y<S/Y>?<S>:"))
  (if (= s_y nil) (setq s_y "S"))
  (initget 1)
  (setq spbl (getreal "\n请输入凳仔宽度"))
  (setq woep_p (- pw (* 2 spbl) 4))
  (setq woep (getreal (strcat "\n请输入针板宽度<" (rtos woep_p) ">:")))
  (if (= woep nil) (setq woep woep_p))
  (setq rp (getreal (strcat "\n请输入回针规格<" (rtos sandp) ">:")))
  (if (/= rp nil) (setq sandp rp))
  (initget 1)
  (setq scrwb (getreal "\n请输入锁B板杯头螺丝大小:") )
  (if (> pl 300) (setq scrwb_n_ 6)
                 (setq scrwb_n_ 4)  )
  (setq scrwb_n (getint (strcat "\n请确定锁B板杯头螺丝数量<" (rtos scrwb_n_) ">:") ) )
  (if (= scrwb_n nil) (setq scrwb_n scrwb_n_) )
  (if (= TYPE_P "S")
    (progn
    (initget "Y y N n")
    (setq a_yn (getkword "\n请确定A板是否画杯头螺丝<Y>:") )
    (if (= a_yn nil) (setq a_yn "Y") )   ) )
  (initget 1)
  (setq scrws (getreal "\n请输入锁凳仔杯头螺丝大小:") )
  (initget 1)
  (setq scrwe (getreal "\n请输入锁针板杯头螺丝大小:"))
  (setq scrwe_n (getint (strcat "\n请确定锁针板杯头螺丝数量<" (rtos scrwb_n_) ">:") ) )
  (if (= scrwe_n nil) (setq scrwe_n scrwb_n_) )
  (setrp sandp sogp scrwb scrwe)
  (setq APD (getstring "\n请输入A板板厚:"))
  (setq BPD (getstring "\n请输入B板板厚:"))
  (setq p1 (list (/ pl -2)  (/ pw -2))            p10 (list (car p1)  (/ plw -2)) 
	p2 (list (car p1) (* -1 (cadr p1)))       p20 (list (car p1) (* -1 (cadr p10)))
	p3 (list (/ pl 2) (/ pw 2))               p30 (list (/ pl 2) (/ plw 2))  
	p4 (list (car p3) (cadr p1))              p40 (list (car p3) (cadr p10))  
	p5 (list (- (car p1) (/ pl 100)) 0)      
	p6 (list 0 (+ (cadr p2) (/ pl 100)))      p60 (list 0 (+ (cadr p20) (/ pl 100)))
	p7 (list (* -1 (car p5)) 0)            
	p8 (list 0 (* -1 (cadr p6)))              p80 (list 0 (* -1 (cadr p60)))
	pw1 (* (/ 0.5 317) 0.6 plw))
 
  (setq oxr (open "c:/data.dat" "w"))
  (princ (strcat "(" (rtos pl) " " (rtos plw) " )\n") oxr)
  (close oxr)

;********以下是上模部分********
  (command "layer" "n" "A" "")
  (command "clayer" "A")
  (con)
  (if (= IH_T "I") 
      (progn 
	(command "line" p10 p20 p30 p40 "c" "line" p1 p4 "" "line" p2 p3 "")
	(cen)(command "line" p5 p7 "" "line" p60 p80 "")))
  (if (= IH_T "H")      
      (progn
      (command "line" p1 p2 p3 p4 "c")
      (cen)(command "line" p5 p7 "" "line" p6 p8 "")))
  (command "dimscale" (/ pl 12) "ltscale" (/ pl 15))
  (if (= IH_T "I")
     (progn
     (din)(command "dim"
	  "ordinate" p10 (polar p10 pi (* pl 0.02)) ""
	  "ordinate" p20 (polar p20 (/ pi 2) (* pl 0.02)) ""
	  "ordinate" p30 (polar p30 (/ pi 2) (* pl 0.02)) ""
	  "ordinate" p20 (polar p20 pi (* pl 0.02)) ""
	  "ordinate" p60 (polar p60 (/ pi 2) (* pl 0.02)) "")))
  (if (= IH_T "H")
     (progn
     (din)(command "dim"
	  "ordinate" p2 (polar p2 (/ pi 2) (* pl 0.02)) ""
	  "ordinate" p3 (polar p3 (/ pi 2) (* pl 0.02)) ""
	  "ordinate" p6 (polar p6 (/ pi 2) (* pl 0.02)) "")))
 (command "ordinate" p2 (polar p2 pi (* pl 0.02)) ""
	  "ordinate" p1 (polar p1 pi (* pl 0.02)) ""
	  "ordinate" p5 (polar p5 pi (* pl 0.02)) "" "e")
  
;*******以下是作钉司部分*********
  (setq FO_P (open "c:/Autolisp/gpin.dat" "r")
	GATE 0)
  (while (/= SOGP GATE )
	 (setq GATE (atof (read-line FO_P))
	       DO_P (read (read-line FO_P))))
  (close FO_P)
  (setq GP_D (car DO_P))
  (setq C_RAD1 (cadr DO_P) C_RAD2 (caddr DO_P))
  (setq SP_D (nth 3 DO_P) S_RAD1 (nth 4 DO_P))
  (if (= TYPE_P "P")
    (progn  
     (if (and (= scrwb "M14") (= sogp 20)) (setq SP_D 56))
     (if (and (= scrwb "M16") (= sogp 30)) (setq SP_D 70))
    )
  )
  (setq c1 (list (+ (car p1) GP_D) (+ (last p1) GP_D))
       c10 (list (+ (car c1) SP_D) (last c1)) 
	c2 (list (+ (car p2) GP_D 2) (- (last p2) GP_D)) 
       c20 (list (+ (car c2) SP_D) (last c2))
	c3 (list (- (car p3) GP_D) (- (last p3) GP_D))
       c30 (list (- (car c3) SP_D) (last c3))
	c4 (list (- (car p4) GP_D) (+ (last p4) GP_D))
       c40 (list (- (car c4) SP_D) (last c4)) )

  (if (= TYPE_P "P")
      (progn
        (if (= P_O_I "O")
          (setq C_POT1 c1 c1 c10 c10 C_POT1
	        C_POT2 c2 c2 c20 c20 C_POT2
	        C_POT3 c3 c3 c30 c30 C_POT3
	        C_POT4 c4 c4 c40 c40 C_POT4)
        )
        (setq cc10 (list (+ (car c10) C_RAD1) (cadr c10))
              cc20 (list (+ (car c20) C_RAD1) (cadr c20))
              cc30 (list (+ (car c30) C_RAD1) (cadr c30))
              cc40 (list (+ (car c40) C_RAD1) (cadr c40))
        )
        (con)(command "circle" c10 C_RAD1) (CEN_L)(ORD_X plw pl CN_L)
        (con)(command "circle" c20 C_RAD1) (CEN_L)(ORD_X plw pl CN_L)
        (con)(command "circle" c30 C_RAD1) (CEN_L)(ORD_X plw pl CN_L)
        (con)(command "circle" c40 C_RAD1) (CEN_L)(ORD_X plw pl CN_L)
        (din) 
        (if (< sogp 5) 
            (if (and (< sogp 2) (> sogp 1)) 
                (command "dim" "leader" (polar c20 (/ pi -3) C_RAD1) 
                         (polar c20 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 
                         (polar (polar c20 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 0 (* pl 0.02))
                         "" (strcat "%%c1-" (rtos (- SOGP 1) 4) "水口边") "e")
                (command "dim" "leader" (polar c20 (/ pi -3) C_RAD1) 
                         (polar c20 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 
                         (polar (polar c20 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 0 (* pl 0.02))
                         "" (strcat "%%c" (rtos SOGP 4) "水口边") "e")
             )
             (command "dim" "leader" (polar c20 (/ pi -3) C_RAD1) 
                         (polar c20 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 
                         (polar (polar c20 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 0 (* pl 0.02))
                         "" (strcat "%%c" (rtos SOGP) "水口边") "e")
        )
      )
  )

  (if (= s_y "Y") (setq m_c_rad c_rad1 c_rad1 c_rad2 c_rad2 m_c_rad))
  (hid)(command "circle" c1 c_rad1) (CEN_L)(ORD_X plw pl CN_L)(ORD_Y CN_L pl)
  (hid)(command "circle" c2 c_rad1) (CEN_L)(ORD_X plw pl CN_L)(ORD_Y CN_L pl)
  (hid)(command "circle" c3 c_rad1) (CEN_L)(ORD_X plw pl CN_L)
  (hid)(command "circle" c4 c_rad1) (CEN_L)(ORD_X plw pl CN_L)
  (din)(if (< sogp 5)
          (if (and (< sogp 2) (> sogp 1)) 
            (command "dim" "leader" (polar c2 (/ pi -3) C_RAD1) 
                               (polar c2 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 
                              (polar (polar c2 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 0 (* pl 0.02)) 
                               "" (strcat "%%c1-" (rtos (- SOGP 1) 4)) "e")
            (command "dim" "leader" (polar c2 (/ pi -3) C_RAD1) 
                               (polar c2 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 
                              (polar (polar c2 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 0 (* pl 0.02)) 
                               "" (strcat "%%c" (rtos SOGP 4)) "e")
          )
          (command "dim" "leader" (polar c2 (/ pi -3) C_RAD1) 
                               (polar c2 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 
                              (polar (polar c2 (/ pi -3) (+ C_RAD1 (* pl 0.05))) 0 (* pl 0.02)) 
                               "" (strcat "%%c" (rtos SOGP)) "e")
       )
  (command "text" (list (+ (car p2) (/ pw 120)) 
                                 (- (cadr p2) (/ pl 120))) (/ pl 70) "270" "DATUM")
;*****以下是上模杯头部分******
  (setq FO_P (open "c:/Autolisp/gpin.dat" "r")
	GATE 0)
  (while (/= scrwb GATE )
	 (setq GATE (atof (read-line FO_P))
	       DO_P (read (read-line FO_P))))
 (close FO_P)
 (setq scw_d2 (* (nth 8 DO_P) 2))
 (if (< scrwb 2) (setq scrwb_d (* scrwb 25.4)) (setq scrwb_d scrwb))
 (if (and (= TYPE_P "S")(= s_y "S"))
     (setq scrw_cx (fix (+ gp_d c_rad1 (/ scrwb_d 2) 10))
           scrw_cy gp_d) )
 (if (and (= TYPE_P "S")(= s_y "Y"))
     (setq scrw_cx (fix (+ gp_d c_rad2 (/ scrwb_d 2) 10))
           scrw_cy gp_d)
 )
 (setq swc1 (list (+ (/ pl -2) scrw_cx) (+ (/ pw -2) scrw_cy))
       swc2 (list (car swc1) (* (cadr swc1) -1))
       swc3 (list (* (car swc2) -1) (cadr swc2))
       swc4 (list (car swc3) (cadr swc1))   )
 (if (= scrwb_n 6)
     (setq swc5 (list 0 (cadr swc1))
           swc6 (list 0 (cadr swc2))  )  )
 (if (= scrwb_n 8)
     (setq swc7 (list (fix (/ (- (car swc4) (car swc1)) -6)) (cadr swc1))
           swc8 (list (car swc7) (cadr swc2))
           swc9 (list (* (car swc8) -1) (cadr swc8))
           swc10 (list (car swc9) (cadr swc7))  ) )
 (if (= scrwb_n 10)
     (setq swc5 (list 0 (cadr swc1))
           swc6 (list 0 (cadr swc2)) 
           swc7 (list (fix (/ (car swc1) 2)) (cadr swc1))
           swc8 (list (car swc7) (cadr swc2))
           swc9 (list (* (car swc8) -1) (cadr swc8))
           swc10 (list (car swc9) (cadr swc7)) )  )
 (if (= a_yn "Y")
    (progn
     (hid)(command "circle" swc3 "d" scw_d2 "arc" "c" swc3 (polar swc3 0 (/ scrwb_d 2)) "a" 270) 
     (CEN_L) (ORD_Y CN_L pl)
     (hid)(command "circle" swc2 "d" scw_d2 "arc" "c" swc2 (polar swc2 0 (/ scrwb_d 2)) "a" 270) 
     (CEN_L) 
     (hid)(command "circle" swc1 "d" scw_d2 "arc" "c" swc1 (polar swc1 0 (/ scrwb_d 2)) "a" 270) 
     (CEN_L) (ORD_X plw pl CN_L)
     (hid)(command "circle" swc4 "d" scw_d2 "arc" "c" swc4 (polar swc4 0 (/ scrwb_d 2)) "a" 270) 
     (CEN_L) (ORD_X plw pl CN_L) (ORD_Y CN_L pl)
     (if (< scrwb 2)
       (command "dim" "leader" (polar swc3 (* pi -0.75) (/ scrwb_d 2))
                   (polar swc3 (* pi -0.75) (* scrwb_d 2.5)) 
            (polar (polar swc3 (* pi -0.75) (* scrwb_d 2.5)) pi (* pl 0.02)) "" 
                   (strcat "%%c" (rtos scrwb 4) "杯头孔(" (itoa scrwb_n) "X)") "e")
       (command "dim" "leader" (polar swc3 (* pi -0.75) (/ scrwb_d 2))
                     (polar swc3 (* pi -0.75) (* scrwb_d 2.5))
              (polar (polar swc3 (* pi -0.75) (* scrwb_d 2.5)) pi (* pl 0.02)) ""   
                     (strcat "M" (rtos scrwb) "(" (itoa scrwb_n) "X)") "e") )
     (if (or (= scrwb_n 6)(= scrwb_n 10))
       (progn
        (hid)(command "circle" swc5 "d" scw_d2 "arc" "c" swc5 (polar swc5 0 (/ scrwb_d 2)) "a" 270) 
        (CEN_L) 
        (hid)(command "circle" swc6 "d" scw_d2 "arc" "c" swc6 (polar swc6 0 (/ scrwb_d 2)) "a" 270) 
        (CEN_L)   )   )
     (if (or (= scrwb_n 8)(= scrwb_n 10))
       (progn 
         (hid)(command "circle" swc8 "d" scw_d2 "arc" "c" swc8 (polar swc8 0 (/ scrwb_d 2)) "a" 270) 
         (CEN_L) 
         (hid)(command "circle" swc9 "d" scw_d2 "arc" "c" swc9 (polar swc9 0 (/ scrwb_d 2)) "a" 270) 
         (CEN_L) 
         (hid)(command "circle" swc7 "d" scw_d2 "arc" "c" swc7 (polar swc7 0 (/ scrwb_d 2)) "a" 270) 
         (CEN_L) (ORD_X plw pl CN_L)
         (hid)(command "circle" swc10 "d" scw_d2 "arc" "c" swc10 (polar swc10 0 (/ scrwb_d 2)) "a" 270) 
         (CEN_L) (ORD_X plw pl CN_L)    )   )
  )   )

;********以下是作下模部分***********
  (command "layer" "n" "B" 
	   "s" "B" "f" "A" "")
  (if (= IH_T "I") 
      (progn 
	(con)(command "line" p10 p20 p30 p40 "c" "line" p1 p4 "" "line" p2 p3 "")
	(cen)(command "line" p5 p7 "" "line" p60 p80 "")))
  (if (= IH_T "H")      
      (progn
      (con)(command "line" p1 p2 p3 p4 "c")
      (cen)(command "line" p5 p7 "" "line" p6 p8 "")))
   (if (= IH_T "I")
     (progn
     (din)(command "dim"
	  "ordinate" p10 (polar p10 pi (* pl 0.02)) ""
	  "ordinate" p20 (polar p20 (/ pi 2) (* pl 0.02)) ""
	  "ordinate" p30 (polar p30 (/ pi 2) (* pl 0.02)) ""
	  "ordinate" p20 (polar p20 pi (* pl 0.02)) ""
	  "ordinate" p60 (polar p60 (/ pi 2) (* pl 0.02)) "")))
 (if (= IH_T "H")
     (progn
(din)(command "dim" "ordinate" p2 (polar p2 (/ pi 2) (* pl 0.02)) ""
		    "ordinate" p3 (polar p3 (/ pi 2) (* pl 0.02)) ""
		    "ordinate" p6 (polar p6 (/ pi 2) (* pl 0.02)) "")))
	   (command "ordinate" p2 (polar p2 pi (* pl 0.02)) ""
		    "ordinate" p1 (polar p1 pi (* pl 0.02)) ""
		    "ordinate" p5 (polar p5 pi (* pl 0.02)) "" "e")
  
;*******以下是下模钉司部分*********
 (setq c1 (list (+ (car p1) GP_D) (+ (last p1) GP_D))
      c10 (list (+ (car c1) SP_D) (last c1))
       c2 (list (+ (car p2) GP_D) (- (last p2) GP_D))
      c20 (list (+ (car c2) SP_D) (last c2)) 
       c3 (list (- (car p3) GP_D 2) (- (last p3) GP_D))
      c30 (list (- (car c3) SP_D) (last c3)) 
       c4 (list (- (car p4) GP_D) (+ (last p4) GP_D))
      c40 (list (- (car c4) SP_D) (last c4)))
  (if (= TYPE_P "P")
      (progn
  (if (= P_O_I "O")
  (setq C_POT1 c1 c1 c10 c10 C_POT1
	C_POT2 c2 c2 c20 c20 C_POT2
	C_POT3 c3 c3 c30 c30 C_POT3
	C_POT4 c4 c4 c40 c40 C_POT4))
  (setq cc10 (list (+ (car c10) S_RAD1) (cadr c10))
        cc20 (list (+ (car c20) S_RAD1) (cadr c20))
        cc30 (list (+ (car c30) S_RAD1) (cadr c30))
        cc40 (list (+ (car c40) S_RAD1) (cadr c40)))
  (con)(command "circle" c10 S_RAD1) (CEN_L)(ORD_X plw pl CN_L)
  (con)(command "circle" c20 S_RAD1) (CEN_L)(ORD_X plw pl CN_L)
  (con)(command "circle" c30 S_RAD1) (CEN_L)(ORD_X plw pl CN_L)
  (con)(command "circle" c40 S_RAD1) (CEN_L)(ORD_X plw pl CN_L)
  (con)(command "pline" cc10 "w" (* pw1 0.95) "" "a" "a" "180" "c" c10 cc10 ""
		"pline" cc20 "w" (* pw1 0.95) "" "a" "a" "180" "c" c20 cc20 ""
		"pline" cc30 "w" (* pw1 0.95) "" "a" "a" "180" "c" c30 cc30 ""
		"pline" cc40 "w" (* pw1 0.95) "" "a" "a" "180" "c" c40 cc40 "")
  (din)(if (< sogp 5)
         (if (and (< sogp 2) (> sogp 1))
           (command "dim" "leader" (polar c20 (/ pi -3) S_RAD1) 
		 	 (polar c20 (/ pi -3) (+ S_RAD1 (* pl 0.08))) 
			 (polar (polar c20 (/ pi -3) (+ S_RAD1 (* pl 0.08))) 0 
			 (* pl 0.02)) "" (strcat "%%c1-" (rtos (- SOGP 1) 4) "水口边避空吼") "e")
           (command "dim" "leader" (polar c20 (/ pi -3) S_RAD1) 
		 	 (polar c20 (/ pi -3) (+ S_RAD1 (* pl 0.08))) 
			 (polar (polar c20 (/ pi -3) (+ S_RAD1 (* pl 0.08))) 0 
			 (* pl 0.02)) "" (strcat "%%c" (rtos SOGP 4) "水口边避空吼") "e")
         )
         (command "dim" "leader" (polar c20 (/ pi -3) S_RAD1) 
		 	 (polar c20 (/ pi -3) (+ S_RAD1 (* pl 0.08))) 
			 (polar (polar c20 (/ pi -3) (+ S_RAD1 (* pl 0.08))) 0 
			 (* pl 0.02)) "" (strcat "%%c" (rtos SOGP) "水口边避空吼") "e")
       )
     )
 )
 (hid)(command "circle" c1 C_RAD2) (CEN_L)(ORD_X plw pl CN_L)(ORD_Y CN_L pl)
 (hid)(command "circle" c2 C_RAD2) (CEN_L)(ORD_X plw pl CN_L)(ORD_Y CN_L pl)
 (hid)(command "circle" c3 C_RAD2) (CEN_L)(ORD_X plw pl CN_L)
 (hid)(command "circle" c4 C_RAD2) (CEN_L)(ORD_X plw pl CN_L)
   (if (< sogp 5)
      (if (and (< sogp 2) (> sogp 1))
        (command "dim" "leader" (polar c2 (/ pi -3) C_RAD2) 
			     (polar c2 (/ pi -3) (+ C_RAD2 (* pl 0.08))) 
			     (polar (polar c2 (/ pi -3) (+ C_RAD2 (* pl 0.08))) 0 (* pl 0.02))
			     "" (strcat "%%c1-" (rtos (- SOGP 1) 4)) "e") 
        (command "dim" "leader" (polar c2 (/ pi -3) C_RAD2) 
			     (polar c2 (/ pi -3) (+ C_RAD2 (* pl 0.08))) 
			     (polar (polar c2 (/ pi -3) (+ C_RAD2 (* pl 0.08))) 0 (* pl 0.02))
			     "" (strcat "%%c" (rtos SOGP 4)) "e")
      ) 
      (command "dim" "leader" (polar c2 (/ pi -3) C_RAD2) 
			     (polar c2 (/ pi -3) (+ C_RAD2 (* pl 0.08))) 
			     (polar (polar c2 (/ pi -3) (+ C_RAD2 (* pl 0.08))) 0 (* pl 0.02))
			     "" (strcat "%%c" (rtos SOGP)) "e")
   )
 (command "text" (list (- (car p3) (/ pw 35)) (- (cadr p3) (/ pl 120))) (/ pl 70) "270" "DATUM")
;******以下是下模针板部分*******
(setq ep1 (list (/ pl -2) (/ woep -2))        ep10 (list (car ep1) (* (- (/ pw 2) spbl) -1))
      ep2 (list (car ep1) (/ woep 2))         ep20 (list (car ep2) (- (/ pw 2) spbl))
      ep3 (list (/ pl 2) (cadr ep2))          ep30 (list (car ep3) (cadr ep20))
      ep4 (list (car ep3) (cadr ep1))         ep40 (list (car ep4) (cadr ep10))
)
(hid)(command "line" ep2 ep3  "" "line" ep20 ep30 ""
              "line" ep1 ep4  "" "line" ep10 ep40 "")
(din)(command "dim" "ordinate" ep3 (polar ep3 0 (* pl 0.015)) ""
                    "ordinate" ep20 (polar ep20 (* pi -1) (* pl 0.02)) "" 
                    "ordinate" ep4 (polar ep4 0 (* pl 0.015)) "" 
                    "ordinate" ep10 (polar ep10 (* pi -1) (* pl 0.02)) "" "e")
;*****以下是下模回针部分*******
(setq FO_D (open "c:/Autolisp/gpin.dat" "r")
	GATE 0)
  (while (/= SANDP GATE )
	 (setq GATE (atof (read-line FO_D))
	       RP_P (read (read-line FO_D))))
(close FO_D)
(setq R_RAD1 (nth 6 RP_P)   R_RAD2 (nth 5 RP_P))
     (if (and (= scrwe 8)(= sandp 12)) (setq rpd_x 21 rpd_y 20))
     (if (and (= scrwe 10)(= sandp 20)) (setq rpd_x 30 rpd_y 22))
     (if (and (= scrwe 12)(= sandp 25)) (setq rpd_x 30 rpd_y 30))
(setq rpc1 (list (- (/ pl 2) rpd_x) (- (/ woep 2) rpd_y))
      rpc2 (list (+ (/ pl -2) rpd_x) (cadr rpc1))
      rpc3 (list (car rpc1) (+ (/ woep -2) rpd_y))
      rpc4 (list (car rpc2) (cadr rpc3))  )
(setq rp1 (list (+ (car rpc1) R_RAD2) (cadr rpc1))
      rp2 (list (+ (car rpc2) R_RAD2) (cadr rpc2))
      rp3 (list (+ (car rpc3) R_RAD2) (cadr rpc3))
      rp4 (list (+ (car rpc4) R_RAD2) (cadr rpc4))   )
(hid)(command "circle" rpc1 R_RAD1) (CEN_L) (ORD_X plw pl CN_L)
(hid)(command "circle" rpc2 R_RAD1) (CEN_L) (ORD_X plw pl CN_L) (ORD_Y CN_L pl)
(hid)(command "circle" rpc3 R_RAD1) (CEN_L)
(hid)(command "circle" rpc4 R_RAD1) (CEN_L) (ORD_Y CN_L pl)
(con)(command "circle" rpc1 R_RAD2
	      "circle" rpc2 ""
	      "circle" rpc3 ""
	      "circle" rpc4 ""
	      "pline" rp1 "w" (* pw1 0.95) "" "a" "a" "180" "c" rpc1 rp1 ""
	      "pline" rp2 "w" (* pw1 0.95) "" "a" "a" "180" "c" rpc2 rp2 ""
	      "pline" rp3 "w" (* pw1 0.95) "" "a" "a" "180" "c" rpc3 rp3 ""
	      "pline" rp4 "w" (* pw1 0.95) "" "a" "a" "180" "c" rpc4 rp4 "")
(con)(command "solid" (polar rpc1 (/ pi 2) R_RAD2) 
		      (polar rpc1 pi R_RAD2) 
		      (polar rpc1 (/ pi -2) R_RAD2) 
		      (polar rpc1 0 R_RAD2) ""
	      "solid" (polar rpc2 (/ pi 2) R_RAD2) 
		      (polar rpc2 pi R_RAD2) 
		      (polar rpc2 (/ pi -2) R_RAD2) 
		      (polar rpc2 0 R_RAD2) ""
	      "solid" (polar rpc3 (/ pi 2) R_RAD2)
		      (polar rpc3 pi R_RAD2) 
		      (polar rpc3 (/ pi -2) R_RAD2) 
		      (polar rpc3 0 R_RAD2) ""
	      "solid" (polar rpc4 (/ pi 2) R_RAD2) 
		      (polar rpc4 pi R_RAD2)
		      (polar rpc4 (/ pi -2) R_RAD2)
		      (polar rpc4 0 R_RAD2) "")
(din)(if (< sandp 5)
        (if (and (< sandp 2) (> sandp 1))
          (command "dim" "leader" (polar rpc2 (/ pi -3) R_RAD1) 
		          (polar rpc2 (/ pi -3) (+ R_RAD1 (* pl 0.05))) 
		          (polar (polar rpc2 (/ pi -3) (+ R_RAD1 (* pl 0.05))) 0 (* pl 0.02))
		       "" (strcat "%%c1-" (rtos (- SANDP 1) 4) "回针") "e")
          (command "dim" "leader" (polar rpc2 (/ pi -3) R_RAD1) 
		          (polar rpc2 (/ pi -3) (+ R_RAD1 (* pl 0.05))) 
		          (polar (polar rpc2 (/ pi -3) (+ R_RAD1 (* pl 0.05))) 0 (* pl 0.02))
		       "" (strcat "%%c" (rtos SANDP 4) "回针") "e")
        )
        (command "dim" "leader" (polar rpc2 (/ pi -3) R_RAD1) 
		          (polar rpc2 (/ pi -3) (+ R_RAD1 (* pl 0.05))) 
		          (polar (polar rpc2 (/ pi -3) (+ R_RAD1 (* pl 0.05))) 0 (* pl 0.02))
		       "" (strcat "%%c" (rtos SANDP) "回针") "e")
      )
;*****以下是下模杯头部分******
   (hid)(command "circle" swc3 "d" scw_d2 "arc" "c" swc3 (polar swc3 0 (/ scrwb_d 2)) "a" 270) 
   (CEN_L) (ORD_Y CN_L pl)
   (hid)(command "circle" swc2 "d" scw_d2 "arc" "c" swc2 (polar swc2 0 (/ scrwb_d 2)) "a" 270) 
   (CEN_L) 
   (hid)(command "circle" swc4 "d" scw_d2 "arc" "c" swc4 (polar swc4 0 (/ scrwb_d 2)) "a" 270) 
   (CEN_L) (ORD_X plw pl CN_L) (ORD_Y CN_L pl)
   (hid)(command "circle" swc1 "d" scw_d2 "arc" "c" swc1 (polar swc1 0 (/ scrwb_d 2)) "a" 270) 
   (CEN_L) (ORD_X plw pl CN_L)
   (if (< scrwb 2)
     (command "dim" "leader" (polar swc3 (* pi -0.75) (/ scrwb_d 2))
                   (polar swc3 (* pi -0.75) (* scrwb_d 2.5)) 
            (polar (polar swc3 (* pi -0.75) (* scrwb_d 2.5)) pi (* pl 0.02)) ""  
                   (strcat "%%c" (rtos scrwb 4) "杯头孔(" (itoa scrwb_n) "X)") "e")
     (command "dim" "leader" (polar swc3 (* pi -0.75) (/ scrwb_d 2))
                   (polar swc3 (* pi -0.75) (* scrwb_d 2.5))
            (polar (polar swc3 (* pi -0.75) (* scrwb_d 2.5)) pi (* pl 0.02)) ""   
                   (strcat "M" (rtos scrwb) "(" (itoa scrwb_n) "X)") "e") )
   (if (or (= scrwb_n 6)(= scrwb_n 10)) 
     (progn
      (hid)(command "circle" swc5 "d" scw_d2 "arc" "c" swc5 (polar swc5 0 (/ scrwb_d 2)) "a" 270) 
      (CEN_L) 
      (hid)(command "circle" swc6 "d" scw_d2 "arc" "c" swc6 (polar swc6 0 (/ scrwb_d 2)) "a" 270) 
      (CEN_L)    )  )
   (if (or (= scrwb_n 8)(= scrwb_n 10))
     (progn 
       (hid)(command "circle" swc8 "d" scw_d2 "arc" "c" swc8 (polar swc8 0 (/ scrwb_d 2)) "a" 270) 
       (CEN_L) 
       (hid)(command "circle" swc9 "d" scw_d2 "arc" "c" swc9 (polar swc9 0 (/ scrwb_d 2)) "a" 270) 
       (CEN_L) 
       (hid)(command "circle" swc7 "d" scw_d2 "arc" "c" swc7 (polar swc7 0 (/ scrwb_d 2)) "a" 270) 
       (CEN_L)(ORD_X plw pl CN_L) 
       (hid)(command "circle" swc10 "d" scw_d2 "arc" "c" swc10 (polar swc10 0 (/ scrwb_d 2)) "a" 270) 
       (CEN_L)(ORD_X plw pl CN_L)   )  )
;******以下是凳仔杯头******
  (setq FO_P (open "c:/Autolisp/gpin.dat" "r")
	GATE 0)
  (while (/= scrws GATE )
	 (setq GATE (atof (read-line FO_P))
	       DO_P (read (read-line FO_P))))
  (close FO_P)
  (setq scw_d2 (* (nth 8 DO_P) 2))
  (if (< scrws 2) (setq scrws_d (* scrws 25.4)) (setq scrws_d scrws))
  (setq c3a (list (+ 2 (car c3)) (cadr c3)))
  (hid)(command "circle" c3a "d" scw_d2 "arc" "c" c3a (polar c3a 0 (/ scrws_d 2)) "a" 270) 
  (CEN_L) ;(ORD_X plw pl CN_L)
  (hid)(command "circle" c2 "d" scw_d2 "arc" "c" c2 (polar c2 0 (/ scrws_d 2)) "a" 270) 
  (CEN_L)
  (hid)(command "circle" c1 "d" scw_d2 "arc" "c" c1 (polar c1 0 (/ scrws_d 2)) "a" 270) 
  (CEN_L)
  (hid)(command "circle" c4 "d" scw_d2 "arc" "c" c4 (polar c4 0 (/ scrws_d 2)) "a" 270) 
  (CEN_L)
  (if (< scrws 2)
   (command "dim" "leader" (polar c4 (* pi 0.75) (/ scrws_d 2))
                   (polar c4 (* pi 0.75) (* scrws_d 2.5)) 
            (polar (polar c4 (* pi 0.75) (* scrws_d 2.5)) pi (* pl 0.02)) "" 
                   (strcat "%%c" (rtos scrws 4) "杯头孔(4X)") "e")
   (command "dim" "leader" (polar c4 (* pi 0.75) (/ scrws_d 2))
                   (polar c4 (* pi 0.75) (* scrws_d 2.5))  
            (polar (polar c4 (* pi 0.75) (* scrws_d 2.5)) pi (* pl 0.02)) "" 
                   (strcat "M" (rtos scrws) "(4X)") "e")     )
;******以下是针板杯头******
  (setq FO_P (open "c:/Autolisp/gpin.dat" "r")
	GATE 0)
  (while (/= scrwe GATE )
	 (setq GATE (atof (read-line FO_P))
	       DO_P (read (read-line FO_P))))
  (close FO_P)
  (setq scw_d2 (* (nth 8 DO_P) 2))
  (if (< scrwe 2) (setq scrwe_d (* scrwe 25.4)) (setq scrwe_d scrwe))  
  (setq src3 (list (- (car ep3) scrw_c) (- (cadr ep3)  scrw_c))
        src2 (list (* (car src3) -1) (cadr src3))
        src1 (list (car src2) (* (cadr src2) -1))
        src4 (list (car src3) (cadr src1))   )
   (if (= scrwe_n 6)
     (setq src5 (list 0 (cadr src1))
           src6 (list 0 (cadr src2))  )  )
   (if (= scrwe_n 8)
     (setq src7 (list (fix (/ (- (car src4) (car swc1)) -6)) (cadr src1))
           src8 (list (car src7) (cadr src2))
           src9 (list (* (car src8) -1) (cadr src8))
           src10 (list (car src9) (cadr src7))  ) )
   (if (= scrwe_n 10)
     (setq src5 (list 0 (cadr src1))
           src6 (list 0 (cadr src2)) 
           src7 (list (fix (/ (car src1) 2)) (cadr src1))
           src8 (list (car src7) (cadr src2))
           src9 (list (* (car src8) -1) (cadr src8))
           src10 (list (car src9) (cadr src7)) )  )
   (hid)(command "circle" src3 "d" scw_d2 "arc" "c" src3 (polar src3 0 (/ scrwe_d 2)) "a" 270) 
   (CEN_L) (ORD_Y CN_L pl)
   (hid)(command "circle" src2 "d" scw_d2 "arc" "c" src2 (polar src2 0 (/ scrwe_d 2)) "a" 270) 
   (CEN_L) 
   (hid)(command "circle" src4 "d" scw_d2 "arc" "c" src4 (polar src4 0 (/ scrwe_d 2)) "a" 270) 
   (CEN_L) (ORD_X plw pl CN_L) (ORD_Y CN_L pl)
   (hid)(command "circle" src1 "d" scw_d2 "arc" "c" src1 (polar src1 0 (/ scrwe_d 2)) "a" 270) 
   (CEN_L) (ORD_X plw pl CN_L)
   (if (< scrwe 2)
     (command "dim" "leader" (polar src3 (* pi -0.25) (/ scrwe_d 2))
                   (polar src3 (* pi -0.25) (* scrwe_d 2.5)) 
            (polar (polar src3 (* pi -0.25) (* scrwe_d 2.5)) 0 (* pl 0.02)) ""  
                   (strcat "%%c" (rtos scrwe 4) "杯头孔(" (itoa scrwe_n) "X)") "e")
     (command "dim" "leader" (polar src3 (* pi -0.25) (/ scrwe_d 2))
                   (polar src3 (* pi -0.25) (* scrwe_d 2.5)) 
            (polar (polar src3 (* pi -0.25) (* scrwe_d 2.5)) 0 (* pl 0.02)) "" 
                   (strcat "M" (rtos scrwe) "(" (itoa scrwe_n) "X)") "e") )
   (if (or (= scrwe_n 6)(= scrwe_n 10))
     (progn
       (hid)(command "circle" src5 "d" scw_d2 "arc" "c" src5 (polar src5 0 (/ scrwe_d 2)) "a" 270) 
       (CEN_L) 
       (hid)(command "circle" src6 "d" scw_d2 "arc" "c" src6 (polar src6 0 (/ scrwe_d 2)) "a" 270) 
       (CEN_L)   )   )
   (if (or (= scrwe_n 8)(= scrwe_n 10))
     (progn 
       (hid)(command "circle" src8 "d" scw_d2 "arc" "c" src8 (polar src8 0 (/ scrwe_d 2)) "a" 270) 
       (CEN_L) 
       (hid)(command "circle" src9 "d" scw_d2 "arc" "c" src9 (polar src9 0 (/ scrwe_d 2)) "a" 270) 
       (CEN_L) 
       (hid)(command "circle" src7 "d" scw_d2 "arc" "c" src7 (polar src7 0 (/ scrwe_d 2)) "a" 270) 
       (CEN_L) (ORD_X plw pl CN_L)
       (hid)(command "circle" src10 "d" scw_d2 "arc" "c" src10 (polar src10 0 (/ scrwe_d 2)) "a" 270) 
       (CEN_L) (ORD_X plw pl CN_L)    ) ) 
;********以下是加腔部分********
  (initget "Y y N n")
  (setq POCK_T (getkword "\n是否需要加腔?Yes or No?<Y>:"))
  (if (or (= POCK_T nil) (= POCK_T "Y"))
    (progn 
      (setq POCK_L (getreal "\n请输入腔的长度:")
	    POCK_W (getreal "\n请输入腔的宽度:")
	    POCK_A (getreal "\n请输入A板腔的深度:")
	    POCK_B (getreal "\n请输入B板腔的深度:")
	    ptp1 (list (* (/ POCK_L 2) -1) (* (/ POCK_W 2) -1))
	    ptp2 (list (car ptp1) (* (cadr ptp1) -1))    
	    ptp3 (list (/ POCK_L 2) (/ POCK_W 2))               
	    ptp4 (list (car ptp3) (cadr ptp1))
 	    POCK_AH POCK_A
	    POCK_BH POCK_B
      )        
    (if (or (= POCK_A nil) (= POCK_B nil))
      (progn
        (if (= POCK_A nil) (setq POCK_AH (atof apd)))
        (if (= POCK_B nil) (setq POCK_BH (atof bpd)))
            (setq pock_h (+ POCK_AH POCK_BH))   
      )
      (setq POCK_H (max POCK_AH POCK_BH)))
        
     
    (setq pk_rr 
       (cond ((<= pock_h 25) 8)
             ((and (> pock_h 25) (<= pock_h 45)) 10)
             ((and (> pock_h 45) (<= pock_h 80)) 13)
             ((and (> pock_h 80) (<= pock_h 160)) 16)
	     ((and (> pock_h 160) (<= pock_h 180)) 18)
             ((and (> pock_h 180) (<= pock_h 220)) 21) 
             ((> pock_h 220) 27)
        )
    )
     (setq POCK_R (getreal (strcat "\n圆角半径:<"(rtos PK_RR )">")))
  (if (= POCK_R nil)
      (setq FILL_R PK_RR)
      (setq FILL_R POCK_R))
    (setq i_d_r (* fill_r 0.4142))
    (con)(command "fillet" "r" FILL_R 
	   "pline" ptp1 "w" (* pw1 0.95) "" ptp2 ptp3 ptp4 "c"
	   "fillet" "p" "l")  
    (rectang ptp1 ptp3)
    (command "fillet" "p" "l" "explode" "l")
    (din)
    (if (= IH_T "I")
      (command "dim" "ordinate" (list (car ptp2) (- (cadr ptp2) FILL_R))
		       (polar ptp2 (/ pi 2) (+ (- (/ plw 2) (cadr ptp2)) (* pl 0.02))) ""
		       "ordinate" (list (car ptp3) (- (cadr ptp3) FILL_R))
		       (polar ptp3 (/ pi 2) (+ (- (/ plw 2) (cadr ptp3)) (* pl 0.02))) "" "e"))
    (if (= IH_T "H")
      (command "dim" "ordinate" (list (car ptp2) (- (cadr ptp2) FILL_R))
		       (polar ptp2 (/ pi 2) (+ (- (/ plw 2) (cadr ptp2)) (* pl 0.02))) ""
		       "ordinate" (list (car ptp3) (- (cadr ptp3) FILL_R))
		       (polar ptp3 (/ pi 2) (+ (- (/ plw 2) (cadr ptp3)) (* pl 0.02))) "" "e"))
      (command "dim" "ordinate" (list (- (car ptp3) FILL_R) (cadr ptp3))
	               (polar ptp3 0 (+ (- (/ pl 2) (car ptp3)) (* pl 0.02))) ""
		       "ordinate" (list (- (car ptp4) FILL_R) (cadr ptp4))
                       (polar ptp4 0 (+ (- (/ pl 2) (car ptp4)) (* pl 0.02))) ""
	               "leader" (polar ptp1 (/ pi 4) I_D_R) 
			    (polar (polar ptp1 (/ pi 4) I_D_R) (/ pi 4) (/ pl 20)) 
		     (polar (polar (polar ptp1 (/ pi 4) I_D_R) (/ pi 4) (/ pl 20)) 0 (* pl 0.02)) ""
			    (strcat "R" (rtos  FILL_R))  "e")
  (if (= POCK_B nil)
 (setq text_ "通腔")
 (setq text_ (strcat "-" (rtos POCK_B))))
	 (command "text" (polar ptp2 (/ pi -3) (/ POCK_L 4)) (* (getvar "dimscale") 0.18)
			    "0" text_)
;********上模加腔********
  (command "layer" "t" "A" "s" "A" "f" "B" "")
  (con)(command "pline" ptp1 "w" (* pw1 0.95) "" ptp2 ptp3 ptp4 "c"
	        "fillet" "p" "l")
  (rectang ptp1 ptp3)
  (command "fillet" "p" "l" "explode" "l")
  (din)
 (if (= IH_T "I")
     (command "dim" "ordinate" (list (car ptp2) (- (cadr ptp2) FILL_R))
		        (polar ptp2 (/ pi 2) (+ (- (/ plw 2) (cadr ptp2)) (* pl 0.02))) ""
		    "ordinate" (list (car ptp3) (- (cadr ptp3) FILL_R))
		        (polar ptp3 (/ pi 2) (+ (- (/ plw 2) (cadr ptp3)) (* pl 0.02))) "" "e"))
 (if (= IH_T "H")
     (command "dim" "ordinate" (list (car ptp2) (- (cadr ptp2) FILL_R))
                    (polar ptp2 (/ pi 2) (+ (- (/ plw 2) (cadr ptp2)) (* pl 0.02))) ""
                    "ordinate" (list (car ptp3) (- (cadr ptp3) FILL_R))
                    (polar ptp3 (/ pi 2) (+ (- (/ plw 2) (cadr ptp3)) (* pl 0.02))) "" "e"))
     (command "dim" "ordinate" (list (- (car ptp3) FILL_R) (cadr ptp3))
                               (polar ptp3 0 (+ (- (/ pl 2) (car ptp3)) (* pl 0.02))) ""
                    "ordinate" (list (- (car ptp4) FILL_R) (cadr ptp4))
                               (polar ptp4 0 (+ (- (/ pl 2) (car ptp4)) (* pl 0.02))) "" 
                    "leader" (polar ptp1 (/ pi 4) I_D_R) 
                             (polar (polar ptp1 (/ pi 4) I_D_R) (/ pi 4) (/ pl 20))
                      (polar (polar (polar ptp1 (/ pi 4) I_D_R) (/ pi 4) (/ pl 20)) 0 (* pl 0.02)) ""
                             (strcat "R" (rtos FILL_R)) "e")
   (if (= POCK_A nil)
   (setq text_ "通腔")
   (setq text_ (strcat "-" (rtos POCK_A))))
	   (command "text" (polar ptp2 (/ pi -3) (/ POCK_L 4)) ""
			    "0" text_)))
  (setvar "cmdecho" ocm) (setvar "blipmode" obl) 
  (setvar "cecolor" oco) (setvar "dimzin" ozin) (setvar "luprec" olup)
  (command "_.UNDO" "_E")
  (setq *error* olderr)
  (princ)
  )
;*** 后叙 ***
(princ "\n  Type-------------< ord >   to run this program.") 
(princ)
