求助：一个程序，有些可以运行，有些不可以

669423907

一个画螺孔的程序，我想改成可以指定螺孔规格的，但M3却变成了M2，M5变成了M4，而且这两个的中心线也有问题，
其它规格的就可以，不懂是哪里错了，恳请路过的大师帮看看，谢谢了。

;绘制螺（孔邹锋 2013.5.10 http://bbs.mjtd.com/thread-100947-3-1.html）
(defun zlk()
(command "undo" "be")
(setq la (getvar"clayer"))
(command "layer" "m" "螺纹" "c" "53" "" "lw" "0.13" "" "l" "Continuous" "" ""
"layer" "m" "3中心线" "c" "1" "" "lw" "0.13" "" "l" "CENTER" "" "" "clayer" la)
;  (if (= a nil)
;    (setq a 8)
;  )
;  (princ "\n请输入螺孔规格(M")
;  (princ (fix a))
;  (princ "):")
;  (setq x (getreal))
;  (setq x 8)
;  (cond        ((= nil (numberp x)) (setq x a))
;        ((= T (numberp x)) (setq a x))
;  )
  (setq pb (getpoint "\n请指定放置位置:"))
  (setq        m  (/ a 2)
        m1 (* 0.85 m)
        p1 (polar pb pi m)
        p2 (polar pb (* pi 1.5) m)
  )
  (command "arc" p2 "e" p1 pb)
(command "chprop" (entlast) "" "P" "la" "螺纹" "c" "byl" "lw" "byl" "lt" "byl" "")
  (setq l1 (ssget "l"))
  (command "circle" pb m1)
(command "chprop" (entlast) "" "P" "la" "0" "c" "byl" "lw" "byl" "lt" "byl" "")
  ;*********************
;计算两条直线四个点
  (setq chklty (tblsearch "LTYPE" "CENTER"))
(if (= chklty nil)
   (entmake (list '(0 . "LTYPE") '(100 . "AcDbSymbolTableRecord")  '(100 . "AcDbLinetypeTableRecord")
      (cons 2 "CENTER")

;  '(3 . "CENTER ____ _ ____ _ ____ _ ____ _ ____ _ ____")
;      '(70 . 0)  '(73 . 2) '(40 . 15.0) '(49 . 10.0)  '(74 . 0) '(49 . -5.0) '(74 . 0)

       )
      )
   )

  (setq xk (* a 0.5))
  (setq pt1 (polar pb 0 (* 1.2 (/ a 2))))
  (setq pt3 (polar pb pi (* 1.2 (/ a 2))))
  (setq pt2 (polar pb (* 0.5 pi) (* 1.2 (/ a 2))))
  (setq pt4 (polar pb (* 1.5 pi) (* 1.2 (/ a 2))))
  (entmake (list (cons 0 "LINE")
                 (CONS 62 1)
                 (cons 6  "CENTER")
                 (cons 48 xk)
                 (cons 10 pt1)
                 (cons 11 pt3)
           )
  )
(command "chprop" (entlast) "" "P" "la" "3中心线" "c" "byl" "lw" "byl" "lt" "byl" "")
  (setq en2 (entlast))
  (entmake (list (cons 0 "LINE")
                 (CONS 62 1)
                 (cons 48 xk)
                 (cons 6  "CENTER")
                 (cons 10 pt2)
                 (cons 11 pt4)
           )
  )
(command "chprop" (entlast) "" "P" "la" "3中心线" "c" "byl" "lw" "byl" "lt" "byl" "")
(command "undo" "e")
(princ))


