绘制键截面图形，自己用得最多，最没技术含量的程序之一。

村夫

;绘制普通平键截面
(defun C:ptpj (/ pt0 jd jb jt js pt1 pt2 pt3 pt4 OSMO CMDE)
  (setq osmO (getvar "osmode"))
  (setq cmdE (getvar "cmdecho"))
  (setvar "osmode" 37)
  (setq pt0 (getpoint "\n指定圆心: "))
  (setvar "osmode" 0)
  (setq jd (getREAL  "\n输入直径: "))
  (cond ((and
    (> jd 6.0)
    (<= jd 8)
  )
  (setq jb 2.0)
  (setq jt1 1.2)
  (setq jt2 1.0)
)
((and
    (> jd 8.0)
    (<= jd 10)
  )
  (setq jb 3.0)
  (setq jt1 1.8)
  (setq jt2 1.4)
)
((and
    (> jd 10)
    (<= jd 12)
  )
  (setq jb 4.0)
  (setq jt1 2.5)
  (setq jt2 1.8)
)
((and
    (> jd 12)
    (<= jd 17)
  )
  (setq jb 5.0)
  (setq jt1 3.0)
  (setq jt2 2.3)
)
((and
    (> jd 17)
    (<= jd 22)
  )
  (setq jb 6.0)
  (setq jt1 3.5)
  (setq jt2 2.8)
)
((and
    (> jd 22)
    (<= jd 30)
  )
  (setq jb 8.0)
  (setq jt1 4.0)
  (setq jt2 3.3)
)
((and
    (> jd 30)
    (<= jd 38)
  )
  (setq jb 10.0)
  (setq jt1 5.0)
  (setq jt2 3.3)
)
((and
    (> jd 38)
    (<= jd 44)
  )
  (setq jb 12.0)
  (setq jt1 5.0)
  (setq jt2 3.3)
)
((and
    (> jd 44)
    (<= jd 50)
  )
  (setq jb 14.0)
  (setq jt1 5.5)
  (setq jt2 3.8)
)
((and
    (> jd 50)
    (<= jd 58)
  )
  (setq jb 16.0)
  (setq jt1 6.0)
  (setq jt2 4.3)
)
((and
    (> jd 58)
    (<= jd 65)
  )
  (setq jb 18.0)
  (setq jt1 7.0)
  (setq jt2 4.4)
)
((and
    (> jd 65)
    (<= jd 75)
  )
  (setq jb 20.0)
  (setq jt1 7.5)
  (setq jt2 4.9)
)
((and
    (> jd 75)
    (<= jd 85)
  )
  (setq jb 22.0)
  (setq jt1 9.0)
  (setq jt2 5.4)
)
((and
    (> jd 85)
    (<= jd 95)
  )
  (setq jb 25.0)
  (setq jt1 9.0)
  (setq jt2 5.4)
)
((and
    (> jd 95)
    (<= jd 110)
  )
  (setq jb 28.0)
  (setq jt1 10.0)
  (setq jt2 6.4)
)
((and
    (> jd 110)
    (<= jd 130)
  )
  (setq jb 32.0)
  (setq jt1 11.0)
  (setq jt2 7.4)
)
((and
    (> jd 130)
    (<= jd 150)
  )
  (setq jb 36.0)
  (setq jt1 12.0)
  (setq jt2 8.4)
)
((and
    (> jd 150)
    (<= jd 170)
  )
  (setq jb 40.0)
  (setq jt1 13.0)
  (setq jt2 9.4)
)
((and
    (> jd 170)
    (<= jd 200)
  )
  (setq jb 45.0)
  (setq jt1 15.0)
  (setq jt2 10.4)
)
((and
    (> jd 200)
    (<= jd 230)
  )
  (setq jb 50.0)
  (setq jt1 17.0)
  (setq jt2 11.4)
)
((and
    (> jd 230)
    (<= jd 260)
  )
  (setq jb 56.0)
  (setq jt1 20.0)
  (setq jt2 12.4)
)
((and
    (> jd 260)
    (<= jd 290)
  )
  (setq jb 63.0)
  (setq jt1 20.0)
  (setq jt2 12.4)
)
((and
    (> jd 290)
    (<= jd 330)
  )
  (setq jb 70.0)
  (setq jt1 22.0)
  (setq jt2 14.4)
)
((and
    (> jd 330)
    (<= jd 380)
  )
  (setq jb 80.0)
  (setq jt1 25.0)
  (setq jt2 15.4)
)
((and
    (> jd 380)
    (<= jd 440)
  )
  (setq jb 90.0)
  (setq jt1 28.0)
  (setq jt2 17.4)
)
((and
    (> jd 440)
    (<= jd 500)
  )
  (setq jb 100.0)
  (setq jt1 31.0)
  (setq jt2 19.5)
)
(t nil)
  )
  (setq jb (* 0.5 jb))
   (setq jd (* 0.5 jd))
  (setq keyx (getstring "\n轴截面图形<y><孔截面图形n> :"))
  (setq keyx (strcase keyx))
  (if (= keyx "Y")
    (setq jt (* -1.0 jt1))
    (setq jt jt2)
  )
  (setq js (sqrt (- (* jd jd) (* jb jb))))
  (setq pt1 (list (+ (car pt0) jb) (+ (cadr pt0) js)))
  (setq pt2 (list (+ (car pt0) jb) (+ (cadr pt0) jd jt)))
  (setq pt3 (list (- (car pt0) jb) (+ (cadr pt0) jd jt)))
  (setq pt4 (list (- (car pt0) jb) (+ (cadr pt0) js)))
  (command "LINE" pt1 pt2 pt3 pt4 "")
  (command "arc" pt4 "c" pt0 pt1)
(setvar "cmdecho" cmdE)
(setvar "osmode" osmO)
)
写过程序，算起来也有十几二十个，但真正常用的已经不多了，特别是从使用3D软件以来，大约就是三五个了，一是代替翻书，二是转换2D图形时尽可能少做点功夫。

