[分享]：画螺栓螺母的LISP程序

lgwlgw

;;;螺栓螺母的lisp程序
;;;=================================================================
(defun C:bls()
(setq o(getpoint "\n 输入插入点:"))
(setq d0(getreal "\n 输入螺栓规格:"))
(setq l0(getDIST O "\n 输入螺栓长度:"))
(SETQ SC(GETREAL "\n 输入比例系数:"))
(setq ang1(getangle o "\n 输入旋转角度:"))
(setq zx(getstring "\n 是否要中心线(Yes/<No>):"))
(setq os(getvar "osmode"))
(setq ang (/ (* 180 ang1) Pi))
(command "osmode" 0)
(cond ((= d0 5) (setq e0 8.63) (setq k0 3.5) (setq l1 20.0) (setq l2 16))
       ((= D0 6) (setq E0 11.0) (setq k0 4.0) (setq l1 23.0) (setq l2 18))
       ((= D0 8) (setq E0 14.4) (setq k0 5.3) (setq l1 28.25) (setq l2 22))
       ((= D0 10) (setq E0 17.8) (setq k0 6.4) (setq l1 33.5) (setq l2 26))
       ((= D0 12) (setq E0 20.0) (setq k0 7.5) (setq l1 38.75) (setq l2 30))
       ((= D0 16) (setq E0 26.8) (setq k0 10.0) (setq l1 48.0) (setq l2 38))
       ((= D0 20) (setq E0 33.0) (setq k0 12.5) (setq l1 58.5) (setq l2 46))
       ((= D0 24) (setq E0 39.6) (setq k0 15.0) (setq l1 69.0) (setq l2 54))
       ((= D0 30) (setq E0 50.9) (setq k0 18.7) (setq l1 83.5) (setq l2 66))
       ((= D0 36) (setq E0 60.8) (setq k0 22.5) (setq l1 95.5) (setq l2 78))
       ((= D0 42) (setq E0 72) (setq k0 26) (setq l1 113.5) (setq l2 96))
       ((= D0 48) (setq E0 82.6) (setq k0 30) (setq l1 121.5) (setq l2 108))
       ((= D0 56) (setq E0 93.6) (setq k0 35) (setq l1 137.5) (setq l2 124))
       ((= D0 64) (setq E0 104.9) (setq k0 40) (setq l1 153.5) (setq l2 140))
      
  )
  (SETQ D(* d0 sc))
  (setq e(* e0 sc))
  (setq k(* k0 sc))
  (setq ls(* sc (- l0 l1)))
  (setq lg(* sc (- l0 l2)))
  (setq l(* l0 sc))
  (setq k1(SQRT (- (* 2.25 (* d d)) (/ (* e e) 16))))
  (setq h(- (* 1.5 d) k1))
  (setq r1 (+ (* h h) (/ (* e e) 64)))
  (setq r (/ (/ r1 2) h))
  (setq P1 (list 0 (/ e 2)))
  (setq p2 (list 0 (- 0 (/ e 2))))
  (command "ucs" "o" o)
  (command "ucs" "z" ang)
  (command "line" p1 p2 "")
  (setq P3 (list (- (* 1.5 d) (+ k k1)) (/ e 4)))
  (setq p4 (list (- (* 1.5 d) (+ k k1)) (- 0 (/ e 4))))
  (setq C1 (list (- (* 1.5 d) k) 0))
  (command "arc" p3 "c" c1 p4)
  (setq p5 (list 0 (/ e 4)))
  (setq p6 (list 0 (- 0 (/ e 4))))
  (command "line" p3 p5 "")
  (command "line" p4 p6 "")
  (setq p7 (list (- (* 1.5 d) (+ k k1)) (/ e 2)))
  (setq c2 (list (- r k) (* 0.375 e)))
  (command "arc" p7 "c" c2 p3)
  (setq p8 (list (- (* 1.5 d) (+ k k1)) (- 0 (/ e 2))))
  (setq c3 (list (- r k) (- 0 (* 0.375 e))))
  (command "arc" p4 "c" c3 p8)
  (command "line" p7 p1 "")
  (command "line" P8 p2 "")
  (setq p9 (list (- 0 K) (* 0.375 e)))
  (setq p10 (list (- 0 k) (- 0 (* 0.375 e))))
  (command "line" p9 p10 "")
  (setq p11 (list 0 (/ d 2)))
  (setq p12 (list (- l (* 0.075 d)) (/ d 2)))
  (command "line" p11 p12 "")
  (setq p13 (list 0 (- 0 (/ d 2))))
  (setq p14 (list (- l (* 0.075 d)) (- 0 (/ d 2))))
  (command "line" p13 p14 "")
  (setq P19 (list Lg (/ d 2)))
  (setq p20 (list lg (- 0 (/ d 2))))
  (command "line" p19 p20 "")
  (SETQ P15 (list lg (* 0.425 d)))
  (setq p16 (list l (*  0.425 d)))
  (setq p17 (list lg (- 0 (* 0.425 D))))
  (setq p18 (list l (- 0 (* 0.425 d))))
  (setq p21 (list ls (/ d 2)))
  (setq p22 (list ls (- 0 (/ d 2))))
  (command "line" p15 p16 "")
  (command "line" p17 p18 "")
  (command "line" p16 p18 "")
  (command "line" p16 p12 "")
  (command "line" p14 p18 "")
  (command "line" p15 p21 "")
  (command "line" p17 p22 "")
  (command "line" p12 p14 "")
  (cond ((or (= zx "y") (= zx "Y"))
        (setq zx1 (list (- -3 k) 0))
        (setq zx2 (list (+ l 3) 0))
        (setq olay(getvar"clayer"))
        (setvar "clayer" "cen")
        (command "line" zx1 zx2 "")
        (setvar "clayer" olay))
  )
  (command "ucs" "z" (- 0 ang))
  (command "ucs" "w")
  (command "osmode" os)
  (COMMAND "REDRAWALL")
  (COMMAND "REGEN")
  (princ)
)
;;;============================================================
(defun C:dd()
(setq o(getpoint "\n 输入插入点:"))
(setq d0(getreal "\n 输入弹垫规格:"))
(SETQ SC(GETREAL "\n 输入比例系数:"))
(setq ang1(getangle o "\n 输入旋转角度:"))
(setq ang(- (/ (* ang1 180) pi) 90))
(setq os(getvar "osmode"))
(command "osmode" 0)
(cond ((= d0 5) (setq d1 5.1) (setq b0 1.3) (setq m0 0.65))
       ((= D0 6) (setq d1 6.1) (setq b0 1.6) (setq m0 0.8))
       ((= D0 8) (setq d1 8.1) (setq b0 2.1) (setq m0 1.05))
       ((= D0 10) (setq d1 10.2) (setq b0 2.6) (setq m0 1.3))
       ((= D0 12) (setq d1 12.2) (setq b0 3.1) (setq m0 1.55))
       ((= D0 16) (setq d1 16.2) (setq b0 4.1) (setq m0 2.05))
       ((= D0 20) (setq d1 20.2) (setq b0 5.0) (setq m0 2.5))
       ((= D0 24) (setq d1 24.5) (setq b0 6.0) (setq m0 3.0))
       ((= D0 30) (setq d1 30.5) (setq b0 7.5) (setq m0 3.75))
       ((= D0 36) (setq d1 36.5) (setq b0 9.0) (setq m0 4.5))
       ((= D0 42) (setq d1 42.5) (setq b0 10.5) (setq m0 5.25))
       ((= D0 48) (setq d1 48.5) (setq b0 12.0) (setq m0 6.0))
)
  (SETQ D(* d1 sc))
  (setq b(* b0 sc))
  (setq m(* m0 sc))
  (setq c(cos (xl_dtor 15)))
  (setq t(/ (sin (xl_dtor 15)) c))
  (setq p1(list (- 0 (/ (+ b d) 2)) 0))
  (setq p2(list (/ (+ b d) 2) 0))
  (command "ucs" "o" o)
  (command "ucs" "z" ang)
  (command "line" p1 p2 "")
  (setq p3(list (- 0 (/ (+ b d) 2)) b))
  (setq p4(list (/ (+ b d) 2) b))
  (command "line" p3 p4 "")
  (command "line" p4 p2 "")
  (COMMAND "LINE" P3 P1 "")
  (SETQ P5 (LIST (/ M (* 2 C)) 0))
  (SETQ p6 (LIST (- (/ M (* C 2)) (* T B)) B))
  (command "line" p5 p6 "")
  (setq p7 (list (- 0 (/ m (* 2 c))) 0))
  (setq p8 (list (- 0 (+ (/ m (* 2 c)) (* b t))) b))
  (command "line" p7 p8 "")
  (command "ucs" "z" (- 0 ang))
  (command "ucs" "w")
  (command "osmode" os)
  (COMMAND "REDRAWALL")
  (princ)
)
;;;=================================================================
(defun C:LM()
(setq o(getpoint "\n 输入插入点:"))
(setq d0(getreal "\n 输入螺母规格:"))
(SETQ SC(GETREAL "\n 输入比例系数:"))
(setq ang1(getangle o "\n 输入旋转角度:"))
(setq ang(- (/ (* ang1 180) pi) 90))
(setq os(getvar "osmode"))
(command "osmode" 0)
(cond ((= d0 5) (setq e0 8.63) (setq m0 5.6))
       ((= D0 6) (setq E0 11.0) (setq m0 6.1))
       ((= D0 8) (setq E0 14.4) (setq m0 7.9))
       ((= D0 10) (setq E0 17.8) (setq m0 9.5))
       ((= D0 12) (setq E0 20.0) (setq m0 12.2))
       ((= D0 14) (setq E0 23.4) (setq m0 13.9))
       ((= D0 16) (setq E0 26.8) (setq m0 14.9))
       ((= D0 18) (setq E0 29.6) (setq m0 15.9))
       ((= D0 20) (setq E0 33.0) (setq m0 18.7))
       ((= D0 24) (setq E0 39.6) (setq m0 22.3))
       ((= D0 30) (setq E0 50.9) (setq m0 26.4))
       ((= D0 36) (setq E0 60.8) (setq m0 31.5))
       ((= D0 42) (setq E0 72) (setq m0 34.9))
       ((= D0 48) (setq E0 82.6) (setq m0 38.9))
       ((= D0 56) (setq E0 93.6) (setq m0 45.9))
       ((= D0 64) (setq E0 104.9) (setq m0 52.4))
       ((= d0 4) (setq e0 7.7) (setq m0 3.2))
)
  (SETQ D(* d0 sc))
  (setq e(* e0 sc))
  (setq m(* m0 sc))
  (setq H1(SQRT (- (* 2.25 (* d d)) (/ (* e e) 16))))
  (setq h(- (* 1.5 d) h1))
  (setq r1 (+ (* h h) (/ (* e e) 64)))
  (setq r (/ (/ r1 2) h))
  (setq P1 (list (/ e 2) (- m h)))
  (setq p2 (list (/ e 4) (- m h)))
  (setq c1 (list (* 0.375 E) (- m r)))
  (command "ucs" "o" o)
  (command "ucs" "z" ang)
  (command "arc" p1 "c" c1 p2)
  (setq P3 (list (/ e 4) h))
  (setq p4 (list (/ e 2) h))
  (setq C2 (list (* 0.375 e) r))
  (command "arc" p3 "c" c2 p4)
  (setq p5 (list (- 0 (/ e 4)) (- m h)))
  (setq p6 (list (- 0 (/ e 2)) (- m h)))
  (setq c3 (list (- 0 (* 0.375 e)) (- m r)))
  (command "arc" p5 "c" c3 p6)
  (setq p7 (list (- 0 (/ e 2)) h))
  (setq p8 (list (- 0 (/ e 4)) h))
  (setq c4 (list (- 0 (* 0.375 e)) r))
  (command "arc" p7 "c" c4 p8)
  (command "line" p1 p4 "")
  (command "line" p2 p3 "")
  (command "line" p5 p8 "")
  (command "line" p6 p7 "")
  (setq P9 (list (* 0.375 e) m))
  (setq p10 (list (- 0 (* 0.375 e)) m))
  (command "line" p9 p10 "")
  (setq p11 (list (* 0.375 e) 0))
  (setq p12 (list (- 0 (* 0.375 e)) 0))
  (command "line" p11 p12 "")
  (setq c5 (list 0 (- m (* 1.5 d))))
  (command "arc" p2 "c" c5 p5)
  (setq c6 (list 0 (* 1.5 d)))
  (command "arc" p8 "c" c6 p3)
  (command "ucs" "z" (- 0 ang))
  (command "ucs" "w")
  (command "osmode" os)
  (COMMAND "REDRAWALL")
  (COMMAND "REGEN")
  (princ)
)
;;;================================================================================
(defun C:lst()
(setq c (getpoint "\n 输入螺栓中心点:"))
(setq m (getreal "\n 输入螺栓规格:"))
(setq e (getreal "\n 输入绘图比例:"))
(setq ang(getangle c "\n 输入旋转角度:"))
(setq zx(getstring "\n 是否要中心线(Yes/<No>):"))

(cond ((= m 6) (setq s0 10))
       ((= m 8) (setq s0 13))
       ((= m 10) (setq s0 16))
       ((= m 12) (setq s0 18))
       ((= m 16) (setq s0 24))
       ((= m 20) (setq s0 30))
       ((= m 24) (setq s0 36))
       ((= m 30) (setq s0 46))
  )   
  (setq os (getvar "osmode"))
  (command "osmode" 0)
  (setq s (* s0 e))
  (setq r (/ s 2))
  (SETQ R1 (/ R (SIN (/ PI 3))))
  (SETQ RR (+ R1 3))
  (setq P1(polar c (- ang (/ pi 2)) r))
  (command  "circle" c "d" s)
  (command "polygon" "6" c "c" p1)
  (cond ((or (= zx "y") (= zx "Y"))
        (setq zx1 (polar c (- ang 0) (+ rR 3)))
        (setq zx2 (polar c (- ang (/ pi 1)) (+ rR 3)))
        (setq zx3 (polar c (- ang (/ pi 2)) (+ rR 3)))
        (setq zx4 (polar c (- ang (* pi 1.5)) (+ rR 3)))
        (command "line" zx3 zx4 "")
        (command "line" zx1 zx2 ""))
  )
  (command "osmode" os)
  (princ)
)
;;;===============================================================
(defun C:nlj()
(setq os (getvar "osmode"))
(setq o(getpoint "\n 输入插入点:"))
(setq d0(getreal "\n 输入内六角圆柱头螺钉规格:"))
(setq l0(getdist o  "\n 输入内六角圆柱头螺钉长度:"))
(SETQ SC(GETREAL "\n 输入比例系数:"))
(setq ang1(getangle o "\n 输入旋转角度:"))
(setq os (getvar "osmode"))
(command "osmode" 0)
(setq ang(/ (* 180 ang1) pi))
(cond ((= d0 5) (setq e0 4.58) (setq k0 8.5) (setq r0 1))
       ((= D0 6) (setq E0 5.72) (setq k0 10.0) (SETQ R0 1.2))
       ((= D0 8) (setq E0 6.86) (setq k0 13.0) (SETQ R0 1.2))
       ((= D0 10) (setq E0 9.12) (setq k0 16.0) (SETQ R0 1.5))
       ((= D0 12) (setq E0 11.43) (setq k0 18.0) (SETQ R0 1.5))
       ((= D0 16) (setq E0 16) (setq k0 24.0) (SETQ R0 2))
       ((= D0 20) (setq E0 19.44) (setq k0 30.0) (SETQ R0 2.5))
       ((= D0 24) (setq E0 21.73) (setq k0 36.0) (SETQ R0 3))
       ((= D0 30) (setq E0 25.15) (setq k0 45.0) (SETQ R0 3.5))
  )
  (SETQ R(* R0 SC))
  (SETQ D(* d0 sc))
  (setq dr (/ d 2))  
  (setq d4 (* d 0.425))
  (setq e(* e0 sc))
  (setq k(* k0 sc))
  (setq kr(/ k 2))
  (setq l(* l0 sc))
  (setq p1 (list (- 0 d) (- kr r)))
  (setq p2 (list (- 0 d) (- r kr)))
  (setq p4 (list 0 (- 0 kr)))
  (setq p3 (list (- r d) (- 0 kr)))
  (setq p5 (list 0 kr))
  (setq p6 (list (- r d) kr))
  (setq c1 (list (- r d) (- kr r)))
  (setq c2 (list (- r d) (- r kr)))
  (command "ucs" "o" o)
  (command "ucs" "z" ang)
  (command "pline" p1 "w" 0 0 p2 "a" "ce" c2 p3 "l" p4 p5 p6 "a" "ce" c1 p1 "")
  (setq dj (* d 0.075))
  (setq p7 (LIST 0 (- 0 dr)))
  (setq p8 (list (- l dj) (- 0 dr)))
  (setq p9 (list l (- 0 d4)))
  (setq p10 (list l d4))
  (setq p11 (list (- l dj) dr))
  (setq p12 (list 0 dr))
  (setq p13 (list 0 d4))
  (setq p14 (list 0 (- 0 d4)))
  (command "line" p7 p8 p9 p10 p11 p12 "")
  (command "line" p13 p10 "")
  (command "line" p14 p9 "")
  (command "line" p11 p8 "")
  (command "ucs" "z" (- 0 ang))
  (command "ucs" "w")
  (command "osmode" os)
  (COMMAND "REDRAWALL")
  (COMMAND "REGEN")
  (princ)
)
;;;=======================================================================
(defun C:Nlw()
(setq c (getpoint "\n 输入螺纹中心点:"))
(setq m0 (getreal "\n 输入螺纹规格:"))
(setq s (getreal "\n 输入绘图比例:"))
(setq zx(getstring "\n 是否要中心线(Yes/<No>):"))
(setq os(getvar "osmode"))
(command "osmode" 0)
  (setq m (* m0 s))
  (setq r (/ m 2))
  (setq D1 (* M 0.85))
  (setq P1 (polar c (xl_dtor 100) r))
  (setq P2 (polar c (xl_dtor 10) r))
  (cond ((or (= zx "y") (= zx "Y"))
        (setq zx1 (polar c 0 (+ r 2.5)))
        (setq zx2 (polar c pi (+ r 2.5)))
        (setq zx3 (polar c (/ pi 2) (+ r 2.5)))
        (setq zx4 (polar c (* pi 1.5) (+ r 2.5)))
        (command "line" zx3 zx4 "")
        (command "line" zx1 zx2 ""))
  )
  (command  "circle" c "d" D1)
  (command "arc" p1 "c" c p2)
  (command "osmode" os)
  (princ)
)
;;;============================================================
(defun C:pd()
(setq o(getpoint "\n 输入插入点:"))
(setq d0(getreal "\n 输入平垫规格:"))
(SETQ SC(GETREAL "\n 输入比例系数:"))
(setq ang1(getangle o "\n 输入旋转角度:"))
(setq ang(- (/ (* ang1 180) pi) 90))
(setq os(getvar "osmode"))
(command "osmode" 0)
(cond ((= d0 5) (setq D20 10.0) (setq H0 1.3))
       ((= D0 6) (setq D20 12.0) (setq H0 1.6))
       ((= D0 8) (setq D20 16.0) (setq H0 2.1))
       ((= D0 10) (setq D20 20.0) (setq H0 2.6))
       ((= D0 12) (setq D20 24.0) (setq H0 3.1))
       ((= D0 16) (setq D20 30.0) (setq H0 4.1))
       ((= D0 20) (setq D20 37.0) (setq H0 5.0))
       ((= D0 24) (setq D20 44.0) (setq H0 6.0))
       ((= D0 30) (setq D20 56.0) (setq H0 7.5))
  )
  (SETQ D(* D20 sc))
  (setq H(* H0 sc))
  (SETQ P1 (LIST (- 0 (/ d 2)) 0))
  (setq p2 (list (/ d 2) 0))
  (setq p3 (list (/ d 2) h))
  (setq p4 (list (- 0 (/ d 2)) h))
  (command "ucs" "o" o)
  (command "ucs" "z" ang)
  (command "pline" p1 "w" "0" "0" p2 p3 p4 "c")
  (command "ucs" "z" (- 0 ang))
  (command "ucs" "w")
  (command "osmode" os)
  (COMMAND "REDRAWALL")
  (princ)
)
;;;===========================================================================
(defun C:qls()
(setq os (getvar "osmode"))
(setq o(getpoint "\n 输入插入点:"))
(setq d0(getreal "\n 输入螺栓规格:"))
(setq l0(getdist o  "\n 输入螺栓长度:"))
(SETQ SC(GETREAL "\n 输入比例系数:"))
(setq ang1(getangle o "\n 输入旋转角度:"))
(setq zx(getstring "\n 是否要中心线(Yes/<No>):"))
(setq os (getvar "osmode"))
(command "osmode" 0)
(setq ang(/ (* 180 ang1) pi))
(cond ((= d0 5) (setq e0 8.63) (setq k0 3.5) (setq a0 3.2))
       ((= D0 6) (setq E0 11.0) (setq k0 4.0) (setq a0 4))
       ((= D0 8) (setq E0 14.4) (setq k0 5.3) (setq a0 5))
       ((= D0 10) (setq E0 17.8) (setq k0 6.4) (setq a0 6))
       ((= D0 12) (setq E0 20.0) (setq k0 7.5) (setq a0 7))
       ((= D0 16) (setq E0 26.8) (setq k0 10.0) (setq a0 8))
       ((= D0 20) (setq E0 33.0) (setq k0 12.5) (setq a0 10))
       ((= D0 24) (setq E0 39.6) (setq k0 15.0) (setq a0 12))
       ((= D0 30) (setq E0 50.9) (setq k0 18.7) (setq a0 14))
  )
  (SETQ D(* d0 sc))
  (setq e(* e0 sc))
  (setq k(* k0 sc))
  (setq a(* a0 sc))
  (setq l(* l0 sc))
  (setq k1(SQRT (- (* 2.25 (* d d)) (/ (* e e) 16))))
  (setq h(- (* 1.5 d) k1))
  (setq r1 (+ (* h h) (/ (* e e) 64)))
  (setq r (/ (/ r1 2) h))
  (setq P1 (list 0 (/ e 2)))
  (setq p2 (list 0 (- 0 (/ e 2))))
  (command "ucs" "o" o)
  (command "ucs" "z" ang)
  (command "line" p1 p2 "")
  (setq P3 (list (- (* 1.5 d) (+ k k1)) (/ e 4)))
  (setq p4 (list (- (* 1.5 d) (+ k k1)) (- 0 (/ e 4))))
  (setq C1 (list (- (* 1.5 d) k) 0))
  (command "arc" p3 "c" c1 p4)
  (setq p5 (list 0 (/ e 4)))
  (setq p6 (list 0 (- 0 (/ e 4))))
  (command "line" p3 p5 "")
  (command "line" p4 p6 "")
  (setq p7 (list (- (* 1.5 d) (+ k k1)) (/ e 2)))
  (setq c2 (list (- r k) (* 0.375 e)))
  (command "arc" p7 "c" c2 p3)
  (setq p8 (list (- (* 1.5 d) (+ k k1)) (- 0 (/ e 2))))
  (setq c3 (list (- r k) (- 0 (* 0.375 e))))
  (command "arc" p4 "c" c3 p8)
  (command "line" p7 p1 "")
  (command "line" P8 p2 "")
  (setq p9 (list (- 0 K) (* 0.375 e)))
  (setq p10 (list (- 0 k) (- 0 (* 0.375 e))))
  (command "line" p9 p10 "")
  (setq p11 (list 0 (/ d 2)))
  (setq p12 (list (- l (* d 0.075)) (/ d 2)))
  (command "line" p11 p12 "")
  (setq p13 (list 0 (- 0 (/ d 2))))
  (setq p14 (list (- l (* d 0.075)) (- 0 (/ d 2))))
  (command "line" p13 p14 "")
  (setq P19 (list a (/ d 2)))
  (setq p20 (list a (- 0 (/ d 2))))
  (command "line" p19 p20 "")
  (SETQ P15 (list a (* 0.425 d)))
  (setq p16 (list l (*  0.425 d)))
  (setq p17 (list a (- 0 (* 0.425 D))))
  (setq p18 (list l (- 0 (* 0.425 d))))
  (command "line" p15 p16 "")
  (command "line" p17 p18 "")
  (command "line" p15 p11 "")
  (command "line" p12 p16 "")
  (command "line" p14 p18 "")
  (command "line" p17 p13 "")
  (command "line" p16 p18 "")
  (command "line" p12 p14 "")
  (cond ((or (= zx "y") (= zx "Y"))
        (setq zx1 (list (- -3 k) 0))
        (setq zx2 (list (+ l 3) 0))
        (command "line" zx1 zx2 ""))
   )
  (command "ucs" "z" (- 0 ang))
  (command "ucs" "w")
  (command "osmode" os)
  (COMMAND "REDRAWALL")
  (COMMAND "REGEN")
  (princ)
)
;;;=====================================================================
(defun C:Wlw()
(setq c (getpoint "\n 输入螺纹中心点:"))
(setq m0 (getreal "\n 输入螺纹规格:"))
(setq s (getreal "\n 输入绘图比例:"))
(setq zx(getstring "\n 是否要中心线(Yes/<No>):"))
(setq os(getvar "osmode"))
(command "osmode" 0)
  (setq m (* m0 s))
  (setq r (/ m 2))
  (setq D1 (* m 0.85))
  (SETQ R1 (/ D1 2))
  (setq P1 (polar c (xl_dtor 110) R1))
  (setq P2 (polar c (xl_dtor 10) R1))
  (command  "circle" c R)
  (command "arc" p1 "ce" c p2)
  (cond ((or (= zx "y") (= zx "Y"))
        (setq zx1 (polar c 0 (+ r 2.5)))
        (setq zx2 (polar c pi (+ r 2.5)))
        (setq zx3 (polar c (/ pi 2) (+ r 2.5)))
        (setq zx4 (polar c (* pi 1.5) (+ r 2.5)))
        (command "line" zx3 zx4 "")
        (command "line" zx1 zx2 ""))
  )
  (command "osmode" os)
  (princ)
)

cjzbdr

谢谢   楼主好人

yxianfo

"dd"、“nlw”、“wlw"这几个程序因缺少此“xl_dtor”函数（或子程序）不能完成绘制。
“bls"程序中的“(setvar "clayer" "cen")  ”  需要有图层“cen”，不通用，有的用不一定设置了“cen”图层，故应改为“(setvar "clayer" "0")”，设在“0”图层不会出问题。或者干脆不要“        (setq olay (getvar"clayer"))”、“ (setvar "clayer" "cen")”和“(setvar "clayer" olay))”这3句，无多大实用性，因为没有写出与中心线有关的代码。

zxc001975cvb

丰常感谢