希望得到lisp高手的帮助--画出剖面线

fgq86233246

几年前（大概是2005年）做了一个画轴承的命令，是用LISP程式写得，图形是画出来了，但美中不足的是，没有画出剖面线，几年没有再去写LISP程式了，许多东西都忘记了，有哪位同行高手能将我这个程式的画剖面线部分补写完整，谢谢
刚才琢磨了一下，这个问题已经解决。上传完整的程式表，哪位提出修改意见，因为本人觉得语句有点偏长，能不能再精简些
程式如下：
(defun c:zc7()
  ;;;说明:将国标GB297-64中的有关尺寸数据保存在表中;
  ;;;说明:7200系列相当于新标准GB/T297-1994--30200系列
  ;;;说明:7300系列相当于新标准GB/T297-1994--30300系列
  ;;;说明:7500系列相当于新标准准GB/T297-1994--32200系列，
  ;;;说明:7600系列相当于新标准准GB/T297-1994--32300系列.
  (setq ptkk '("7202" "7203" "7204" "7205" "7206" "7207" "7208" "7209" "7210" "7211" "7212" "7213" "7214" "7215" "7216" "7217" "7218" "7219" "7220" "7221" "7222" "7224" "7226" "7228" "7230" "7232" "7236" "7238" "7240" "7244"
  "7302" "7303" "7304" "7305" "7306" "7307" "7308" "7309" "7310" "7311" "7312" "7313" "7314" "7315" "7316" "7317" "7318" "7319" "7320" "7321" "7322" "7324" "7326" "7328" "7330" "7334" "7352"
  "7504" "7505" "7506" "7507" "7508" "7509" "7510" "7511" "7512" "7513" "7514" "7515" "7516" "7517" "7518" "7519" "7520" "7521" "7522" "7524" "7526" "7528" "7530" "7532" "7536" "7538" "7540" "7544"
  "7603" "7604" "7605" "7606" "7607" "7608" "7609" "7610" "7611" "7612" "7613" "7614" "7615" "7616" "7617" "7618" "7619" "7620" "7621" "7622" "7624" "7626" "7630" "7632" "7634"));;;轴承型号表
  (setq ptdd '(35 40 47 52 62 72 80 85 90 100 110 120 125 130 140 150 160 170 180 190 200 215 230 250 270 290 320 340 360 400
  42 47 52 62 72 80 90 100 110 120 130 140 150 160 170 180 190 200 215 225 240 260 280 300 320 360 540
  47 52 62 72 80 85 90 100 110 120 125 130 140 150 160 170 180 190 200 215 230 250 270 290 320 340 360 400
  47 52 62 72 80 90 100 110 120 130 140 150 160 170 180 190 200 215 225 240 260 280 320 340 360 ))
  (setq ptbb '(11 12 14 15 16 17 18 19 20 21 22 23 24 25 26 28 30 32 34 36 38 40 40 42 45 48 52 55 58 65
  13 14 15 17 19 21 23 25 27 29 31 33 35 37 39 41 43 45 47 49 50 55 58 62 65 72 102
  18 18 20 23 23 23 23 25 28 31 31 31 33 36 40 43 46 50 53 58 64 68 73 80 86 92 98 108
  19 21 24 27 31 33 36 40 43 46 48 51 55 58 60 64 67 73 77 80 86 93 108 114 120))
  (setq ptcc '(10 11 12 13 14 15 16 16 17 18 19 20 21 22 22 24 26 27 29 30 32 34 34 36 38 40 43 46 48 54
  11 12 13 15 16 18 20 22 23 25 26 28 30 31 33 34 36 38 39 41 42 46 49 53 55 62 85
  16 16 17 19 19 19 19 21 24 27 27 27 28 30 34 37 39 43 46 50 54 58 60 67 71 75 82 90
  16 18 20 23 25 27 30 33 35 37 39 42 45 48 49 53 55 60 63 65 69 78 90 95 100))
  (setq pttt '(12 13.5 15.5 16.5 17.5 18.5 20 21 22 23 24 25 26.5 27.5 28.5 31 33 35 37.5 39.5 41.5 44 44.5 46.5 50 53 58 61 65 73
  14.5 15.5 16.5 18.5 21 23 25.5 27.5 29.5 32 34 36.5 38.5 40.5 43 45 47 50 52 54 55 60 64.5 68.5 73 81 114
  19.5 19.5 21.5 24.5 25 25 25 27 30 33 33.5 33.5 33.5 39 43 46 49.5 53.5 56.5 62 68.5 72.5 78 85 92 98 105 115
  20.5 22.5 25.5 29 33 35.5 38.5 42.5 46 49 51.5 54.5 58.5 62 64 68 72 78 82 85 91 99.5 115 122 128))
  (setq ptr '(1 1 1.5 1.5 1.5 2 2 2 2 2.5 2.5 2.5 2.5 2.5 3 3 3 3.5 3.5 3.5 3.5 3.5 44 4 4 5 5 5 5
  1.5 1.5 2 2 2 2.5 2.5 2.5 3 3 3.5 3.5 3.5 3.5 3.5 4 4 4 4 4 4 4 5 5 5 5 8
  1.5 1.5 1.5 2 2 2 2 2.5 2.5 2.5 2.5 2.5 3 3 3  3.5 3.5 3.5 3.5 3.5 4 4 4 4 5 5 5 5
  1.5 2 2 2 2.5 2.5 2.5 3 3 3.5 3.5 3.5 3.5 3.5 4 4 4 4 4 4 4 5 5 5 5))
  (setq ptr1 '(0.3 0.5 0.5 0.5 0.5 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 1 1 1 1.2 1.2 1.2 1.2 1.2 1.5 1.5 1.5 1.5 2 2 2
  0.5 0.5 0.8 0.8 0.8 0.8 0.8 0.8 1 1 1.2 1.2 1.2 1.2 1.2 1.5 1.5 1.5 1.5 1.5 1.5 1.5 2 2 2 2 3.5
  0.5 0.5 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 0.8 1 1 1 1.2 1.2 1.2 1.2 1.2 1.2 1.5 1.5 1.5 1.5 2 2 2 2
  0.5 0.8 0.8 0.8 0.8 0.8 0.8 1 1 1.2 1.2 1.2 1.2 1.2 1.5 1.5 1.5 1.5 1.5 1.5 1.5 2 2 2 2 ))
   (setq os(getvar"osmode")) ;;保存OSNAP系统变量值。
  (setvar"osmode"0)        ;;关闭捕捉功能
  (setq p0 (getpoint"\n输入绘图起点:"))
   (setq kk (getstring "\n轴承型号："))
  (setq k (vl-position kk ptkk))
  
  (setq bb (nth k ptbb))
  (setq dd (nth k ptdd))
  (setq cc (nth k ptcc ))
  (setq tt (nth k pttt))
  (setq r (nth k ptr ))
  (setq r1 (nth k ptr1))
  ;;;按国标GB4459.7-1998机械制图简化画法计算各点的坐标。
  (setq kk1 (atoi kk))
  (setq aa (/ (* 15 pi) 180.0))
  (setq ak (/ (sin aa) (cos aa)))
  (setq rr1 (/ dd 2.0))
  (SETQ KKK (REM KK1 100))
  (if (> kkk 3)  (setq rr2 (* 2.5 kkk)));;;尾数02及03轴承内径不能按5进制算法
  (IF (= kkk 3)  (SETQ rr2 8.5))        ;;;所以用条件判断得出直径
  (IF (= kkk 2)  (SETQ rr2 7.5))        ;;;02的内径为15mm,03的内径为17mm,其它遵循5进制.
  (setq a2 (/ ( - rr1 rr2) 2.0))
  (setq a4 (/ a2 2.0))
  (setq p1 (polar p0 0 (- tt bb)))
  (setq p2 (polar p0 0 tt))
  (setq p3 (polar p2 (/ pi 2.0 ) (+ rr2 r)))
  (setq p4 (polar p2 (/ pi 2.0 ) (- (+ rr2 a2) r)))
  (setq p5 (polar p4 ( * pi 0.75 ) (* (sqrt 2)  r)))
  (setq p6 (list (+ (car p0) cc) (+ (cadr p0) rr2 a2)))
  (setq p7 (polar p6 (/ pi 2.0 ) (- a2 r1)))
  (setq p8 (polar p7 (* pi 0.75)  (* (sqrt 2) r1)))
  (setq p10 (polar p0 (/ pi 2.0) (- rr1 r)))
  (setq p9 (polar p10 ( /  pi 4.0) (* (sqrt 2) r)))
  (setq pc0 (list(+ (car p0) (/ tt 2.0)) (+ (cadr p0) rr2 a2)))
  (setq p11 (list (car p0) (- (+ (/ a4 (cos aa)) (cadr pc0)) (* (/ tt 2.0) ak))))
  (setq p12 (polar p11 aa (/ cc (cos aa))))
  (setq p14 (polar p12 (+ pi aa) (* (- (cadr p12) (cadr p6)) (sin aa))))
  (setq p13 (polar p14 (- aa (/ pi 2)) a2))
  (setq p110 (polar pc0 (+ aa (/ pi 2.0)) a4))
  (setq p16 (list  (- (* 2.0 (car p110)) (car p14)) (- (* 2.0 (cadr p110)) (cadr p14))))
  (setq p15 (polar p16 (- aa (/ pi 2.0)) a2))
  (setq p17 (polar p1 (/ pi 2.0) (+ rr2 a4)))
  (setq p18 (list (+ (car p16) (* (- (cadr p16) (cadr p17)) ak)) (cadr p17)))
  (setq p19 (polar p1 (/ pi 2.0) (+ rr2 r1)))
  (setq p20 (list (+ (car p1) r1) (+ (cadr p1 ) rr2)))
  (setq p21(polar p20 0 (- bb r1 r)))
  (setq pc1 (polar p3 pi r))
  (setq pc2 (polar p4 pi r))
  (setq pc3 (polar p7 pi r1))
  (setq pc4 (polar p10 0  r))
  (setq pc5 (polar p19 0 r1))
  (setq pp0 (polar p0 0 -2))
  (setq pp2 (polar p2 0 2))
  ;;;绘图命令。
  (command "layer" "s" "粗实线" "");;;将粗实线层置为当前图层
  (setq abcd (ssadd)) ;;;建立选择集
  (command "pline" p18"w""0" "0" p17 p19 "a""ce" pc5 p20 "l" p21  "a""ce" pc1 p3 "l" p4
  "a""ce"pc2 p5"l" p6 p13 p15 p18"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (setq abcd1 (ssget "l"))
  (command "layer" "s" "剖面线" "")
  (command "hatch" "u" "45" 2 "n" abcd "")
  (setq abcd (ssadd (entlast) abcd1));;;将最后创建的对象加入选择集
  (command "layer" "s" "粗实线" "");;;将粗实线层置为当前图层
  (command "pline" p12 p7 "a" "ce"pc3 p8 "l" p9 "a""ce"pc4 p10 "l"p11 p12"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (setq abcd2 (ssget "l"))
  (command "layer" "s" "剖面线" "")
  (command "hatch" "u" "135" 2 "n" abcd2 "")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "layer" "s" "粗实线" "");;;将粗实线层置为当前图层
  (command "line" p0 p11"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "line" p2 p3"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "line" p1 p19"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "line" p6 p12"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "line" p6 p14"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "line" p16 p18"")
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "mirror" abcd"" pp0 pp2 "");;;镜像选择集
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集
  (command "layer" "s" "中心线" "")   ;;;将中心线置于当前层
  (command "line" pp0 pp2"")          ;;;绘制中心线.
  (setq abcd (ssadd (entlast) abcd));;;将最后创建的对象加入选择集

  
  (setvar"osmode"os)  ;;;恢复系统变量值。
  (princ) ;;;退出程序
)