(defun c:3`()(setq a 3)(zlk)(princ))
(defun c:4`()(setq a 4)(zlk)(princ))
(defun c:5`()(setq a 5)(zlk)(princ))
(defun c:6`()(setq a 6)(zlk)(princ))
(defun c:8`()(setq a 8)(zlk)(princ))
(defun c:10`()(setq a 10)(zlk)(princ))
(defun c:12`()(setq a 12)(zlk)(princ))
(defun c:14`()(setq a 14)(zlk)(princ))
(defun c:16`()(setq a 16)(zlk)(princ))
(defun c:18`()(setq a 18)(zlk)(princ))
(defun c:20`()(setq a 20)(zlk)(princ))
(defun c:22`()(setq a 22)(zlk)(princ))
(defun c:24`()(setq a 24)(zlk)(princ))

pzweng

程序还可以这样写呀,不知道你的lisp怎么学的

669423907

pzweng 发表于 2013-7-15 22:30
程序还可以这样写呀,不知道你的lisp怎么学的

我英文只考了几十分，一直都读不懂字母，非常惭愧。

ZZXXQQ

;直径整除了。

2. ;绘制螺（孔邹锋 2013.5.10 http://bbs.mjtd.com/thread-100947-3-1.html）
   
3. (defun zlk()
   
4. (command "undo" "be")
   
5. (setq la (getvar "clayer"))
   
6. ;  (if (= a nil) (setq a 8))
   
7. ;  (setq x (getreal (strcat "\n请输入螺孔规格(M" (rtos (fix a) 2) "):")))
   
8. ;  (or x (setq x 8))
   
9. ;  (cond
   
10. ;   ((= nil (numberp x)) (setq x a))
    
11. ;   ((= T (numberp x)) (setq a x))
    
12. ;  )
    
13. (setq pb (getpoint "\n请指定放置位置:"))
    
14. (setq m  (/ a 2.0)
    
15.        m1 (* 0.85 m)
    
16.        p1 (polar pb pi m)
    
17.        p2 (polar pb (* pi 1.5) m))
    
18. (command "layer" "m" "螺纹" "c" "53" "" "lw" "0.13" "" "")
    
19. (command "arc" p2 "e" p1 pb)
    
20. (command "layer" "m" "3中心线" "c" "1" "" "lw" "0.13" "" "lt" "CENTER" "" "")
    
21. (command "circle" pb m1)
    
22. (setvar "clayer" la)
    
23.   ;*********************
    
24. ;计算两条直线四个点
    
25. (setq pt1 (polar pb 0 (* 1.2 m)))
    
26. (setq pt3 (polar pb pi (* 1.2 m)))
    
27. (setq pt2 (polar pb (* 0.5 pi) (* 1.2 m)))
    
28. (setq pt4 (polar pb (* 1.5 pi) (* 1.2 m)))
    
29. (entmake (list (cons 0 "LINE") (cons 8 "3中心线") (cons 10 pt1) (cons 11 pt3)))
    
30. (entmake (list (cons 0 "LINE") (cons 8 "3中心线") (cons 10 pt2) (cons 11 pt4)))
    
31. (command "undo" "e")
    
32. (princ)
    
33. )
    
34. (defun c:3 ()(setq a 3)(zlk))
    
35. (defun c:4 ()(setq a 4)(zlk))
    
36. (defun c:5 ()(setq a 5)(zlk))
    
37. (defun c:6 ()(setq a 6)(zlk))
    
38. (defun c:8 ()(setq a 8)(zlk)))
    
39. (defun c:10 ()(setq a 10)(zlk))
    
40. (defun c:12 ()(setq a 12)(zlk))
    
41. (defun c:14 ()(setq a 14)(zlk))
    
42. (defun c:16 ()(setq a 16)(zlk))
    
43. (defun c:18 ()(setq a 18)(zlk))
    
44. (defun c:20 ()(setq a 20)(zlk))
    
45. (defun c:22 ()(setq a 22)(zlk))
    
46. (defun c:24 ()(setq a 24)(zlk))
    

;绘制螺（孔邹锋 2013.5.10 http://bbs.mjtd.com/thread-100947-3-1.html）<br /> (defun zlk()<br /> (command "undo" "be")<br /> (setq la (getvar "clayer"))<br /> ;  (if (= a nil) (setq a 8))<br /> ;  (setq x (getreal (strcat "\n请输入螺孔规格(M" (rtos (fix a) 2) "):")))<br /> ;  (or x (setq x 8))<br /> ;  (cond<br /> ;   ((= nil (numberp x)) (setq x a))<br /> ;   ((= T (numberp x)) (setq a x))<br /> ;  )<br /> (setq pb (getpoint "\n请指定放置位置:"))<br /> (setq m  (/ a 2.0)<br />        m1 (* 0.85 m)<br />        p1 (polar pb pi m)<br />        p2 (polar pb (* pi 1.5) m))<br /> (command "layer" "m" "螺纹" "c" "53" "" "lw" "0.13" "" "")<br /> (command "arc" p2 "e" p1 pb)<br /> (command "layer" "m" "3中心线" "c" "1" "" "lw" "0.13" "" "lt" "CENTER" "" "")<br /> (command "circle" pb m1)<br /> (setvar "clayer" la)<br />   ;*********************<br /> ;计算两条直线四个点<br /> (setq pt1 (polar pb 0 (* 1.2 m)))<br /> (setq pt3 (polar pb pi (* 1.2 m)))<br /> (setq pt2 (polar pb (* 0.5 pi) (* 1.2 m)))<br /> (setq pt4 (polar pb (* 1.5 pi) (* 1.2 m)))<br /> (entmake (list (cons 0 "LINE") (cons 8 "3中心线") (cons 10 pt1) (cons 11 pt3)))<br /> (entmake (list (cons 0 "LINE") (cons 8 "3中心线") (cons 10 pt2) (cons 11 pt4)))<br /> (command "undo" "e")<br /> (princ)<br /> )<br /> (defun c:3 ()(setq a 3)(zlk))<br /> (defun c:4 ()(setq a 4)(zlk))<br /> (defun c:5 ()(setq a 5)(zlk))<br /> (defun c:6 ()(setq a 6)(zlk))<br /> (defun c:8 ()(setq a 8)(zlk)))<br /> (defun c:10 ()(setq a 10)(zlk))<br /> (defun c:12 ()(setq a 12)(zlk))<br /> (defun c:14 ()(setq a 14)(zlk))<br /> (defun c:16 ()(setq a 16)(zlk))<br /> (defun c:18 ()(setq a 18)(zlk))<br /> (defun c:20 ()(setq a 20)(zlk))<br /> (defun c:22 ()(setq a 22)(zlk))<br /> (defun c:24 ()(setq a 24)(zlk))<br />

669423907

非常感谢Z版帮忙，手机上，明天用上