求大神帮忙调试一下驱动程序和dcl文件哪里错了（谁有推力滚子轴承的绘图程序也行）...

晨阳依旧

(defun c:bearing (/ d l x y id std x1 y1)
  (setq chilun "1"
        std 2
        s_t "0"
        p0 (list x y)

  )
  (defun getdata ()                       ; 从控件得到D,L,x,y的值
    (setq ra (atof (get_tile "ra_box")))
    (setq rb (atof (get_tile "rb_box")))
    (setq rc (atof (get_tile "rc_box")))
    (setq rd (atof (get_tile "rd_box")))
    (setq r1 (atof (get_tile "r1_box")))
    (setq b (atof (get_tile "b_box")))
    (setq x (atof (get_tile "X_box")))
    (setq y (atof (get_tile "Y_box")))
    (setq BL (atof (get_tile "dimscale_box")))
    (setq PMBL (atof (get_tile "PMBL_box")))
    (setq alf (atof (get_tile "alf")))
    (setq p0 (list x y))
  )
  (setvar "cmdecho" 0)
  (setq id (load_dialog "C:\\Users\\Administrator\\Desktop\\毕业设计资料\\源文件.dcl")) ; 装入对话框文件
  (if (< id 0)
    (exit)
  )
  (setq ra 0
        rb 0
        rc 0
        rd 0
        b 0
        rl 0
        x 0
        y 0
        std 2
        p0 (list 0 0)
        alf 0
        BL 1
        PMBL 0.5
  )
  (while (> std 1)
    (if (not (new_dialog "bearing_dlg" id))
      (exit)
    )                                       ; 初始化对话框shaft
    (setq gear (list "带顶丝外球面球轴承" "带偏心套外球面球轴承"
                     "带球面座圈的双向推力球轴承" "带球面座圈的推力球轴承"
                     "单列调心滚子轴承" "分离角接触轴承" "角接触轴承"
                     "内圈分离角接触球轴承" "双半内圈三点接触球轴承"
                     "双半外圈三点接触球轴承" "双半外圈四点接触球轴承"
                     "双列角接触球轴承" "双列圆柱滚子轴承" "双向推力球轴承"
                     "四点接触球轴承" "锁扣在内圈的角接触球轴承"
                     "推力球轴承" "推力圆柱滚子轴承" "圆锥孔外球面球轴承"
                     "双向圆柱滚子轴承" "框图"
               )
    )
    (start_list "s_type")               ; 开始处理列表
    (mapcar
      'add_list
      gear
    )                                       ; 将gear表的表项逐个添加到gear list
                                       ; 列表
    (end_list)                               ; 处理列表结束
    (action_tile "s_type" "(setq chilun $value) )") ; 定义列表的活动为将选?
                                       ; ?
                                       ; 的表项序号赋给变量chilun
    (setq s_t chilun)
    (setq sldname (strcat "E:\\程序\\sold\\scr" s_t)) ; 拼接幻灯片文件的名?
                                       ; ?
                                       ; 和路径
    (f_img "image" sldname)               ; 将幻灯片文件显示到图像按钮上
    (set_tile "ra_box" (rtos ra 2 2))  ; 设置编辑框控件的值
    (set_tile "rb_box" (rtos rb 2 2))
    (set_tile "rc_box" (rtos rc 2 2))  ; 设置编辑框控件的值
    (set_tile "rd_box" (rtos rd 2 2))
    (set_tile "r1_box" (rtos r1 2 2))
    (set_tile "b_box" (rtos b 2 2))
    (set_tile "X_box" (rtos x 2 2))
    (set_tile "Y_box" (rtos y 2 2))
    (set_tile "dimscale_box" (rtos BL 2 2))
    (set_tile "PMBL_box" (rtos PMBL 2 2))
    (set_tile "alf" (rtos alf 2 2))
    (action_tile "p_b" "(getdata) (done_dialog 2)") ; 设置按钮的活动
    (action_tile "p_a" "(getdata) (done_dialog 3)") ; 设置按钮的活动
    (action_tile "p_c" "(getdata) (done_dialog 4)") ; 设置按钮的活动
    (action_tile "accept" "(getdata) (done_dialog 1)")
    (action_tile "cancel" " (done_dialog 0)")
    (setq std (start_dialog))

    (if (= std 2)                       ; 注意:该表达式在while内部
      (progn
        (setq p0 (getpoint "定位点:"))
        (setq x (car p0)
              y (cadr p0)
        )
      )
    )
    (if (= std 3)
      (progn                               ; 用光杯硝定旋装角
        (initget 1)                       ; 禁止空輸入
        (setq ang (getangle p0 "輸入旋装角:"))
        (setq alf (* 180.0 (/ ang pi)))
      )

    )
    (if (= std 4)
      (progn                               ; 用光示硝定旋特角
      )
    )
  )                                       ; whlie循坏結束
  (unload_dialog id)                       ; 卸栽対活框文件
  (if (=std1)                               ; 絵制所迭奘型的釉承
    (bearing s_t ra rb rc rd r1 BL PMBL alf po)
  )
  (princ)
)
(defun f_img (key sld)
  (start_image key)
  (slide_image 0 0 (dimx_tile key) (dimy_tile key) sld)
  (end_image)
)
(bearing /p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15
                        p16 p17 p18 p19 p20 p21 p22 p23 pm1 pm2 pm3 a b alf
                        r a1 a2 b1
                   )
  (command "limist" "0,0" "210,297")   ;
  (setvar "osmode" 0)                       ; 关闭目标捕捉状态
  (setvar "cmdecho" 0)
  (setq p0 (getpoint "插入点p0: "))
  (setq ra (getdist p0 "外半径A:"))
  (setq rb (getdist p0 "内半径d1:"))
  (setq b (getdist p0 "宽度B："))
  (setq r1 (getdist p0 "倒圆内半径 r1: "))
  (setq af (getangle p0 "旋转角 alf:"))
  (setq a1 (- ra rb))
  (setq b1 (* 0.5 b))
  b2
  (* 0.5 b1)
  a2
  (* 0.5 a1)
  a3
  (* 0.5 a2)
)
(setq p1 (polar p0 (+ alf (* 0.5 pi)) b2))
(setq p2 (polar p0 (+ alf (* 0.5 pi)) b1))
;;; p1-p16用于绘制直线
(setq p3 (polar p0 (+ alf (* -0.5 pi)) b2))
(setq p4 (polar p0 (+ alf (* -0.5 pi)) b1))
(setq p5 (polar p2 alf rb))
(setq p6 (polar p1 alf rb))
(setq p7 (polar p4 alf rb))
(setq p8 (polar p3 alf rb))
(setq p9 (polar p2 alf ra))
(setq p10 (polar p1 alf ra))
(setq p11 (polar p4 alf ra))
(setq p12 (polar p3 alf ra))
(setq p16 (polar p6 alf a3))
(setq p15 (polar p8 alf a3))
(setq p13 (polar p16 alf a2))
(setq p14 (polar p15 alf a2))
(command "linetype" "set" "bylayer" " ")
;;; 设置新实体为随层
(command "line" p2 p9 " ")
(command "line" p1 p10 " ")
(command "line" p9 p10 " ")
(command "line" p4 p11 " ")
(command "line" p3 p12 " ")
(command "line" p11 p12 " ")
(command "line" p5 p6 " ")
(command "line" p7 p8 " ")
(command "line" p15 p16 " ")
(command "line" p13 p14 " ")
(setq c1 (polar p9 (+ alf (* -0.5 pi)) (* 0.1 b1)))
;;; 设置倒圆角点
(setq c2 (polar p9 (+ alf pi) (* 0.1 b1)))
(setq c3 (polar p11 (+ alf (* 0.5 pi)) (* 0.1 b1)))
(setq c4 (polar p11 (+ alf pi) (* 0.1 b1)))
(command "fillet" "r" r1 "fillet" c1 c2)
(command "fillet" "r" r1 "fillet" c3 c4)
(setq pm1 (polar p15 (+ alf (* -0.5 pi)) 5))
;;; 剖面线点
(setq pm1 (polar p16 (+ alf (* 0.5 pi)) 5))
(command "bhatch" "p" "ansi31" "2" "90" pm1 "")
;;; 绘制剖面线
(command "bhatch" "p" "ansi31" "2" "0" pm2 "")
(command "linetype" "set" "center" "")
;;; 设置新实体为中心线
(setq p18 (polar p4 (+ alf (* -0.5 pi)) (* 0.1 b)))
;;; 剖面线点
(setq p17 (polar p2 (+ alf (* 0.5 pi)) (* 0.1 b)))
(setq p20 (polar p0 alf (+ ra (* 0.1 b1))))
(setq p19 (polar p0 (+ alf pi) (* 0.1 b1)))
(command "lind" p19 p20 "")
(command "lind" p17 p18 "")
(command "linetype" "set" "bylayer" "")
;;; 设置新实体为随层
(setvar "dinscale" 5)
;;; 开始尺寸标注
(setq t1 (polar p7 (+ alf (* -0.5 pi)) b1))
(setq t2 (polar p7 (+ alf (* -0.5 pi)) (* 0.5 b1)))
(setq t3 (polar p10 alf (* 0.5 b1)))
(setq t4 (polar p4 (+ alf (* 0.5 pi)) b2))
(setq t5 (polar p4 (+ alf pi) (* 0.5 a2)))
(command "dimlinear" p4 p11 "h" t1)
(command "dimlinear" p4 p7 "h" t2)
(command "dimlinear" P2 p4 "v" t3)
(command "dimlinear" p13 p14 "v" t5)

