请帮忙给程序查错

bbb1980726

初学，错误可能较多，麻烦哪位大大帮忙看看哪些地方出错，

(defun c:xkyc_1 ()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq sr1 (getreal "\n输入壁厚"))
  (setq sr2 (getreal "\n输入瓶口以下高度"))
  (setq sr3 (getreal "\n需做轻的重量"))
  (setq sr4 (getreal "\n冲头直径（口内径"))
  (setq sr5 (getreal "\n输入底到肩高度"))
  (setq sr6 (getreal "\n瓶子重量"))
  (setq sr7 (getreal "\n输入初模颈部直径"))
  (setq sr8 (getreal "\n输入瓶总高"))
  (setq sr9 (getreal "\n输入瓶底凸起高度"))
  (setq sr1 (getreal "\n输入口模内腔含套筒高度"))
  ;以上为用户需输入参数
  (setq p1 (getpoint "\n请输入一点"))
  (setq p2 (polar p1 (* pi 1.5) (- sr8 sr9 sr10)))
  (setq l_ysl (- (/ 8 sr2) (+ 20 sr1) 100)) ;计算延伸量
  (setq p3 (polar p2 (* pi 0.5) l_ysl))
  (setq p4 (polar p3 (* pi 0.5) 4))
  (setq h1 (distance p1 p3));计算初胚总长
  (setq h2 (- (* h1 20) 98));计算初胚根部位置
  (setq p5 (polar p1 (* pi 1.5) h2))
  (setq h3 (- (+ (* 5 h1) (/ 9 (/ sr5 sr2) 100)) 159));计算初胚肩部位置
  (setq p6 (polar p1 (* pi 1.5) h3))
  (setq d4 (+ (- (* 67 sr6) (+ 682 h1)) 37));计算初胚根部直径
  (setq p7 (polar p5 pi (* 0.5 d4)))
  (setq d5 (+ (/ 9 d4) 14));计算初胚闷头直径
  (setq p8 (polar p4 pi (* 0.5 d5)))
  (setq d3 (+ (- (* 28 sr6) (* 11 h1)) 39));计算初胚肩部直径
  (setq p9 (polar p4 pi (* 0.5 d3)))
  (setq h6 (* 5 (- h2 h3)));计算腰部直径
  (setq p10 (polar p6 (* pi 1.5) h6))
  ;计算初胚腰部直径，并绘制腰部直线
  (command "line" p7 p9 "")
  (setq ll2 (entlast))
  (setq pp10 (polar p10 pi 100))
  (command "line" p10 pp10 "")
  (setq ll3 (entlast))
  (command "trim" ll2 "" (list ll3 pp10) "")
  (setq ll3data (entget ll3))
  (setq pp11 (cdr (assoc 11 ll3data)))
  (setq h4 (distance p5 p6))
  (setq sd (* 0.04 h4))
  (setq dd3 (distance p10 pp11))
  (setq dd4 (- dd3 sd))
  (command "line" p10 (polar p10 pi dd4) "")
  (setq l3 (entlast))
  ;至此，初模各要素点设置完成，下面开始画初模各段直线及圆弧
  (command "line" p4 p8 "")
  (setq l1 (entlast))
  (command "line" p5 p7 "")
  (setq l2  (entlast))
  (command "line" p6 p9 "")
  (setq l4  (entlast))
  (setq cen1 (polar p7 0 70))
  (command "arc" p7 "c" cen1 p8)
  (setq r1 (entlast))
  ;下面画一段辅助线
  (setq pp1 (polar p3 pi 38))
  (command "line" p3 pp1 "")
  (setq ll1 (entlast))
  ;下面r2半径
  (setq pp2 (polar cen1 (* pi 1.02) 70))
  (setq pp3 (polar p3 pi 8))
  (command "circle" "_3p" "tan" pp2 "tan" pp3 p8)
  (setq cc1 (entlast))
  (setq cc1data (entget cc1))
  (setq rr1 (cdr (assoc 40 cc1data)))
  (setq rr2 (* 0.83 rr1));暂定r2的求值系数为0.83，可实际应用时调节，以作最佳
  (setq rr3 (rtos rr2 2 4))
  (setq rr4 (atoi rr3))
  ;下面求r2圆心
  (setq pp4 (polar p8 0 rr4))
  (command "arc" pp4 "c" p8 p7)
  (setq aa1 (entlast))
  (entdel cc1)
  (setq pp5 (polar p7 0 rr4))
  (command "arc" "c" cen1 pp5 p8)
  (setq aa2 (entlast))
  (setq pp6 (polar p8 (* pi 0.5) rr4))
  (command "trim" aa1 aa2 "" (list aa1 pp6) "")
  (vl-load-com)
  (setq vaa1 (vlax-ename->vla-object aa1))
  (setq pp7 (vlax-curve-getclosestpointto vaa1 p7))
  ;下面画r2
  (command "circle" pp7 rr4)
  (setq r2 (entlast))
  ;下面准备画r3
  (command "erase" aa1 aa2 "")
  (command "mirror" r2 "" p3 p4 "")
  (setq rr2 (entlast))
  (setq r2data (entget r2))
  (setq r2r (cdr (assoc 40 r2data)))
  (setq r2cen (cdr (assoc 10 r2data)))
  (setq pp4 (polar r2cen (* pi 1.5) r2r))
  (setq rr2data (entget rr2))
  (setq rr2r (cdr (assoc 40 rr2data)))
  (setq rr2cen (cdr (assoc 10 rr2data)))
  (setq pp5 (polar r2cen (* pi 1.5) rr2r))
  (command "circle" "3p" "tan" pp4 p3 "tan" pp5);画r3
  (setq r3 (entget))
  (setq r3data (entget r3))
  (setq rr3 (cdr (assoc 40 r3data)))
  (setq pp1 (polar p3 (* pi 0.5) (* rr3 2)))
  (setq vr1 (vlax-ename->vla-object r1))
  (setq pp2 (vlax-curve-getclosestpointto vr1 p8))
  (setq pp3 (polar pp7 0 rr4))
  (command "trim" ll1 r2 "" (list r3 pp1) "");修剪r3
  (command "trim" r1 r2 r3 "" (list r1 pp2) "");修剪r1
  (command "trim" r1 r2 r3 "" (list r2 3) "");修剪r2
  (command "erase" ll1 ll2 ll3 rr2 "")
  (setvar "osmode" os)
  (setvar "clayer" lodlay)
  (prin1)
  )