村夫

严重鄙视下自己！

清风明月名字

谢谢楼主的分享！收藏备用。

669423907

顶上。看来搞机械的实在是太少了

云中孤鹰

俺是玩模具的

村夫

再来一个，剖面注释：

669423907

今天我把这个程序改了一下，用左右键选择，为什么第一次运行程序的时候选择左键时总是提示 错误: 参数类型错误: numberp: nil，第二次就没问题了
诚望大师指教

(defun C:jc(/ pt0 jd jb jt js pt1 pt2 pt3 pt4 OSMO CMDE)
  (setq osmO (getvar "osmode"))
  (setq cmdE (getvar "cmdecho"))
  (setq jd (getREAL "\n输入直径: "))
(princ"\n左键孔,右键轴")
(setq jiancao (grread))
(cond
((=(car jiancao)25) (setq jt (* -1.0 jt1)))    ;右键
((=(car jiancao)3)  (setq jt jt2))             ;左键
((=(cadr jiancao)32)(setq jt (* -1.0 jt1)))    ;空格
)
  (setq pt0 (getpoint "\n指定圆心: "))
  (setvar "osmode" 37)
  (setvar "osmode" 0)

;
;
;

(t nil)
  )
  (setq jb (* 0.5 jb))
   (setq jd (* 0.5 jd))
;  (setq keyx (getstring "\n轴截面图形<y><孔截面图形n> :"))
;  (setq keyx (strcase keyx))
;  (if (= keyx "Y")
;    (setq jt (* -1.0 jt1))
;    (setq jt jt2)
;  )
(setvar "cmdecho" 0)
  (setq js (sqrt (- (* jd jd) (* jb jb))))
  (setq pt1 (list (+ (car pt0) jb) (+ (cadr pt0) js)))
  (setq pt2 (list (+ (car pt0) jb) (+ (cadr pt0) jd jt)))
  (setq pt3 (list (- (car pt0) jb) (+ (cadr pt0) jd jt)))
  (setq pt4 (list (- (car pt0) jb) (+ (cadr pt0) js)))
  (command "LINE" pt1 pt2 pt3 pt4 "")
  (command "arc" pt4 "c" pt0 pt1)
(setvar "cmdecho" cmdE)
(setvar "osmode" osmO)
(princ))