晨阳依旧

只需加载出推力滚子轴承的就行

yshf

(defun c:bearing (/ d l x y id std x1 y1)
  (setq chilun "1"
        std 2
        s_t "0"
        p0 (list x y)

  )
  (defun getdata ()                       ; 从控件得到D,L,x,y的值
    (setq ra (atof (get_tile "ra_box")))
    (setq rb (atof (get_tile "rb_box")))
    (setq rc (atof (get_tile "rc_box")))
    (setq rd (atof (get_tile "rd_box")))
    (setq r1 (atof (get_tile "r1_box")))
    (setq b (atof (get_tile "b_box")))
    (setq x (atof (get_tile "X_box")))
    (setq y (atof (get_tile "Y_box")))
    (setq BL (atof (get_tile "dimscale_box")))
    (setq PMBL (atof (get_tile "PMBL_box")))
    (setq alf (atof (get_tile "alf")))
    (setq p0 (list x y))
  )
  (setvar "cmdecho" 0)
  (setq id (load_dialog "C:\\Users\\Administrator\\Desktop\\毕业设计资料\\源文件.dcl")) ; 装入对话框文件
  (setq id (load_dialog "d:\\360安全浏览器下载\\源文件.dcl")) ; 装入对话框文件
  (if (< id 0)
    (exit)
  )
  (setq ra 0
        rb 0
        rc 0
        rd 0
        b 0
        rl 0
        x 0
        y 0
        std 2
        p0 (list 0 0)
        alf 0
        BL 1
        PMBL 0.5
  )
  (while (> std 1)
    (if (not (new_dialog "bearing_dlg" id))
      (exit)
    )                                       ; 初始化对话框shaft
    (setq gear (list "带顶丝外球面球轴承" "带偏心套外球面球轴承"
                     "带球面座圈的双向推力球轴承" "带球面座圈的推力球轴承"
                     "单列调心滚子轴承" "分离角接触轴承" "角接触轴承"
                     "内圈分离角接触球轴承" "双半内圈三点接触球轴承"
                     "双半外圈三点接触球轴承" "双半外圈四点接触球轴承"
                     "双列角接触球轴承" "双列圆柱滚子轴承" "双向推力球轴承"
                     "四点接触球轴承" "锁扣在内圈的角接触球轴承"
                     "推力球轴承" "推力圆柱滚子轴承" "圆锥孔外球面球轴承"
                     "双向圆柱滚子轴承" "框图"
               )
    )
    (start_list "s_type")               ; 开始处理列表
    (mapcar
      'add_list
      gear
    )                                       ; 将gear表的表项逐个添加到gear list
                                       ; 列表
    (end_list)                               ; 处理列表结束
    (action_tile "s_type" "(setq chilun $value) )") ; 定义列表的活动为将选?
                                       ; ?
                                       ; 的表项序号赋给变量chilun
    (setq s_t chilun)
    (setq sldname (strcat "E:\\程序\\sold\\scr" s_t)) ; 拼接幻灯片文件的名?
                                       ; ?
                                       ; 和路径
    (f_img "image" sldname)               ; 将幻灯片文件显示到图像按钮上
    (set_tile "ra_box" (rtos ra 2 2))  ; 设置编辑框控件的值
    (set_tile "rb_box" (rtos rb 2 2))
    (set_tile "rc_box" (rtos rc 2 2))  ; 设置编辑框控件的值
    (set_tile "rd_box" (rtos rd 2 2))
    (set_tile "r1_box" (rtos r1 2 2))
    (set_tile "b_box" (rtos b 2 2))
    (set_tile "X_box" (rtos x 2 2))
    (set_tile "Y_box" (rtos y 2 2))
    ;(set_tile "dimscale_box" (rtos BL 2 2)) ;控件名是dimsale_box而非dimscale_box
    (set_tile "dimsale_box" (rtos BL 2 2))
    (set_tile "PMBL_box" (rtos PMBL 2 2))
    (set_tile "alf" (rtos alf 2 2))
    (action_tile "p_b" "(getdata) (done_dialog 2)") ; 设置按钮的活动
    (action_tile "p_a" "(getdata) (done_dialog 3)") ; 设置按钮的活动
    (action_tile "p_c" "(getdata) (done_dialog 4)") ; 设置按钮的活动
    (action_tile "accept" "(getdata) (done_dialog 1)")
    (action_tile "cancel" " (done_dialog 0)")
    (setq std (start_dialog))

    (cond ((= std 2)  ; 注意:该表达式在while内部
             (setq p0 (getpoint "定位点:"))
               (setq x (car p0)
                   y (cadr p0)
             )
         )
         ((= std 3)  ; 用光杯硝定旋装角
                (initget 1)                       ; 禁止空輸入
             (setq ang (getangle p0 "輸入旋装角:"))
             (setq alf (* 180.0 (/ ang pi)))
        )
        (cond (= std 4) ; 用光示硝定旋特角
                                             
        )
    )
  )                                       ; whlie循坏結束
  (unload_dialog id)                       ; 卸栽対活框文件
  (if (= std 1)                               ; 絵制所迭奘型的釉承
      ;(bearing s_t ra rb rc rd r1 BL PMBL alf po) ;bearing函数不应与主程序同名
  )
  (princ)
)
(defun f_img (key sld)
  (start_image key)
  (slide_image 0 0 (dimx_tile key) (dimy_tile key) sld)
  (end_image)
)