julson

(defun c:xkyc_1 ()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq sr1 (getreal "\n输入壁厚"))
  (setq sr2 (getreal "\n输入瓶口以下高度"))
  (setq sr3 (getreal "\n需做轻的重量"))
  (setq sr4 (getreal "\n冲头直径（口内径"))
  (setq sr5 (getreal "\n输入底到肩高度"))
  (setq sr6 (getreal "\n瓶子重量"))
  (setq sr7 (getreal "\n输入初模颈部直径"))
  (setq sr8 (getreal "\n输入瓶总高"))
  (setq sr9 (getreal "\n输入瓶底凸起高度"))
  (setq sr1 (getreal "\n输入口模内腔含套筒高度"))
  ;以上为用户需输入参数
  (setq p1 (getpoint "\n请输入一点"))
  (setq p2 (polar p1 (* pi 1.5) (- sr8 sr9 sr10)))
  (setq l_ysl (- (/ 8 sr2) (+ 20 sr1) 100)) ;计算延伸量
  (setq p3 (polar p2 (* pi 0.5) l_ysl))
  (setq p4 (polar p3 (* pi 0.5) 4))
  (setq h1 (distance p1 p3));计算初胚总长
  (setq h2 (- (* h1 20) 98));计算初胚根部位置
  (setq p5 (polar p1 (* pi 1.5) h2))
  (setq h3 (- (+ (* 5 h1) (/ 9 (/ sr5 sr2) 100)) 159));计算初胚肩部位置
  (setq p6 (polar p1 (* pi 1.5) h3))
  (setq d4 (+ (- (* 67 sr6) (+ 682 h1)) 37));计算初胚根部直径
  (setq p7 (polar p5 pi (* 0.5 d4)))
  (setq d5 (+ (/ 9 d4) 14));计算初胚闷头直径
  (setq p8 (polar p4 pi (* 0.5 d5)))
  (setq d3 (+ (- (* 28 sr6) (* 11 h1)) 39));计算初胚肩部直径
  (setq p9 (polar p4 pi (* 0.5 d3)))
  (setq h6 (* 5 (- h2 h3)));计算腰部直径
  (setq p10 (polar p6 (* pi 1.5) h6))
  ;计算初胚腰部直径，并绘制腰部直线
  (command "line" p7 p9 "")
  (setq ll2 (entlast))
  (setq pp10 (polar p10 pi 100))
  (command "line" p10 pp10 "")
  (setq ll3 (entlast))
  (command "trim" ll2 "" (list ll3 pp10) "")
  (setq ll3data (entget ll3))
  (setq pp11 (cdr (assoc 11 ll3data)))
  (setq h4 (distance p5 p6))
  (setq sd (* 0.04 h4))
  (setq dd3 (distance p10 pp11))
  (setq dd4 (- dd3 sd))
  (command "line" p10 (polar p10 pi dd4) "")
  (setq l3 (entlast))
  ;至此，初模各要素点设置完成，下面开始画初模各段直线及圆弧
  (command "line" p4 p8 "")
  (setq l1 (entlast))
  (command "line" p5 p7 "")
  (setq l2  (entlast))
  (command "line" p6 p9 "")
  (setq l4  (entlast))
  (setq cen1 (polar p7 0 70))
  (command "arc" p7 "c" cen1 p8)
  (setq r1 (entlast))
  ;下面画一段辅助线
  (setq pp1 (polar p3 pi 38))
  (command "line" p3 pp1 "")
  (setq ll1 (entlast))
  ;下面r2半径
  (setq pp2 (polar cen1 (* pi 1.02) 70))
  (setq pp3 (polar p3 pi 8))
  (command "circle" "_3p" "tan" pp2 "tan" pp3 p8)
  (setq cc1 (entlast))
  (setq cc1data (entget cc1))
  (setq rr1 (cdr (assoc 40 cc1data)))
  (setq rr2 (* 0.83 rr1));暂定r2的求值系数为0.83，可实际应用时调节，以作最佳
  (setq rr3 (rtos rr2 2 4))
  (setq rr4 (atoi rr3))
  ;下面求r2圆心
  (setq pp4 (polar p8 0 rr4))
  (command "arc" pp4 "c" p8 p7)
  (setq aa1 (entlast))
  (entdel cc1)
  (setq pp5 (polar p7 0 rr4))
  (command "arc" "c" cen1 pp5 p8)
  (setq aa2 (entlast))
  (setq pp6 (polar p8 (* pi 0.5) rr4))
  (command "trim" aa1 aa2 "" (list aa1 pp6) "")
  (vl-load-com)
  (setq vaa1 (vlax-ename->vla-object aa1))
  (setq pp7 (vlax-curve-getclosestpointto vaa1 p7))
  ;下面画r2
  (command "circle" pp7 rr4)
  (setq r2 (entlast))
  ;下面准备画r3
  (command "erase" aa1 aa2 "")
  (command "mirror" r2 "" p3 p4 "")
  (setq rr2 (entlast))
  (setq r2data (entget r2))
  (setq r2r (cdr (assoc 40 r2data)))
  (setq r2cen (cdr (assoc 10 r2data)))
  (setq pp4 (polar r2cen (* pi 1.5) r2r))
  (setq rr2data (entget rr2))
  (setq rr2r (cdr (assoc 40 rr2data)))
  (setq rr2cen (cdr (assoc 10 rr2data)))
  (setq pp5 (polar r2cen (* pi 1.5) rr2r))
  (command "circle" "3p" "tan" pp4 p3 "tan" pp5);画r3
  (setq r3 (entget))
  (setq r3data (entget r3))
  (setq rr3 (cdr (assoc 40 r3data)))
  (setq pp1 (polar p3 (* pi 0.5) (* rr3 2)))
  (setq vr1 (vlax-ename->vla-object r1))
  (setq pp2 (vlax-curve-getclosestpointto vr1 p8))
  (setq pp3 (polar pp7 0 rr4))
  (command "trim" ll1 r2 "" (list r3 pp1) "");修剪r3
  (command "trim" r1 r2 r3 "" (list r1 pp2) "");修剪r1
  (command "trim" r1 r2 r3 "" (list r2 3) "");修剪r2
  (command "erase" ll1 ll2 ll3 rr2 "")
  (setvar "osmode" os)
  (setvar "clayer" lodlay)
  (prin1)
  )

bbb1980726

呵呵，谢谢julson兄，上面几处已改，是我转抄时抄错了，现在再试试程序行不？

再次谢谢

bbb1980726

我在运行程序时，最容易出错的地方在画r3时，也就是

  (setq pp4 (polar r2cen (* pi 1.5) r2r))
  (setq rr2data (entget rr2))
  (setq rr2r (cdr (assoc 40 rr2data)))
  (setq rr2cen (cdr (assoc 10 rr2data)))
  (setq pp5 (polar r2cen (* pi 1.5) rr2r))
  (command "circle" "3p" "tan" pp4 p3 "tan" pp5);画r3

不知道是不是这种画三切圆的用法有问题，大家能否指点一下？

ZZXXQQ

(setq pp5 (polar rr2cen (* pi 1.5) rr2r))

bbb1980726

谢谢版主，我查了原来写的程序，是转抄时少的，谢谢提醒，

我还想明白在lisp中这种做三切圆的做法行不行，确实很着急，就卡这了（我在运行到画r2时好像一直没问题，但运行到画r3时就是过不去，还请指点！

ZZXXQQ

如果要画相切圆，首先要求能显示（看到）图形，不然捕捉不到特征点。

bbb1980726

谢谢版主，我再查查资料