[求助]：lisp程序不能加载，请高手帮助修改一下！

xuhoushui

这是我在网上下载的关于化工设备绘制鞍座的程序,加载后不能用
但我是做化工的，这个程序对我帮助很大。这里想请高手帮忙修改修改！

;;鞍式支座绘制程序
;;作者:王颂菊
;;时间:2007.4.2
;;程序输入命令:az-2007
;;输入参数:
;;该程序本人保留全部版权，特此申明。
______________________________________________________________

(defun MODES (a)
  (setq MLST '
                  ())
  (repeat (length a)
         (setq MLST (append MLST (list (list (car a) (getvar (car a))))))
         (setq a (cdr a))
  )
)
;;;
;;; Restore modes
;;;
______________________________________________
(defun MODER ()
  (repeat (length MLST)
         (setvar (caar MLST) (cadar MLST))
         (setq MLST (cdr MLST))
  )
)
_______________________________________________

(defun DCH (pt pt1) (setq pt1 (list (- (* (car pt1) 2) (car pt)) (cadr pt))))
________________________________________________
;;;
;;; Ascii Text error handler
;;;
(defun at_err (st)                    ; If an error (such as CTRL-C) occurs
                                        ; while this command is active...
  (if (or (= st "Function cancelled")
                          (= st "quit / exit abort")
                )
         (princ (strcat "\n数据错误，中断、退出。"))
  )
  (moder)                             ; Restore modified modes
  (if (= (type fp) 'FILE)
         (close fp)
  )
  (setq fp nil)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)
___________________________________________________________
(defun dc (/ dcl_id)
        (setq dcl_id (load_dialog "az-2007.dcl"))
        (if (not (new_dialog "az" dcl_id))(exit))
        (if dn (set_tile "dn" (rtos dn 2 0)))
        (if s (set_tile "s" (rtos s 2 0)))
        (if h (set_tile "h" (rtos h 2 0)))
       (setq sht 0 lx "B1")
        (action_tile "A" "(setq lx $key) (公称直径a)")
        (action_tile "B1" "(setq lx $key) (公称直径b)")
        (action_tile "B2" "(setq lx $key) (公称直径c)")
        (action_tile "dn" "(setq dn (atof $value))")
        (action_tile "s" "(setq s (atof $value))")
        (action_tile "h" "(setq h (atof $value))")
       (mode_tile "dn" 2)        (mode_tile "dn" 3)
       (mode_tile "s" 1)
        (action_tile "pup_dn" "(setq pup_dn $value) (标准高度)
           (set_tile \"dn\" (nth (read pup_dn) dna)) (mode_tile \"dn\" 2) ")
        (action_tile "zhush" "(setq sht 0) (幻灯片显示) (mode_tile \"s\" 1) (mode_tile \"h\" 0)")
        (action_tile "chesh" "(setq sht 1) (幻灯片显示) (mode_tile \"s\" 0) (mode_tile \"h\" 0)")
        (action_tile "fush" "(setq sht 2) (幻灯片显示) (mode_tile \"s\" 1) (mode_tile \"h\" 1)")
       (公称直径b)
       (if (= sht 0) (az_vslide "az_image" "sht(sht)" 0))
        (action_tile "accept" "(done_dialog 1)")
        (action_tile "cancel" "(done_dialog 0)")
        (setq opt (start_dialog))
        ;(start_dialog)
        (unload_dialog dcl_id)
        (if (or (and (= sht 0) (or (= h nil) (= dn nil)))
               (and (= sht 1) (or (= s nil)(= h nil)(= dn nil)))
               (and (= sht 2) (= dn nil))
            )
             (setq opt 0)
        )
)
______________________________________________________
(defun read_txt (/ fp txt txt_sb1 opt_1 fn)
        (if (= (getvar "filedia") 0)(setvar "filedia" 1))
        (setq fn (findfile "jbt4712.1.dat"))
        (setq fp (open fn "r"))
                (setq txt_sb '())
                (setq opt_1 1)
                (while (= opt_1 1)
                        (setq txt (read-line fp))
                        (if (/= txt nil)
                                (progn
                                        (setq txt_sb1 (read txt))
                                        (setq txt_sb (append txt_sb (list txt_sb1)))
                                )
                                (setq opt_1 0)
                        )
                );while end
                (close fp)
)
________________________________________________________________
(defun c:az-2007 (/ lx txt_sb txt_sb1 sb mlst scale d0 s0 s1 s2 s3 s4 s5 s6 p0 pp pt p01
                 n b1 b2 b3 b4 e l l1 l2 l3 k w a a1 a2 aa r x x1 x2 x3 x4 y y1 y2 y3  
                 y4 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 m1 m2 m3 m4
                 m5 m6 m7 m8 m9 m10 m11 m12 m13 m14 m15 m16 m17 m18 m19 m20 m21 m22  
                 m23 m24 m25 m26 m27 m28 m30 m31 h1 w1 opt dh dh1 d jdu ss1 ss2 pt0
               pta ptb ptc pt1 pt3 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13
               pt14 pt15 pt16 pt17 pt18 pt19 pt20 pt21 pt22 pt23 pt24 pt25 pt26 sht)
        (setq olderr *error*
                        *error* at_err)
        (modes '("osmode" "clayer" "cmdecho"))
        ;;(setvar "dimse1" 0)
        ;;(setvar "dimse2" 0)
        (setvar "cmdecho" 0)
        ;;(setq scale (getvar "userr1"))
        (dc)
        (if (= opt 0) (exit))
        (setvar "osmode" 32)
        (cond ((= sht 0) (setq p0 (getpoint "\n请输入鞍座主视图的定位点(鞍座中心线与筒体外表面的交点):")) )
              ((= sht 1) (setq pp (getpoint "\n请输入鞍座侧视图的定位点:")) )
              ((= sht 2) (setq pt (getpoint "\n请点取鞍座俯视图的定位点:")) )
       )
        (setvar "osmode" 0)
----------------------------------------------------------------------------------------
        (read_txt)
        (foreach txt_sb1 txt_sb
                (if (= lx (nth 0 txt_sb1))
                        (if (= dn (nth 1 txt_sb1))
                                (setq sb txt_sb1)
                        )
                )
        )
        (setq h1 (nth 3 sb) l1 (nth 4 sb) b1 (nth 5 sb) s1 (nth 6 sb) s2 (nth 7 sb))
        (setq l3 (nth 8 sb) b2 (nth 9 sb) b3 (nth 10 sb) s3 (nth 11 sb) l (nth 12 sb))
        (setq b4 (nth 13 sb) s4 (nth 14 sb) e (nth 15 sb) l2 (nth 16 sb) w  (nth 17 sb))
        (setq w1 (nth 18 sb) d (nth 19 sb) dh (nth 20 sb) dh1 (nth 21 sb) s5 10 s6 15)
       (cond ((or (= lx "A") (= lx "B1")) (setq jdu (/ (* 7.0 pi) 6.0) ))
             ((= lx "B2") (setq jdu (/ (* 13.0 pi) 12.0) ))
       )
_______________________________________________________________________________________
     (cond ((= sht 0)
         (setq p1 (list (- (car p0) (+ (- (/ b1 2.0) 10) e)) (cadr p0)))
         (setq p2 (list (+ (car p1) b4) (cadr p0)))
         (setq p3 (list (car p1) (- (cadr p1) s4)))
         (setq p4 (list (car p2) (cadr p3)))
         (setq p5 (list (- (car p0) (/ b1 2.0)) (- (cadr p0) h)))
         (setq p6 (list (+ (car p0) (/ b1 2.0)) (cadr p5)))
         (setq p7 (list (car p5) (+ (cadr p5) s1)))
         (setq p8 (list (car p6) (cadr p7)))
         (setq p9 (list (+ (car p7) s5) (cadr p7)))
         (setq p10 (list (car p9) (cadr p3)))
         (setq p11 (list (+ (car p9) s2) (cadr p9)))
         (setq p12 (list (car p11) (cadr p10)))
         (setq p15 (list (car p0) (- (cadr p5) 50) ))
         (setq p16 (list (car p0) (- (cadr p0) 80) )) )
    ((= sht 2)
       (setq pt1 (list (- (car pt) (* 0.5 b1)) (+ (cadr pt) (* 0.5 l1)) ))
       (setq pt2 (list (+ (car pt1) b1) (cadr pt1)))
       (setq pt3 (list (car pt2) (- (cadr pt2) l1) ))
       (setq pt4 (list (- (car pt3) b1) (cadr pt3) ))
       (setq pt13 (list (car pt) (+ (cadr pt) (* 0.5 l2)) ))
       (setq pt14 (list (car pt) (- (cadr pt) (* 0.5 l2)) ))
       (setq pt15 (list (- (car pt13) (* 0.5 dh)) (+ (cadr pt13) (* 0.5 d)) ))
       (setq pt16 (list (+ (car pt13) (* 0.5 dh)) (+ (cadr pt13) (* 0.5 d)) ))
       (setq pt17 (list (+ (car pt13) (* 0.5 dh)) (- (cadr pt13) (* 0.5 d)) ))
       (setq pt18 (list (- (car pt13) (* 0.5 dh)) (- (cadr pt13) (* 0.5 d)) ))
       (setq pt19 (list (car pt15) (+ (cadr pt15) 10) ))
       (setq pt20 (list (car pt18) (- (cadr pt18) 10) ))
       (setq pt21 (list (car pt16) (+ (cadr pt16) 10) ))
       (setq pt22 (list (car pt17) (- (cadr pt17) 10) ))
       (setq pt23 (list (car pt13) (+ (cadr pt13) (+ (* 0.5 d) 15)) ))
       (setq pt24 (list (car pt13) (- (cadr pt13) (+ (* 0.5 d) 15)) ))
       (setq pt25 (list (car pt14) (+ (cadr pt14) (+ (* 0.5 d) 15)) ))
       (setq pt26 (list (car pt14) (- (cadr pt14) (+ (* 0.5 d) 15)) ))
       (setq pt0 (list (+ (car pt) (* 0.5 b1) 30.0) (cadr pt) ))
       (setq pta (list (- (car pt) (* 0.5 b1) 30.0) (cadr pt) ))
       (setq ptb (list (+ (car pt) (* 0.5 b1) 100.0) (cadr pt) ))
       (setq ptc (list (car ptb) (+ (cadr ptb) 100.0) ))
     )
    )
    (cond ((>= dn 1000) (az1000))
           ((< dn 1000) (az900))
    )
--------------------------------------------------------
        (setq dn (fix dn))
        (setq w (+ w (* (/ (- h h1) 100) w1)))
        (prompt "\nJB/T4712-2007 鞍座")(prin1 (read (strcase lx)))
                (prin1 dn) (prompt "-F(S)  ") (prin1 w) (prompt " kg")
        (moder)
        (princ)
)
________________________________________________________
(defun az900 ()
    (if (= sht 1) (progn
      (if (or (< dn 300)(= dn 325)(= dn 377)(= dn 426) )
         (setq d0 dn)
         (setq d0 (+ dn (* 2.0 s)))
        )
        (setq a (/ l d0))  
        (setq a1 (- (/ (* 3.0 pi) 2.0) a))
        (setq a2 (+ (/ (* 3.0 pi) 2.0) a))  
    ))
    (if (= sht 2) (progn
       (setq pt5 (list (+ (car pt1) 10) (- (cadr pt1) 5.0) ))
       (setq pt6 (list (+ (car pt5) s2) (cadr pt5) ))
       (setq pt7 (list (car pt6) (- (cadr pt6) (- l1 10) ) ))
       (setq pt8 (list (- (car pt7) s2) (cadr pt7) ))
       (setq ss1 (ssadd))
        (command "pline" pt1 pt2 pt3 pt4 "c")
       (ssadd (entlast) ss1)
          (command "pline" pt5 pt6 pt7 pt8 "c")
       (ssadd (entlast) ss1)
          (command "line" pt0 pta "")
       (ssadd (entlast) ss1)
        (command "circle" pt13 (* 0.5 d))
        (command "circle" pt14 (* 0.5 d))
          (command "line" pt23 pt24 "")
       (ssadd (entlast) ss1)
          (command "line" pt25 pt26 "")
       (ssadd (entlast) ss1)
          (command "line" (list (- (car pt13) (+ (* 0.5 d) 10)) (cadr pt13))
                       (list (+ (car pt13) (+ (* 0.5 d) 10)) (cadr pt13)) "")
          (command "line" (list (- (car pt14) (+ (* 0.5 d) 10)) (cadr pt14))
                       (list (+ (car pt14) (+ (* 0.5 d) 10)) (cadr pt14)) "")
     ))
    (if (= sht 0) (progn  
        (setq p13 (list (+ (car p11) b3) (cadr p11)))   
        (setq p14 (list (car p13) (cadr p12)))
        (command "pline" p1 p3 p4 p2 "")  
        (command "pline" p7 p5 p6 p8 p7 "")
        (command "line" p9 p10 "")
        (command "line" p11 p12 "")
        (command "line" p13 p14 "")
        (command "line" p15 p16 "")
     ))
    (if (= sht 1) (progn
        (setq m1 (polar pp a1 (/ d0 2.0)))
        (setq m3 (polar pp a1 (+ (/ d0 2.0) s4)))
        (setq m5 (polar pp jdu (+ (/ d0 2.0) s4)))
        (setq m9 (list (- (car pp) (/ l1 2.0)) (- (cadr pp) (* 0.5 d0) h)))
        (setq m11 (list (car m9) (+ (cadr m9) s1)))   
        (setq m13 (list (+ (car m11) 5.0) (cadr m11)))   
        (setq m7 (polar pp (/ (* 7.0 pi) 6.0) (+ (/ d0 2.0) s4 10)))
        (setq m19 (list (car pp) (- (cadr m9) (* 2.0 s1))))
        (setq m20 (list (car pp) (+ (cadr pp) (/ (* 5.0 d0) 8.0))))
        (setq m21 (list (- (car pp) (/ (* 5.0 d0) 8.0)) (cadr pp)))
        (setq m23 (list (car pp) (- (cadr pp) (/ d0 2.0))))   
        (setq m24 (list (- (car pp) (/ l2 2.0)) (+ (cadr m11) 10) ))
        (setq m25 (list (car m24) (- (cadr m11) s1 10) ))
        (command "arc" m3 "e" (dch m3 pp) pp)
        (setq ss3 (ssadd))
        (command "line" m1 m3 "")
        (ssadd (entlast) ss3)
        (command "pline" m5 m7 m13 "")
        (ssadd (entlast) ss3)
        (command "pline" m11 m9 (dch m9 pp) (dch m11 pp) m11 "")
        ;(setvar "clayer" "ddhx")
        ;;(command "line" p15 p16 "")
        (command "line" m19 m20 "")
        (command "line" m21 (dch m21 pp) "")
        (command "line" m24 m25 "")
        (ssadd (entlast) ss3)
        (command "mirror" ss3 "" m19 m20 "")
     ))
     (cond ((<= dn 450)     
             (setq r (+ (/ d0 2.0) s4))  
             (setq x1 (/ s3 2.0))
             (setq y1 (sqrt (- (* r r) (* x1 x1))))     
             (cond ((= sht 1)
                     (setq m15 (list (- (car pp) x1) (cadr m13)))
                     (setq m16 (list (car m15) (- (cadr pp) y1)))  
                   (command "line" m15 m16 "")
                     (command "mirror" (entlast) "" m19 m20 "n")
                  )
                 ((= sht 2)
                  (setq pt9 (list (car pt6) (+ (cadr pt) (* 0.5 s3)) ))
                  (setq pt10 (list (+ (car pt9) b3) (cadr pt9)  ))
                  (setq pt11 (list (car pt10) (- (cadr pt10) s3)  ))
                  (setq pt12 (list (- (car pt11) b3) (cadr pt11)  ))
                  (command "pline" pt9 pt10 pt11 pt12 "")
                  (ssadd (entlast) ss1)
                  (公用程序)
                 )
            )
            )   
          ((>= dn 500)     
           (setq r (+ (/ d0 2.0) s4))  
           (setq x1 (/ l3 2.0))   
           (setq y1 (sqrt (- (* r r) (* x1 x1))))
           (setq x2 (+ (/ l3 2.0) s3))   
           (setq y2 (sqrt (- (* r r) (* x2 x2))))
           (cond ((= sht 1)
                   (setq m15 (list (- (car pp) x2) (cadr m13)))
                   (setq m16 (list (car m15) (- (cadr pp) y2)))
                   (setq m17 (list (+ (car pp) x1) (cadr m13)))
                   (setq m18 (list (car m17) (- (cadr pp) y1)))
                 (command "line" m15 m16 "")  
                   (setq st1 (entlast))
                   (command "line" m17 m18 "")  
                   (setq st2 (entlast))
                   (command "mirror" st1 st2 "" m23 m19 "n")
                )
              ((= sht 2)
               (setq pt9 (list (car pt6) (- (cadr pt) (* 0.5 l3)) ))
               (setq pt10 (list (+ (car pt9) b3) (cadr pt9)  ))
               (setq pt11 (list (car pt10) (- (cadr pt10) s3)  ))
               (setq pt12 (list (- (car pt11) b3) (cadr pt11)  ))
               (command "pline" pt9 pt10 pt11 pt12 "")
               (setq st3 (entlast))
               (ssadd st3 ss1)
                 (command "mirror" st3 "" pt0 pta "")
               (ssadd (entlast) ss1)
               (公用程序)
              )
         )
         )
    )
)
_______________________________________________________________________
(defun az1000 ()
         (if (= sht 1) (progn (setq d0 (+ dn (* 2.0 s)))
         (setq a (/ l d0))  
         (setq a1 (- (/ (* 3.0 pi) 2.0) a)) ))
        ;(setvar "clayer" "shx")
    (if (= sht 0) (progn
         (setq p13 (list (- (car p8) (- b1 10 b2 s2)) (cadr p11)))
         (setq k (* 0.087 (- h s1)))
         (setq p14 (list (+ (car p13) k) (cadr p12)))
         (command "line" p1 p3 p4 p2 "")  
         (command "line" p7 p5 p6 p8 p7 "")
         (command "line" p9 p10 "")  
         (command "line" p11 p12 "")  
         (command "line" p13 p14 "")
               (command "line" p15 p16 "")
    ))
    (if (= sht 2) (progn
        (setq pt5 (list (+ (car pt1) 10) (- (cadr pt1) 10.0) ))
        (setq pt6 (list (+ (car pt5) s2) (cadr pt5) ))
        (setq pt7 (list (car pt6) (- (cadr pt6) (- l1 20) ) ))
        (setq pt8 (list (- (car pt7) s2) (cadr pt7) ))
        (setq pt9 (list (car pt6) (- (cadr pt6) 15) ))
        (setq pt10 (list (+ (car pt9) b2) (cadr pt9)  ))
        (setq pt11 (list (car pt10) (- (cadr pt10) s3)  ))
        (setq pt12 (list (- (car pt11) b2) (cadr pt11)  ))
        (setq px1 (list (car pt12) (- (cadr pt12) l3) ))
        (setq px2 (list (+ (car px1) b2) (cadr px1)  ))
        (setq px3 (list (car px2) (- (cadr px2) s3)  ))
        (setq px4 (list (- (car px3) b2) (cadr px3)  ))
        (setq px5 (list (car px4) (- (cadr px4) l3) ))
        (setq px6 (list (+ (car px5) b2) (cadr px5)  ))
        (setq px7 (list (car px6) (- (cadr px6) s3)  ))
        (setq px8 (list (- (car px7) b2) (cadr px7)  ))
        (setq ss1 (ssadd))
         (command "pline" pt1 pt2 pt3 pt4 "c")
        (ssadd (entlast) ss1)
           (command "pline" pt5 pt6 pt7 pt8 "c")
        (ssadd (entlast) ss1)
           (command "line" pt0 pta "")
        (ssadd (entlast) ss1)
         (command "circle" pt13 (* 0.5 d))
         (command "circle" pt14 (* 0.5 d))
           (command "line" pt23 pt24 "")
        (ssadd (entlast) ss1)
           (command "line" pt25 pt26 "")
        (ssadd (entlast) ss1)
        (command "pline" pt9 pt10 pt11 pt12 "")
        (setq st3 (entlast))
        (ssadd st3 ss1)
        (command "mirror" st3 "" pt0 pta "")
        (ssadd (entlast) ss1)
        (command "pline" px1 px2 px3 px4 "")
        (ssadd (entlast) ss1)
        (command "mirror" (entlast) "" pt0 pta "")
        (ssadd (entlast) ss1)
           (command "line" (list (- (car pt13) (+ (* 0.5 d) 10)) (cadr pt13))
                        (list (+ (car pt13) (+ (* 0.5 d) 10)) (cadr pt13)) "")
           (command "line" (list (- (car pt14) (+ (* 0.5 d) 10)) (cadr pt14))
                        (list (+ (car pt14) (+ (* 0.5 d) 10)) (cadr pt14)) "")
        (if (and (>= dn 2100) (= sht 2)) (progn
            (command "pline" px5 px6 px7 px8 "")
             (ssadd (entlast) ss1)
             (command "mirror" (entlast) "" pt0 pta "")
             (ssadd (entlast) ss1) ))
       (公用程序)
    ))
    (if (= sht 1) (progn
         (setq m1 (polar pp a1 (/ d0 2.0)))
         (setq m3 (polar pp a1 (+ (/ d0 2.0) s4)))
         (setq m5 (polar pp jdu (+ (/ d0 2.0) s4)))
         (setq m6 (list (- (car pp) (- (/ l1 2.0) s5 s6 s3)) (- (cadr pp) (- h s1) (/ d0 2.0))))
         (setq m7 (list (- (car pp) (/ l1 2.0)) (- (cadr pp) h (/ d0 2.0))))
         (setq m9 (list (car m7) (cadr m6)))
         (setq aa (atan (- (car m6) (car m5)) (- (cadr m5) (cadr m6)) ))
         (setq m11 (polar m5 (+ pi aa) s3))
         (setq m12 (list (- (car m6) (/ s3 (cos aa))) (cadr m6)))
         (setq m14 (polar m11 (+ (/ (* 3.0 pi) 2.0) aa) (/ dh1 (cos aa)) ))
         (setq m13 (list (+ (car m14) (/ s3 (cos aa))) (cadr m14)))
         (setq m15 (polar m14 (* 1.25 pi) (/ s6 (cos (- (/ pi 4.0) aa)))))
         (setq m16 (list (- (car m12) (/ s6 (cos aa))) (cadr m6)))
         (setq r (+ (/ d0 2.0) s4))
         (setq y (- (cadr pp) (cadr m13)))
         (setq x (sqrt (- (* r r) (* y y))))
         (setq m17 (list (- (car pp) x) (cadr m13)))
         (setq x1 (- (car pp) (car m6) l3))
         (setq y1 (sqrt (- (* r r) (* x1 x1))))
         (setq m18 (list (- (car pp) x1) (cadr m6)))
         (setq m19 (list (car m18) (- (cadr pp) y1)))
         (setq x2 (- (car pp) (car m6) l3 s3))
         (setq y2 (sqrt (- (* r r) (* x2 x2))))
         (setq m20 (list (- (car pp) x2) (cadr m6)))
         (setq m21 (list (car m20) (- (cadr pp) y2)))
         (setq m26 (list (car pp) (- (cadr m7) 50)))
         (setq m27 (list (car pp) (+ (cadr pp) (/ (* 5.0 d0) 8.0))))
         (setq m28 (list (- (car pp) (/ (* 5.0 d0) 8.0)) (cadr pp)))
         (setq m30 (list (- (car pp) (/ l2 2.0)) (+ (cadr m9) 20) ))
         (setq m31 (list (- (car pp) (/ l2 2.0)) (- (cadr m9) s1 20) ))
         ;(command "circle" pp (/ d0 2.0) )
         ;(command "arc" m1 "e" (dch m1 pp) pp)
         (command "arc" m3 "e" (dch m3 pp) pp)
         (setq ss3 (ssadd))
         (command "line" m1 m3 "")
         (ssadd (entlast) ss3)
         (command "pline" m5 m11 m14 m17 "")
         (ssadd (entlast) ss3)
         (command "line" m5 m13 "")
         (ssadd (entlast) ss3)
         (command "pline" m14 m15 m16 "")
         (ssadd (entlast) ss3)
         (command "pline" m9 (dch m9 pp) (dch m7 pp) m7 m9 "")
         ;(setvar "clayer" "ddhx")
         ;;(command "line" p15 p16 "")
         (command "line" m26 m27 "")
         (command "line" m28 (dch m28 pp) "")
         (command "line" m30 m31 "")
         (ssadd (entlast) ss3)
         ;(setvar "clayer" "xux")
         (command "line" m12 m14 "")
         (ssadd (entlast) ss3)
         (command "line" m6 m13 "")
         (ssadd (entlast) ss3)
         (command "line" m18 m19 "")
         (ssadd (entlast) ss3)
         (command "line" m20 m21 "")
         (ssadd (entlast) ss3)
         (cond ((>= dn 2100)
                 (setq x3 (- (car pp) (car m20) l3))
                 (setq y3 (sqrt (- (* r r) (* x3 x3))))
                 (setq m22 (list (- (car pp) x3) (cadr m20)))
                 (setq m23 (list (car m22) (- (cadr pp) y3)))
                 (setq x4 (- (car pp) (car m20) l3 s3))
                 (setq y4 (sqrt (- (* r r) (* x4 x4))))
                 (setq m24 (list (- (car pp) x4) (cadr m6)))
                 (setq m25 (list (car m24) (- (cadr pp) y4)))
                 ;(setvar "clayer" "XUX")
                 (command "line" m22 m23 "")
               (ssadd (entlast) ss3)
                 (command "line" m24 m25 "")
               (ssadd (entlast) ss3)
               )  
          )
         (command "mirror" ss3 "" m26 m27 "")
    ))
)
(defun 公用程序 ()
   (command "pline" pt18 "A" "D" "@20<180" pt15 "L" pt16 "A" pt17 "L" pt18 "")
   (setq ss2 (ssadd))
   (ssadd (entlast) ss2)
   (command "mirror" (entlast) "" pt0 pta "")
   (ssadd (entlast) ss2)
   (command "line" pt19 pt20 "")
   (ssadd (entlast) ss2)
   (command "mirror" (entlast) "" pt0 pta "")
   (ssadd (entlast) ss2)
   (command "line" pt21 pt22 "")
   (ssadd (entlast) ss2)
   (command "mirror" (entlast) "" pt0 pta "")
   (ssadd (entlast) ss2)
   (command "line" (list (- (car pt13) (+ (* 0.5 dh) (* 0.5 d) 15)) (cadr pt13))
                   (list (+ (car pt13) (+ (* 0.5 dh) (* 0.5 d) 15)) (cadr pt13)) "")
   (ssadd (entlast) ss2)
   (command "line" (list (- (car pt14) (+ (* 0.5 dh) (* 0.5 d) 15)) (cadr pt14))
                   (list (+ (car pt14) (+ (* 0.5 dh) (* 0.5 d) 15)) (cadr pt14)) "")
   (ssadd (entlast) ss2)
   (command "mirror" ss2 "" ptb ptc "y")
   (command "mirror" ss1 "" ptb ptc "")
)
--------------------------------------------------------------------------------------------
(defun az_vslide (key s_name n / x y)
     (start_image key)
     (setq x (dimx_tile key))
     (setq y (dimy_tile key))
     (fill_image 0 0 x y 0)
     (slide_image 0 -15 x y s_name)
     (end_image)
  )
(defun 幻灯片显示 ()
    (cond ((= sht 0) (az_vslide "az_image" "sht(sht)" 0))
          ((= sht 1) (az_vslide "az_image" "sht(sht1)" 0))
          ((= sht 2) (az_vslide "az_image" "sht(sht2)" 0))
     )
)
(defun 公称直径a ()
    (setq dna (list "1000" "1100" "1200" "1300" "1400" "1500" "1600" "1700"
                    "1800" "1900" "2000" "2100" "2200" "2300"  "2400" "2600"
                    "2800" "3000" "3200" "3400" "3600" "3800" "4000"))
    (start_list "pup_dn")
    (mapcar 'add_list dna)
    (end_list)
)
(defun 公称直径b ()
    (setq dna (list "159" "219" "273" "325" "377" "426" "300" "350"  "400" "450"
                    "500" "550" "600" "650" "700" "800" "900" "1000" "1100" "1200"
                    "1300" "1400" "1500" "1600" "1700" "1800" "1900" "2000" "2100"
                    "2200" "2300" "2400" "2600" "2800" "3000" "3200" "3400" "3600"
                    "3800" "4000"))
    (start_list "pup_dn")
    (mapcar 'add_list dna)
    (end_list)
  )
(defun 公称直径c ()
    (setq dna (list "1000" "1100" "1200" "1300" "1400" "1500" "1600" "1700" "1800" "1900" "2000" "2100" "2200" "2300"
                    "2400" "2600" "2800" "3000" "3200" "3400" "3600" "3800" "4000"))
    (start_list "pup_dn")
    (mapcar 'add_list dna)
    (end_list)
)
(defun 标准高度 ()
    (cond ((and (= lx "A") (<= (atoi pup_dn) 4)) (setq h 200))
          ((and (= lx "A") (> (atoi pup_dn) 4)) (setq h 250))
          ((and (= lx "B1") (<= (atoi pup_dn) 21)) (setq h 200))
          ((and (= lx "B1") (> (atoi pup_dn) 21)) (setq h 250))
          ((and (= lx "B2") (<= (atoi pup_dn) 4)) (setq h 200))
          ((= lx "B2") (setq h 250))
    )
    (set_tile "h" (rtos h 2 0))
  )
___________________________________________________________________________________________
(princ)
(princ "\n鞍座绘制程序已加载，请以 ＡＺ 启动程序。")
(princ)

jxh2003zfr

哪些地方有问题？

xuhoushui

加载不了啊！

jxh2003zfr

因defun c:az-2007，所以命令为az-2007而不是az,
另外，此程序运行还要az-2007.dcl对话框文件