yshf

(set_tile "dimscale_box" (rtos BL 2 2)) 应为 (set_tile "dimsale_box" (rtos BL 2 2))
(if (=std1) 应为 (if (= std 1)       

仲文玉

(setq ra 0
        ****
        rl 0 <----  此处是rl    下面是r1

(set_tile "r1_box" (rtos r1 2 2))

lee50310

lisp執行時有呼叫.dcl及.sdl兩個檔,可是一個放在C槽另一個放E槽
而這兩個檔都是這程序會用到的,這樣的存放方式不是很好,因為以後寫了很多程序時會很難維護

因此這地方有作修改,還有多處錯誤也已修正改好了,錯誤的地方不ㄧ ㄧ列舉請下載自行比對

所有的程序都放在bearing資料夾,內含Bearing.lsp兩個資料夾DCL,SLD及檔案(beargin.dcl,scr1.sld)
執行方式下載bearing.rar解壓在E:\程序\內從CAD載入bearing.lsp
執行指令: bearing及可
倘若所放的位置不是這樣,請照實際的存放位置修改bearing.lsp內共同路徑(setq PATH "E:\\程序\\Bearing\\")
程序已在AutoCcad2018測試 ok
(註:壓縮檔是用WinRAR 5.5 Beta5壓縮因此解壓不可低於此版本否則無法解壓)
gif檔